[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/improved-locked-narrowing aef803d6c3: Merge master into feature/
|
From: |
Gregory Heytings |
|
Subject: |
feature/improved-locked-narrowing aef803d6c3: Merge master into feature/improved-locked-narrowing. |
|
Date: |
Sun, 30 Oct 2022 12:02:16 -0400 (EDT) |
branch: feature/improved-locked-narrowing
commit aef803d6c3d61004f15d0bc82fa7bf9952302312
Merge: 3bf19c417f 3fa4cca3d2
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>
Merge master into feature/improved-locked-narrowing.
---
.clang-format | 2 +-
.dir-locals.el | 10 +-
.gitignore | 4 +-
.mailmap | 197 +
ChangeLog.1 | 2 +-
ChangeLog.3 | 319 +-
GNUmakefile | 2 +-
INSTALL | 2 +-
Makefile.in | 122 +-
admin/admin.el | 201 +-
admin/automerge | 21 +-
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 | 46 +-
admin/gitmerge.el | 31 +-
admin/grammars/Makefile.in | 2 +-
admin/make-manuals | 11 +-
admin/make-tarball.txt | 30 +-
admin/merge-gnulib | 4 +-
admin/notes/repo | 29 +-
admin/notes/unicode | 4 +
admin/notes/www | 4 +-
admin/unidata/BidiBrackets.txt | 6 +-
admin/unidata/BidiMirroring.txt | 8 +-
admin/unidata/Blocks.txt | 21 +-
admin/unidata/IVD_Sequences.txt | 6 +-
admin/unidata/IdnaMappingTable.txt | 169 +-
admin/unidata/Makefile.in | 3 +-
admin/unidata/NormalizationTest.txt | 92 +-
admin/unidata/PropertyValueAliases.txt | 24 +-
admin/unidata/README | 14 +-
admin/unidata/ScriptExtensions.txt | 10 +-
admin/unidata/Scripts.txt | 106 +-
admin/unidata/SpecialCasing.txt | 10 +-
admin/unidata/UnicodeData.txt | 300 +-
admin/unidata/blocks.awk | 2 +-
admin/unidata/confusables.txt | 22 +-
admin/unidata/copyright.html | 24 +-
admin/unidata/emoji-data.txt | 73 +-
admin/unidata/emoji-sequences.txt | 343 +-
admin/unidata/emoji-test.txt | 125 +-
admin/unidata/emoji-zwj-sequences.txt | 13 +-
admin/unidata/unidata-gen.el | 10 +-
admin/update-copyright | 2 +
admin/update_autogen | 20 +-
admin/upload-manuals | 9 +-
build-aux/config.guess | 4 +-
build-aux/config.sub | 4 +-
config.bat | 1 +
configure.ac | 50 +-
doc/emacs/ack.texi | 13 +-
doc/emacs/buffers.texi | 12 +-
doc/emacs/building.texi | 11 +-
doc/emacs/commands.texi | 49 +-
doc/emacs/custom.texi | 32 +-
doc/emacs/dired.texi | 29 +-
doc/emacs/display.texi | 2 +-
doc/emacs/emacs.texi | 36 +-
doc/emacs/files.texi | 13 +-
doc/emacs/frames.texi | 21 +-
doc/emacs/haiku.texi | 2 +-
doc/emacs/help.texi | 14 +-
doc/emacs/killing.texi | 4 +-
doc/emacs/macos.texi | 6 +-
doc/emacs/maintaining.texi | 121 +-
doc/emacs/mark.texi | 43 +-
doc/emacs/mini.texi | 8 +-
doc/emacs/misc.texi | 31 +-
doc/emacs/modes.texi | 9 +-
doc/emacs/mule.texi | 40 +-
doc/emacs/package.texi | 14 +-
doc/emacs/programs.texi | 233 +-
doc/emacs/regs.texi | 3 +-
doc/emacs/text.texi | 24 +-
doc/emacs/vc1-xtra.texi | 51 +
doc/lispintro/emacs-lisp-intro.texi | 5 +-
doc/lispref/backups.texi | 2 +-
doc/lispref/buffers.texi | 10 +-
doc/lispref/commands.texi | 2 +-
doc/lispref/compile.texi | 38 +-
doc/lispref/control.texi | 47 +-
doc/lispref/customize.texi | 24 +-
doc/lispref/display.texi | 81 +-
doc/lispref/edebug.texi | 5 +-
doc/lispref/eval.texi | 7 +-
doc/lispref/files.texi | 38 +-
doc/lispref/frames.texi | 143 +-
doc/lispref/functions.texi | 49 +-
doc/lispref/help.texi | 33 +-
doc/lispref/internals.texi | 4 +-
doc/lispref/keymaps.texi | 4 +
doc/lispref/lists.texi | 8 +-
doc/lispref/loading.texi | 2 +-
doc/lispref/minibuf.texi | 3 +
doc/lispref/modes.texi | 17 +-
doc/lispref/nonascii.texi | 9 +-
doc/lispref/numbers.texi | 48 +-
doc/lispref/os.texi | 3 +
doc/lispref/processes.texi | 2 +-
doc/lispref/searching.texi | 18 +-
doc/lispref/sequences.texi | 57 +-
doc/lispref/strings.texi | 24 +-
doc/lispref/symbols.texi | 13 +-
doc/lispref/text.texi | 21 +-
doc/lispref/variables.texi | 204 +-
doc/lispref/windows.texi | 54 +-
doc/man/emacsclient.1 | 11 +-
doc/misc/Makefile.in | 2 +-
doc/misc/calc.texi | 4 -
doc/misc/cc-mode.texi | 10 +-
doc/misc/cl.texi | 65 +-
doc/misc/ede.texi | 5 +-
doc/misc/ediff.texi | 2 +-
doc/misc/efaq-w32.texi | 8 +-
doc/misc/efaq.texi | 358 +-
doc/misc/eglot.texi | 1139 ++++
doc/misc/eieio.texi | 12 +-
doc/misc/eshell.texi | 275 +-
doc/misc/flymake.texi | 9 +-
doc/misc/gnus-coding.texi | 227 -
doc/misc/gnus-faq.texi | 302 +-
doc/misc/gnus.texi | 37 +-
doc/misc/idlwave.texi | 4 +-
doc/misc/mh-e.texi | 66 +-
doc/misc/modus-themes.org | 240 +-
doc/misc/newsticker.texi | 2 +-
doc/misc/octave-mode.texi | 7 +-
doc/misc/org.org | 32 +-
doc/misc/rcirc.texi | 75 +-
doc/misc/reftex.texi | 12 -
doc/misc/remember.texi | 7 -
doc/misc/sem-user.texi | 2 +-
doc/misc/semantic.texi | 12 +-
doc/misc/sieve.texi | 2 +-
doc/misc/texinfo.tex | 585 +-
doc/misc/tramp.texi | 58 +-
doc/misc/transient.texi | 2 +-
doc/misc/url.texi | 38 +-
doc/misc/vhdl-mode.texi | 2 +-
doc/misc/viper.texi | 8 +-
etc/AUTHORS | 23 +-
etc/DEBUG | 10 +-
etc/ERC-NEWS | 20 +-
etc/HELLO | 8 +-
etc/HISTORY | 2 +
etc/NEWS | 1057 ++-
etc/NEWS.21 | 2 +-
etc/NEWS.22 | 5 +-
etc/NEWS.23 | 2 +
etc/NEWS.25 | 2 +-
etc/NEWS.26 | 2 +-
etc/NEWS.28 | 94 +-
etc/PROBLEMS | 18 +
etc/TODO | 55 +-
etc/images/checked.xpm | 19 -
etc/images/gnus/gnus-pointer.xpm | 6 +-
etc/images/gnus/gnus.xpm | 4 +-
etc/images/gud/README | 4 +-
etc/images/mh-logo.xpm | 28 +-
etc/images/outline-close.pbm | Bin 0 -> 39 bytes
etc/images/outline-close.svg | 6 +
etc/images/outline-open.pbm | Bin 0 -> 39 bytes
etc/images/outline-open.svg | 4 +
etc/images/unchecked.xpm | 19 -
etc/publicsuffix.txt | 127 +-
etc/refcards/orgcard.tex | 2 +-
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 | 5 +-
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 | 244 +-
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 +-
etc/tutorials/TUTORIAL.translators | 4 +
etc/tutorials/TUTORIAL.uk | 1150 ++++
leim/Makefile.in | 2 -
lib-src/Makefile.in | 8 +-
lib-src/emacsclient.c | 87 +-
lib-src/rcs2log | 2 +-
lib-src/seccomp-filter.c | 43 +-
lib/acl-internal.h | 1 -
lib/acl.h | 1 -
lib/assert.in.h | 27 +
lib/c-ctype.h | 2 -
lib/canonicalize-lgpl.c | 1 -
lib/cloexec.h | 2 -
lib/close-stream.c | 1 -
lib/count-leading-zeros.h | 20 +-
lib/count-trailing-zeros.h | 16 +-
lib/diffseq.h | 1 -
lib/filevercmp.c | 4 +-
lib/fsusage.h | 1 -
lib/getloadavg.c | 1 -
lib/getrandom.c | 1 -
lib/gnulib.mk.in | 39 +-
lib/malloc/dynarray.h | 1 -
lib/md5.c | 1 -
lib/mini-gmp.c | 5 +-
lib/nanosleep.c | 4 +-
lib/nstrftime.c | 1 -
lib/openat.h | 1 -
lib/pipe2.c | 3 +-
lib/rawmemchr.c | 4 +-
lib/regex_internal.h | 1 -
lib/sha1.c | 1 -
lib/sha256.c | 1 -
lib/sha512.c | 1 -
lib/signal.in.h | 14 +-
lib/stdalign.in.h | 24 +-
lib/stdckdint.in.h | 2 -
lib/stdlib.in.h | 6 +-
lib/string.in.h | 2 +
lib/strtoimax.c | 6 +-
lib/sys_random.in.h | 2 +
lib/sys_select.in.h | 9 +-
lib/sys_stat.in.h | 76 +-
lib/tempname.c | 183 +-
lib/time.in.h | 4 +
lib/time_rz.c | 1 -
lib/unistd.in.h | 4 +-
lib/utimens.c | 1 -
lib/verify.h | 39 +-
lisp/ChangeLog.10 | 2 +-
lisp/ChangeLog.14 | 4 +-
lisp/ChangeLog.15 | 2 +-
lisp/ChangeLog.17 | 2 +-
lisp/Makefile.in | 36 +-
lisp/abbrev.el | 20 +-
lisp/allout-widgets.el | 6 +-
lisp/allout.el | 8 -
lisp/ansi-color.el | 2 +-
lisp/ansi-osc.el | 201 +
lisp/arc-mode.el | 2 -
lisp/auth-source-pass.el | 10 +
lisp/auth-source.el | 15 +
lisp/autoinsert.el | 45 +-
lisp/autorevert.el | 7 +-
lisp/battery.el | 16 +-
lisp/bindings.el | 8 +
lisp/bookmark.el | 21 +-
lisp/buff-menu.el | 18 -
lisp/calc/calc-embed.el | 5 +-
lisp/calc/calc-prog.el | 3 +-
lisp/calc/calc-stuff.el | 8 +-
lisp/calc/calc-yank.el | 12 +-
lisp/calc/calc.el | 11 +-
lisp/calendar/cal-move.el | 5 +-
lisp/calendar/timeclock.el | 9 -
lisp/cedet/ede/autoconf-edit.el | 3 +-
lisp/cedet/ede/locate.el | 4 +-
lisp/cedet/pulse.el | 10 +-
lisp/cedet/semantic/db-el.el | 3 -
lisp/cedet/semantic/db-file.el | 2 -
lisp/cedet/semantic/ede-grammar.el | 7 +-
lisp/cedet/semantic/edit.el | 16 +-
lisp/cedet/semantic/fw.el | 2 +-
lisp/cedet/semantic/grammar.el | 8 +-
lisp/cedet/semantic/lex.el | 2 -
lisp/cedet/semantic/mru-bookmark.el | 8 +-
lisp/cedet/semantic/util-modes.el | 36 +-
lisp/cedet/semantic/wisent.el | 2 +-
lisp/cedet/srecode/fields.el | 4 +-
lisp/cedet/srecode/insert.el | 4 +-
lisp/cedet/srecode/srt-mode.el | 16 +-
lisp/char-fold.el | 78 +-
lisp/comint.el | 418 +-
lisp/cus-dep.el | 2 +-
lisp/cus-edit.el | 9 +-
lisp/cus-start.el | 1 -
lisp/cus-theme.el | 4 +-
lisp/custom.el | 82 +-
lisp/dabbrev.el | 3 -
lisp/dired-aux.el | 17 +-
lisp/dired.el | 79 +-
lisp/disp-table.el | 72 +
lisp/dnd.el | 16 +-
lisp/doc-view.el | 128 +-
lisp/dom.el | 68 +-
lisp/ebuff-menu.el | 3 -
lisp/ecomplete.el | 161 +-
lisp/elide-head.el | 4 +-
lisp/emacs-lisp/backtrace.el | 3 +-
lisp/emacs-lisp/benchmark.el | 3 +-
lisp/emacs-lisp/bindat.el | 6 +-
lisp/emacs-lisp/byte-opt.el | 36 +-
lisp/emacs-lisp/byte-run.el | 48 +-
lisp/emacs-lisp/bytecomp.el | 84 +-
lisp/emacs-lisp/cconv.el | 201 +-
lisp/emacs-lisp/checkdoc.el | 10 +-
lisp/emacs-lisp/cl-extra.el | 14 +-
lisp/emacs-lisp/cl-generic.el | 38 +-
lisp/emacs-lisp/cl-lib.el | 6 -
lisp/emacs-lisp/cl-macs.el | 300 +-
lisp/emacs-lisp/comp-cstr.el | 2 +-
lisp/emacs-lisp/comp.el | 260 +-
lisp/emacs-lisp/crm.el | 2 +-
lisp/emacs-lisp/debug.el | 8 +-
lisp/emacs-lisp/easy-mmode.el | 12 +-
lisp/emacs-lisp/edebug.el | 25 +-
lisp/emacs-lisp/eieio-core.el | 18 +-
lisp/emacs-lisp/eieio-opt.el | 2 +-
lisp/emacs-lisp/eieio.el | 20 +-
lisp/emacs-lisp/eldoc.el | 127 +-
lisp/emacs-lisp/ert-x.el | 57 +-
lisp/emacs-lisp/generate-lisp-file.el | 14 +-
lisp/emacs-lisp/gv.el | 28 +-
lisp/emacs-lisp/hierarchy.el | 85 +-
lisp/emacs-lisp/icons.el | 21 +-
lisp/emacs-lisp/lisp-mode.el | 27 +-
lisp/emacs-lisp/loaddefs-gen.el | 30 +-
lisp/emacs-lisp/macroexp.el | 3 +-
lisp/emacs-lisp/map.el | 164 +-
lisp/emacs-lisp/memory-report.el | 7 +-
lisp/emacs-lisp/nadvice.el | 47 +-
lisp/emacs-lisp/oclosure.el | 15 +
lisp/emacs-lisp/package.el | 114 +-
lisp/emacs-lisp/re-builder.el | 34 +-
lisp/emacs-lisp/regexp-opt.el | 1 -
lisp/emacs-lisp/seq.el | 69 +-
lisp/emacs-lisp/shortdoc.el | 67 +-
lisp/emacs-lisp/subr-x.el | 1 +
lisp/emacs-lisp/tabulated-list.el | 2 +-
lisp/emacs-lisp/testcover.el | 3 +-
lisp/emacs-lisp/vtable.el | 17 +-
lisp/emulation/viper-macs.el | 5 +-
lisp/epa-hook.el | 8 +
lisp/epa-ks.el | 18 +-
lisp/epa.el | 48 +-
lisp/epg.el | 8 +-
lisp/erc/ChangeLog.1 | 4 +-
lisp/erc/erc-button.el | 1 -
lisp/erc/erc-capab.el | 2 +-
lisp/erc/erc-dcc.el | 3 -
lisp/erc/erc-match.el | 55 +-
lisp/erc/erc-networks.el | 6 +-
lisp/erc/erc.el | 19 +-
lisp/eshell/em-cmpl.el | 29 +-
lisp/eshell/em-glob.el | 2 +-
lisp/eshell/em-script.el | 3 +-
lisp/eshell/em-smart.el | 3 +-
lisp/eshell/em-term.el | 2 +-
lisp/eshell/em-unix.el | 6 +-
lisp/eshell/esh-arg.el | 30 +-
lisp/eshell/esh-cmd.el | 25 +-
lisp/eshell/esh-ext.el | 23 +-
lisp/eshell/esh-io.el | 228 +-
lisp/eshell/esh-mode.el | 6 -
lisp/eshell/esh-proc.el | 187 +-
lisp/eshell/esh-util.el | 57 +-
lisp/eshell/esh-var.el | 198 +-
lisp/eshell/eshell.el | 11 -
lisp/faces.el | 51 +-
lisp/ffap.el | 12 +-
lisp/filenotify.el | 1 +
lisp/files-x.el | 118 +-
lisp/files.el | 207 +-
lisp/filesets.el | 2 -
lisp/find-file.el | 36 +-
lisp/find-lisp.el | 77 +-
lisp/follow.el | 2 +-
lisp/font-lock.el | 20 +-
lisp/format-spec.el | 17 +-
lisp/format.el | 7 +-
lisp/forms.el | 6 +-
lisp/frame.el | 38 +-
lisp/generic-x.el | 7 -
lisp/gnus/gnus-art.el | 223 +-
lisp/gnus/gnus-bookmark.el | 2 +-
lisp/gnus/gnus-cite.el | 22 +-
lisp/gnus/gnus-cloud.el | 1 +
lisp/gnus/gnus-cus.el | 9 +-
lisp/gnus/gnus-gravatar.el | 1 -
lisp/gnus/gnus-group.el | 74 +-
lisp/gnus/gnus-rfc1843.el | 3 +-
lisp/gnus/gnus-search.el | 8 +-
lisp/gnus/gnus-srvr.el | 7 +-
lisp/gnus/gnus-start.el | 4 +-
lisp/gnus/gnus-sum.el | 4 +-
lisp/gnus/gnus-util.el | 5 +-
lisp/gnus/gnus.el | 30 +-
lisp/gnus/message.el | 80 +-
lisp/gnus/mm-bodies.el | 20 +-
lisp/gnus/mm-decode.el | 3 +-
lisp/gnus/mm-uu.el | 2 +-
lisp/gnus/nndiary.el | 6 -
lisp/gnus/nndoc.el | 2 +-
lisp/gnus/score-mode.el | 12 +-
lisp/gnus/smime.el | 12 +-
lisp/help-fns.el | 109 +-
lisp/help-macro.el | 12 +-
lisp/help.el | 288 +-
lisp/hexl.el | 2 +-
lisp/hilit-chg.el | 1 -
lisp/hl-line.el | 7 +
lisp/htmlfontify.el | 25 +-
lisp/icomplete.el | 69 +-
lisp/ido.el | 16 +-
lisp/ielm.el | 36 +
lisp/image-dired.el | 3080 ---------
lisp/image-file.el | 7 +-
lisp/image-mode.el | 67 +-
lisp/image.el | 68 +-
lisp/image/exif.el | 14 +-
lisp/image/image-crop.el | 452 ++
lisp/image/image-dired-dired.el | 412 ++
lisp/image/image-dired-external.el | 473 ++
lisp/image/image-dired-tags.el | 385 ++
lisp/image/image-dired-util.el | 186 +
lisp/image/image-dired.el | 2013 ++++++
lisp/image/wallpaper.el | 586 ++
lisp/imenu.el | 18 +-
lisp/indent.el | 14 +-
lisp/info-look.el | 4 +-
lisp/info.el | 23 +-
lisp/international/characters.el | 81 +-
lisp/international/fontset.el | 41 +-
lisp/international/latin1-disp.el | 5 +-
lisp/international/mule-cmds.el | 148 +-
lisp/international/mule-diag.el | 2 +-
lisp/international/mule.el | 17 +-
lisp/international/quail.el | 6 -
lisp/international/rfc1843.el | 5 +-
lisp/international/robin.el | 6 -
lisp/international/textsec-check.el | 2 +-
lisp/international/textsec.el | 2 +-
lisp/international/titdic-cnv.el | 10 +-
lisp/isearch.el | 58 +-
lisp/jit-lock.el | 39 +-
lisp/language/cyrillic.el | 14 +-
lisp/language/ethio-util.el | 43 +-
lisp/language/indian.el | 30 +-
lisp/language/indonesian.el | 21 +-
lisp/language/lao.el | 6 +-
lisp/language/misc-lang.el | 74 +-
lisp/language/philippine.el | 12 +-
lisp/ldefs-boot.el | 881 ++-
lisp/leim/quail/hangul.el | 4 -
lisp/leim/quail/indian.el | 275 +
lisp/leim/quail/misc-lang.el | 495 ++
lisp/leim/quail/slovak.el | 125 +-
lisp/leim/quail/uni-input.el | 4 -
lisp/loadhist.el | 7 +
lisp/loadup.el | 14 +-
lisp/mail/emacsbug.el | 11 +-
lisp/mail/feedmail.el | 25 +-
lisp/mail/hashcash.el | 25 +-
lisp/mail/rmail.el | 38 +-
lisp/mail/rmailsum.el | 96 +-
lisp/mail/sendmail.el | 8 +-
lisp/mail/smtpmail.el | 2 +-
lisp/man.el | 8 +-
lisp/menu-bar.el | 10 +-
lisp/mh-e/mh-e.el | 6 +-
lisp/mh-e/mh-folder.el | 2 +-
lisp/mh-e/mh-funcs.el | 2 +-
lisp/mh-e/mh-junk.el | 4 +-
lisp/mh-e/mh-utils.el | 10 +-
lisp/minibuf-eldef.el | 5 +-
lisp/minibuffer.el | 27 +-
lisp/mpc.el | 2 -
lisp/net/browse-url.el | 5 +
lisp/net/dictionary.el | 7 +-
lisp/net/eudc.el | 61 +-
lisp/net/eww.el | 55 +-
lisp/net/goto-addr.el | 89 +-
lisp/net/ldap.el | 21 +-
lisp/net/mailcap.el | 69 +-
lisp/net/newst-backend.el | 1 -
lisp/net/pop3.el | 2 +
lisp/net/rcirc.el | 1497 +++--
lisp/net/shr.el | 78 +-
lisp/net/sieve-manage.el | 127 +-
lisp/net/sieve-mode.el | 8 +-
lisp/net/sieve.el | 3 +-
lisp/net/tramp-adb.el | 179 +-
lisp/net/tramp-archive.el | 37 +-
lisp/net/tramp-cache.el | 201 +-
lisp/net/tramp-cmds.el | 63 +-
lisp/net/tramp-compat.el | 52 +
lisp/net/tramp-container.el | 211 +
lisp/net/tramp-crypt.el | 18 +-
lisp/net/tramp-ftp.el | 4 +-
lisp/net/tramp-fuse.el | 15 +-
lisp/net/tramp-gvfs.el | 169 +-
lisp/net/tramp-integration.el | 42 +-
lisp/net/tramp-rclone.el | 12 +-
lisp/net/tramp-sh.el | 617 +-
lisp/net/tramp-smb.el | 347 +-
lisp/net/tramp-sshfs.el | 6 +-
lisp/net/tramp-sudoedit.el | 230 +-
lisp/net/tramp-uu.el | 2 +-
lisp/net/tramp.el | 909 +--
lisp/nxml/nxml-mode.el | 6 +-
lisp/nxml/nxml-util.el | 6 -
lisp/nxml/rng-nxml.el | 77 +-
lisp/nxml/rng-uri.el | 8 +-
lisp/nxml/rng-valid.el | 37 +-
lisp/obsolete/crisp.el | 3 -
lisp/{ => obsolete}/linum.el | 26 +-
lisp/{ => obsolete}/thumbs.el | 23 +-
lisp/obsolete/url-about.el | 2 +-
lisp/obsolete/vc-arch.el | 2 +-
lisp/obsolete/vc-mtn.el | 2 +-
lisp/org/ob-matlab.el | 2 +-
lisp/org/ob-plantuml.el | 2 +-
lisp/org/org-agenda.el | 2 +-
lisp/org/org-ctags.el | 2 +-
lisp/org/org-macro.el | 2 +-
lisp/org/org-protocol.el | 2 +-
lisp/org/org-version.el | 4 +-
lisp/org/org.el | 14 +-
lisp/org/ox-ascii.el | 2 +-
lisp/org/ox.el | 2 +-
lisp/outline.el | 471 +-
lisp/paren.el | 19 +-
lisp/pcmpl-git.el | 110 +
lisp/pcmpl-gnu.el | 36 +-
lisp/pcmpl-linux.el | 68 +
lisp/pcmpl-rpm.el | 43 +-
lisp/pcmpl-unix.el | 490 +-
lisp/pcmpl-x.el | 43 +
lisp/pcomplete.el | 168 +-
lisp/pixel-scroll.el | 117 +-
lisp/play/gamegrid.el | 8 +-
lisp/play/hanoi.el | 5 +-
lisp/play/zone.el | 50 +-
lisp/printing.el | 30 +-
lisp/proced.el | 159 +-
lisp/progmodes/antlr-mode.el | 18 +-
lisp/progmodes/cc-align.el | 13 +-
lisp/progmodes/cc-awk.el | 25 +-
lisp/progmodes/cc-defs.el | 48 +-
lisp/progmodes/cc-engine.el | 740 ++-
lisp/progmodes/cc-fonts.el | 593 +-
lisp/progmodes/cc-langs.el | 347 +-
lisp/progmodes/cc-mode.el | 141 +-
lisp/progmodes/compile.el | 15 +-
lisp/progmodes/cperl-mode.el | 59 +-
lisp/progmodes/eglot.el | 3469 ++++++++++
lisp/progmodes/elisp-mode.el | 14 +-
lisp/progmodes/etags.el | 28 +-
lisp/progmodes/flymake.el | 7 +-
lisp/progmodes/fortran.el | 59 +-
lisp/progmodes/gdb-mi.el | 30 +-
lisp/progmodes/glasses.el | 16 +-
lisp/progmodes/grep.el | 26 +-
lisp/progmodes/gud.el | 232 +-
lisp/progmodes/hideif.el | 8 +-
lisp/progmodes/hideshow.el | 146 +-
lisp/progmodes/make-mode.el | 319 +-
lisp/progmodes/modula2.el | 63 +-
lisp/progmodes/octave.el | 4 +-
lisp/progmodes/opascal.el | 3 +-
lisp/progmodes/perl-mode.el | 16 +-
lisp/progmodes/prog-mode.el | 8 +-
lisp/progmodes/project.el | 26 +-
lisp/progmodes/prolog.el | 2 +-
lisp/progmodes/ps-mode.el | 50 +-
lisp/progmodes/python.el | 564 +-
lisp/progmodes/ruby-mode.el | 4 +-
lisp/progmodes/sh-script.el | 98 +-
lisp/progmodes/subword.el | 5 +-
lisp/progmodes/verilog-mode.el | 17 +-
lisp/progmodes/vhdl-mode.el | 7 +-
lisp/progmodes/xref.el | 42 +-
lisp/recentf.el | 3 +-
lisp/repeat.el | 72 +-
lisp/replace.el | 235 +-
lisp/reveal.el | 12 +-
lisp/server.el | 60 +-
lisp/shell.el | 281 +
lisp/simple.el | 298 +-
lisp/speedbar.el | 7 +-
lisp/startup.el | 18 +-
lisp/strokes.el | 11 +-
lisp/subr.el | 322 +-
lisp/t-mouse.el | 7 +-
lisp/tab-bar.el | 124 +-
lisp/tab-line.el | 71 +-
lisp/tar-mode.el | 2 +-
lisp/term.el | 19 +-
lisp/term/fbterm.el | 27 +
lisp/term/haiku-win.el | 39 +
lisp/term/linux.el | 10 +-
lisp/term/pgtk-win.el | 1 +
lisp/term/x-win.el | 93 +-
lisp/textmodes/artist.el | 2 -
lisp/textmodes/bibtex.el | 132 +-
lisp/textmodes/emacs-authors-mode.el | 15 +-
lisp/textmodes/emacs-news-mode.el | 19 +-
lisp/textmodes/enriched.el | 3 +-
lisp/textmodes/flyspell.el | 61 +-
lisp/textmodes/ispell.el | 13 +-
lisp/textmodes/less-css-mode.el | 8 +-
lisp/textmodes/page-ext.el | 92 +-
lisp/textmodes/paragraphs.el | 6 +-
lisp/textmodes/picture.el | 174 +-
lisp/textmodes/reftex-global.el | 37 +-
lisp/textmodes/remember.el | 20 +-
lisp/textmodes/rst.el | 13 -
lisp/textmodes/sgml-mode.el | 4 +-
lisp/textmodes/string-edit.el | 12 +-
lisp/textmodes/table.el | 24 +-
lisp/textmodes/tex-mode.el | 79 +-
lisp/time.el | 10 +-
lisp/transient.el | 209 +-
lisp/url/url-file.el | 1 -
lisp/url/url-gw.el | 15 +-
lisp/url/url-handlers.el | 19 +-
lisp/url/url-misc.el | 8 +-
lisp/url/url-parse.el | 11 -
lisp/url/url-util.el | 37 +-
lisp/url/url-vars.el | 2 -
lisp/url/url.el | 6 +-
lisp/vc/add-log.el | 4 +-
lisp/vc/diff-mode.el | 47 +-
lisp/vc/ediff-wind.el | 8 -
lisp/vc/log-edit.el | 20 +-
lisp/vc/log-view.el | 1 +
lisp/vc/pcvs-util.el | 2 -
lisp/vc/vc-bzr.el | 16 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-dir.el | 12 +-
lisp/vc/vc-dispatcher.el | 276 +-
lisp/vc/vc-git.el | 281 +-
lisp/vc/vc-hg.el | 50 +-
lisp/vc/vc-hooks.el | 9 +-
lisp/vc/vc-svn.el | 2 +-
lisp/vc/vc.el | 394 +-
lisp/view.el | 11 +-
lisp/wdired.el | 51 +-
lisp/whitespace.el | 571 +-
lisp/wid-browse.el | 18 +-
lisp/wid-edit.el | 17 +-
lisp/window.el | 160 +-
lisp/winner.el | 17 +-
lisp/x-dnd.el | 15 +-
lisp/xdg.el | 25 +
lisp/xwidget.el | 2 +-
lwlib/lwlib-Xaw.c | 2 +
m4/assert_h.m4 | 61 +
m4/c-bool.m4 | 51 +
m4/gettime.m4 | 31 +-
m4/gnulib-common.m4 | 7 +-
m4/gnulib-comp.m4 | 11 +-
m4/nanosleep.m4 | 17 +-
m4/stdalign.m4 | 104 +-
m4/time_h.m4 | 8 +-
msdos/sed2v2.inp | 1 +
msdos/sedlibmk.inp | 19 +-
nextstep/Makefile.in | 2 +-
nt/INSTALL | 24 +-
nt/INSTALL.W64 | 2 +-
nt/Makefile.in | 4 +-
oldXMenu/Activate.c | 10 -
oldXMenu/XMenu.h | 2 -
src/ChangeLog.13 | 4 +-
src/Makefile.in | 39 +-
src/alloc.c | 62 +-
src/buffer.c | 1505 ++---
src/buffer.h | 114 +-
src/bytecode.c | 4 +-
src/callproc.c | 31 +-
src/character.c | 12 +-
src/coding.c | 6 +-
src/comp.c | 107 +-
src/composite.c | 50 +-
src/composite.h | 1 +
src/conf_post.h | 6 +-
src/data.c | 1 +
src/dbusbind.c | 4 +-
src/dired.c | 5 +-
src/dispextern.h | 23 +-
src/dispnew.c | 30 +-
src/doc.c | 17 +-
src/dynlib.h | 1 -
src/editfns.c | 78 +-
src/emacs-module.c | 1 -
src/emacs-module.h.in | 3 +-
src/emacs.c | 23 +-
src/eval.c | 107 +-
src/fileio.c | 27 +-
src/fns.c | 330 +-
src/font.c | 792 +--
src/font.h | 2 +-
src/fontset.c | 3 +-
src/frame.c | 30 +-
src/ftcrfont.c | 32 +-
src/haiku_font_support.cc | 282 +-
src/haiku_io.c | 2 +
src/haiku_support.cc | 53 +
src/haiku_support.h | 34 +-
src/haikufns.c | 6 +-
src/haikufont.c | 109 +-
src/haikuselect.c | 129 +
src/haikuterm.c | 63 +-
src/haikuterm.h | 11 +
src/hbfont.c | 2 +-
src/image.c | 54 +-
src/indent.c | 28 +-
src/insdel.c | 12 -
src/intervals.c | 8 +-
src/itree.c | 1432 ++++
src/itree.h | 182 +
src/keyboard.c | 101 +-
src/lisp.h | 38 +-
src/lread.c | 75 +-
src/macuvs.h | 1762 ++---
src/marker.c | 18 -
src/menu.c | 16 +-
src/minibuf.c | 12 +-
src/msdos.c | 1 -
src/msdos.h | 1 -
src/nsfont.m | 244 +-
src/nsmenu.m | 5 +-
src/nsterm.m | 86 +-
src/pdumper.c | 70 +-
src/pgtkfns.c | 2 -
src/pgtkterm.c | 2 +
src/print.c | 14 +-
src/process.c | 38 +-
src/regex-emacs.c | 14 +-
src/sqlite.c | 219 +-
src/sysdep.c | 7 +-
src/systhread.h | 2 -
src/term.c | 62 +-
src/termchar.h | 5 +
src/textprop.c | 67 +-
src/w32.c | 25 +-
src/w32.h | 2 +
src/w32fns.c | 71 +-
src/w32image.c | 2 +-
src/w32notify.c | 12 +-
src/w32term.c | 2 +
src/widget.c | 34 +-
src/widget.h | 2 +-
src/widgetprv.h | 1 -
src/window.c | 119 +-
src/window.h | 10 +
src/xdisp.c | 345 +-
src/xfaces.c | 65 +-
src/xfns.c | 310 +-
src/xfont.c | 34 +-
src/xmenu.c | 151 +-
src/xrdb.c | 104 -
src/xselect.c | 78 +-
src/xsettings.c | 45 +-
src/xsmfns.c | 4 +-
src/xterm.c | 2178 +++++--
src/xterm.h | 127 +-
test/lisp/ansi-color-tests.el | 4 +-
test/lisp/ansi-osc-tests.el | 57 +
test/lisp/apropos-tests.el | 17 +-
test/lisp/autorevert-tests.el | 2 +-
test/lisp/calendar/icalendar-tests.el | 2 +-
test/lisp/cedet/semantic-utest.el | 1 -
test/lisp/char-fold-tests.el | 2 +-
test/lisp/dired-tests.el | 4 +-
test/lisp/dnd-tests.el | 12 +-
test/lisp/electric-tests.el | 2 +-
test/lisp/elide-head-tests.el | 21 +-
test/lisp/emacs-lisp/bindat-tests.el | 19 +-
.../warn-variable-set-nonvariable.el | 3 -
...arn-wide-docstring-ignore-function-signature.el | 4 +
test/lisp/emacs-lisp/bytecomp-tests.el | 21 +-
test/lisp/emacs-lisp/cconv-tests.el | 17 +
test/lisp/emacs-lisp/cl-extra-tests.el | 26 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 22 +
test/lisp/emacs-lisp/cl-macs-tests.el | 78 +-
test/lisp/emacs-lisp/comp-tests.el | 77 +
test/lisp/emacs-lisp/edebug-tests.el | 3 +-
test/lisp/emacs-lisp/ert-x-tests.el | 15 +
test/lisp/emacs-lisp/gv-tests.el | 75 +-
test/lisp/emacs-lisp/hierarchy-tests.el | 143 +
test/lisp/emacs-lisp/map-tests.el | 204 +-
test/lisp/emacs-lisp/package-resources/key.pub | 25 +-
test/lisp/emacs-lisp/package-resources/key.sec | 27 +-
.../package-resources/signed/archive-contents.sig | Bin 95 -> 119 bytes
.../signed/signed-good-1.0.el.sig | Bin 95 -> 119 bytes
.../package-resources/signed/update-signatures.sh | 7 +-
.../package-resources/ustar-withsub-0.1.tar | Bin 0 -> 10240 bytes
.../package-resources/v7-withsub-0.1.tar | Bin 0 -> 10240 bytes
test/lisp/emacs-lisp/package-tests.el | 24 +-
test/lisp/emacs-lisp/seq-tests.el | 21 +
test/lisp/epg-resources/pubkey.asc | 28 +-
test/lisp/epg-resources/seckey.asc | 43 +-
test/lisp/epg-tests.el | 19 +-
test/lisp/erc/erc-match-tests.el | 193 +
test/lisp/erc/erc-scenarios-base-reconnect.el | 45 +-
test/lisp/erc/erc-scenarios-base-reuse-buffers.el | 35 +-
test/lisp/erc/erc-tests.el | 2 +-
.../erc/resources/base/assoc/samenet/chester.eld | 2 +-
.../erc/resources/base/assoc/samenet/tester.eld | 2 +-
.../erc/resources/base/assoc/samenet/tester2.eld | 2 +-
.../erc/resources/base/netid/samenet/chester.eld | 2 +-
.../erc/resources/base/netid/samenet/tester.eld | 2 +-
test/lisp/erc/resources/erc-d/erc-d-tests.el | 6 +-
test/lisp/eshell/esh-cmd-tests.el | 19 +
test/lisp/eshell/esh-ext-tests.el | 76 +
test/lisp/eshell/esh-io-tests.el | 292 +
test/lisp/eshell/esh-proc-tests.el | 155 +-
test/lisp/eshell/esh-var-tests.el | 232 +-
test/lisp/eshell/eshell-tests-helpers.el | 55 +-
test/lisp/eshell/eshell-tests.el | 19 -
test/lisp/filenotify-tests.el | 143 +-
test/lisp/files-tests.el | 57 +-
test/lisp/files-x-tests.el | 152 +-
test/lisp/format-spec-tests.el | 11 +
.../0062E2DBC6D6848AE88BCE181CC1938F2FAC816C.key | 5 +
.../02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key | Bin 797 -> 0 bytes
.../052E3324B4811A197A1DE922671AA6ABE475025E.key | 5 +
.../066DBED74BA05B5AA1E2A6E4634EF6F62C0D7A5F.key | 5 +
.../0B0D8E451BFADF816524AF5E185EBF3DED48CA00.key | 5 +
.../171B444DE92BEF997229000D9784118A94EEC1C9.key | Bin 526 -> 0 bytes
.../1967CB6C7B1C00996FCFF5930C3467D3D4FB702C.key | 5 +
.../19FFEBC04DF3E037E16F6A4474DCB7984406975D.key | Bin 841 -> 0 bytes
.../1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key | Bin 797 -> 0 bytes
.../293109315BE584AB2EFEFCFCAD64666221D8B36C.key | Bin 526 -> 0 bytes
.../2C9A99AF2FB073D3328B0F995BD6DE74616A6CC2.key | 5 +
.../3250B5BE67E704F82BC9AAE00EC8A0CAC8C2A94F.key | 5 +
.../335689599E1C0F66D73ADCF51E03EE36C97D121F.key | Bin 797 -> 0 bytes
.../40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key | Bin 797 -> 0 bytes
.../515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key | Bin 798 -> 0 bytes
.../5294CDB62DB28FBB486DE077DAF248FB32BE286A.key | 5 +
.../5A11B1935C46D0B227A73978DCA1293A85604F1D.key | Bin 798 -> 0 bytes
.../5B2B6633E89C0BD58A0FA2C785A31EAA96278695.key | 5 +
.../61F5836DA69D9F63059D2665451F18E4346DF43A.key | 5 +
.../62643CEBC7AEBE6817577A34399483700D76BD64.key | Bin 526 -> 0 bytes
.../64CA92780975EEB798D2083FF25AFD43A4033DB7.key | 5 +
.../6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key | Bin 798 -> 0 bytes
.../78C17E134E86E691297F7B719B2F2CDF41976234.key | Bin 527 -> 0 bytes
.../7A788436224049A2FE1E446E16B70DB012C830BB.key | 5 +
.../7F714F4D9D9676638214991E96D45704E4FFC409.key | Bin 798 -> 0 bytes
.../854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key | Bin 526 -> 0 bytes
.../8865328E25351B0D7697D4156A13497174F999D5.key | 5 +
.../9504643B1FB8AAC7529134D1565DF8B4ECA01E35.key | 5 +
.../A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key | Bin 797 -> 0 bytes
.../A6BC0634D18962998AB53A0134DD2AD0DC4E0782.key | 5 +
.../AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key | Bin 841 -> 0 bytes
.../BCFF2771AD5F49BEC185CDED47EC47D15550CB93.key | 5 +
.../C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key | Bin 841 -> 0 bytes
.../C36C6A8B40A2179CFE83CB0C2827358AB171CDFD.key | 5 +
.../C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key | Bin 527 -> 0 bytes
.../CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key | Bin 797 -> 0 bytes
.../CC68630A06B048F5A91136C162C7A3273E20DE6F.key | Bin 710 -> 0 bytes
.../CF723A68027A82B538F04BF4A2A1323D1B3E095C.key | 5 +
.../D6A2C195DEBA3506F0ECFBE3DDD7C57F6913DC7C.key | 5 +
.../DB8C922A471E08FAF083EC2465AFB4063904C282.key | 5 +
.../E0C3163E69C57319C6038F9EBE14F5D55DE553F7.key | 5 +
.../E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key | Bin 797 -> 0 bytes
.../ECB164A45A1D5C5078508A9869DF6DB84DEA543B.key | 5 +
.../F0117468BE801ED4B81972E159A98FDD4814DCEC.key | Bin 797 -> 0 bytes
.../F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key | Bin 841 -> 0 bytes
.../F4E86D61A71E9CE6B0DBC65C5121846E542913B9.key | 5 +
.../FE38C61A8DB32297C7C3C18E7A837D7B70263BC7.key | 5 +
test/lisp/gnus/mml-sec-resources/pubring.gpg | Bin 13883 -> 11564 bytes
test/lisp/gnus/mml-sec-resources/secring.gpg | Bin 17362 -> 9315 bytes
test/lisp/gnus/mml-sec-resources/trustdb.gpg | Bin 1880 -> 1680 bytes
test/lisp/gnus/mml-sec-tests.el | 86 +-
test/lisp/help-tests.el | 58 +-
test/lisp/{ => image}/image-dired-tests.el | 0
test/lisp/image/image-dired-util-tests.el | 71 +
test/lisp/image/wallpaper-tests.el | 184 +
test/lisp/international/textsec-tests.el | 2 +-
test/lisp/international/ucs-normalize-tests.el | 89 +-
test/lisp/md4-tests.el | 2 +-
test/lisp/net/eudc-tests.el | 155 +
test/lisp/net/hmac-md5-tests.el | 2 +-
test/lisp/net/mailcap-tests.el | 405 ++
test/lisp/net/puny-resources/IdnaTestV2.txt | 4 +-
test/lisp/net/tramp-archive-tests.el | 55 +-
test/lisp/net/tramp-tests.el | 339 +-
test/lisp/{ => obsolete}/thumbs-tests.el | 0
test/lisp/pcomplete-tests.el | 100 +
.../cperl-mode-resources/cperl-bug-11996.pl | 8 +
.../cperl-mode-resources/cperl-indents.erts | 26 +
.../progmodes/cperl-mode-resources/here-docs.pl | 66 +
test/lisp/progmodes/cperl-mode-tests.el | 45 +
test/lisp/progmodes/elisp-mode-tests.el | 10 +
test/lisp/progmodes/hideshow-tests.el | 374 ++
test/lisp/progmodes/python-tests.el | 490 +-
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 4 +-
test/lisp/so-long-tests/so-long-tests-helpers.el | 12 +-
test/lisp/sort-tests.el | 2 +-
test/lisp/subr-tests.el | 47 +-
test/lisp/tabify-tests.el | 4 +-
test/lisp/textmodes/reftex-tests.el | 173 +
test/lisp/time-stamp-tests.el | 8 +-
test/lisp/whitespace-tests.el | 247 +
test/lisp/xdg-tests.el | 10 +
test/lisp/xt-mouse-tests.el | 50 +-
test/manual/BidiCharacterTest.txt | 12 +-
test/manual/image-circular-tests.el | 41 +-
test/{src => manual}/image-tests.el | 127 +-
test/manual/noverlay/.gitignore | 1 +
test/manual/noverlay/Makefile.in | 32 +
test/manual/noverlay/check-sanitize.sh | 11 +
test/manual/noverlay/emacs-compat.h | 52 +
test/manual/noverlay/itree-tests.c | 1381 ++++
test/manual/noverlay/many-errors.py | 2480 +++++++
test/manual/noverlay/overlay-perf.el | 764 +++
test/src/buffer-tests.el | 6858 ++++++++++++++++++++
test/src/casefiddle-tests.el | 6 +-
test/src/comp-tests.el | 159 +-
test/src/data-tests.el | 3 +-
test/src/emacs-module-resources/mod-test.c | 1 -
test/src/emacs-module-tests.el | 2 +-
test/src/eval-tests.el | 20 -
test/src/fns-tests.el | 210 +-
test/src/image-tests.el | 190 +-
test/src/lcms-tests.el | 2 +-
test/src/print-tests.el | 6 +-
test/src/process-tests.el | 4 +-
test/src/regex-emacs-tests.el | 5 +
test/src/sqlite-tests.el | 13 +
931 files changed, 58579 insertions(+), 20251 deletions(-)
diff --git a/.clang-format b/.clang-format
index 44200a3995..ac9f95c88a 100644
--- a/.clang-format
+++ b/.clang-format
@@ -6,7 +6,7 @@ BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE]
+ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE, ITREE_FOREACH]
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
diff --git a/.dir-locals.el b/.dir-locals.el
index 7812beb001..f7c73031cc 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,11 +1,13 @@
-;;; Directory Local Variables
+;;; Directory Local Variables -*- no-byte-compile: t; -*-
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((tab-width . 8)
(sentence-end-double-space . t)
(fill-column . 70)
(emacs-lisp-docstring-fill-column . 65)
- (bug-reference-url-format . "https://debbugs.gnu.org/%s";)))
+ (vc-git-annotate-switches . "-w")
+ (bug-reference-url-format . "https://debbugs.gnu.org/%s";)
+ (diff-add-log-use-relative-names . t)))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
@@ -17,7 +19,8 @@
(electric-quote-string . nil)
(mode . bug-reference-prog)))
(log-edit-mode . ((log-edit-font-lock-gnu-style . t)
- (log-edit-setup-add-author . t)))
+ (log-edit-setup-add-author . t)
+ (vc-git-log-edit-summary-target-len . 50)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
(mode . bug-reference)))
@@ -26,6 +29,7 @@
(electric-quote-comment . nil)
(electric-quote-string . nil)
(mode . bug-reference-prog)))
+ (lisp-data-mode . ((indent-tabs-mode . nil)))
(texinfo-mode . ((electric-quote-comment . nil)
(electric-quote-string . nil)
(mode . bug-reference-prog)))
diff --git a/.gitignore b/.gitignore
index 0ecbcd061f..a7828d3386 100644
--- a/.gitignore
+++ b/.gitignore
@@ -53,6 +53,7 @@ src/emacs-module.h
# C-level sources built by 'make'.
lib/alloca.h
+lib/assert.h
lib/byteswap.h
lib/dirent.h
lib/errno.h
@@ -323,10 +324,11 @@ 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
# Ignore a directory used by dap-mode.
.vscode
+/test/gmp.h
diff --git a/.mailmap b/.mailmap
new file mode 100644
index 0000000000..8454eb9154
--- /dev/null
+++ b/.mailmap
@@ -0,0 +1,197 @@
+#
+# This list is used to fix a few misspelled names in various git
+# listings (e.g., "git log"). This can be used to fix incorrect
+# attribution, poor display, or names showing up more than once.
+# It also allows updating an old email addresses to a new one.
+#
+# See "man git-shortlog" for more information on the format.
+#
+# Keep file sorted using `M-x sort-lines'.
+#
+Aaron S. Hawley <aaron.s.hawley@gmail.com> <Aaron.Hawley@vtinfo.com>
+Aaron S. Hawley <aaron.s.hawley@gmail.com> <Aaron.S.Hawley@gmail.com>
+Aaron S. Hawley <aaron.s.hawley@gmail.com> <ashawley@burlingtontelecom.net>
+Alan Third <alan@idiocy.org>
+Alan Third <alan@idiocy.org> <alan@breton-build.holly.idiocy.org>
+Alan Third <alan@idiocy.org> Alan Third <address@hidden>
+Alan Third <alan@idiocy.org> bug-gnu-emacs@gnu.org <bug-gnu-emacs@gnu.org>
+Alex Harsanyi <AlexHarsanyi@gmail.com> <harsanyi@mac.com>
+Alexander Gramiak <agrambot@gmail.com>
+Amin Bandali <bandali@gnu.org> <mab@gnu.org>
+Andrea Corallo <akrl@sdf.org>
+Andrea Corallo <akrl@sdf.org> <akrl@sdf.com>
+Andrea Corallo <akrl@sdf.org> <andcor03@e112547.nice.arm.com>
+Andrea Corallo <akrl@sdf.org> <andrea_corallo@yahoo.it>
+Andrew G Cohen <cohen@andy.bu.edu>
+Andrew G Cohen <cohen@andy.bu.edu> <cohen@bu.edu>
+Arash Esbati <arash@gnu.org> <arash.esbati@gmail.com>
+Arash Esbati <arash@gnu.org> <esbati@gmx.de>
+Artur Malabarba <bruce.connor.am@gmail.com> <am12548@it055607.users.bris.ac.uk>
+Bastien Guerry <bzg@gnu.org>
+Bastien Guerry <bzg@gnu.org> <bastien1@free.fr>
+Bastien Guerry <bzg@gnu.org> <bzg@altern.org>
+Benjamin Schwerdtner <Benjamin.Schwerdtner@gmail.com>
+Bob Rogers <rogers@rgrjr.com> <rogers-emacs@rgrjr.homedns.org>
+Bruno Félix Rezende Ribeiro <oitofelix@gnu.org> <oitofelix@gmail.com>
+Carlos Pita <carlosjosepita@gmail.com>
+Chong Yidong <cyd@gnu.org> <cyd@stupidchicken.com>
+Christoph Scholtes <cschol2112@gmail.com>
+Christoph Scholtes <cschol2112@gmail.com> <cschol2112@googlemail.com>
+Christoph Scholtes <cschol2112@gmail.com> Christoph Scholtes <>
+Clément Pit-Claudel <clement.pitclaudel@live.com>
+Clément Pit-Claudel <clement.pitclaudel@live.com> <clement.pit@gmail.com>
+Courtney Bane <emacs-bugs-7626@cbane.org>
+Daiki Ueno <ueno@gnu.org> <ueno@unixuser.org>
+Daiki Ueno <ueno@gnu.org> Daiki Ueno <ueno@debian>
+Dan Nicolaescu <dann@ics.uci.edu> <dann@gnu.org>
+Dan Nicolaescu <dann@ics.uci.edu> <done@ece.arizona.edu>
+Daniel Colascione <dancol@dancol.org> <dan.colascione@gmail.com>
+David Abrahams <dave@boostpro.com>
+David M. Koppelman <koppel@ece.lsu.edu>
+Deniz Dogan <deniz@dogan.se> <deniz.a.m.dogan@gmail.com>
+Dick R. Chiang <dick.r.chiang@gmail.com>
+Dick R. Chiang <dick.r.chiang@gmail.com> dickmao <none>
+Earl Hyatt <ej32u@protonmail.com>
+Earl Hyatt <ej32u@protonmail.com> <okamsn@protonmail.com>
+Edward M. Reingold <reingold@emr.cs.iit.edu>
+Eli Zaretskii <eliz@gnu.org> <eliz@is.elta.co.il>
+Emilio C. Lopes <eclig@gmx.net>
+Enami Tsugutomo <tsugutomo.enami@jp.sony.com>
+Era Eriksson <era+emacs@iki.fi> <era+emacsbugs@iki.fi>
+Eric Ludlam <zappo@gnu.org>
+Eric Ludlam <zappo@gnu.org> <eric@siege-engine.com>
+Eric Ludlam <zappo@gnu.org> <ericludlam@gmail.com>
+Eric S. Raymond <esr@thyrsus.com> <esr@snark.thyrsus.com>
+Etienne Prud’homme <e.e.f.prudhomme@gmail.com>
+Fabián Ezequiel Gallina <fgallina@gnu.org> <fgallina@cuca>
+Fabián Ezequiel Gallina <fgallina@gnu.org> <galli.87@gmail.com>
+Francis Litterio <flitterio@gmail.com>
+Gabor Vida <vidagabor@gmail.com>
+Gerd Möllmann <gerd@gnu.org>
+Gerd Möllmann <gerd@gnu.org> <gerd.moellmann@gmail.com>
+Glenn Morris <rgm@gnu.org>
+Glenn Morris <rgm@gnu.org> <rgm@fencepost>
+Glenn Morris <rgm@gnu.org> <rgm@stanford.edu>
+Gnus developers <ding@gnus.org.noreply> <ding@gnus.org>
+Gregory Heytings <gregory@heytings.org> <ghe@sdf.org>
+Grégoire Jadi <daimrod@gmail.com>
+Ian Dunn <dunni@gnu.org>
+Jan Djärv <jan.h.d@swipnet.se>
+Jan Djärv <jan.h.d@swipnet.se> <jhd@f20.localdomain>
+Jason Rumney <jasonr@gnu.org> <jasonr@wanchan>
+Jeff Walsh <fejfighter@gmail.com> <jawalsh@localhost.localdomain>
+Jeff Walsh <fejfighter@gmail.com> <jeff.walsh@drtusers-MacBook-Pro.local>
+Jeff Walsh <fejfighter@gmail.com> <jewalsh@redhat.com>
+Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
+Jim Blandy <jimb@red-bean.com> <jimb@redhat.com>
+Jimmy Aguilar Mena <spacibba@aol.com>
+Joakim Verona <joakim@verona.se>
+Joakim Verona <joakim@verona.se> <root@exodia.verona.se>
+John Wiegley <johnw@newartisans.com> <jwiegley@gmail.com>
+Jose A. Ortega Ruiz <jao@gnu.org>
+João Távora <joaotavora@gmail.com>
+Julien Danjou <julien@danjou.info> <jd@dex.adm.naquadah.org>
+Julien Danjou <julien@danjou.info> Julien Danjou <jd@abydos>
+Juri Linkov <juri@linkov.net> <juri@jurta.org>
+Jérémy Compostella <jeremy.compostella@gmail.com>
+Jürgen Hötzel <juergen@archlinux.org>
+Karl Fogel <kfogel@red-bean.com> <karl.fogel@canonical.com>
+Katsumi Yamaoka <yamaoka@jpl.org> <katsumi@flagship2>
+Kaushal Modi <kaushal.modi@gmail.com>
+Kelvin White <kwhite@gnu.org>
+Kelvin White <kwhite@gnu.org> <kelvin.white77@gmail.com>
+Ken Raeburn <raeburn@raeburn.org> <raeburn@permabit.com>
+Kenichi Handa <handa@gnu.org>
+Kenichi Handa <handa@gnu.org> <handa@etlken>
+Kenichi Handa <handa@gnu.org> <handa@m17n.org>
+Kenjiro Nakayama <nakayamakenjiro@gmail.com>
+Kjartan Óli Ágústsson <kjartanoli@outlook.com>
+Károly Lőrentey <lorentey@elte.hu>
+Lars Ingebrigtsen <larsi@gnus.org>
+Lars Ingebrigtsen <larsi@gnus.org> <larsi@emkay.local>
+Lars Ingebrigtsen <larsi@gnus.org> <larsi@openbsd6.gnus.org>
+Lars Ingebrigtsen <larsi@gnus.org> <larsi@quimbies.gnus.org>
+Lars Ingebrigtsen <larsi@gnus.org> <larsi@stories.gnus.org>
+Laurence Warne <laurencewarne@gmail.com>
+Lin Sun <lin.sun@zoom.us>
+Ludovic Courtès <ludo@gnu.org>
+Luke Lee <luke.yx.lee@gmail.com>
+Martin Rudalics <rudalics@gmx.at>
+Martin Rudalics <rudalics@gmx.at> <“rudalics@gmx.atâ€>
+Masatake YAMATO <yamato@redhat.com> <jet@gyve.org>
+Matt Armstrong <matt@rfc20.org> <marmstrong@google.com>
+Matt Armstrong <matt@rfc20.org> <matt@mdeb>
+Mattias Engdegård <mattiase@acm.org>
+Maxim Nikulin <manikulin@gmail.com>
+Michael Albinus <michael.albinus@gmx.de> <albinus@detlef>
+Michalis V <mvar.40k@gmail.com>
+Miha Rihtaršič <miha@kamnitnik.top>
+Morgan J. Smith <Morgan.J.Smith@outlook.com>
+Nick Drozd <nicholasdrozd@gmail.com>
+Nicolas Petton <nicolas@petton.fr> <petton.nicolas@gmail.com>
+Nitish Chandra <nitishchandrachinta@gmail.com>
+Noam Postavsky <npostavs@gmail.com> <npostavs@users.sourceforge.net>
+Noam Postavsky <npostavs@gmail.com> <npostavs@users.sourceforget.net>
+Paul Eggert <eggert@cs.ucla.edu> <eggert@Penguin.CS.UCLA.EDU>
+Paul Eggert <eggert@cs.ucla.edu> <eggert@day>
+Paul Eggert <eggert@cs.ucla.edu> <eggert@twinsun.com>
+Paul Eggert <eggert@cs.ucla.edu> <eggert@union>
+Peter J. Weisberg <pj@irregularexpressions.net>
+Peter Oliver <p.d.oliver@mavit.org.uk> <bzr@mavit.org.uk>
+Peter Oliver <p.d.oliver@mavit.org.uk> <git@mavit.org.uk>
+Philip Kaludercic <philipk@posteo.net>
+Philip Kaludercic <philipk@posteo.net> <philip.kaludercic@fau.de>
+Philip Kaludercic <philipk@posteo.net> <philip@icterid>
+Philip Kaludercic <philipk@posteo.net> <philip@warpmail.net>
+Philipp Stephani <phst@google.com>
+Philipp Stephani <phst@google.com> Philipp Stephani <p.stephani2@gmail.com>
+Phillip Lord <phillip.lord@russet.org.uk> <phillip.lord@newcastle.ac.uk>
+Pierre Lorenzon <devel@pollock-nageoire.net>
+Pieter van Oostrum <pieter@vanoostrum.org> <pieter-l@vanoostrum.org>
+Pip Cet <pipcet@gmail.com>
+Po Lu <luangruo@yahoo.com>
+Po Lu <luangruo@yahoo.com> Po Lu via <emacs-devel@gnu.org>
+Przemysław Wojnowski <esperanto@cumego.com>
+Rasmus <rasmus@gmx.us>
+Richard M. Stallman <rms@gnu.org>
+Robert J. Chassell <bob@gnu.org> <bob@rattlesnake.com>
+Robert Weiner <rsw@gnu.org> <rswgnu@gmail.com>
+Roland Winkler <winkler@gnu.org> <Roland.Winkler@physik.uni-erlangen.de>
+Ronnie Schnell <ronnie@driver-aces.com>
+Ryan C. Thompson <rct@thompsonclan.org>
+Sam Steingold <sds@gnu.org> <sdsg@amazon.com>
+Simen Heggestøyl <simenheg@runbox.com>
+Simen Heggestøyl <simenheg@runbox.com> <simenheg@ifi.uio.no>
+Simen Heggestøyl <simenheg@runbox.com> <simenheg@gmail.com>
+Simon Josefsson <simon@josefsson.org> <jas@extundo.com>
+Stefan Kangas <stefankangas@gmail.com> <stefan@marxist.se>
+Stefan Monnier <monnier@iro.umontreal.ca> <monnier@IRO.UMontreal.CA>
+Stephen Berman <stephen.berman@gmx.net> <Stephen.Berman@gmx.net>
+Stephen Berman <stephen.berman@gmx.net> <Stephen.Berman@gmx.net>
+Stephen Berman <stephen.berman@gmx.net> <steve@rosalinde.fritz.box>
+Stephen Gildea <stepheng+emacs@gildea.com>
+Stephen Gildea <stepheng+emacs@gildea.com> <gildea@stop.mail-abuse.org>
+Stephen Gildea <stepheng+emacs@gildea.com>
<stepheng+git-config-global@gildea.com>
+Stephen Gildea <stepheng+emacs@gildea.com> <stepheng+savannah@gildea.com>
+Tassilo Horn <tsdh@gnu.org> <tassilo@member.fsf.org>
+Ted Zlatanov <tzz@lifelogs.com>
+Thien-Thi Nguyen <ttn@gnu.org> <ttn@gnuvola.org>
+Thierry Volpiatto <thievol@posteo.net> <thierry.volpiatto@gmail.com>
+Tino Calancha <ccalancha@suse.com> <f92capac@gmail.com>
+Tino Calancha <ccalancha@suse.com> <tino.calancha@gmail.com>
+Tom Tromey <tom@tromey.com> <tromey@redhat.com>
+Ulf Jasper <ulf.jasper@web.de> Ulf Jasper <>
+Ulf Jasper <ulf.jasper@web.de> Ulf Jasper <ulf@uthinkpad>
+Ulrich Müller <ulm@gentoo.org>
+Vinicius Jose Latorre <viniciusjl@ig.com.br> <viniciusjl.gnu@gmail.com>
+Vladimir Nikishkin <lockywolf@gmail.com>
<for.emacs-table.el-environment-patch_2022-05-09@lockywolf.net>
+Werner Lemberg <wl@gnu.org>
+Wolfgang Scherer <wolfgang.scherer@gmx.de> <Wolfgang.Scherer@gmx.de>
+Xi Lu <lx@shellcodes.org>
+Xue Fuqiao <xfq.free@gmail.com> <xfq@gnu.org>
+Yilkal Argaw <yilkalargawworkneh@gmail.com>
+Yuuki Harano <masm+github@masm11.me> <masm@masm11.ddo.jp>
+Óscar Fuentes <ofv@wanadoo.es>
+İ. Göktuğ Kayaalp <self@gkayaalp.com>
+Łukasz Stelmach <stlman@poczta.fm> <l.stelmach@samsung.com>
+Łukasz Stelmach <stlman@poczta.fm> <lukasz.stelmach@iem.pw.edu.pl>
diff --git a/ChangeLog.1 b/ChangeLog.1
index cd31aacafb..35533d60ff 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -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.3 b/ChangeLog.3
index 700a210f35..f2245a4ed5 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,314 @@
+2022-09-06 Stefan Kangas <stefankangas@gmail.com>
+
+ * doc/misc/idlwave.texi (Troubleshooting): Don't say "Emacsen".
+
+2022-09-06 Stefan Kangas <stefankangas@gmail.com>
+
+ Don't mention very old Emacs versions in docs
+
+ * doc/misc/mh-e.texi (Conventions):
+ * doc/misc/reftex.texi (Problems and Work-Arounds):
+ * doc/misc/viper.texi (Loading Viper): Delete references to
+ very old versions of Emacs.
+
+2022-09-05 Stefan Kangas <stefankangas@gmail.com>
+
+ * lisp/server.el: Improve Commentary.
+
+2022-09-05 Gregory Heytings <gregory@heytings.org>
+
+ Explain how the font appearance can be fine-tuned in fbterm.
+
+ * doc/misc/efaq.texi (Emacs in a Linux console): Briefly document
+ Xft font specifications with which the font appearance can be
+ fine-tuned.
+
+2022-09-04 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.5.5
+
+2022-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/comp.el (comp-run-async-workers): Fail more gracefully
+
+ Otherwise Emacs may fail to start if it can't find a writable
+ `~/.emacs.d/eln-cache` directory.
+ Fixes bug#57562. See also Debian's bug #1017739.
+
+2022-09-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Update acknowledgments
+
+ * doc/emacs/ack.texi (Acknowledgments): Update.
+ * doc/emacs/emacs.texi (Acknowledgments): Add several names from
+ Author: headers.
+
+2022-09-01 Stefan Kangas <stefankangas@gmail.com>
+
+ Make some versions in docs match package version
+
+ * doc/emacs/misc.texi (Interactive Shell): Bump Emacs version.
+ * doc/misc/ediff.texi:
+ * doc/misc/flymake.texi:
+ * doc/misc/viper.texi: Fix version to match package.
+ * lisp/emulation/viper.el: Make version match variable.
+
+2022-09-01 Stefan Kangas <stefankangas@gmail.com>
+
+ Minor doc fix; improve sorting of VC backends
+
+ * doc/emacs/maintaining.texi (Version Control Systems): Minor doc fix;
+ rearrange list to put git, cvs and subversion at the top.
+
+2022-09-01 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify the doc string of 'set-face-attribute'
+
+ * lisp/faces.el (set-face-attribute): Clarify the issue with
+ resetting attribute values to 'unspecified' for future frames.
+ (Bug#57499)
+
+2022-08-30 Gregory Heytings <gregory@heytings.org>
+
+ Enable 256 colors in fbterm.
+
+ * lisp/term/fbterm.el: New file.
+
+ * doc/misc/efaq.texi (Emacs in a Linux console): Document the TERM
+ environment variable with which the new file is used.
+
+2022-08-30 Eli Zaretskii <eliz@gnu.org>
+
+ One more fix for find-file.el
+
+ * lisp/find-file.el (ff-get-file-name): Use 'expand-file-name'
+ instead of 'concat', which doesn't DTRT with absolute file names.
+ (ff-other-file-alist): Yet another doc fix. (Bug#57325)
+
+2022-08-29 Gregory Heytings <gregory@heytings.org>
+
+ Recommend using fbterm in the Linux console.
+
+ * doc/misc/efaq.texi (Emacs in a Linux console): New node.
+ (Common requests): Entry for the new node.
+
+ * etc/PROBLEMS (Linux console problems...): Mention the new FAQ node.
+
+2022-08-29 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/find-file.el (ff-other-file-alist): Doc fix. (Bug#57325)
+
+2022-08-28 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/info.el (Info-mode): Support the Linux console better.
+
+2022-08-28 Eli Zaretskii <eliz@gnu.org>
+
+ Improve the documentation of glyphless-character display
+
+ * lisp/international/characters.el (glyphless-char-display-control):
+ * src/xdisp.c (syms_of_xdisp) <glyphless-char-display>: Mention
+ the 'glyphless-char' face in the doc string.
+
+ * doc/lispref/display.texi (Glyphless Chars): Index
+ 'glyphless-char' face.
+
+2022-08-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix documentation of 'glyphless-char-display'
+
+ * src/xdisp.c (syms_of_xdisp)<glyphless-char-display>: Doc fix.
+ (gui_produce_glyphs, lookup_glyphless_char_display): Fix
+ indentation.
+
+2022-08-25 Robert Pluim <rpluim@gmail.com>
+
+ Treat smtp-auth method from auth-info as a symbol
+
+ The lookup of the SMTP auth method is done based on symbols, but
+ sometimes the requested value comes from `auth-info', in which case it
+ is a string, so call `intern-soft' to convert it to a symbol (which
+ does nothing if it's already a symbol).
+
+ * lisp/mail/smtpmail.el (smtpmail-try-auth-methods): Call
+ `intern-soft' on the smtp-auth key's value. (Bug#57373)
+
+ Do not merge to master
+
+2022-08-25 Stefan Kangas <stefankangas@gmail.com>
+
+ * lisp/wdired.el: Improve "Commentary" section.
+
+ * lisp/wdired.el: Doc fix; don't mention obsolete variable.
+
+ * lisp/progmodes/etags.el (next-file): Minor doc fix.
+
+2022-08-25 Andreas Schwab <schwab@suse.de>
+
+ * configure.ac: Move AC_LANG_PUSH/POP out of AC_CACHE_CHECK.
(Bug#57380)
+
+ (cherry picked from commit ce82300221f270241fdda1f5dfb567bdb1208543)
+
+2022-08-21 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.5.4-19-g4dff42
+
+2022-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/find-file.el (ff-other-file-alist): Doc fix. (Bug#57325)
+
+2022-08-19 Stefan Kangas <stefankangas@gmail.com>
+
+ Resurrect obsoletion warning for two functions
+
+ These were supposed to have been deleted, but never were. Resurrect
+ their obsoletion warning and let's delete them in Emacs 29 instead.
+
+ * lisp/subr.el (process-filter-multibyte-p)
+ (set-process-filter-multibyte): Resurrect obsoletion warning.
+ * etc/NEWS: Don't announce their deletion.
+
+2022-08-19 Alan Mackenzie <acm@muc.de>
+
+ * src/window.c (select_window): Fix assert for buffer = non-active
minibuffer
+
+2022-08-19 Gerd Möllmann <gerd@gnu.org>
+
+ Find libgccjit on macOS with Homebrew differently
+
+ * configure.ac (MAC_LIBS): Find libgccjit's directory slightly
+ differently for brew installations.
+
+2022-08-18 Stefan Kangas <stefankangas@gmail.com>
+
+ Improve image-mode-as-hex docstring
+
+ * lisp/image-mode.el: Fix typos.
+ (image-mode-as-hex): Doc fix; say that it uses 'hexl-mode' and reflow.
+
+2022-08-18 Stefan Kangas <stefankangas@gmail.com>
+
+ * lisp/image-mode.el (image-mode-as-hex): Fix toggle instructions.
+
+ * lisp/image-mode.el: Improve commentary.
+
+2022-08-18 Colin Woodbury <colin@fosskers.ca>
+
+ cl-reduce doc string improvement
+
+ * lisp/emacs-lisp/cl-seq.el (cl-reduce): Explain what happens when
+ using :from-end (bug#57273).
+
+2022-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Backport tempname changes from master (bug#57129)
+
+ * lib/tempname.c: Backport from master, which uses current Gnulib.
+
+2022-08-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Revert "; * doc/lispintro/emacs-lisp-intro.texi: Fix typo."
+
+ This reverts commit 9d0dba44da7ac83d018fff3c26d33dac12ebd806.
+
+ This was not a typo, but incorrectly matching parens in Info-mode.
+
+2022-08-16 Stefan Kangas <stefankangas@gmail.com>
+
+ * doc/misc/gnus.texi (Article Washing): Fix Links URL.
+
+2022-08-12 Stefan Kangas <stefan@marxist.se>
+
+ Delete references to deleted library hilit19.el
+
+ * doc/misc/gnus.texi (Compatibility):
+ * lisp/progmodes/f90.el:
+ * lisp/ps-print.el:
+ * lisp/vc/ediff.el: Delete references to hilit19.el.
+
+2022-08-12 Stefan Kangas <stefan@marxist.se>
+
+ Delete stale comments from Lisp Intro manual
+
+ * doc/lispintro/emacs-lisp-intro.texi (Args as Variable or List)
+ (print-elements-of-list, Miscellaneous): Delete some references to
+ Emacs 22.
+
+2022-08-11 Stefan Kangas <stefan@marxist.se>
+
+ Don't list Emacs as requirement for built-in package
+
+ * doc/misc/htmlfontify.texi (Requirements): Don't list Emacs as
+ requirement for built-in package.
+
+2022-08-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Fix wrong metrics for bitmap-only fonts with HarfBuzz 5
+
+ * src/ftcrfont.c (ftcrhbfont_begin_hb_font): Always use the standard
+ position unit value on HarfBuzz 5 and later regardless of whether the
+ font is bitmap-only or not. (Bug#57066)
+
+2022-08-09 Stefan Kangas <stefan@marxist.se>
+
+ Improve wording when documenting other TRAMP syntaxes
+
+ * doc/misc/tramp.texi (Change file name syntax): Improve wording.
+ (Bug#57061)
+
+2022-08-08 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/vc/diff-mode.el: Don't mention XEmacs.
+
+2022-08-08 Stefan Kangas <stefan@marxist.se>
+
+ Don't mention XEmacs toolbar in ediff manual
+
+ * doc/misc/ediff.texi (Other Session Commands): Don't mention XEmacs
+ specific toolbar support for now. This can be changed back once the
+ toolbar is ported to Emacs.
+
+2022-08-06 Eli Zaretskii <eliz@gnu.org>
+
+ * etc/PROBLEMS: Problems with Alacritty and Emoji. (Bug#56952)
+
+2022-08-06 Yuga Ego <yet@ego.team>
+
+ Link from (emacs)Init Syntax to (elisp)Introduction
+
+ * doc/emacs/custom.texi (Init Syntax): Link to the ELisp manual
(Bug#56870)
+
+2022-08-06 Stefan Kangas <stefan@marxist.se>
+
+ Don't mention removed XEmacs support in reftex manual
+
+ * doc/misc/reftex.texi (Installation, Imprint): Don't mention
+ removed XEmacs support.
+
+2022-08-06 Stefan Kangas <stefan@marxist.se>
+
+ Don't mention removed XEmacs support in idlwave manual
+
+ * doc/misc/idlwave.texi (Lesson I---Development Cycle)
+ (Syntax Highlighting, Windows and macOS, Troubleshooting): Delete
+ most references to XEmacs. Support for it was deleted in 28.1.
+
+2022-08-05 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/play/fortune.el: Doc fixes.
+
+2022-08-04 Stefan Kangas <stefan@marxist.se>
+
+ * doc/lispref/loading.texi (Autoload by Prefix): Fix typo.
+
+2022-08-03 Philipp Stephani <phst@google.com>
+
+ * lisp/uniquify.el (uniquify-buffer-name-style): Quote apostrophe.
+
+2022-08-02 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/term.el: Doc fix; don't mention rlogin.
+
2022-07-31 Eli Zaretskii <eliz@gnu.org>
* src/lisp.h (CHECK_INTEGER): Fix the predicate. (Bug#56856)
@@ -185062,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>
@@ -196786,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.
@@ -198886,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.
@@ -236607,7 +236918,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit 78759ddcb0fc7dd75a7a8edfb2c19dc2f1d86ee2 (inclusive).
+commit ddabb03a0176beb4b7fc8d4f2267d459fd2ebded (inclusive).
See ChangeLog.2 for earlier changes.
;; Local Variables:
diff --git a/GNUmakefile b/GNUmakefile
index 8eb61dc0ad..05edbe099b 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -115,7 +115,7 @@ endif
# 'make bootstrap' in a fresh checkout needn't run 'configure' twice.
bootstrap: Makefile
- $(MAKE) -f Makefile all
+ $(MAKE) -f Makefile bootstrap-all
.PHONY: bootstrap default $(ORDINARY_GOALS)
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 7541e8d6b6..45b4a59e3d 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -51,7 +51,15 @@
#
# make bootstrap
# Removes all the compiled files to force a new bootstrap from a
-# clean slate, and then build in the normal way.
+# clean slate, and then build in the normal way. If the FAST Make
+# 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 though it does not work in general.
#
# make docs
# Make Emacs documentation files from their sources; requires makeinfo.
@@ -358,7 +366,67 @@ endif
gsettings_SCHEMAS = etc/org.gnu.emacs.defaults.gschema.xml
-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lisp
+all:
+ $(MAKE) actual-all || $(MAKE) advice-on-failure make-target=all
exit-status=$$?
+ $(MAKE) sanity-check make-target=all
+
+# This target is used by the 'bootstrap' target in GNUmakefile, instead of
'all'.
+bootstrap-all:
+ $(MAKE) actual-all || $(MAKE) advice-on-failure make-target=bootstrap
exit-status=$$?
+ $(MAKE) sanity-check make-target=bootstrap
+
+.PHONY: bootstrap-all actual-all advice-on-failure sanity-check
+
+actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid)
src-depending-on-lisp
+
+# ADVICE-ON-FAILURE-BEGIN:all
+# You could try to:
+# - run "make bootstrap", which might fix the problem
+# - run "make V=1", which displays the full commands invoked by make,
+# to further investigate the problem
+# ADVICE-ON-FAILURE-END:all
+
+# ADVICE-ON-FAILURE-BEGIN:bootstrap
+# You could try to:
+# - run "make extraclean" and run "make" again (or, equivalently, run
+# "make bootstrap configure=default"), to rebuild Emacs with the
+# default configuration options, which might fix the problem
+# - run "git clean -fdx" and run "make bootstrap" again, which might
+# fix the problem if "make bootstrap configure=default" did not
+# !BEWARE! "git clean -fdx" deletes all files that are not under
+# !BEWARE! version control, which means that all changes to such
+# !BEWARE! files will be lost and cannot be restored later
+# - run "make V=1", which displays the full commands invoked by make,
+# to further investigate the problem
+# - report the problem and ask for help by sending an email to
+# bug-gnu-emacs@gnu.org, mentioning at least the build error
+# message, the platform, and the repository revision displayed by
+# "git rev-parse HEAD"
+# ADVICE-ON-FAILURE-END:bootstrap
+
+advice-on-failure:
+ @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
+ @echo >&2 '***'
+ @exit ${exit-status}
+
+sanity-check:
+ @v=$$(src/emacs${EXEEXT} --batch --eval \
+ '(progn (defun f (n) (if (= 0 n) 1 (* n (f (- n 1))))) (princ (f
10)))' \
+ 2> /dev/null); \
+ [ "X$$v" = "X3628800" ] && exit 0; \
+ echo >&2 '***'; \
+ 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; \
+ echo >&2 '***'; \
+ exit 1
.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32
epaths-force-ns-self-contained etc-emacsver
@@ -462,6 +530,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/).
@@ -514,7 +587,7 @@ $(srcdir)/configure: $(srcdir)/configure.ac
$(srcdir)/m4/*.m4
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
-install: all install-arch-indep install-etcdoc install-arch-dep
install-$(NTDIR) blessmail install-eln install-gsettings-schemas
+install: actual-all install-arch-indep install-etcdoc install-arch-dep
install-$(NTDIR) blessmail install-eln install-gsettings-schemas
@true
## Ensure that $subdir contains a subdirs.el file.
@@ -630,8 +703,8 @@ install-arch-indep: lisp install-info install-man
${INSTALL_ARCH_INDEP_EXTRA}
[ -d $${dir} ] || exit 1 ; \
dest="$$1" ; shift ; \
if [ -d "$${dest}" ]; then \
- exp_dest=`cd "$${dest}" && /bin/pwd`; \
- [ "$$exp_dest" = "`cd $${dir} && /bin/pwd`" ] && continue ; \
+ exp_dest=`cd "$${dest}" && pwd -P`; \
+ [ "$$exp_dest" = "`cd $${dir} && pwd -P`" ] && continue ; \
else true; \
fi; \
rm -rf "$${dest}" ; \
@@ -687,8 +760,8 @@ install-arch-indep: lisp install-info install-man
${INSTALL_ARCH_INDEP_EXTRA}
install-etcdoc: src install-arch-indep
-unset CDPATH; \
umask 022; ${MKDIR_P} "$(DESTDIR)${etcdocdir}" ; \
- exp_etcdocdir=`cd "$(DESTDIR)${etcdocdir}"; /bin/pwd`; \
- if [ "`cd ./etc; /bin/pwd`" != "$$exp_etcdocdir" ]; \
+ exp_etcdocdir=`cd "$(DESTDIR)${etcdocdir}"; pwd -P`; \
+ if [ "`cd ./etc; pwd -P`" != "$$exp_etcdocdir" ]; \
then \
docfile="DOC"; \
printf 'Copying %s to %s ...\n' "etc/$$docfile" \
@@ -703,9 +776,9 @@ install-etcdoc: src install-arch-indep
install-info: info
umask 022; ${MKDIR_P} "$(DESTDIR)${infodir}"
-unset CDPATH; \
- thisdir=`/bin/pwd`; \
- exp_infodir=`cd "$(DESTDIR)${infodir}" && /bin/pwd`; \
- if [ "`cd ${srcdir}/info && /bin/pwd`" = "$$exp_infodir" ]; then \
+ thisdir=`pwd -P`; \
+ exp_infodir=`cd "$(DESTDIR)${infodir}" && pwd -P`; \
+ if [ "`cd ${srcdir}/info && pwd -P`" = "$$exp_infodir" ]; then \
true; \
else \
[ -f "$(DESTDIR)${infodir}/dir" ] || \
@@ -734,7 +807,7 @@ install-info: info
## but not sure if portable.
install-man:
umask 022; ${MKDIR_P} "$(DESTDIR)${man1dir}"
- thisdir=`/bin/pwd`; \
+ thisdir=`pwd -P`; \
cd ${mansrcdir}; \
for page in *.1; do \
test "$$page" = ChangeLog.1 && continue; \
@@ -801,7 +874,7 @@ install-etc:
${srcdir}/etc/emacs.service > $${tmp}; \
$(INSTALL_DATA) $${tmp}
"$(DESTDIR)$(systemdunitdir)/${EMACS_NAME}.service"; \
rm -f $${tmp}
- thisdir=`/bin/pwd`; \
+ thisdir=`pwd -P`; \
cd ${iconsrcdir} || exit 1; umask 022 ; \
for dir in */*/apps */*/mimetypes; do \
[ -d $${dir} ] || continue ; \
@@ -836,10 +909,10 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
uninstall-gsettings-schemas
rm -f "$(DESTDIR)$(includedir)/emacs-module.h"
$(MAKE) -C lib-src uninstall
-unset CDPATH; \
- for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \
+ for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}"
"$(ELN_DESTDIR)" ; do \
if [ -d "$${dir}" ]; then \
- case `cd "$${dir}" ; /bin/pwd` in \
- "`cd ${srcdir} ; /bin/pwd`"* ) ;; \
+ case `cd "$${dir}" ; pwd -P` in \
+ "`cd ${srcdir} ; pwd -P`"* ) ;; \
* ) rm -rf "$${dir}" ;; \
esac ; \
case "$${dir}" in \
@@ -850,7 +923,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
uninstall-gsettings-schemas
fi ; \
done
-rm -rf "$(DESTDIR)${libexecdir}/emacs/${version}"
- thisdir=`/bin/pwd`; \
+ thisdir=`pwd -P`; \
(info_misc=`MAKEFLAGS= $(MAKE) --no-print-directory -s -C doc/misc
echo-info`; \
if cd "$(DESTDIR)${infodir}"; then \
for elt in ${INFO_NONMISC} $${info_misc}; do \
@@ -936,7 +1009,7 @@ clean: $(clean_dirs:=_clean) clean-gsettings-schemas
### 'bootclean'
### Delete all files that need to be remade for a clean bootstrap.
top_bootclean=\
- rm -f config.cache config.log ${srcdir}/doc/man/emacs.1
+ rm -f config.log ${srcdir}/doc/man/emacs.1
### 'distclean'
### Delete all files from the current directory that are created by
@@ -946,7 +1019,7 @@ top_bootclean=\
### distribution.
top_distclean=\
${top_bootclean}; \
- rm -f config.status config.log~ \
+ rm -f config.cache config.status config.log~ \
Makefile makefile lib/gnulib.mk ${SUBDIR_MAKEFILES}
distclean_dirs = $(clean_dirs) leim lisp admin/grammars
@@ -966,6 +1039,9 @@ bootstrap-clean: $(distclean_dirs:=_bootstrap-clean)
rm -rf ${srcdir}/info
rm -f ${srcdir}/etc/refcards/emacsver.tex
rm -rf native-lisp/ lisp/leim/ja-dic/
+ifndef FAST
+ rm -fr autom4te.cache config.cache
+endif
${top_bootclean}
### 'maintainer-clean'
@@ -1159,7 +1235,11 @@ check-info: info
### This first cleans the lisp subdirectory, removing all compiled
### Lisp files. Then re-run make to build all the files anew.
-.PHONY: bootstrap
+.PHONY: bootstrap actual-bootstrap
+
+bootstrap:
+ $(MAKE) actual-bootstrap || $(MAKE) advice-on-failure
make-target=bootstrap exit-status=$$?
+ $(MAKE) sanity-check make-target=bootstrap
# Without a 'configure' variable, bootstrapping does the following:
# * Remove files to start from a bootstrap-clean slate.
@@ -1170,7 +1250,7 @@ check-info: info
# * Remove files to start from an extraclean slate.
# * Do the actual build, during which the 'configure' variable is
# used (see the Makefile goal in GNUmakefile).
-bootstrap:
+actual-bootstrap:
ifndef configure
$(MAKE) bootstrap-clean
cd $(srcdir) && ./autogen.sh autoconf
@@ -1178,7 +1258,7 @@ ifndef configure
else
$(MAKE) extraclean
endif
- $(MAKE) all
+ $(MAKE) actual-all
.PHONY: ChangeLog change-history change-history-commit change-history-nocommit
.PHONY: preferred-branch-is-current unchanged-history-files
diff --git a/admin/admin.el b/admin/admin.el
index c84287a702..6a67f172e2 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -124,9 +124,6 @@ Root must be the root of an Emacs source tree."
;; Major version only.
(when (string-match "\\([0-9]\\{2,\\}\\)" version)
(let ((newmajor (match-string 1 version)))
- (set-version-in-file root "src/msdos.c" newmajor
- (rx (and "Vwindow_system_version" (1+ not-newline)
- ?\( (submatch (1+ (in "0-9"))) ?\))))
(set-version-in-file root "etc/refcards/ru-refcard.tex" newmajor
"\\\\newcommand{\\\\versionemacs}\\[0\\]\
{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")))
@@ -781,6 +778,204 @@ Optional argument TYPE is type of output (nil means all)."
(if (member type (list nil m))
(make-manuals-dist--1 root m))))
+(defvar admin--org-export-headers-format "\
+#+title: GNU Emacs %s NEWS -- history of user-visible changes
+#+author:
+#+options: author:nil creator:nil toc:2 num:3 *:nil \\n:t ^:nil tex:nil
+#+language: en
+#+HTML_LINK_HOME: /software/emacs
+#+HTML_LINK_UP: /software/emacs
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\"
href=\"/mini.css\" media=\"handheld\" />
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\"
href=\"/layout.min.css\" media=\"screen\" />
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\"
href=\"/print.min.css\" media=\"print\" />
+
+#+BEGIN_EXPORT html
+<div style=\"float:right;margin-left:1em;padding:3px;border:0px
solid;text-align:center\">
+<a href=\"/graphics/gnu-head.jpg\">
+<img src=\"/graphics/gnu-head-sm.jpg\" alt=\" [image of the head
+of a GNU] \" width=\"129\" height=\"122\"/>
+</a>
+</div>
+#+END_EXPORT\n\n")
+
+(defvar admin--org-html-postamble "
+<p>
+Return to the <a href=\"/software/emacs/emacs.html\">GNU Emacs home page</a>.
+</p>
+
+<div id=\"footer\">
+<div class=\"unprintable\">
+
+<p>
+Please send FSF & GNU inquiries to
+<a href=\"mailto:gnu@gnu.org\";><gnu@gnu.org></a>.
+There are also <a href=\"/contact/\">other ways to contact</a>
+the FSF.
+Broken links and other corrections or suggestions can be sent to
+<a href=\"mailto:bug-gnu-emacs@gnu.org\";><bug-gnu-emacs@gnu.org></a>.
+</p>
+</div>
+
+<p>
+ Copyright © %s Free Software Foundation, Inc.
+</p>
+
+<p>This page is licensed under
+a <a href=\"https://creativecommons.org/licenses/by-sa/4.0\";>CC-BY-SA</a>
+license.</p>
+
+<!--#include virtual=\"/server/bottom-notes.html\" -->
+
+<p class=\"unprintable\">
+Updated:
+<!-- timestamp start -->
+$Date: %s $
+<!-- timestamp end -->
+</p>
+</div>
+</div>")
+
+(defun admin--require-external-package (pkg)
+ (package-initialize)
+ (require pkg nil t)
+ (unless (featurep pkg)
+ (when (yes-or-no-p (format "Package \"%s\" is missing. Install now?" pkg))
+ (package-install pkg)
+ (require pkg nil t))))
+
+(defvar org-html-postamble)
+(defvar org-html-mathjax-template)
+(defun make-news-html-file (root version)
+ "Convert the NEWS file into an HTML file."
+ (interactive (let ((root
+ (if noninteractive
+ (or (pop command-line-args-left)
+ default-directory)
+ (read-directory-name "Emacs root directory: "
+ source-directory nil t))))
+ (list root
+ (read-string "Major version number: "
+ (number-to-string emacs-major-version)))))
+ (unless (file-exists-p (expand-file-name "src/emacs.c" root))
+ (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
+ (admin--require-external-package 'htmlize)
+ (let* ((newsfile (expand-file-name "etc/NEWS" root))
+ (orgfile (expand-file-name (format "etc/NEWS.%s.org" version) root))
+ (html (format "%s.html" (file-name-base orgfile)))
+ (copyright-years (format-time-string "%Y")))
+ (delete-file orgfile)
+ (copy-file newsfile orgfile t)
+ (find-file orgfile)
+
+ ;; Find the copyright range.
+ (goto-char (point-min))
+ (re-search-forward "^Copyright (C) \\([0-9-]+\\) Free Software Foundation,
Inc.")
+ (setq copyright-years (match-string 1))
+
+ ;; Delete some unnecessary stuff.
+ (replace-regexp-in-region "^---$" "" (point-min) (point-max))
+ (replace-regexp-in-region "^\\+\\+\\+$" "" (point-min) (point-max))
+ (dolist (str '(" \n"
+ "GNU Emacs NEWS -- history of user-visible changes."
+ "Temporary note:"
+ "+++ indicates that all relevant manuals in doc/ have been
updated."
+ "--- means no change in the manuals is needed."
+ "When you add a new item, use the appropriate mark if you
are sure it"
+ "applies, and please also update docstrings as needed."
+ "You can narrow news to a specific version by calling
'view-emacs-news'"
+ "with a prefix argument or by typing 'C-u C-h C-n'."))
+ (replace-string-in-region str "" (point-min) (point-max)))
+
+ ;; Escape some characters.
+ (replace-regexp-in-region (rx "$") "@@html:$@@" (point-min)
(point-max))
+
+ ;; Use Org-mode markers for 'symbols', 'C-x k', etc.
+ (replace-regexp-in-region
+ (rx (or (: (group (in " \t\n("))
+ "'"
+ (group (+ (or (not (in "'\n"))
+ (: "'" (not (in " .,\t\n)"))))))
+ "'"
+ (group (in ",.;:!? \t\n)")))
+ ;; Buffer names, e.g. "*scratch*".
+ (: "\""
+ (group-n 2 "*" (+ (not (in "*\""))) "*")
+ "\"")))
+ "\\1~\\2~\\3" (point-min) (point-max))
+
+ ;; Format code blocks.
+ (while (re-search-forward "^ " nil t)
+ (let ((elisp-block (looking-at "(")))
+ (backward-paragraph)
+ (insert (if elisp-block
+ "\n#+BEGIN_SRC emacs-lisp"
+ "\n#+BEGIN_EXAMPLE"))
+ (forward-paragraph)
+ (insert (if elisp-block
+ "#+END_SRC\n"
+ "#+END_EXAMPLE\n"))))
+
+ ;; Delete buffer local variables.
+ (goto-char (point-max))
+ (when (re-search-backward "Local variables:")
+ (forward-line -1)
+ (delete-region (point) (point-max)))
+
+ ;; Insert Org-mode export headers.
+ (goto-char (point-min))
+ (insert (format admin--org-export-headers-format version))
+ (org-mode)
+ (save-buffer)
+
+ ;; Make everything one level lower.
+ (goto-char (point-min))
+ (while (re-search-forward (rx bol (group (+ "*")) " ") nil t)
+ (replace-match "*\\1" nil nil nil 1))
+
+ ;; Insert anchors for different versions.
+ (goto-char (point-min))
+ (let (last-major last-minor)
+ (while (re-search-forward (rx bol "** " (+ (not "\n")) "in Emacs "
+ (group digit digit) "." (group digit)
+ eol)
+ nil t)
+ (unless (and (equal (match-string 1) last-major)
+ (equal (match-string 2) last-minor))
+ (setq last-major (match-string 1))
+ (setq last-minor (match-string 2))
+ (forward-line -1)
+ (insert (format
+ (concat
+ "#+HTML: <p> </p>\n"
+ "* Changes in Emacs %s.%s\n"
+ ;; Add anchor to allow linking to
+ ;; e.g. "NEWS.28.html#28.1".
+ ":PROPERTIES:\n"
+ ":CUSTOM_ID: %s.%s\n"
+ ":END:\n")
+ last-major last-minor
+ last-major last-minor)))))
+
+ (save-buffer)
+
+ ;; Make the HTML export.
+ (let* ((org-html-postamble
+ (format admin--org-html-postamble
+ copyright-years
+ ;; e.g. "2022/09/13 09:13:13"
+ (format-time-string "%Y/%m/%d %H:%m:%S")))
+ (org-html-mathjax-template "")
+ (htmlize-output-type 'css))
+ (org-html-export-as-html))
+
+ ;; Write HTML to file.
+ (let ((html (expand-file-name html (expand-file-name "etc" root))))
+ (write-file html)
+ (unless noninteractive
+ (find-file html)
+ (html-mode))
+ (message "Successfully exported HTML to %s" html))))
+
;; Stuff to check new `defcustom's got :version tags.
;; Adapted from check-declare.el.
diff --git a/admin/automerge b/admin/automerge
index 9919186736..d2c92948e1 100755
--- a/admin/automerge
+++ b/admin/automerge
@@ -35,16 +35,7 @@
## it with the -d option in the repository directory, in case a pull
## updates this script while it is working.
-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 ()
{
@@ -127,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" ] && {
@@ -261,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 5894abed3d..22d5a3a151 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -272,7 +272,7 @@ currently defined groups."
(if group
(memq symbol groups)
(or
- ;; (user-variable-p symbol)
+ ;; (custom-variable-p symbol)
(get symbol 'standard-value)
;; (get symbol 'saved-value)
(get symbol 'custom-type)))
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 dfe3664e12..e2f38501e9 100755
--- a/admin/emake
+++ b/admin/emake
@@ -20,7 +20,20 @@ if [ -f /proc/cpuinfo ]; then
sed 's/^[0-9]*/+/')))
fi
-make -j$cores "$@" 2>&1 | \
+NOCOLOR=0
+NOCHECK=0
+FASTOPT="FAST=true"
+QUIETER=0
+while :
+do
+ [[ "X$1" == "X--no-color" ]] && { NOCOLOR=1; shift; continue; }
+ [[ "X$1" == "X--no-check" ]] && { NOCHECK=1; shift; continue; }
+ [[ "X$1" == "X--no-fast" ]] && { FASTOPT=""; shift; continue; }
+ [[ "X$1" == "X--quieter" ]] && { QUIETER=1; shift; continue; }
+ break
+done
+
+make $FASTOPT -j$cores "$@" 2>&1 | \
sed -u 's# \.\./\.\./# #
s# \.\./# #
s#^Configuring local git # Configuring local git #
@@ -30,6 +43,7 @@ s#^Configured for # Configured for #
s#^./temacs.*# \\& #
s#^make.*Error# \\& #
s#^Dumping under the name.*# \\& #
+:a;/\\$/N;s/\\\n//;ta
' | \
grep -E --line-buffered -v "^make|\
^Loading|\
@@ -82,16 +96,38 @@ The GNU allocators don't work|\
^\^\(\(|\
^ANCIENT=yes make|\
^touch -t|\
-^'build-aux/git-hooks\
+^'build-aux/git-hooks|\
+^GNUmakefile:[0-9]*: There seems to be no |\
+^GNUmakefile:[0-9]*: Running |\
+^GNUmakefile:[0-9]*: No Makefile|\
+^rm -f |\
+^rm -rf|\
+^find \. |\
+^rm -fr deps|\
+^if test -f \./\.gdbinit|\
+^true|\
+^for file in |\
+^rmdir|\
+^\[ \"\.\" = \"\.\" \]\
" | \
while read
do
C=""
- [[ "X${REPLY:0:1}" != "X " ]] && C="\033[1;31m"
- [[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m"
- [[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n"
"$REPLY"
+ (($NOCOLOR == 0)) && [[ "X${REPLY:0:1}" != "X " ]] && C="\033[1;31m"
+ (($NOCOLOR == 0)) && [[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m"
+ if (($QUIETER == 0))
+ then
+ [[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n"
"$REPLY"
+ else
+ [[ "X$C" == "X" ]] && printf "%-80s\r" "$REPLY" || printf
"$C%-80s\033[0m\n" "$REPLY"
+ fi
done
+# If make failed, exit now with its error code.
+((${PIPESTATUS[0]} != 0)) && exit ${PIPESTATUS[0]}
+
+(($NOCHECK == 1)) && exit 0
+
# Run a "make check" on all test files belonging to files that have
# changed since last time.
make -j$cores check-maybe 2>&1 | \
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index 25bed949ad..ddd3e18442 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -97,11 +97,14 @@ If nil, the function `gitmerge-default-branch' guesses.")
(defvar gitmerge-mode-map
(let ((map (make-keymap)))
- (define-key map [(l)] 'gitmerge-show-log)
- (define-key map [(d)] 'gitmerge-show-diff)
- (define-key map [(f)] 'gitmerge-show-files)
- (define-key map [(s)] 'gitmerge-toggle-skip)
- (define-key map [(m)] 'gitmerge-start-merge)
+ (define-key map [(l)] #'gitmerge-show-log)
+ (define-key map [(d)] #'gitmerge-show-diff)
+ (define-key map [(f)] #'gitmerge-show-files)
+ (define-key map [(s)] #'gitmerge-toggle-skip)
+ (define-key map [(m)] #'gitmerge-start-merge)
+ ;; For convenience:
+ (define-key map [(n)] #'next-line)
+ (define-key map [(p)] #'previous-line)
map)
"Keymap for gitmerge major mode.")
@@ -631,12 +634,18 @@ Branch FROM will be prepended to the list."
(with-current-buffer
(gitmerge-setup-log-buffer gitmerge--commits gitmerge--from)
(goto-char (point-min))
- (insert (propertize "Commands: " 'font-lock-face 'bold)
- "(s) Toggle skip, (l) Show log, (d) Show diff, "
- "(f) Show files, (m) Start merge\n"
- (propertize "Flags: " 'font-lock-face 'bold)
- "(C) Detected backport (cherry-mark), (R) Matches skip "
- "regexp, (M) Manually picked\n\n")
+ (insert (substitute-command-keys
+ (concat
+ (propertize "Commands: " 'font-lock-face 'bold)
+ "\\<gitmerge-mode-map>"
+ "(\\[gitmerge-toggle-skip]) Toggle skip, "
+ "(\\[gitmerge-show-log]) Show log, "
+ "(\\[gitmerge-show-diff]) Show diff, "
+ "(\\[gitmerge-show-files]) Show files, "
+ "(\\[gitmerge-start-merge]) Start merge\n"
+ (propertize "Flags: " 'font-lock-face 'bold)
+ "(C) Detected backport (cherry-mark), (R) Matches skip "
+ "regexp, (M) Manually picked\n\n")))
(gitmerge-mode)
(pop-to-buffer (current-buffer))
(if noninteractive (gitmerge-start-merge))))))
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index 4ca88982cd..178c79b7a0 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -35,7 +35,7 @@ unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH
EMACS = ${top_builddir}/src/emacs
emacs = "${EMACS}" -batch --no-site-file --no-site-lisp \
- --eval '(setq max-specpdl-size 5000)' --eval '(setq load-prefer-newer t)'
+ --eval '(setq load-prefer-newer t)'
make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser
make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser
diff --git a/admin/make-manuals b/admin/make-manuals
index 8085412cc8..a252bf20f1 100755
--- a/admin/make-manuals
+++ b/admin/make-manuals
@@ -33,13 +33,7 @@
### Code:
-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 ()
{
@@ -94,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 a60fead267..d881b81612 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -52,10 +52,12 @@ General steps (for each step, check for possible errors):
./autogen.sh
./configure --with-native-compilation && make
- For a release (as opposed to pretest), delete any left-over "---"
- and "+++" markers from etc/NEWS, as well as the "Temporary note"
- section at the beginning of that file, and commit etc/NEWS if it
- was modified.
+ For a release (as opposed to pretest), visit etc/NEWS and use the
+ "M-x emacs-news-delete-temporary-markers" command to delete any
+ left-over "---" and "+++" markers from etc/NEWS, as well as the
+ "Temporary note" section at the beginning of that file, and commit
+ etc/NEWS if it was modified. For a bug fix release (e.g. 28.2),
+ delete any empty headlines too.
2. Regenerate the versioned ChangeLog.N and etc/AUTHORS files.
@@ -118,12 +120,13 @@ General steps (for each step, check for possible errors):
Set the version number to that of the actual release (commit in
one, as described above). Pick a date about a week from now when
- you intend to make the release. Use M-x add-release-logs to add
- entries to etc/HISTORY and the ChangeLog file. It's best not to
- commit these files until the release is actually made. Merge the
- entries from (unversioned) ChangeLog into the top of the current
- versioned ChangeLog.N and commit that along with etc/HISTORY.
- Then you can tag that commit as the release.
+ you intend to make the release. Use M-x add-release-logs from
+ admin/admin.el to add entries to etc/HISTORY and the ChangeLog
+ file. It's best not to commit these files until the release is
+ actually made. Merge the entries from (unversioned) ChangeLog
+ into the top of the current versioned ChangeLog.N and commit that
+ along with etc/HISTORY. Then you can tag that commit as the
+ release.
Alternatively, you can commit and tag with the RC tag right away,
and delay the final tagging until you actually decide to make a
@@ -163,7 +166,10 @@ General steps (for each step, check for possible errors):
Commit ChangeLog.N, etc/AUTHORS, lisp/ldefs-boot.el, and the files
changed by M-x set-version. Note that the set-version changes
- should be committed separately, as described in step 3 above.
+ should be committed separately, as described in step 3 above, to
+ avoid them being merged to master. The lisp/ldefs-boot.el file
+ should not be merged to master either, so it could be added to the
+ same commit or committed separately.
The easiest way of doing that is "C-x v d ROOT-DIR RET", then go
to the first modified file, press 'M' to mark all modified files,
@@ -384,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/merge-gnulib b/admin/merge-gnulib
index 4dd6a4d222..d3c5520ad0 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -43,7 +43,7 @@ GNULIB_MODULES='
nanosleep nproc nstrftime
pathmax pipe2 pselect pthread_sigmask
qcopy-acl readlink readlinkat regex
- sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio
+ sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stdbool stddef stdio
stpcpy strnlen strtoimax symlink sys_stat sys_time
tempname time time_r time_rz timegm timer-time timespec-add timespec-sub
update-copyright unlocked-io utimensat
@@ -54,7 +54,7 @@ AVOIDED_MODULES='
btowc chmod close crypto/af_alg dup fchdir fstat langinfo lock
mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo
openat-die opendir pthread-h raise
- save-cwd select setenv sigprocmask stat stdarg stdbool
+ save-cwd select setenv sigprocmask stat stdarg
threadlib tzset unsetenv utime utime-h
wchar wcrtomb wctype-h
'
diff --git a/admin/notes/repo b/admin/notes/repo
index f6004a97db..2185c5a003 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
@@ -124,6 +142,11 @@ This ChangeLog file is not put into the repository.
'make change-history' copies all newer ChangeLog entries into the
start of the newest ChangeLog history file. These ChangeLog entries
are thereafter considered to be old, so later uses of 'make ChangeLog'
-and/or 'make change-history' will no longer copy the entries. To
-alter ChangeLog history, run 'make change-history', then edit
-the ChangeLog history files manually and commit your changes.
+and/or 'make change-history' will no longer copy the entries.
+
+To alter ChangeLog history, run 'make change-history' and commit the
+changes made by that command. Then edit the ChangeLog history files
+manually and commit those changes in a second, distinct commit.
+Altering ChangeLog history like this can make things harder for those
+who handle merging branches and Emacs releases, so reserve it for
+correcting more serious mistakes.
diff --git a/admin/notes/unicode b/admin/notes/unicode
index f699f4fb1c..014bfb9b0d 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -103,6 +103,10 @@ modified to follow suit. If there's trailing whitespace in
BidiCharacterTest.txt, it should be removed before committing the new
version.
+src/macuvs.h is a generated file, but if it has changed as a result
+of the updates, please commit it as well (see
+admin/unidata/Makefile.in for an explanation).
+
Visit "emoji-data.txt" with the rebuilt Emacs, and check that an
appropriate font is being used for the emoji (by default Emacs uses
"Noto Color Emoji"). Running the following command in that buffer
diff --git a/admin/notes/www b/admin/notes/www
index 61a80e3d19..d1a8f0637f 100644
--- a/admin/notes/www
+++ b/admin/notes/www
@@ -26,7 +26,7 @@ more specialized, alternative to M-x vc-dir.
* Manual pages
The scripts admin/make-manuals, admin/upload-manuals can be used to do
-a complete update of the on-line manual pages (eg after a release).
+a complete update of the on-line manual pages (e.g. after a release).
* Renaming pages, redirects
@@ -99,7 +99,7 @@ https://lists.gnu.org/r/bug-gnulib/2012-12/msg00072.html
To use something other than CVS, convert the web-pages CVS repository
to the other VCS, then set up a two-way sync between them.
It needs to be two-way in case eg GNU webmasters make a change to the CVS.
-Ref eg
+Ref e.g.
https://github.com/mikjo/bigitr
https://lists.gnu.org/r/savannah-hackers-public/2013-04/msg00022.html
diff --git a/admin/unidata/BidiBrackets.txt b/admin/unidata/BidiBrackets.txt
index 89698f588a..e138e7f5be 100644
--- a/admin/unidata/BidiBrackets.txt
+++ b/admin/unidata/BidiBrackets.txt
@@ -1,6 +1,6 @@
-# BidiBrackets-14.0.0.txt
-# Date: 2021-06-30, 23:59:00 GMT [AG, LI, KW]
-# © 2021 Unicode®, Inc.
+# BidiBrackets-15.0.0.txt
+# Date: 2022-05-03, 18:42:00 GMT [AG, LI, KW]
+# © 2022 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 https://www.unicode.org/terms_of_use.html
#
diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt
index bd8e2c5d00..5861d6e7f4 100644
--- a/admin/unidata/BidiMirroring.txt
+++ b/admin/unidata/BidiMirroring.txt
@@ -1,6 +1,6 @@
-# BidiMirroring-14.0.0.txt
-# Date: 2021-08-08, 22:55:00 GMT [KW, RP]
-# © 2021 Unicode®, Inc.
+# BidiMirroring-15.0.0.txt
+# Date: 2022-05-03, 18:47:00 GMT [KW, RP]
+# © 2022 Unicode®, Inc.
# For terms of use, see https://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
@@ -15,7 +15,7 @@
# value, for which there is another Unicode character that typically has a
glyph
# that is the mirror image of the original character's glyph.
#
-# The repertoire covered by the file is Unicode 14.0.0.
+# The repertoire covered by the file is Unicode 15.0.0.
#
# The file contains a list of lines with mappings from one code point
# to another one for character-based mirroring.
diff --git a/admin/unidata/Blocks.txt b/admin/unidata/Blocks.txt
index cc5d61988b..12684594c9 100644
--- a/admin/unidata/Blocks.txt
+++ b/admin/unidata/Blocks.txt
@@ -1,10 +1,10 @@
-# Blocks-14.0.0.txt
-# Date: 2021-01-22, 23:29:00 GMT [KW]
-# © 2021 Unicode®, Inc.
-# For terms of use, see http://www.unicode.org/terms_of_use.html
+# Blocks-15.0.0.txt
+# Date: 2022-01-28, 20:58:00 GMT [KW]
+# © 2022 Unicode®, Inc.
+# For terms of use, see https://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# Format:
# Start Code..End Code; Block Name
@@ -15,7 +15,7 @@
# and underbars are ignored.
# For example, "Latin Extended-A" and "latin extended a" are
equivalent.
# For more information on the comparison of property values,
-# see UAX #44: http://www.unicode.org/reports/tr44/
+# see UAX #44: https://www.unicode.org/reports/tr44/
#
# All block ranges start with a value where (cp MOD 16) = 0,
# and end with a value where (cp MOD 16) = 15. In other words,
@@ -241,6 +241,7 @@ FFF0..FFFF; Specials
10D00..10D3F; Hanifi Rohingya
10E60..10E7F; Rumi Numeral Symbols
10E80..10EBF; Yezidi
+10EC0..10EFF; Arabic Extended-C
10F00..10F2F; Old Sogdian
10F30..10F6F; Sogdian
10F70..10FAF; Old Uyghur
@@ -272,11 +273,13 @@ FFF0..FFFF; Specials
11A50..11AAF; Soyombo
11AB0..11ABF; Unified Canadian Aboriginal Syllabics Extended-A
11AC0..11AFF; Pau Cin Hau
+11B00..11B5F; Devanagari Extended-A
11C00..11C6F; Bhaiksuki
11C70..11CBF; Marchen
11D00..11D5F; Masaram Gondi
11D60..11DAF; Gunjala Gondi
11EE0..11EFF; Makasar
+11F00..11F5F; Kawi
11FB0..11FBF; Lisu Supplement
11FC0..11FFF; Tamil Supplement
12000..123FF; Cuneiform
@@ -284,7 +287,7 @@ FFF0..FFFF; Specials
12480..1254F; Early Dynastic Cuneiform
12F90..12FFF; Cypro-Minoan
13000..1342F; Egyptian Hieroglyphs
-13430..1343F; Egyptian Hieroglyph Format Controls
+13430..1345F; Egyptian Hieroglyph Format Controls
14400..1467F; Anatolian Hieroglyphs
16800..16A3F; Bamum Supplement
16A40..16A6F; Mro
@@ -309,6 +312,7 @@ FFF0..FFFF; Specials
1D000..1D0FF; Byzantine Musical Symbols
1D100..1D1FF; Musical Symbols
1D200..1D24F; Ancient Greek Musical Notation
+1D2C0..1D2DF; Kaktovik Numerals
1D2E0..1D2FF; Mayan Numerals
1D300..1D35F; Tai Xuan Jing Symbols
1D360..1D37F; Counting Rod Numerals
@@ -316,9 +320,11 @@ FFF0..FFFF; Specials
1D800..1DAAF; Sutton SignWriting
1DF00..1DFFF; Latin Extended-G
1E000..1E02F; Glagolitic Supplement
+1E030..1E08F; Cyrillic Extended-D
1E100..1E14F; Nyiakeng Puachue Hmong
1E290..1E2BF; Toto
1E2C0..1E2FF; Wancho
+1E4D0..1E4FF; Nag Mundari
1E7E0..1E7FF; Ethiopic Extended-B
1E800..1E8DF; Mende Kikakui
1E900..1E95F; Adlam
@@ -348,6 +354,7 @@ FFF0..FFFF; Specials
2CEB0..2EBEF; CJK Unified Ideographs Extension F
2F800..2FA1F; CJK Compatibility Ideographs Supplement
30000..3134F; CJK Unified Ideographs Extension G
+31350..323AF; CJK Unified Ideographs Extension H
E0000..E007F; Tags
E0100..E01EF; Variation Selectors Supplement
F0000..FFFFF; Supplementary Private Use Area-A
diff --git a/admin/unidata/IVD_Sequences.txt b/admin/unidata/IVD_Sequences.txt
index 886d8519ab..86a4ab5138 100644
--- a/admin/unidata/IVD_Sequences.txt
+++ b/admin/unidata/IVD_Sequences.txt
@@ -2,6 +2,9 @@
#
# History:
#
+# 2022-09-13 Registration of additional sequences in the Adobe-Japan1
+# collection.
+#
# 2020-11-06 Registration of additional sequences in the MSARG
# collection.
#
@@ -32,7 +35,7 @@
# For more details on the IVD, see UTS #37:
# https://www.unicode.org/reports/tr37/
#
-# Copyright 2006-2020 Unicode, Inc.
+# Copyright 2006-2022 Unicode, Inc.
# For terms of use, see: https://www.unicode.org/copyright.html#8
#
3402 E0100; Adobe-Japan1; CID+13698
@@ -39337,4 +39340,5 @@ FA29 E0100; Adobe-Japan1; CID+8687
2EB71 E0101; Moji_Joho; MJ059252
2EB79 E0100; Moji_Joho; MJ059255
2EB79 E0101; Moji_Joho; MJ059256
+31350 E0100; Adobe-Japan1; CID+19130
# EOF
diff --git a/admin/unidata/IdnaMappingTable.txt
b/admin/unidata/IdnaMappingTable.txt
index 1b862827ef..e4c0611792 100644
--- a/admin/unidata/IdnaMappingTable.txt
+++ b/admin/unidata/IdnaMappingTable.txt
@@ -1,13 +1,13 @@
# IdnaMappingTable.txt
-# Date: 2021-07-10, 00:49:51 GMT
-# © 2021 Unicode®, Inc.
+# Date: 2022-05-02, 19:29:26 GMT
+# © 2022 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
+# Version: 15.0.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr46
+# For documentation and usage, see https://www.unicode.org/reports/tr46
#
0000..002C ; disallowed_STD3_valid # 1.1
<control-0000>..COMMA
002D..002E ; valid # 1.1
HYPHEN-MINUS..FULL STOP
@@ -1278,7 +1278,8 @@
0CE6..0CEF ; valid # 1.1 KANNADA DIGIT
ZERO..KANNADA DIGIT NINE
0CF0 ; disallowed # NA <reserved-0CF0>
0CF1..0CF2 ; valid # 5.0 KANNADA SIGN
JIHVAMULIYA..KANNADA SIGN UPADHMANIYA
-0CF3..0CFF ; disallowed # NA
<reserved-0CF3>..<reserved-0CFF>
+0CF3 ; valid # 15.0 KANNADA SIGN
COMBINING ANUSVARA ABOVE RIGHT
+0CF4..0CFF ; disallowed # NA
<reserved-0CF4>..<reserved-0CFF>
0D00 ; valid # 10.0 MALAYALAM SIGN
COMBINING ANUSVARA ABOVE
0D01 ; valid # 7.0 MALAYALAM SIGN
CANDRABINDU
0D02..0D03 ; valid # 1.1 MALAYALAM SIGN
ANUSVARA..MALAYALAM SIGN VISARGA
@@ -1386,7 +1387,8 @@
0EC6 ; valid # 1.1 LAO KO LA
0EC7 ; disallowed # NA <reserved-0EC7>
0EC8..0ECD ; valid # 1.1 LAO TONE MAI
EK..LAO NIGGAHITA
-0ECE..0ECF ; disallowed # NA
<reserved-0ECE>..<reserved-0ECF>
+0ECE ; valid # 15.0 LAO YAMAKKAN
+0ECF ; disallowed # NA <reserved-0ECF>
0ED0..0ED9 ; valid # 1.1 LAO DIGIT
ZERO..LAO DIGIT NINE
0EDA..0EDB ; disallowed # NA
<reserved-0EDA>..<reserved-0EDB>
0EDC ; mapped ; 0EAB 0E99 # 1.1 LAO HO NO
@@ -6206,7 +6208,8 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
10EAD ; valid ; ; NV8 # 13.0 YEZIDI
HYPHENATION MARK
10EAE..10EAF ; disallowed # NA
<reserved-10EAE>..<reserved-10EAF>
10EB0..10EB1 ; valid # 13.0 YEZIDI LETTER
LAM WITH DOT ABOVE..YEZIDI LETTER YOT WITH CIRCUMFLEX ABOVE
-10EB2..10EFF ; disallowed # NA
<reserved-10EB2>..<reserved-10EFF>
+10EB2..10EFC ; disallowed # NA
<reserved-10EB2>..<reserved-10EFC>
+10EFD..10EFF ; valid # 15.0 ARABIC SMALL LOW
WORD SAKTA..ARABIC SMALL LOW WORD MADDA
10F00..10F1C ; valid # 11.0 OLD SOGDIAN
LETTER ALEPH..OLD SOGDIAN LETTER FINAL TAW WITH VERTICAL TAIL
10F1D..10F26 ; valid ; ; NV8 # 11.0 OLD SOGDIAN
NUMBER ONE..OLD SOGDIAN FRACTION ONE HALF
10F27 ; valid # 11.0 OLD SOGDIAN
LIGATURE AYIN-DALETH
@@ -6271,7 +6274,8 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
11213..11237 ; valid # 7.0 KHOJKI LETTER
NYA..KHOJKI SIGN SHADDA
11238..1123D ; valid ; ; NV8 # 7.0 KHOJKI
DANDA..KHOJKI ABBREVIATION SIGN
1123E ; valid # 9.0 KHOJKI SIGN SUKUN
-1123F..1127F ; disallowed # NA
<reserved-1123F>..<reserved-1127F>
+1123F..11241 ; valid # 15.0 KHOJKI LETTER
QA..KHOJKI VOWEL SIGN VOCALIC R
+11242..1127F ; disallowed # NA
<reserved-11242>..<reserved-1127F>
11280..11286 ; valid # 8.0 MULTANI LETTER
A..MULTANI LETTER GA
11287 ; disallowed # NA <reserved-11287>
11288 ; valid # 8.0 MULTANI LETTER
GHA
@@ -6443,7 +6447,9 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
11AA3..11AAF ; disallowed # NA
<reserved-11AA3>..<reserved-11AAF>
11AB0..11ABF ; valid # 14.0 CANADIAN
SYLLABICS NATTILIK HI..CANADIAN SYLLABICS SPA
11AC0..11AF8 ; valid # 7.0 PAU CIN HAU
LETTER PA..PAU CIN HAU GLOTTAL STOP FINAL
-11AF9..11BFF ; disallowed # NA
<reserved-11AF9>..<reserved-11BFF>
+11AF9..11AFF ; disallowed # NA
<reserved-11AF9>..<reserved-11AFF>
+11B00..11B09 ; valid ; ; NV8 # 15.0 DEVANAGARI HEAD
MARK..DEVANAGARI SIGN MINDU
+11B0A..11BFF ; disallowed # NA
<reserved-11B0A>..<reserved-11BFF>
11C00..11C08 ; valid # 9.0 BHAIKSUKI LETTER
A..BHAIKSUKI LETTER VOCALIC L
11C09 ; disallowed # NA <reserved-11C09>
11C0A..11C36 ; valid # 9.0 BHAIKSUKI LETTER
E..BHAIKSUKI VOWEL SIGN VOCALIC L
@@ -6489,7 +6495,15 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
11DAA..11EDF ; disallowed # NA
<reserved-11DAA>..<reserved-11EDF>
11EE0..11EF6 ; valid # 11.0 MAKASAR LETTER
KA..MAKASAR VOWEL SIGN O
11EF7..11EF8 ; valid ; ; NV8 # 11.0 MAKASAR
PASSIMBANG..MAKASAR END OF SECTION
-11EF9..11FAF ; disallowed # NA
<reserved-11EF9>..<reserved-11FAF>
+11EF9..11EFF ; disallowed # NA
<reserved-11EF9>..<reserved-11EFF>
+11F00..11F10 ; valid # 15.0 KAWI SIGN
CANDRABINDU..KAWI LETTER O
+11F11 ; disallowed # NA <reserved-11F11>
+11F12..11F3A ; valid # 15.0 KAWI LETTER
KA..KAWI VOWEL SIGN VOCALIC R
+11F3B..11F3D ; disallowed # NA
<reserved-11F3B>..<reserved-11F3D>
+11F3E..11F42 ; valid # 15.0 KAWI VOWEL SIGN
E..KAWI CONJOINER
+11F43..11F4F ; valid ; ; NV8 # 15.0 KAWI DANDA..KAWI
PUNCTUATION CLOSING SPIRAL
+11F50..11F59 ; valid # 15.0 KAWI DIGIT
ZERO..KAWI DIGIT NINE
+11F5A..11FAF ; disallowed # NA
<reserved-11F5A>..<reserved-11FAF>
11FB0 ; valid # 13.0 LISU LETTER YHA
11FB1..11FBF ; disallowed # NA
<reserved-11FB1>..<reserved-11FBF>
11FC0..11FF1 ; valid ; ; NV8 # 12.0 TAMIL FRACTION
ONE THREE-HUNDRED-AND-TWENTIETH..TAMIL SIGN VAKAIYARAA
@@ -6511,9 +6525,11 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
12FF1..12FF2 ; valid ; ; NV8 # 14.0 CYPRO-MINOAN
SIGN CM301..CYPRO-MINOAN SIGN CM302
12FF3..12FFF ; disallowed # NA
<reserved-12FF3>..<reserved-12FFF>
13000..1342E ; valid # 5.2 EGYPTIAN
HIEROGLYPH A001..EGYPTIAN HIEROGLYPH AA032
-1342F ; disallowed # NA <reserved-1342F>
+1342F ; valid # 15.0 EGYPTIAN
HIEROGLYPH V011D
13430..13438 ; disallowed # 12.0 EGYPTIAN
HIEROGLYPH VERTICAL JOINER..EGYPTIAN HIEROGLYPH END SEGMENT
-13439..143FF ; disallowed # NA
<reserved-13439>..<reserved-143FF>
+13439..1343F ; disallowed # 15.0 EGYPTIAN
HIEROGLYPH INSERT AT MIDDLE..EGYPTIAN HIEROGLYPH END WALLED ENCLOSURE
+13440..13455 ; valid # 15.0 EGYPTIAN
HIEROGLYPH MIRROR HORIZONTALLY..EGYPTIAN HIEROGLYPH MODIFIER DAMAGED
+13456..143FF ; disallowed # NA
<reserved-13456>..<reserved-143FF>
14400..14646 ; valid # 8.0 ANATOLIAN
HIEROGLYPH A001..ANATOLIAN HIEROGLYPH A530
14647..167FF ; disallowed # NA
<reserved-14647>..<reserved-167FF>
16800..16A38 ; valid # 6.0 BAMUM LETTER
PHASE-A NGKUE MFON..BAMUM LETTER PHASE-F VUEQ
@@ -6615,9 +6631,13 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1B000..1B001 ; valid # 6.0 KATAKANA LETTER
ARCHAIC E..HIRAGANA LETTER ARCHAIC YE
1B002..1B11E ; valid # 10.0 HENTAIGANA
LETTER A-1..HENTAIGANA LETTER N-MU-MO-2
1B11F..1B122 ; valid # 14.0 HIRAGANA LETTER
ARCHAIC WU..KATAKANA LETTER ARCHAIC WU
-1B123..1B14F ; disallowed # NA
<reserved-1B123>..<reserved-1B14F>
+1B123..1B131 ; disallowed # NA
<reserved-1B123>..<reserved-1B131>
+1B132 ; valid # 15.0 HIRAGANA LETTER
SMALL KO
+1B133..1B14F ; disallowed # NA
<reserved-1B133>..<reserved-1B14F>
1B150..1B152 ; valid # 12.0 HIRAGANA LETTER
SMALL WI..HIRAGANA LETTER SMALL WO
-1B153..1B163 ; disallowed # NA
<reserved-1B153>..<reserved-1B163>
+1B153..1B154 ; disallowed # NA
<reserved-1B153>..<reserved-1B154>
+1B155 ; valid # 15.0 KATAKANA LETTER
SMALL KO
+1B156..1B163 ; disallowed # NA
<reserved-1B156>..<reserved-1B163>
1B164..1B167 ; valid # 12.0 KATAKANA LETTER
SMALL WI..KATAKANA LETTER SMALL N
1B168..1B16F ; disallowed # NA
<reserved-1B168>..<reserved-1B16F>
1B170..1B2FB ; valid # 10.0 NUSHU
CHARACTER-1B170..NUSHU CHARACTER-1B2FB
@@ -6668,7 +6688,9 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1D1E9..1D1EA ; valid ; ; NV8 # 14.0 MUSICAL SYMBOL
SORI..MUSICAL SYMBOL KORON
1D1EB..1D1FF ; disallowed # NA
<reserved-1D1EB>..<reserved-1D1FF>
1D200..1D245 ; valid ; ; NV8 # 4.1 GREEK VOCAL
NOTATION SYMBOL-1..GREEK MUSICAL LEIMMA
-1D246..1D2DF ; disallowed # NA
<reserved-1D246>..<reserved-1D2DF>
+1D246..1D2BF ; disallowed # NA
<reserved-1D246>..<reserved-1D2BF>
+1D2C0..1D2D3 ; valid ; ; NV8 # 15.0 KAKTOVIK NUMERAL
ZERO..KAKTOVIK NUMERAL NINETEEN
+1D2D4..1D2DF ; disallowed # NA
<reserved-1D2D4>..<reserved-1D2DF>
1D2E0..1D2F3 ; valid ; ; NV8 # 11.0 MAYAN NUMERAL
ZERO..MAYAN NUMERAL NINETEEN
1D2F4..1D2FF ; disallowed # NA
<reserved-1D2F4>..<reserved-1D2FF>
1D300..1D356 ; valid ; ; NV8 # 4.0 MONOGRAM FOR
EARTH..TETRAGRAM FOR FOSTERING
@@ -7701,7 +7723,9 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1DAA1..1DAAF ; valid # 8.0 SIGNWRITING
ROTATION MODIFIER-2..SIGNWRITING ROTATION MODIFIER-16
1DAB0..1DEFF ; disallowed # NA
<reserved-1DAB0>..<reserved-1DEFF>
1DF00..1DF1E ; valid # 14.0 LATIN SMALL
LETTER FENG DIGRAPH WITH TRILL..LATIN SMALL LETTER S WITH CURL
-1DF1F..1DFFF ; disallowed # NA
<reserved-1DF1F>..<reserved-1DFFF>
+1DF1F..1DF24 ; disallowed # NA
<reserved-1DF1F>..<reserved-1DF24>
+1DF25..1DF2A ; valid # 15.0 LATIN SMALL
LETTER D WITH MID-HEIGHT LEFT HOOK..LATIN SMALL LETTER T WITH MID-HEIGHT LEFT
HOOK
+1DF2B..1DFFF ; disallowed # NA
<reserved-1DF2B>..<reserved-1DFFF>
1E000..1E006 ; valid # 9.0 COMBINING
GLAGOLITIC LETTER AZU..COMBINING GLAGOLITIC LETTER ZHIVETE
1E007 ; disallowed # NA <reserved-1E007>
1E008..1E018 ; valid # 9.0 COMBINING
GLAGOLITIC LETTER ZEMLJA..COMBINING GLAGOLITIC LETTER HERU
@@ -7711,7 +7735,72 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1E023..1E024 ; valid # 9.0 COMBINING
GLAGOLITIC LETTER YU..COMBINING GLAGOLITIC LETTER SMALL YUS
1E025 ; disallowed # NA <reserved-1E025>
1E026..1E02A ; valid # 9.0 COMBINING
GLAGOLITIC LETTER YO..COMBINING GLAGOLITIC LETTER FITA
-1E02B..1E0FF ; disallowed # NA
<reserved-1E02B>..<reserved-1E0FF>
+1E02B..1E02F ; disallowed # NA
<reserved-1E02B>..<reserved-1E02F>
+1E030 ; mapped ; 0430 # 15.0 MODIFIER LETTER
CYRILLIC SMALL A
+1E031 ; mapped ; 0431 # 15.0 MODIFIER LETTER
CYRILLIC SMALL BE
+1E032 ; mapped ; 0432 # 15.0 MODIFIER LETTER
CYRILLIC SMALL VE
+1E033 ; mapped ; 0433 # 15.0 MODIFIER LETTER
CYRILLIC SMALL GHE
+1E034 ; mapped ; 0434 # 15.0 MODIFIER LETTER
CYRILLIC SMALL DE
+1E035 ; mapped ; 0435 # 15.0 MODIFIER LETTER
CYRILLIC SMALL IE
+1E036 ; mapped ; 0436 # 15.0 MODIFIER LETTER
CYRILLIC SMALL ZHE
+1E037 ; mapped ; 0437 # 15.0 MODIFIER LETTER
CYRILLIC SMALL ZE
+1E038 ; mapped ; 0438 # 15.0 MODIFIER LETTER
CYRILLIC SMALL I
+1E039 ; mapped ; 043A # 15.0 MODIFIER LETTER
CYRILLIC SMALL KA
+1E03A ; mapped ; 043B # 15.0 MODIFIER LETTER
CYRILLIC SMALL EL
+1E03B ; mapped ; 043C # 15.0 MODIFIER LETTER
CYRILLIC SMALL EM
+1E03C ; mapped ; 043E # 15.0 MODIFIER LETTER
CYRILLIC SMALL O
+1E03D ; mapped ; 043F # 15.0 MODIFIER LETTER
CYRILLIC SMALL PE
+1E03E ; mapped ; 0440 # 15.0 MODIFIER LETTER
CYRILLIC SMALL ER
+1E03F ; mapped ; 0441 # 15.0 MODIFIER LETTER
CYRILLIC SMALL ES
+1E040 ; mapped ; 0442 # 15.0 MODIFIER LETTER
CYRILLIC SMALL TE
+1E041 ; mapped ; 0443 # 15.0 MODIFIER LETTER
CYRILLIC SMALL U
+1E042 ; mapped ; 0444 # 15.0 MODIFIER LETTER
CYRILLIC SMALL EF
+1E043 ; mapped ; 0445 # 15.0 MODIFIER LETTER
CYRILLIC SMALL HA
+1E044 ; mapped ; 0446 # 15.0 MODIFIER LETTER
CYRILLIC SMALL TSE
+1E045 ; mapped ; 0447 # 15.0 MODIFIER LETTER
CYRILLIC SMALL CHE
+1E046 ; mapped ; 0448 # 15.0 MODIFIER LETTER
CYRILLIC SMALL SHA
+1E047 ; mapped ; 044B # 15.0 MODIFIER LETTER
CYRILLIC SMALL YERU
+1E048 ; mapped ; 044D # 15.0 MODIFIER LETTER
CYRILLIC SMALL E
+1E049 ; mapped ; 044E # 15.0 MODIFIER LETTER
CYRILLIC SMALL YU
+1E04A ; mapped ; A689 # 15.0 MODIFIER LETTER
CYRILLIC SMALL DZZE
+1E04B ; mapped ; 04D9 # 15.0 MODIFIER LETTER
CYRILLIC SMALL SCHWA
+1E04C ; mapped ; 0456 # 15.0 MODIFIER LETTER
CYRILLIC SMALL BYELORUSSIAN-UKRAINIAN I
+1E04D ; mapped ; 0458 # 15.0 MODIFIER LETTER
CYRILLIC SMALL JE
+1E04E ; mapped ; 04E9 # 15.0 MODIFIER LETTER
CYRILLIC SMALL BARRED O
+1E04F ; mapped ; 04AF # 15.0 MODIFIER LETTER
CYRILLIC SMALL STRAIGHT U
+1E050 ; mapped ; 04CF # 15.0 MODIFIER LETTER
CYRILLIC SMALL PALOCHKA
+1E051 ; mapped ; 0430 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER A
+1E052 ; mapped ; 0431 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER BE
+1E053 ; mapped ; 0432 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER VE
+1E054 ; mapped ; 0433 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER GHE
+1E055 ; mapped ; 0434 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER DE
+1E056 ; mapped ; 0435 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER IE
+1E057 ; mapped ; 0436 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER ZHE
+1E058 ; mapped ; 0437 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER ZE
+1E059 ; mapped ; 0438 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER I
+1E05A ; mapped ; 043A # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER KA
+1E05B ; mapped ; 043B # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER EL
+1E05C ; mapped ; 043E # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER O
+1E05D ; mapped ; 043F # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER PE
+1E05E ; mapped ; 0441 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER ES
+1E05F ; mapped ; 0443 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER U
+1E060 ; mapped ; 0444 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER EF
+1E061 ; mapped ; 0445 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER HA
+1E062 ; mapped ; 0446 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER TSE
+1E063 ; mapped ; 0447 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER CHE
+1E064 ; mapped ; 0448 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER SHA
+1E065 ; mapped ; 044A # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER HARD SIGN
+1E066 ; mapped ; 044B # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER YERU
+1E067 ; mapped ; 0491 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER GHE WITH UPTURN
+1E068 ; mapped ; 0456 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+1E069 ; mapped ; 0455 # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER DZE
+1E06A ; mapped ; 045F # 15.0 CYRILLIC
SUBSCRIPT SMALL LETTER DZHE
+1E06B ; mapped ; 04AB # 15.0 MODIFIER LETTER
CYRILLIC SMALL ES WITH DESCENDER
+1E06C ; mapped ; A651 # 15.0 MODIFIER LETTER
CYRILLIC SMALL YERU WITH BACK YER
+1E06D ; mapped ; 04B1 # 15.0 MODIFIER LETTER
CYRILLIC SMALL STRAIGHT U WITH STROKE
+1E06E..1E08E ; disallowed # NA
<reserved-1E06E>..<reserved-1E08E>
+1E08F ; valid # 15.0 COMBINING
CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+1E090..1E0FF ; disallowed # NA
<reserved-1E090>..<reserved-1E0FF>
1E100..1E12C ; valid # 12.0 NYIAKENG PUACHUE
HMONG LETTER MA..NYIAKENG PUACHUE HMONG LETTER W
1E12D..1E12F ; disallowed # NA
<reserved-1E12D>..<reserved-1E12F>
1E130..1E13D ; valid # 12.0 NYIAKENG PUACHUE
HMONG TONE-B..NYIAKENG PUACHUE HMONG SYLLABLE LENGTHENER
@@ -7726,7 +7815,9 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1E2C0..1E2F9 ; valid # 12.0 WANCHO LETTER
AA..WANCHO DIGIT NINE
1E2FA..1E2FE ; disallowed # NA
<reserved-1E2FA>..<reserved-1E2FE>
1E2FF ; valid ; ; NV8 # 12.0 WANCHO NGUN SIGN
-1E300..1E7DF ; disallowed # NA
<reserved-1E300>..<reserved-1E7DF>
+1E300..1E4CF ; disallowed # NA
<reserved-1E300>..<reserved-1E4CF>
+1E4D0..1E4F9 ; valid # 15.0 NAG MUNDARI
LETTER O..NAG MUNDARI DIGIT NINE
+1E4FA..1E7DF ; disallowed # NA
<reserved-1E4FA>..<reserved-1E7DF>
1E7E0..1E7E6 ; valid # 14.0 ETHIOPIC
SYLLABLE HHYA..ETHIOPIC SYLLABLE HHYO
1E7E7 ; disallowed # NA <reserved-1E7E7>
1E7E8..1E7EB ; valid # 14.0 ETHIOPIC
SYLLABLE GURAGE HHWA..ETHIOPIC SYLLABLE HHWE
@@ -8213,7 +8304,8 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
1F6D3..1F6D4 ; valid ; ; NV8 # 10.0 STUPA..PAGODA
1F6D5 ; valid ; ; NV8 # 12.0 HINDU TEMPLE
1F6D6..1F6D7 ; valid ; ; NV8 # 13.0 HUT..ELEVATOR
-1F6D8..1F6DC ; disallowed # NA
<reserved-1F6D8>..<reserved-1F6DC>
+1F6D8..1F6DB ; disallowed # NA
<reserved-1F6D8>..<reserved-1F6DB>
+1F6DC ; valid ; ; NV8 # 15.0 WIRELESS
1F6DD..1F6DF ; valid ; ; NV8 # 14.0 PLAYGROUND
SLIDE..RING BUOY
1F6E0..1F6EC ; valid ; ; NV8 # 7.0 HAMMER AND
WRENCH..AIRPLANE ARRIVING
1F6ED..1F6EF ; disallowed # NA
<reserved-1F6ED>..<reserved-1F6EF>
@@ -8225,10 +8317,13 @@ FFFE..FFFF ; disallowed
# 1.1 <noncharacter-FFFE
1F6FB..1F6FC ; valid ; ; NV8 # 13.0 PICKUP
TRUCK..ROLLER SKATE
1F6FD..1F6FF ; disallowed # NA
<reserved-1F6FD>..<reserved-1F6FF>
1F700..1F773 ; valid ; ; NV8 # 6.0 ALCHEMICAL
SYMBOL FOR QUINTESSENCE..ALCHEMICAL SYMBOL FOR HALF OUNCE
-1F774..1F77F ; disallowed # NA
<reserved-1F774>..<reserved-1F77F>
+1F774..1F776 ; valid ; ; NV8 # 15.0 LOT OF
FORTUNE..LUNAR ECLIPSE
+1F777..1F77A ; disallowed # NA
<reserved-1F777>..<reserved-1F77A>
+1F77B..1F77F ; valid ; ; NV8 # 15.0 HAUMEA..ORCUS
1F780..1F7D4 ; valid ; ; NV8 # 7.0 BLACK
LEFT-POINTING ISOSCELES RIGHT TRIANGLE..HEAVY TWELVE POINTED PINWHEEL STAR
1F7D5..1F7D8 ; valid ; ; NV8 # 11.0 CIRCLED
TRIANGLE..NEGATIVE CIRCLED SQUARE
-1F7D9..1F7DF ; disallowed # NA
<reserved-1F7D9>..<reserved-1F7DF>
+1F7D9 ; valid ; ; NV8 # 15.0 NINE POINTED
WHITE STAR
+1F7DA..1F7DF ; disallowed # NA
<reserved-1F7DA>..<reserved-1F7DF>
1F7E0..1F7EB ; valid ; ; NV8 # 12.0 LARGE ORANGE
CIRCLE..LARGE BROWN SQUARE
1F7EC..1F7EF ; disallowed # NA
<reserved-1F7EC>..<reserved-1F7EF>
1F7F0 ; valid ; ; NV8 # 14.0 HEAVY EQUALS SIGN
@@ -8295,30 +8390,37 @@ FFFE..FFFF ; disallowed
# 1.1 <noncharacter-FFFE
1FA6E..1FA6F ; disallowed # NA
<reserved-1FA6E>..<reserved-1FA6F>
1FA70..1FA73 ; valid ; ; NV8 # 12.0 BALLET
SHOES..SHORTS
1FA74 ; valid ; ; NV8 # 13.0 THONG SANDAL
-1FA75..1FA77 ; disallowed # NA
<reserved-1FA75>..<reserved-1FA77>
+1FA75..1FA77 ; valid ; ; NV8 # 15.0 LIGHT BLUE
HEART..PINK HEART
1FA78..1FA7A ; valid ; ; NV8 # 12.0 DROP OF
BLOOD..STETHOSCOPE
1FA7B..1FA7C ; valid ; ; NV8 # 14.0 X-RAY..CRUTCH
1FA7D..1FA7F ; disallowed # NA
<reserved-1FA7D>..<reserved-1FA7F>
1FA80..1FA82 ; valid ; ; NV8 # 12.0 YO-YO..PARACHUTE
1FA83..1FA86 ; valid ; ; NV8 # 13.0
BOOMERANG..NESTING DOLLS
-1FA87..1FA8F ; disallowed # NA
<reserved-1FA87>..<reserved-1FA8F>
+1FA87..1FA88 ; valid ; ; NV8 # 15.0 MARACAS..FLUTE
+1FA89..1FA8F ; disallowed # NA
<reserved-1FA89>..<reserved-1FA8F>
1FA90..1FA95 ; valid ; ; NV8 # 12.0 RINGED
PLANET..BANJO
1FA96..1FAA8 ; valid ; ; NV8 # 13.0 MILITARY
HELMET..ROCK
1FAA9..1FAAC ; valid ; ; NV8 # 14.0 MIRROR
BALL..HAMSA
-1FAAD..1FAAF ; disallowed # NA
<reserved-1FAAD>..<reserved-1FAAF>
+1FAAD..1FAAF ; valid ; ; NV8 # 15.0 FOLDING HAND
FAN..KHANDA
1FAB0..1FAB6 ; valid ; ; NV8 # 13.0 FLY..FEATHER
1FAB7..1FABA ; valid ; ; NV8 # 14.0 LOTUS..NEST WITH
EGGS
-1FABB..1FABF ; disallowed # NA
<reserved-1FABB>..<reserved-1FABF>
+1FABB..1FABD ; valid ; ; NV8 # 15.0 HYACINTH..WING
+1FABE ; disallowed # NA <reserved-1FABE>
+1FABF ; valid ; ; NV8 # 15.0 GOOSE
1FAC0..1FAC2 ; valid ; ; NV8 # 13.0 ANATOMICAL
HEART..PEOPLE HUGGING
1FAC3..1FAC5 ; valid ; ; NV8 # 14.0 PREGNANT
MAN..PERSON WITH CROWN
-1FAC6..1FACF ; disallowed # NA
<reserved-1FAC6>..<reserved-1FACF>
+1FAC6..1FACD ; disallowed # NA
<reserved-1FAC6>..<reserved-1FACD>
+1FACE..1FACF ; valid ; ; NV8 # 15.0 MOOSE..DONKEY
1FAD0..1FAD6 ; valid ; ; NV8 # 13.0
BLUEBERRIES..TEAPOT
1FAD7..1FAD9 ; valid ; ; NV8 # 14.0 POURING
LIQUID..JAR
-1FADA..1FADF ; disallowed # NA
<reserved-1FADA>..<reserved-1FADF>
+1FADA..1FADB ; valid ; ; NV8 # 15.0 GINGER ROOT..PEA
POD
+1FADC..1FADF ; disallowed # NA
<reserved-1FADC>..<reserved-1FADF>
1FAE0..1FAE7 ; valid ; ; NV8 # 14.0 MELTING
FACE..BUBBLES
-1FAE8..1FAEF ; disallowed # NA
<reserved-1FAE8>..<reserved-1FAEF>
+1FAE8 ; valid ; ; NV8 # 15.0 SHAKING FACE
+1FAE9..1FAEF ; disallowed # NA
<reserved-1FAE9>..<reserved-1FAEF>
1FAF0..1FAF6 ; valid ; ; NV8 # 14.0 HAND WITH INDEX
FINGER AND THUMB CROSSED..HEART HANDS
-1FAF7..1FAFF ; disallowed # NA
<reserved-1FAF7>..<reserved-1FAFF>
+1FAF7..1FAF8 ; valid ; ; NV8 # 15.0 LEFTWARDS
PUSHING HAND..RIGHTWARDS PUSHING HAND
+1FAF9..1FAFF ; disallowed # NA
<reserved-1FAF9>..<reserved-1FAFF>
1FB00..1FB92 ; valid ; ; NV8 # 13.0 BLOCK
SEXTANT-1..UPPER HALF INVERSE MEDIUM SHADE AND LOWER HALF BLOCK
1FB93 ; disallowed # NA <reserved-1FB93>
1FB94..1FBCA ; valid ; ; NV8 # 13.0 LEFT HALF
INVERSE MEDIUM SHADE AND RIGHT HALF BLOCK..WHITE UP-POINTING CHEVRON
@@ -8341,7 +8443,8 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
2A6E0..2A6FF ; disallowed # NA
<reserved-2A6E0>..<reserved-2A6FF>
2A700..2B734 ; valid # 5.2 CJK UNIFIED
IDEOGRAPH-2A700..CJK UNIFIED IDEOGRAPH-2B734
2B735..2B738 ; valid # 14.0 CJK UNIFIED
IDEOGRAPH-2B735..CJK UNIFIED IDEOGRAPH-2B738
-2B739..2B73F ; disallowed # NA
<reserved-2B739>..<reserved-2B73F>
+2B739 ; valid # 15.0 CJK UNIFIED
IDEOGRAPH-2B739
+2B73A..2B73F ; disallowed # NA
<reserved-2B73A>..<reserved-2B73F>
2B740..2B81D ; valid # 6.0 CJK UNIFIED
IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D
2B81E..2B81F ; disallowed # NA
<reserved-2B81E>..<reserved-2B81F>
2B820..2CEA1 ; valid # 8.0 CJK UNIFIED
IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1
@@ -8883,7 +8986,9 @@ FFFE..FFFF ; disallowed #
1.1 <noncharacter-FFFE
2FA1E..2FFFD ; disallowed # NA
<reserved-2FA1E>..<reserved-2FFFD>
2FFFE..2FFFF ; disallowed # 2.0
<noncharacter-2FFFE>..<noncharacter-2FFFF>
30000..3134A ; valid # 13.0 CJK UNIFIED
IDEOGRAPH-30000..CJK UNIFIED IDEOGRAPH-3134A
-3134B..3FFFD ; disallowed # NA
<reserved-3134B>..<reserved-3FFFD>
+3134B..3134F ; disallowed # NA
<reserved-3134B>..<reserved-3134F>
+31350..323AF ; valid # 15.0 CJK UNIFIED
IDEOGRAPH-31350..CJK UNIFIED IDEOGRAPH-323AF
+323B0..3FFFD ; disallowed # NA
<reserved-323B0>..<reserved-3FFFD>
3FFFE..3FFFF ; disallowed # 2.0
<noncharacter-3FFFE>..<noncharacter-3FFFF>
40000..4FFFD ; disallowed # NA
<reserved-40000>..<reserved-4FFFD>
4FFFE..4FFFF ; disallowed # 2.0
<noncharacter-4FFFE>..<noncharacter-4FFFF>
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index 4b3e72f013..f3e653879c 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -138,7 +138,8 @@ gen-clean:
rm -f ${unidir}/charscript.el*
rm -f ${unidir}/emoji-zwj.el*
rm -f ${unifiles} ${unidir}/charprop.el
- rm -f ${unidir}/emoji-labels.el*
+ rm -f ${unidir}/emoji-labels.el ${unidir}/idna-mapping.el \
+ ${unidir}/uni-confusable.el ${unidir}/uni-scripts.el
## ref: https://lists.gnu.org/r/emacs-devel/2013-11/msg01029.html
maintainer-clean: gen-clean distclean
diff --git a/admin/unidata/NormalizationTest.txt
b/admin/unidata/NormalizationTest.txt
index 302c35f37c..e75b4801c9 100644
--- a/admin/unidata/NormalizationTest.txt
+++ b/admin/unidata/NormalizationTest.txt
@@ -1,11 +1,11 @@
-# NormalizationTest-14.0.0.txt
-# Date: 2021-05-28, 21:49:12 GMT
-# © 2021 Unicode®, Inc.
+# NormalizationTest-15.0.0.txt
+# Date: 2022-04-02, 01:29:09 GMT
+# © 2022 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 Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# Normalization Test Suite
# Format:
@@ -16208,6 +16208,68 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; )
HALFWIDTH WHITE CIRCLE
1D7FD;1D7FD;1D7FD;0037;0037; # (𝟽; 𝟽; 𝟽; 7; 7; ) MATHEMATICAL MONOSPACE DIGIT
SEVEN
1D7FE;1D7FE;1D7FE;0038;0038; # (𝟾; 𝟾; 𝟾; 8; 8; ) MATHEMATICAL MONOSPACE DIGIT
EIGHT
1D7FF;1D7FF;1D7FF;0039;0039; # (𝟿; 𝟿; 𝟿; 9; 9; ) MATHEMATICAL MONOSPACE DIGIT
NINE
+1E030;1E030;1E030;0430;0430; # (𞀰; 𞀰; 𞀰; а; а; ) MODIFIER LETTER CYRILLIC
SMALL A
+1E031;1E031;1E031;0431;0431; # (𞀱; 𞀱; 𞀱; б; б; ) MODIFIER LETTER CYRILLIC
SMALL BE
+1E032;1E032;1E032;0432;0432; # (𞀲; 𞀲; 𞀲; в; в; ) MODIFIER LETTER CYRILLIC
SMALL VE
+1E033;1E033;1E033;0433;0433; # (𞀳; 𞀳; 𞀳; г; г; ) MODIFIER LETTER CYRILLIC
SMALL GHE
+1E034;1E034;1E034;0434;0434; # (𞀴; 𞀴; 𞀴; д; д; ) MODIFIER LETTER CYRILLIC
SMALL DE
+1E035;1E035;1E035;0435;0435; # (𞀵; 𞀵; 𞀵; е; е; ) MODIFIER LETTER CYRILLIC
SMALL IE
+1E036;1E036;1E036;0436;0436; # (𞀶; 𞀶; 𞀶; ж; ж; ) MODIFIER LETTER CYRILLIC
SMALL ZHE
+1E037;1E037;1E037;0437;0437; # (𞀷; 𞀷; 𞀷; з; з; ) MODIFIER LETTER CYRILLIC
SMALL ZE
+1E038;1E038;1E038;0438;0438; # (𞀸; 𞀸; 𞀸; и; и; ) MODIFIER LETTER CYRILLIC
SMALL I
+1E039;1E039;1E039;043A;043A; # (𞀹; 𞀹; 𞀹; к; к; ) MODIFIER LETTER CYRILLIC
SMALL KA
+1E03A;1E03A;1E03A;043B;043B; # (𞀺; 𞀺; 𞀺; л; л; ) MODIFIER LETTER CYRILLIC
SMALL EL
+1E03B;1E03B;1E03B;043C;043C; # (𞀻; 𞀻; 𞀻; м; м; ) MODIFIER LETTER CYRILLIC
SMALL EM
+1E03C;1E03C;1E03C;043E;043E; # (𞀼; 𞀼; 𞀼; о; о; ) MODIFIER LETTER CYRILLIC
SMALL O
+1E03D;1E03D;1E03D;043F;043F; # (𞀽; 𞀽; 𞀽; п; п; ) MODIFIER LETTER CYRILLIC
SMALL PE
+1E03E;1E03E;1E03E;0440;0440; # (𞀾; 𞀾; 𞀾; р; р; ) MODIFIER LETTER CYRILLIC
SMALL ER
+1E03F;1E03F;1E03F;0441;0441; # (𞀿; 𞀿; 𞀿; с; с; ) MODIFIER LETTER CYRILLIC
SMALL ES
+1E040;1E040;1E040;0442;0442; # (𞁀; 𞁀; 𞁀; т; т; ) MODIFIER LETTER CYRILLIC
SMALL TE
+1E041;1E041;1E041;0443;0443; # (𞁁; 𞁁; 𞁁; у; у; ) MODIFIER LETTER CYRILLIC
SMALL U
+1E042;1E042;1E042;0444;0444; # (𞁂; 𞁂; 𞁂; ф; ф; ) MODIFIER LETTER CYRILLIC
SMALL EF
+1E043;1E043;1E043;0445;0445; # (𞁃; 𞁃; 𞁃; х; х; ) MODIFIER LETTER CYRILLIC
SMALL HA
+1E044;1E044;1E044;0446;0446; # (𞁄; 𞁄; 𞁄; ц; ц; ) MODIFIER LETTER CYRILLIC
SMALL TSE
+1E045;1E045;1E045;0447;0447; # (𞁅; 𞁅; 𞁅; ч; ч; ) MODIFIER LETTER CYRILLIC
SMALL CHE
+1E046;1E046;1E046;0448;0448; # (𞁆; 𞁆; 𞁆; ш; ш; ) MODIFIER LETTER CYRILLIC
SMALL SHA
+1E047;1E047;1E047;044B;044B; # (𞁇; 𞁇; 𞁇; ы; ы; ) MODIFIER LETTER CYRILLIC
SMALL YERU
+1E048;1E048;1E048;044D;044D; # (𞁈; 𞁈; 𞁈; э; э; ) MODIFIER LETTER CYRILLIC
SMALL E
+1E049;1E049;1E049;044E;044E; # (𞁉; 𞁉; 𞁉; ю; ю; ) MODIFIER LETTER CYRILLIC
SMALL YU
+1E04A;1E04A;1E04A;A689;A689; # (𞁊; 𞁊; 𞁊; ꚉ; ꚉ; ) MODIFIER LETTER CYRILLIC
SMALL DZZE
+1E04B;1E04B;1E04B;04D9;04D9; # (𞁋; 𞁋; 𞁋; ә; ә; ) MODIFIER LETTER CYRILLIC
SMALL SCHWA
+1E04C;1E04C;1E04C;0456;0456; # (𞁌; 𞁌; 𞁌; і; і; ) MODIFIER LETTER CYRILLIC
SMALL BYELORUSSIAN-UKRAINIAN I
+1E04D;1E04D;1E04D;0458;0458; # (𞁍; 𞁍; 𞁍; ј; ј; ) MODIFIER LETTER CYRILLIC
SMALL JE
+1E04E;1E04E;1E04E;04E9;04E9; # (𞁎; 𞁎; 𞁎; ө; ө; ) MODIFIER LETTER CYRILLIC
SMALL BARRED O
+1E04F;1E04F;1E04F;04AF;04AF; # (𞁏; 𞁏; 𞁏; ү; ү; ) MODIFIER LETTER CYRILLIC
SMALL STRAIGHT U
+1E050;1E050;1E050;04CF;04CF; # (𞁐; 𞁐; 𞁐; ӏ; ӏ; ) MODIFIER LETTER CYRILLIC
SMALL PALOCHKA
+1E051;1E051;1E051;0430;0430; # (𞁑; 𞁑; 𞁑; а; а; ) CYRILLIC SUBSCRIPT SMALL
LETTER A
+1E052;1E052;1E052;0431;0431; # (𞁒; 𞁒; 𞁒; б; б; ) CYRILLIC SUBSCRIPT SMALL
LETTER BE
+1E053;1E053;1E053;0432;0432; # (𞁓; 𞁓; 𞁓; в; в; ) CYRILLIC SUBSCRIPT SMALL
LETTER VE
+1E054;1E054;1E054;0433;0433; # (𞁔; 𞁔; 𞁔; г; г; ) CYRILLIC SUBSCRIPT SMALL
LETTER GHE
+1E055;1E055;1E055;0434;0434; # (𞁕; 𞁕; 𞁕; д; д; ) CYRILLIC SUBSCRIPT SMALL
LETTER DE
+1E056;1E056;1E056;0435;0435; # (𞁖; 𞁖; 𞁖; е; е; ) CYRILLIC SUBSCRIPT SMALL
LETTER IE
+1E057;1E057;1E057;0436;0436; # (𞁗; 𞁗; 𞁗; ж; ж; ) CYRILLIC SUBSCRIPT SMALL
LETTER ZHE
+1E058;1E058;1E058;0437;0437; # (𞁘; 𞁘; 𞁘; з; з; ) CYRILLIC SUBSCRIPT SMALL
LETTER ZE
+1E059;1E059;1E059;0438;0438; # (𞁙; 𞁙; 𞁙; и; и; ) CYRILLIC SUBSCRIPT SMALL
LETTER I
+1E05A;1E05A;1E05A;043A;043A; # (𞁚; 𞁚; 𞁚; к; к; ) CYRILLIC SUBSCRIPT SMALL
LETTER KA
+1E05B;1E05B;1E05B;043B;043B; # (𞁛; 𞁛; 𞁛; л; л; ) CYRILLIC SUBSCRIPT SMALL
LETTER EL
+1E05C;1E05C;1E05C;043E;043E; # (𞁜; 𞁜; 𞁜; о; о; ) CYRILLIC SUBSCRIPT SMALL
LETTER O
+1E05D;1E05D;1E05D;043F;043F; # (𞁝; 𞁝; 𞁝; п; п; ) CYRILLIC SUBSCRIPT SMALL
LETTER PE
+1E05E;1E05E;1E05E;0441;0441; # (𞁞; 𞁞; 𞁞; с; с; ) CYRILLIC SUBSCRIPT SMALL
LETTER ES
+1E05F;1E05F;1E05F;0443;0443; # (𞁟; 𞁟; 𞁟; у; у; ) CYRILLIC SUBSCRIPT SMALL
LETTER U
+1E060;1E060;1E060;0444;0444; # (𞁠; 𞁠; 𞁠; ф; ф; ) CYRILLIC SUBSCRIPT SMALL
LETTER EF
+1E061;1E061;1E061;0445;0445; # (𞁡; 𞁡; 𞁡; х; х; ) CYRILLIC SUBSCRIPT SMALL
LETTER HA
+1E062;1E062;1E062;0446;0446; # (𞁢; 𞁢; 𞁢; ц; ц; ) CYRILLIC SUBSCRIPT SMALL
LETTER TSE
+1E063;1E063;1E063;0447;0447; # (𞁣; 𞁣; 𞁣; ч; ч; ) CYRILLIC SUBSCRIPT SMALL
LETTER CHE
+1E064;1E064;1E064;0448;0448; # (𞁤; 𞁤; 𞁤; ш; ш; ) CYRILLIC SUBSCRIPT SMALL
LETTER SHA
+1E065;1E065;1E065;044A;044A; # (𞁥; 𞁥; 𞁥; ъ; ъ; ) CYRILLIC SUBSCRIPT SMALL
LETTER HARD SIGN
+1E066;1E066;1E066;044B;044B; # (𞁦; 𞁦; 𞁦; ы; ы; ) CYRILLIC SUBSCRIPT SMALL
LETTER YERU
+1E067;1E067;1E067;0491;0491; # (𞁧; 𞁧; 𞁧; ґ; ґ; ) CYRILLIC SUBSCRIPT SMALL
LETTER GHE WITH UPTURN
+1E068;1E068;1E068;0456;0456; # (𞁨; 𞁨; 𞁨; і; і; ) CYRILLIC SUBSCRIPT SMALL
LETTER BYELORUSSIAN-UKRAINIAN I
+1E069;1E069;1E069;0455;0455; # (𞁩; 𞁩; 𞁩; ѕ; ѕ; ) CYRILLIC SUBSCRIPT SMALL
LETTER DZE
+1E06A;1E06A;1E06A;045F;045F; # (𞁪; 𞁪; 𞁪; џ; џ; ) CYRILLIC SUBSCRIPT SMALL
LETTER DZHE
+1E06B;1E06B;1E06B;04AB;04AB; # (𞁫; 𞁫; 𞁫; ҫ; ҫ; ) MODIFIER LETTER CYRILLIC
SMALL ES WITH DESCENDER
+1E06C;1E06C;1E06C;A651;A651; # (𞁬; 𞁬; 𞁬; ꙑ; ꙑ; ) MODIFIER LETTER CYRILLIC
SMALL YERU WITH BACK YER
+1E06D;1E06D;1E06D;04B1;04B1; # (𞁭; 𞁭; 𞁭; ұ; ұ; ) MODIFIER LETTER CYRILLIC
SMALL STRAIGHT U WITH STROKE
1EE00;1EE00;1EE00;0627;0627; # (𞸀; 𞸀; 𞸀; ا; ا; ) ARABIC MATHEMATICAL ALEF
1EE01;1EE01;1EE01;0628;0628; # (𞸁; 𞸁; 𞸁; ب; ب; ) ARABIC MATHEMATICAL BEH
1EE02;1EE02;1EE02;062C;062C; # (𞸂; 𞸂; 𞸂; ج; ج; ) ARABIC MATHEMATICAL JEEM
@@ -18496,6 +18558,12 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; )
HALFWIDTH WHITE CIRCLE
0061 10EAB 0315 0300 05AE 0062;0061 05AE 10EAB 0300 0315 0062;0061 05AE 10EAB
0300 0315 0062;0061 05AE 10EAB 0300 0315 0062;0061 05AE 10EAB 0300 0315 0062; #
(a◌𐺫◌̕◌̀◌֮b; a◌֮◌𐺫◌̀◌̕b; a◌֮◌𐺫◌̀◌̕b; a◌֮◌𐺫◌̀◌̕b; a◌֮◌𐺫◌̀◌̕b; ) LATIN SMALL
LETTER A, YEZIDI COMBINING HAMZA MARK, COMBINING COMMA ABOVE RIGHT, COMBINING
GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 10EAC 0062;00E0 05AE 10EAC 0315 0062;0061 05AE 0300 10EAC
0315 0062;00E0 05AE 10EAC 0315 0062;0061 05AE 0300 10EAC 0315 0062; #
(a◌̕◌̀◌֮◌𐺬b; à◌֮◌𐺬◌̕b; a◌֮◌̀◌𐺬◌̕b; à◌֮◌𐺬◌̕b; a◌֮◌̀◌𐺬◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
YEZIDI COMBINING MADDA MARK, LATIN SMALL LETTER B
0061 10EAC 0315 0300 05AE 0062;0061 05AE 10EAC 0300 0315 0062;0061 05AE 10EAC
0300 0315 0062;0061 05AE 10EAC 0300 0315 0062;0061 05AE 10EAC 0300 0315 0062; #
(a◌𐺬◌̕◌̀◌֮b; a◌֮◌𐺬◌̀◌̕b; a◌֮◌𐺬◌̀◌̕b; a◌֮◌𐺬◌̀◌̕b; a◌֮◌𐺬◌̀◌̕b; ) LATIN SMALL
LETTER A, YEZIDI COMBINING MADDA MARK, COMBINING COMMA ABOVE RIGHT, COMBINING
GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
+0061 059A 0316 1DFA 10EFD 0062;0061 1DFA 0316 10EFD 059A 0062;0061 1DFA 0316
10EFD 059A 0062;0061 1DFA 0316 10EFD 059A 0062;0061 1DFA 0316 10EFD 059A 0062;
# (a◌֚◌̖◌᷺◌𐻽b; a◌᷺◌̖◌𐻽◌֚b; a◌᷺◌̖◌𐻽◌֚b; a◌᷺◌̖◌𐻽◌֚b; a◌᷺◌̖◌𐻽◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, ARABIC SMALL LOW WORD SAKTA, LATIN SMALL LETTER B
+0061 10EFD 059A 0316 1DFA 0062;0061 1DFA 10EFD 0316 059A 0062;0061 1DFA 10EFD
0316 059A 0062;0061 1DFA 10EFD 0316 059A 0062;0061 1DFA 10EFD 0316 059A 0062; #
(a◌𐻽◌֚◌̖◌᷺b; a◌᷺◌𐻽◌̖◌֚b; a◌᷺◌𐻽◌̖◌֚b; a◌᷺◌𐻽◌̖◌֚b; a◌᷺◌𐻽◌̖◌֚b; ) LATIN SMALL
LETTER A, ARABIC SMALL LOW WORD SAKTA, HEBREW ACCENT YETIV, COMBINING GRAVE
ACCENT BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
+0061 059A 0316 1DFA 10EFE 0062;0061 1DFA 0316 10EFE 059A 0062;0061 1DFA 0316
10EFE 059A 0062;0061 1DFA 0316 10EFE 059A 0062;0061 1DFA 0316 10EFE 059A 0062;
# (a◌֚◌̖◌᷺◌𐻾b; a◌᷺◌̖◌𐻾◌֚b; a◌᷺◌̖◌𐻾◌֚b; a◌᷺◌̖◌𐻾◌֚b; a◌᷺◌̖◌𐻾◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, ARABIC SMALL LOW WORD QASR, LATIN SMALL LETTER B
+0061 10EFE 059A 0316 1DFA 0062;0061 1DFA 10EFE 0316 059A 0062;0061 1DFA 10EFE
0316 059A 0062;0061 1DFA 10EFE 0316 059A 0062;0061 1DFA 10EFE 0316 059A 0062; #
(a◌𐻾◌֚◌̖◌᷺b; a◌᷺◌𐻾◌̖◌֚b; a◌᷺◌𐻾◌̖◌֚b; a◌᷺◌𐻾◌̖◌֚b; a◌᷺◌𐻾◌̖◌֚b; ) LATIN SMALL
LETTER A, ARABIC SMALL LOW WORD QASR, HEBREW ACCENT YETIV, COMBINING GRAVE
ACCENT BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
+0061 059A 0316 1DFA 10EFF 0062;0061 1DFA 0316 10EFF 059A 0062;0061 1DFA 0316
10EFF 059A 0062;0061 1DFA 0316 10EFF 059A 0062;0061 1DFA 0316 10EFF 059A 0062;
# (a◌֚◌̖◌᷺◌𐻿b; a◌᷺◌̖◌𐻿◌֚b; a◌᷺◌̖◌𐻿◌֚b; a◌᷺◌̖◌𐻿◌֚b; a◌᷺◌̖◌𐻿◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, ARABIC SMALL LOW WORD MADDA, LATIN SMALL LETTER B
+0061 10EFF 059A 0316 1DFA 0062;0061 1DFA 10EFF 0316 059A 0062;0061 1DFA 10EFF
0316 059A 0062;0061 1DFA 10EFF 0316 059A 0062;0061 1DFA 10EFF 0316 059A 0062; #
(a◌𐻿◌֚◌̖◌᷺b; a◌᷺◌𐻿◌̖◌֚b; a◌᷺◌𐻿◌̖◌֚b; a◌᷺◌𐻿◌̖◌֚b; a◌᷺◌𐻿◌̖◌֚b; ) LATIN SMALL
LETTER A, ARABIC SMALL LOW WORD MADDA, HEBREW ACCENT YETIV, COMBINING GRAVE
ACCENT BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
0061 059A 0316 1DFA 10F46 0062;0061 1DFA 0316 10F46 059A 0062;0061 1DFA 0316
10F46 059A 0062;0061 1DFA 0316 10F46 059A 0062;0061 1DFA 0316 10F46 059A 0062;
# (a◌֚◌̖◌᷺◌𐽆b; a◌᷺◌̖◌𐽆◌֚b; a◌᷺◌̖◌𐽆◌֚b; a◌᷺◌̖◌𐽆◌֚b; a◌᷺◌̖◌𐽆◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, SOGDIAN COMBINING DOT BELOW, LATIN SMALL LETTER B
0061 10F46 059A 0316 1DFA 0062;0061 1DFA 10F46 0316 059A 0062;0061 1DFA 10F46
0316 059A 0062;0061 1DFA 10F46 0316 059A 0062;0061 1DFA 10F46 0316 059A 0062; #
(a◌𐽆◌֚◌̖◌᷺b; a◌᷺◌𐽆◌̖◌֚b; a◌᷺◌𐽆◌̖◌֚b; a◌᷺◌𐽆◌̖◌֚b; a◌᷺◌𐽆◌̖◌֚b; ) LATIN SMALL
LETTER A, SOGDIAN COMBINING DOT BELOW, HEBREW ACCENT YETIV, COMBINING GRAVE
ACCENT BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
0061 059A 0316 1DFA 10F47 0062;0061 1DFA 0316 10F47 059A 0062;0061 1DFA 0316
10F47 059A 0062;0061 1DFA 0316 10F47 059A 0062;0061 1DFA 0316 10F47 059A 0062;
# (a◌֚◌̖◌᷺◌𐽇b; a◌᷺◌̖◌𐽇◌֚b; a◌᷺◌̖◌𐽇◌֚b; a◌᷺◌̖◌𐽇◌֚b; a◌᷺◌̖◌𐽇◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, SOGDIAN COMBINING TWO DOTS BELOW, LATIN SMALL LETTER B
@@ -18640,6 +18708,10 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; )
HALFWIDTH WHITE CIRCLE
0061 11D45 05B0 094D 3099 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45
094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062; #
(a◌𑵅◌ְ◌्◌゙b; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; ) LATIN SMALL
LETTER A, MASARAM GONDI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA,
COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 11D97 0062;0061 3099 094D 11D97 05B0 0062;0061 3099 094D
11D97 05B0 0062;0061 3099 094D 11D97 05B0 0062;0061 3099 094D 11D97 05B0 0062;
# (a◌ְ◌्◌゙◌𑶗b; a◌゙◌्◌𑶗◌ְb; a◌゙◌्◌𑶗◌ְb; a◌゙◌्◌𑶗◌ְb; a◌゙◌्◌𑶗◌ְb; ) LATIN SMALL
LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING
KATAKANA-HIRAGANA VOICED SOUND MARK, GUNJALA GONDI VIRAMA, LATIN SMALL LETTER B
0061 11D97 05B0 094D 3099 0062;0061 3099 11D97 094D 05B0 0062;0061 3099 11D97
094D 05B0 0062;0061 3099 11D97 094D 05B0 0062;0061 3099 11D97 094D 05B0 0062; #
(a◌𑶗◌ְ◌्◌゙b; a◌゙◌𑶗◌्◌ְb; a◌゙◌𑶗◌्◌ְb; a◌゙◌𑶗◌्◌ְb; a◌゙◌𑶗◌्◌ְb; ) LATIN SMALL
LETTER A, GUNJALA GONDI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA,
COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11F41 0062;0061 3099 094D 11F41 05B0 0062;0061 3099 094D
11F41 05B0 0062;0061 3099 094D 11F41 05B0 0062;0061 3099 094D 11F41 05B0 0062;
# (a◌ְ◌्◌゙𑽁b; a◌゙◌्𑽁◌ְb; a◌゙◌्𑽁◌ְb; a◌゙◌्𑽁◌ְb; a◌゙◌्𑽁◌ְb; ) LATIN SMALL LETTER
A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA
VOICED SOUND MARK, KAWI SIGN KILLER, LATIN SMALL LETTER B
+0061 11F41 05B0 094D 3099 0062;0061 3099 11F41 094D 05B0 0062;0061 3099 11F41
094D 05B0 0062;0061 3099 11F41 094D 05B0 0062;0061 3099 11F41 094D 05B0 0062; #
(a𑽁◌ְ◌्◌゙b; a◌゙𑽁◌्◌ְb; a◌゙𑽁◌्◌ְb; a◌゙𑽁◌्◌ְb; a◌゙𑽁◌्◌ְb; ) LATIN SMALL LETTER A,
KAWI SIGN KILLER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING
KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11F42 0062;0061 3099 094D 11F42 05B0 0062;0061 3099 094D
11F42 05B0 0062;0061 3099 094D 11F42 05B0 0062;0061 3099 094D 11F42 05B0 0062;
# (a◌ְ◌्◌゙◌𑽂b; a◌゙◌्◌𑽂◌ְb; a◌゙◌्◌𑽂◌ְb; a◌゙◌्◌𑽂◌ְb; a◌゙◌्◌𑽂◌ְb; ) LATIN SMALL
LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING
KATAKANA-HIRAGANA VOICED SOUND MARK, KAWI CONJOINER, LATIN SMALL LETTER B
+0061 11F42 05B0 094D 3099 0062;0061 3099 11F42 094D 05B0 0062;0061 3099 11F42
094D 05B0 0062;0061 3099 11F42 094D 05B0 0062;0061 3099 11F42 094D 05B0 0062; #
(a◌𑽂◌ְ◌्◌゙b; a◌゙◌𑽂◌्◌ְb; a◌゙◌𑽂◌्◌ְb; a◌゙◌𑽂◌्◌ְb; a◌゙◌𑽂◌्◌ְb; ) LATIN SMALL
LETTER A, KAWI CONJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING
KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 16FF0 0334 16AF0 0062;0061 0334 16AF0 16FF0 0062;0061 0334 16AF0 16FF0
0062;0061 0334 16AF0 16FF0 0062;0061 0334 16AF0 16FF0 0062; # (a𖿰◌̴◌𖫰b;
a◌̴◌𖫰𖿰b; a◌̴◌𖫰𖿰b; a◌̴◌𖫰𖿰b; a◌̴◌𖫰𖿰b; ) LATIN SMALL LETTER A, VIETNAMESE
ALTERNATE READING MARK CA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING HIGH
TONE, LATIN SMALL LETTER B
0061 16AF0 16FF0 0334 0062;0061 16AF0 0334 16FF0 0062;0061 16AF0 0334 16FF0
0062;0061 16AF0 0334 16FF0 0062;0061 16AF0 0334 16FF0 0062; # (a◌𖫰𖿰◌̴b;
a◌𖫰◌̴𖿰b; a◌𖫰◌̴𖿰b; a◌𖫰◌̴𖿰b; a◌𖫰◌̴𖿰b; ) LATIN SMALL LETTER A, BASSA VAH COMBINING
HIGH TONE, VIETNAMESE ALTERNATE READING MARK CA, COMBINING TILDE OVERLAY, LATIN
SMALL LETTER B
0061 16FF0 0334 16AF1 0062;0061 0334 16AF1 16FF0 0062;0061 0334 16AF1 16FF0
0062;0061 0334 16AF1 16FF0 0062;0061 0334 16AF1 16FF0 0062; # (a𖿰◌̴◌𖫱b;
a◌̴◌𖫱𖿰b; a◌̴◌𖫱𖿰b; a◌̴◌𖫱𖿰b; a◌̴◌𖫱𖿰b; ) LATIN SMALL LETTER A, VIETNAMESE
ALTERNATE READING MARK CA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING LOW
TONE, LATIN SMALL LETTER B
@@ -18812,6 +18884,8 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH
WHITE CIRCLE
0061 1E029 0315 0300 05AE 0062;0061 05AE 1E029 0300 0315 0062;0061 05AE 1E029
0300 0315 0062;0061 05AE 1E029 0300 0315 0062;0061 05AE 1E029 0300 0315 0062; #
(a◌𞀩◌̕◌̀◌֮b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; ) LATIN SMALL
LETTER A, COMBINING GLAGOLITIC LETTER IOTATED BIG YUS, COMBINING COMMA ABOVE
RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 1E02A 0062;00E0 05AE 1E02A 0315 0062;0061 05AE 0300 1E02A
0315 0062;00E0 05AE 1E02A 0315 0062;0061 05AE 0300 1E02A 0315 0062; #
(a◌̕◌̀◌֮◌𞀪b; à◌֮◌𞀪◌̕b; a◌֮◌̀◌𞀪◌̕b; à◌֮◌𞀪◌̕b; a◌֮◌̀◌𞀪◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
COMBINING GLAGOLITIC LETTER FITA, LATIN SMALL LETTER B
0061 1E02A 0315 0300 05AE 0062;0061 05AE 1E02A 0300 0315 0062;0061 05AE 1E02A
0300 0315 0062;0061 05AE 1E02A 0300 0315 0062;0061 05AE 1E02A 0300 0315 0062; #
(a◌𞀪◌̕◌̀◌֮b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; ) LATIN SMALL
LETTER A, COMBINING GLAGOLITIC LETTER FITA, COMBINING COMMA ABOVE RIGHT,
COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
+0061 0315 0300 05AE 1E08F 0062;00E0 05AE 1E08F 0315 0062;0061 05AE 0300 1E08F
0315 0062;00E0 05AE 1E08F 0315 0062;0061 05AE 0300 1E08F 0315 0062; #
(a◌̕◌̀◌֮◌𞂏b; à◌֮◌𞂏◌̕b; a◌֮◌̀◌𞂏◌̕b; à◌֮◌𞂏◌̕b; a◌֮◌̀◌𞂏◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
COMBINING CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I, LATIN SMALL LETTER B
+0061 1E08F 0315 0300 05AE 0062;0061 05AE 1E08F 0300 0315 0062;0061 05AE 1E08F
0300 0315 0062;0061 05AE 1E08F 0300 0315 0062;0061 05AE 1E08F 0300 0315 0062; #
(a◌𞂏◌̕◌̀◌֮b; a◌֮◌𞂏◌̀◌̕b; a◌֮◌𞂏◌̀◌̕b; a◌֮◌𞂏◌̀◌̕b; a◌֮◌𞂏◌̀◌̕b; ) LATIN SMALL
LETTER A, COMBINING CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I, COMBINING
COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL
LETTER B
0061 0315 0300 05AE 1E130 0062;00E0 05AE 1E130 0315 0062;0061 05AE 0300 1E130
0315 0062;00E0 05AE 1E130 0315 0062;0061 05AE 0300 1E130 0315 0062; #
(a◌̕◌̀◌֮◌𞄰b; à◌֮◌𞄰◌̕b; a◌֮◌̀◌𞄰◌̕b; à◌֮◌𞄰◌̕b; a◌֮◌̀◌𞄰◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
NYIAKENG PUACHUE HMONG TONE-B, LATIN SMALL LETTER B
0061 1E130 0315 0300 05AE 0062;0061 05AE 1E130 0300 0315 0062;0061 05AE 1E130
0300 0315 0062;0061 05AE 1E130 0300 0315 0062;0061 05AE 1E130 0300 0315 0062; #
(a◌𞄰◌̕◌̀◌֮b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; ) LATIN SMALL
LETTER A, NYIAKENG PUACHUE HMONG TONE-B, COMBINING COMMA ABOVE RIGHT, COMBINING
GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 1E131 0062;00E0 05AE 1E131 0315 0062;0061 05AE 0300 1E131
0315 0062;00E0 05AE 1E131 0315 0062;0061 05AE 0300 1E131 0315 0062; #
(a◌̕◌̀◌֮◌𞄱b; à◌֮◌𞄱◌̕b; a◌֮◌̀◌𞄱◌̕b; à◌֮◌𞄱◌̕b; a◌֮◌̀◌𞄱◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
NYIAKENG PUACHUE HMONG TONE-M, LATIN SMALL LETTER B
@@ -18836,6 +18910,14 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; )
HALFWIDTH WHITE CIRCLE
0061 1E2EE 0315 0300 05AE 0062;0061 05AE 1E2EE 0300 0315 0062;0061 05AE 1E2EE
0300 0315 0062;0061 05AE 1E2EE 0300 0315 0062;0061 05AE 1E2EE 0300 0315 0062; #
(a◌𞋮◌̕◌̀◌֮b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; ) LATIN SMALL
LETTER A, WANCHO TONE KOI, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT,
HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 1E2EF 0062;00E0 05AE 1E2EF 0315 0062;0061 05AE 0300 1E2EF
0315 0062;00E0 05AE 1E2EF 0315 0062;0061 05AE 0300 1E2EF 0315 0062; #
(a◌̕◌̀◌֮◌𞋯b; à◌֮◌𞋯◌̕b; a◌֮◌̀◌𞋯◌̕b; à◌֮◌𞋯◌̕b; a◌֮◌̀◌𞋯◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
WANCHO TONE KOINI, LATIN SMALL LETTER B
0061 1E2EF 0315 0300 05AE 0062;0061 05AE 1E2EF 0300 0315 0062;0061 05AE 1E2EF
0300 0315 0062;0061 05AE 1E2EF 0300 0315 0062;0061 05AE 1E2EF 0300 0315 0062; #
(a◌𞋯◌̕◌̀◌֮b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; ) LATIN SMALL
LETTER A, WANCHO TONE KOINI, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE
ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
+0061 035C 0315 0300 1E4EC 0062;00E0 0315 1E4EC 035C 0062;0061 0300 0315 1E4EC
035C 0062;00E0 0315 1E4EC 035C 0062;0061 0300 0315 1E4EC 035C 0062; #
(a◌͜◌̕◌̀◌𞓬b; à◌̕◌𞓬◌͜b; a◌̀◌̕◌𞓬◌͜b; à◌̕◌𞓬◌͜b; a◌̀◌̕◌𞓬◌͜b; ) LATIN SMALL LETTER
A, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE
ACCENT, NAG MUNDARI SIGN MUHOR, LATIN SMALL LETTER B
+0061 1E4EC 035C 0315 0300 0062;00E0 1E4EC 0315 035C 0062;0061 0300 1E4EC 0315
035C 0062;00E0 1E4EC 0315 035C 0062;0061 0300 1E4EC 0315 035C 0062; #
(a◌𞓬◌͜◌̕◌̀b; à◌𞓬◌̕◌͜b; a◌̀◌𞓬◌̕◌͜b; à◌𞓬◌̕◌͜b; a◌̀◌𞓬◌̕◌͜b; ) LATIN SMALL LETTER
A, NAG MUNDARI SIGN MUHOR, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE
RIGHT, COMBINING GRAVE ACCENT, LATIN SMALL LETTER B
+0061 035C 0315 0300 1E4ED 0062;00E0 0315 1E4ED 035C 0062;0061 0300 0315 1E4ED
035C 0062;00E0 0315 1E4ED 035C 0062;0061 0300 0315 1E4ED 035C 0062; #
(a◌͜◌̕◌̀◌𞓭b; à◌̕◌𞓭◌͜b; a◌̀◌̕◌𞓭◌͜b; à◌̕◌𞓭◌͜b; a◌̀◌̕◌𞓭◌͜b; ) LATIN SMALL LETTER
A, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE
ACCENT, NAG MUNDARI SIGN TOYOR, LATIN SMALL LETTER B
+0061 1E4ED 035C 0315 0300 0062;00E0 1E4ED 0315 035C 0062;0061 0300 1E4ED 0315
035C 0062;00E0 1E4ED 0315 035C 0062;0061 0300 1E4ED 0315 035C 0062; #
(a◌𞓭◌͜◌̕◌̀b; à◌𞓭◌̕◌͜b; a◌̀◌𞓭◌̕◌͜b; à◌𞓭◌̕◌͜b; a◌̀◌𞓭◌̕◌͜b; ) LATIN SMALL LETTER
A, NAG MUNDARI SIGN TOYOR, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE
RIGHT, COMBINING GRAVE ACCENT, LATIN SMALL LETTER B
+0061 059A 0316 1DFA 1E4EE 0062;0061 1DFA 0316 1E4EE 059A 0062;0061 1DFA 0316
1E4EE 059A 0062;0061 1DFA 0316 1E4EE 059A 0062;0061 1DFA 0316 1E4EE 059A 0062;
# (a◌֚◌̖◌᷺◌𞓮b; a◌᷺◌̖◌𞓮◌֚b; a◌᷺◌̖◌𞓮◌֚b; a◌᷺◌̖◌𞓮◌֚b; a◌᷺◌̖◌𞓮◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, NAG MUNDARI SIGN IKIR, LATIN SMALL LETTER B
+0061 1E4EE 059A 0316 1DFA 0062;0061 1DFA 1E4EE 0316 059A 0062;0061 1DFA 1E4EE
0316 059A 0062;0061 1DFA 1E4EE 0316 059A 0062;0061 1DFA 1E4EE 0316 059A 0062; #
(a◌𞓮◌֚◌̖◌᷺b; a◌᷺◌𞓮◌̖◌֚b; a◌᷺◌𞓮◌̖◌֚b; a◌᷺◌𞓮◌̖◌֚b; a◌᷺◌𞓮◌̖◌֚b; ) LATIN SMALL
LETTER A, NAG MUNDARI SIGN IKIR, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT
BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
+0061 0315 0300 05AE 1E4EF 0062;00E0 05AE 1E4EF 0315 0062;0061 05AE 0300 1E4EF
0315 0062;00E0 05AE 1E4EF 0315 0062;0061 05AE 0300 1E4EF 0315 0062; #
(a◌̕◌̀◌֮◌𞓯b; à◌֮◌𞓯◌̕b; a◌֮◌̀◌𞓯◌̕b; à◌֮◌𞓯◌̕b; a◌֮◌̀◌𞓯◌̕b; ) LATIN SMALL LETTER
A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR,
NAG MUNDARI SIGN SUTUH, LATIN SMALL LETTER B
+0061 1E4EF 0315 0300 05AE 0062;0061 05AE 1E4EF 0300 0315 0062;0061 05AE 1E4EF
0300 0315 0062;0061 05AE 1E4EF 0300 0315 0062;0061 05AE 1E4EF 0300 0315 0062; #
(a◌𞓯◌̕◌̀◌֮b; a◌֮◌𞓯◌̀◌̕b; a◌֮◌𞓯◌̀◌̕b; a◌֮◌𞓯◌̀◌̕b; a◌֮◌𞓯◌̀◌̕b; ) LATIN SMALL
LETTER A, NAG MUNDARI SIGN SUTUH, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE
ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 059A 0316 1DFA 1E8D0 0062;0061 1DFA 0316 1E8D0 059A 0062;0061 1DFA 0316
1E8D0 059A 0062;0061 1DFA 0316 1E8D0 059A 0062;0061 1DFA 0316 1E8D0 059A 0062;
# (a◌֚◌̖◌᷺◌𞣐b; a◌᷺◌̖◌𞣐◌֚b; a◌᷺◌̖◌𞣐◌֚b; a◌᷺◌̖◌𞣐◌֚b; a◌᷺◌̖◌𞣐◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, MENDE KIKAKUI COMBINING NUMBER TEENS, LATIN SMALL LETTER B
0061 1E8D0 059A 0316 1DFA 0062;0061 1DFA 1E8D0 0316 059A 0062;0061 1DFA 1E8D0
0316 059A 0062;0061 1DFA 1E8D0 0316 059A 0062;0061 1DFA 1E8D0 0316 059A 0062; #
(a◌𞣐◌֚◌̖◌᷺b; a◌᷺◌𞣐◌̖◌֚b; a◌᷺◌𞣐◌̖◌֚b; a◌᷺◌𞣐◌̖◌֚b; a◌᷺◌𞣐◌̖◌֚b; ) LATIN SMALL
LETTER A, MENDE KIKAKUI COMBINING NUMBER TEENS, HEBREW ACCENT YETIV, COMBINING
GRAVE ACCENT BELOW, COMBINING DOT BELOW LEFT, LATIN SMALL LETTER B
0061 059A 0316 1DFA 1E8D1 0062;0061 1DFA 0316 1E8D1 059A 0062;0061 1DFA 0316
1E8D1 059A 0062;0061 1DFA 0316 1E8D1 059A 0062;0061 1DFA 0316 1E8D1 059A 0062;
# (a◌֚◌̖◌᷺◌𞣑b; a◌᷺◌̖◌𞣑◌֚b; a◌᷺◌̖◌𞣑◌֚b; a◌᷺◌̖◌𞣑◌֚b; a◌᷺◌̖◌𞣑◌֚b; ) LATIN SMALL
LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, COMBINING DOT
BELOW LEFT, MENDE KIKAKUI COMBINING NUMBER TENS, LATIN SMALL LETTER B
diff --git a/admin/unidata/PropertyValueAliases.txt
b/admin/unidata/PropertyValueAliases.txt
index bdc13857dc..9346fcf03e 100644
--- a/admin/unidata/PropertyValueAliases.txt
+++ b/admin/unidata/PropertyValueAliases.txt
@@ -1,11 +1,11 @@
-# PropertyValueAliases-14.0.0.txt
-# Date: 2021-05-10, 21:08:53 GMT
-# © 2021 Unicode®, Inc.
+# PropertyValueAliases-15.0.0.txt
+# Date: 2022-08-05, 23:42:17 GMT
+# © 2022 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 Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# This file contains aliases for property values used in the UCD.
# These names can be used for XML formats of UCD data, for regular-expression
@@ -90,6 +90,7 @@ age; 12.0 ; V12_0
age; 12.1 ; V12_1
age; 13.0 ; V13_0
age; 14.0 ; V14_0
+age; 15.0 ; V15_0
age; NA ; Unassigned
# Alphabetic (Alpha)
@@ -135,7 +136,6 @@ Bidi_M; Y ; Yes
; T
# Bidi_Mirroring_Glyph (bmg)
-# @missing: 0000..10FFFF; Bidi_Mirroring_Glyph; <none>
# Bidi_Paired_Bracket (bpb)
@@ -162,6 +162,7 @@ blk; Ancient_Symbols ; Ancient_Symbols
blk; Arabic ; Arabic
blk; Arabic_Ext_A ; Arabic_Extended_A
blk; Arabic_Ext_B ; Arabic_Extended_B
+blk; Arabic_Ext_C ; Arabic_Extended_C
blk; Arabic_Math ; Arabic_Mathematical_Alphabetic_Symbols
blk; Arabic_PF_A ; Arabic_Presentation_Forms_A ;
Arabic_Presentation_Forms-A
blk; Arabic_PF_B ; Arabic_Presentation_Forms_B
@@ -206,6 +207,7 @@ blk; CJK_Ext_D ;
CJK_Unified_Ideographs_Extension_D
blk; CJK_Ext_E ; CJK_Unified_Ideographs_Extension_E
blk; CJK_Ext_F ; CJK_Unified_Ideographs_Extension_F
blk; CJK_Ext_G ; CJK_Unified_Ideographs_Extension_G
+blk; CJK_Ext_H ; CJK_Unified_Ideographs_Extension_H
blk; CJK_Radicals_Sup ; CJK_Radicals_Supplement
blk; CJK_Strokes ; CJK_Strokes
blk; CJK_Symbols ; CJK_Symbols_And_Punctuation
@@ -223,10 +225,12 @@ blk; Cyrillic ; Cyrillic
blk; Cyrillic_Ext_A ; Cyrillic_Extended_A
blk; Cyrillic_Ext_B ; Cyrillic_Extended_B
blk; Cyrillic_Ext_C ; Cyrillic_Extended_C
+blk; Cyrillic_Ext_D ; Cyrillic_Extended_D
blk; Cyrillic_Sup ; Cyrillic_Supplement ;
Cyrillic_Supplementary
blk; Deseret ; Deseret
blk; Devanagari ; Devanagari
blk; Devanagari_Ext ; Devanagari_Extended
+blk; Devanagari_Ext_A ; Devanagari_Extended_A
blk; Diacriticals ; Combining_Diacritical_Marks
blk; Diacriticals_Ext ; Combining_Diacritical_Marks_Extended
blk; Diacriticals_For_Symbols ;
Combining_Diacritical_Marks_For_Symbols; Combining_Marks_For_Symbols
@@ -288,6 +292,7 @@ blk; Jamo_Ext_A ;
Hangul_Jamo_Extended_A
blk; Jamo_Ext_B ; Hangul_Jamo_Extended_B
blk; Javanese ; Javanese
blk; Kaithi ; Kaithi
+blk; Kaktovik_Numerals ; Kaktovik_Numerals
blk; Kana_Ext_A ; Kana_Extended_A
blk; Kana_Ext_B ; Kana_Extended_B
blk; Kana_Sup ; Kana_Supplement
@@ -296,6 +301,7 @@ blk; Kangxi ; Kangxi_Radicals
blk; Kannada ; Kannada
blk; Katakana ; Katakana
blk; Katakana_Ext ; Katakana_Phonetic_Extensions
+blk; Kawi ; Kawi
blk; Kayah_Li ; Kayah_Li
blk; Kharoshthi ; Kharoshthi
blk; Khitan_Small_Script ; Khitan_Small_Script
@@ -360,6 +366,7 @@ blk; Myanmar ; Myanmar
blk; Myanmar_Ext_A ; Myanmar_Extended_A
blk; Myanmar_Ext_B ; Myanmar_Extended_B
blk; Nabataean ; Nabataean
+blk; Nag_Mundari ; Nag_Mundari
blk; Nandinagari ; Nandinagari
blk; NB ; No_Block
blk; New_Tai_Lue ; New_Tai_Lue
@@ -663,7 +670,6 @@ EPres; Y ; Yes
; T
# Equivalent_Unified_Ideograph (EqUIdeo)
-# @missing: 0000..10FFFF; Equivalent_Unified_Ideograph; <none>
# Expands_On_NFC (XO_NFC)
@@ -1143,7 +1149,6 @@ NFD_QC; Y ; Yes
# NFKC_Casefold (NFKC_CF)
-# @missing: 0000..10FFFF; NFKC_Casefold; <code point>
# NFKC_Quick_Check (NFKC_QC)
@@ -1313,6 +1318,7 @@ sc ; Ital ; Old_Italic
sc ; Java ; Javanese
sc ; Kali ; Kayah_Li
sc ; Kana ; Katakana
+sc ; Kawi ; Kawi
sc ; Khar ; Kharoshthi
sc ; Khmr ; Khmer
sc ; Khoj ; Khojki
@@ -1345,6 +1351,7 @@ sc ; Mroo ; Mro
sc ; Mtei ; Meetei_Mayek
sc ; Mult ; Multani
sc ; Mymr ; Myanmar
+sc ; Nagm ; Nag_Mundari
sc ; Nand ; Nandinagari
sc ; Narb ; Old_North_Arabian
sc ; Nbat ; Nabataean
@@ -1418,7 +1425,6 @@ sc ; Zzzz ; Unknown
# Script_Extensions (scx)
-# @missing: 0000..10FFFF; Script_Extensions; <script>
# Sentence_Break (SB)
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/ScriptExtensions.txt
b/admin/unidata/ScriptExtensions.txt
index 3f5cd1c0db..2f5a1727e3 100644
--- a/admin/unidata/ScriptExtensions.txt
+++ b/admin/unidata/ScriptExtensions.txt
@@ -1,11 +1,11 @@
-# ScriptExtensions-14.0.0.txt
-# Date: 2021-06-04, 02:19:38 GMT
-# © 2021 Unicode®, Inc.
+# ScriptExtensions-15.0.0.txt
+# Date: 2022-02-02, 00:57:11 GMT
+# © 2022 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 Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# The Script_Extensions property indicates which characters are commonly used
# with more than one script, but with a limited number of scripts.
diff --git a/admin/unidata/Scripts.txt b/admin/unidata/Scripts.txt
index a138373011..2b138bffb8 100644
--- a/admin/unidata/Scripts.txt
+++ b/admin/unidata/Scripts.txt
@@ -1,11 +1,11 @@
-# Scripts-14.0.0.txt
-# Date: 2021-07-10, 00:35:31 GMT
-# © 2021 Unicode®, Inc.
+# Scripts-15.0.0.txt
+# Date: 2022-04-26, 23:15:02 GMT
+# © 2022 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 Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
# For more information, see:
# UAX #24, Unicode Script Property: https://www.unicode.org/reports/tr24/
# Especially the sections:
@@ -532,6 +532,7 @@ FFFC..FFFD ; Common # So [2] OBJECT REPLACEMENT
CHARACTER..REPLACEMENT CHAR
1D183..1D184 ; Common # So [2] MUSICAL SYMBOL ARPEGGIATO UP..MUSICAL SYMBOL
ARPEGGIATO DOWN
1D18C..1D1A9 ; Common # So [30] MUSICAL SYMBOL RINFORZANDO..MUSICAL SYMBOL
DEGREE SLASH
1D1AE..1D1EA ; Common # So [61] MUSICAL SYMBOL PEDAL MARK..MUSICAL SYMBOL
KORON
+1D2C0..1D2D3 ; Common # No [20] KAKTOVIK NUMERAL ZERO..KAKTOVIK NUMERAL
NINETEEN
1D2E0..1D2F3 ; Common # No [20] MAYAN NUMERAL ZERO..MAYAN NUMERAL NINETEEN
1D300..1D356 ; Common # So [87] MONOGRAM FOR EARTH..TETRAGRAM FOR FOSTERING
1D360..1D378 ; Common # No [25] COUNTING ROD UNIT DIGIT ONE..TALLY MARK FIVE
@@ -601,10 +602,10 @@ FFFC..FFFD ; Common # So [2] OBJECT REPLACEMENT
CHARACTER..REPLACEMENT CHAR
1F300..1F3FA ; Common # So [251] CYCLONE..AMPHORA
1F3FB..1F3FF ; Common # Sk [5] EMOJI MODIFIER FITZPATRICK TYPE-1-2..EMOJI
MODIFIER FITZPATRICK TYPE-6
1F400..1F6D7 ; Common # So [728] RAT..ELEVATOR
-1F6DD..1F6EC ; Common # So [16] PLAYGROUND SLIDE..AIRPLANE ARRIVING
+1F6DC..1F6EC ; Common # So [17] WIRELESS..AIRPLANE ARRIVING
1F6F0..1F6FC ; Common # So [13] SATELLITE..ROLLER SKATE
-1F700..1F773 ; Common # So [116] ALCHEMICAL SYMBOL FOR
QUINTESSENCE..ALCHEMICAL SYMBOL FOR HALF OUNCE
-1F780..1F7D8 ; Common # So [89] BLACK LEFT-POINTING ISOSCELES RIGHT
TRIANGLE..NEGATIVE CIRCLED SQUARE
+1F700..1F776 ; Common # So [119] ALCHEMICAL SYMBOL FOR QUINTESSENCE..LUNAR
ECLIPSE
+1F77B..1F7D9 ; Common # So [95] HAUMEA..NINE POINTED WHITE STAR
1F7E0..1F7EB ; Common # So [12] LARGE ORANGE CIRCLE..LARGE BROWN SQUARE
1F7F0 ; Common # So HEAVY EQUALS SIGN
1F800..1F80B ; Common # So [12] LEFTWARDS ARROW WITH SMALL TRIANGLE
ARROWHEAD..DOWNWARDS ARROW WITH LARGE TRIANGLE ARROWHEAD
@@ -615,22 +616,20 @@ FFFC..FFFD ; Common # So [2] OBJECT REPLACEMENT
CHARACTER..REPLACEMENT CHAR
1F8B0..1F8B1 ; Common # So [2] ARROW POINTING UPWARDS THEN NORTH
WEST..ARROW POINTING RIGHTWARDS THEN CURVING SOUTH WEST
1F900..1FA53 ; Common # So [340] CIRCLED CROSS FORMEE WITH FOUR DOTS..BLACK
CHESS KNIGHT-BISHOP
1FA60..1FA6D ; Common # So [14] XIANGQI RED GENERAL..XIANGQI BLACK SOLDIER
-1FA70..1FA74 ; Common # So [5] BALLET SHOES..THONG SANDAL
-1FA78..1FA7C ; Common # So [5] DROP OF BLOOD..CRUTCH
-1FA80..1FA86 ; Common # So [7] YO-YO..NESTING DOLLS
-1FA90..1FAAC ; Common # So [29] RINGED PLANET..HAMSA
-1FAB0..1FABA ; Common # So [11] FLY..NEST WITH EGGS
-1FAC0..1FAC5 ; Common # So [6] ANATOMICAL HEART..PERSON WITH CROWN
-1FAD0..1FAD9 ; Common # So [10] BLUEBERRIES..JAR
-1FAE0..1FAE7 ; Common # So [8] MELTING FACE..BUBBLES
-1FAF0..1FAF6 ; Common # So [7] HAND WITH INDEX FINGER AND THUMB
CROSSED..HEART HANDS
+1FA70..1FA7C ; Common # So [13] BALLET SHOES..CRUTCH
+1FA80..1FA88 ; Common # So [9] YO-YO..FLUTE
+1FA90..1FABD ; Common # So [46] RINGED PLANET..WING
+1FABF..1FAC5 ; Common # So [7] GOOSE..PERSON WITH CROWN
+1FACE..1FADB ; Common # So [14] MOOSE..PEA POD
+1FAE0..1FAE8 ; Common # So [9] MELTING FACE..SHAKING FACE
+1FAF0..1FAF8 ; Common # So [9] HAND WITH INDEX FINGER AND THUMB
CROSSED..RIGHTWARDS PUSHING HAND
1FB00..1FB92 ; Common # So [147] BLOCK SEXTANT-1..UPPER HALF INVERSE MEDIUM
SHADE AND LOWER HALF BLOCK
1FB94..1FBCA ; Common # So [55] LEFT HALF INVERSE MEDIUM SHADE AND RIGHT
HALF BLOCK..WHITE UP-POINTING CHEVRON
1FBF0..1FBF9 ; Common # Nd [10] SEGMENTED DIGIT ZERO..SEGMENTED DIGIT NINE
E0001 ; Common # Cf LANGUAGE TAG
E0020..E007F ; Common # Cf [96] TAG SPACE..CANCEL TAG
-# Total code points: 8252
+# Total code points: 8301
# ================================================
@@ -697,8 +696,9 @@ FF41..FF5A ; Latin # L& [26] FULLWIDTH LATIN SMALL
LETTER A..FULLWIDTH LATIN
1DF00..1DF09 ; Latin # L& [10] LATIN SMALL LETTER FENG DIGRAPH WITH
TRILL..LATIN SMALL LETTER T WITH HOOK AND RETROFLEX HOOK
1DF0A ; Latin # Lo LATIN LETTER RETROFLEX CLICK WITH RETROFLEX
HOOK
1DF0B..1DF1E ; Latin # L& [20] LATIN SMALL LETTER ESH WITH DOUBLE BAR..LATIN
SMALL LETTER S WITH CURL
+1DF25..1DF2A ; Latin # L& [6] LATIN SMALL LETTER D WITH MID-HEIGHT LEFT
HOOK..LATIN SMALL LETTER T WITH MID-HEIGHT LEFT HOOK
-# Total code points: 1475
+# Total code points: 1481
# ================================================
@@ -784,8 +784,10 @@ A680..A69B ; Cyrillic # L& [28] CYRILLIC CAPITAL
LETTER DWE..CYRILLIC SMALL
A69C..A69D ; Cyrillic # Lm [2] MODIFIER LETTER CYRILLIC HARD
SIGN..MODIFIER LETTER CYRILLIC SOFT SIGN
A69E..A69F ; Cyrillic # Mn [2] COMBINING CYRILLIC LETTER EF..COMBINING
CYRILLIC LETTER IOTIFIED E
FE2E..FE2F ; Cyrillic # Mn [2] COMBINING CYRILLIC TITLO LEFT
HALF..COMBINING CYRILLIC TITLO RIGHT HALF
+1E030..1E06D ; Cyrillic # Lm [62] MODIFIER LETTER CYRILLIC SMALL A..MODIFIER
LETTER CYRILLIC SMALL STRAIGHT U WITH STROKE
+1E08F ; Cyrillic # Mn COMBINING CYRILLIC SMALL LETTER
BYELORUSSIAN-UKRAINIAN I
-# Total code points: 443
+# Total code points: 506
# ================================================
@@ -883,6 +885,7 @@ FDFD..FDFF ; Arabic # So [3] ARABIC LIGATURE BISMILLAH
AR-RAHMAN AR-RAHEEM.
FE70..FE74 ; Arabic # Lo [5] ARABIC FATHATAN ISOLATED FORM..ARABIC
KASRATAN ISOLATED FORM
FE76..FEFC ; Arabic # Lo [135] ARABIC FATHA ISOLATED FORM..ARABIC LIGATURE
LAM WITH ALEF FINAL FORM
10E60..10E7E ; Arabic # No [31] RUMI DIGIT ONE..RUMI FRACTION TWO THIRDS
+10EFD..10EFF ; Arabic # Mn [3] ARABIC SMALL LOW WORD SAKTA..ARABIC SMALL
LOW WORD MADDA
1EE00..1EE03 ; Arabic # Lo [4] ARABIC MATHEMATICAL ALEF..ARABIC
MATHEMATICAL DAL
1EE05..1EE1F ; Arabic # Lo [27] ARABIC MATHEMATICAL WAW..ARABIC MATHEMATICAL
DOTLESS QAF
1EE21..1EE22 ; Arabic # Lo [2] ARABIC MATHEMATICAL INITIAL BEH..ARABIC
MATHEMATICAL INITIAL JEEM
@@ -918,7 +921,7 @@ FE76..FEFC ; Arabic # Lo [135] ARABIC FATHA ISOLATED
FORM..ARABIC LIGATURE LA
1EEAB..1EEBB ; Arabic # Lo [17] ARABIC MATHEMATICAL DOUBLE-STRUCK
LAM..ARABIC MATHEMATICAL DOUBLE-STRUCK GHAIN
1EEF0..1EEF1 ; Arabic # Sm [2] ARABIC MATHEMATICAL OPERATOR MEEM WITH HAH
WITH TATWEEL..ARABIC MATHEMATICAL OPERATOR HAH WITH DAL
-# Total code points: 1365
+# Total code points: 1368
# ================================================
@@ -970,8 +973,9 @@ A8FB ; Devanagari # Lo DEVANAGARI HEADSTROKE
A8FC ; Devanagari # Po DEVANAGARI SIGN SIDDHAM
A8FD..A8FE ; Devanagari # Lo [2] DEVANAGARI JAIN OM..DEVANAGARI LETTER AY
A8FF ; Devanagari # Mn DEVANAGARI VOWEL SIGN AY
+11B00..11B09 ; Devanagari # Po [10] DEVANAGARI HEAD MARK..DEVANAGARI SIGN
MINDU
-# Total code points: 154
+# Total code points: 164
# ================================================
@@ -1182,8 +1186,9 @@ A8FF ; Devanagari # Mn DEVANAGARI VOWEL
SIGN AY
0CE2..0CE3 ; Kannada # Mn [2] KANNADA VOWEL SIGN VOCALIC L..KANNADA VOWEL
SIGN VOCALIC LL
0CE6..0CEF ; Kannada # Nd [10] KANNADA DIGIT ZERO..KANNADA DIGIT NINE
0CF1..0CF2 ; Kannada # Lo [2] KANNADA SIGN JIHVAMULIYA..KANNADA SIGN
UPADHMANIYA
+0CF3 ; Kannada # Mc KANNADA SIGN COMBINING ANUSVARA ABOVE RIGHT
-# Total code points: 90
+# Total code points: 91
# ================================================
@@ -1263,11 +1268,11 @@ A8FF ; Devanagari # Mn DEVANAGARI VOWEL
SIGN AY
0EBD ; Lao # Lo LAO SEMIVOWEL SIGN NYO
0EC0..0EC4 ; Lao # Lo [5] LAO VOWEL SIGN E..LAO VOWEL SIGN AI
0EC6 ; Lao # Lm LAO KO LA
-0EC8..0ECD ; Lao # Mn [6] LAO TONE MAI EK..LAO NIGGAHITA
+0EC8..0ECE ; Lao # Mn [7] LAO TONE MAI EK..LAO YAMAKKAN
0ED0..0ED9 ; Lao # Nd [10] LAO DIGIT ZERO..LAO DIGIT NINE
0EDC..0EDF ; Lao # Lo [4] LAO HO NO..LAO LETTER KHMU NYO
-# Total code points: 82
+# Total code points: 83
# ================================================
@@ -1532,10 +1537,11 @@ AB70..ABBF ; Cherokee # L& [80] CHEROKEE SMALL
LETTER A..CHEROKEE SMALL LETT
309D..309E ; Hiragana # Lm [2] HIRAGANA ITERATION MARK..HIRAGANA VOICED
ITERATION MARK
309F ; Hiragana # Lo HIRAGANA DIGRAPH YORI
1B001..1B11F ; Hiragana # Lo [287] HIRAGANA LETTER ARCHAIC YE..HIRAGANA
LETTER ARCHAIC WU
+1B132 ; Hiragana # Lo HIRAGANA LETTER SMALL KO
1B150..1B152 ; Hiragana # Lo [3] HIRAGANA LETTER SMALL WI..HIRAGANA LETTER
SMALL WO
1F200 ; Hiragana # So SQUARE HIRAGANA HOKA
-# Total code points: 380
+# Total code points: 381
# ================================================
@@ -1552,9 +1558,10 @@ FF71..FF9D ; Katakana # Lo [45] HALFWIDTH KATAKANA
LETTER A..HALFWIDTH KATAK
1AFFD..1AFFE ; Katakana # Lm [2] KATAKANA LETTER MINNAN NASALIZED
TONE-7..KATAKANA LETTER MINNAN NASALIZED TONE-8
1B000 ; Katakana # Lo KATAKANA LETTER ARCHAIC E
1B120..1B122 ; Katakana # Lo [3] KATAKANA LETTER ARCHAIC YI..KATAKANA
LETTER ARCHAIC WU
+1B155 ; Katakana # Lo KATAKANA LETTER SMALL KO
1B164..1B167 ; Katakana # Lo [4] KATAKANA LETTER SMALL WI..KATAKANA LETTER
SMALL N
-# Total code points: 320
+# Total code points: 321
# ================================================
@@ -1582,14 +1589,15 @@ FA70..FAD9 ; Han # Lo [106] CJK COMPATIBILITY
IDEOGRAPH-FA70..CJK COMPATIBILI
16FE3 ; Han # Lm OLD CHINESE ITERATION MARK
16FF0..16FF1 ; Han # Mc [2] VIETNAMESE ALTERNATE READING MARK
CA..VIETNAMESE ALTERNATE READING MARK NHAY
20000..2A6DF ; Han # Lo [42720] CJK UNIFIED IDEOGRAPH-20000..CJK UNIFIED
IDEOGRAPH-2A6DF
-2A700..2B738 ; Han # Lo [4153] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED
IDEOGRAPH-2B738
+2A700..2B739 ; Han # Lo [4154] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED
IDEOGRAPH-2B739
2B740..2B81D ; Han # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED
IDEOGRAPH-2B81D
2B820..2CEA1 ; Han # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED
IDEOGRAPH-2CEA1
2CEB0..2EBE0 ; Han # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED
IDEOGRAPH-2EBE0
2F800..2FA1D ; Han # Lo [542] CJK COMPATIBILITY IDEOGRAPH-2F800..CJK
COMPATIBILITY IDEOGRAPH-2FA1D
30000..3134A ; Han # Lo [4939] CJK UNIFIED IDEOGRAPH-30000..CJK UNIFIED
IDEOGRAPH-3134A
+31350..323AF ; Han # Lo [4192] CJK UNIFIED IDEOGRAPH-31350..CJK UNIFIED
IDEOGRAPH-323AF
-# Total code points: 94215
+# Total code points: 98408
# ================================================
@@ -2093,10 +2101,13 @@ AADE..AADF ; Tai_Viet # Po [2] TAI VIET SYMBOL HO
HOI..TAI VIET SYMBOL KOI
# ================================================
-13000..1342E ; Egyptian_Hieroglyphs # Lo [1071] EGYPTIAN HIEROGLYPH
A001..EGYPTIAN HIEROGLYPH AA032
-13430..13438 ; Egyptian_Hieroglyphs # Cf [9] EGYPTIAN HIEROGLYPH VERTICAL
JOINER..EGYPTIAN HIEROGLYPH END SEGMENT
+13000..1342F ; Egyptian_Hieroglyphs # Lo [1072] EGYPTIAN HIEROGLYPH
A001..EGYPTIAN HIEROGLYPH V011D
+13430..1343F ; Egyptian_Hieroglyphs # Cf [16] EGYPTIAN HIEROGLYPH VERTICAL
JOINER..EGYPTIAN HIEROGLYPH END WALLED ENCLOSURE
+13440 ; Egyptian_Hieroglyphs # Mn EGYPTIAN HIEROGLYPH MIRROR
HORIZONTALLY
+13441..13446 ; Egyptian_Hieroglyphs # Lo [6] EGYPTIAN HIEROGLYPH FULL
BLANK..EGYPTIAN HIEROGLYPH WIDE LOST SIGN
+13447..13455 ; Egyptian_Hieroglyphs # Mn [15] EGYPTIAN HIEROGLYPH MODIFIER
DAMAGED AT TOP START..EGYPTIAN HIEROGLYPH MODIFIER DAMAGED
-# Total code points: 1080
+# Total code points: 1110
# ================================================
@@ -2440,8 +2451,10 @@ ABF0..ABF9 ; Meetei_Mayek # Nd [10] MEETEI MAYEK
DIGIT ZERO..MEETEI MAYEK DI
11236..11237 ; Khojki # Mn [2] KHOJKI SIGN NUKTA..KHOJKI SIGN SHADDA
11238..1123D ; Khojki # Po [6] KHOJKI DANDA..KHOJKI ABBREVIATION SIGN
1123E ; Khojki # Mn KHOJKI SIGN SUKUN
+1123F..11240 ; Khojki # Lo [2] KHOJKI LETTER QA..KHOJKI LETTER SHORT I
+11241 ; Khojki # Mn KHOJKI VOWEL SIGN VOCALIC R
-# Total code points: 62
+# Total code points: 65
# ================================================
@@ -2988,4 +3001,31 @@ ABF0..ABF9 ; Meetei_Mayek # Nd [10] MEETEI MAYEK
DIGIT ZERO..MEETEI MAYEK DI
# Total code points: 70
+# ================================================
+
+11F00..11F01 ; Kawi # Mn [2] KAWI SIGN CANDRABINDU..KAWI SIGN ANUSVARA
+11F02 ; Kawi # Lo KAWI SIGN REPHA
+11F03 ; Kawi # Mc KAWI SIGN VISARGA
+11F04..11F10 ; Kawi # Lo [13] KAWI LETTER A..KAWI LETTER O
+11F12..11F33 ; Kawi # Lo [34] KAWI LETTER KA..KAWI LETTER JNYA
+11F34..11F35 ; Kawi # Mc [2] KAWI VOWEL SIGN AA..KAWI VOWEL SIGN ALTERNATE
AA
+11F36..11F3A ; Kawi # Mn [5] KAWI VOWEL SIGN I..KAWI VOWEL SIGN VOCALIC R
+11F3E..11F3F ; Kawi # Mc [2] KAWI VOWEL SIGN E..KAWI VOWEL SIGN AI
+11F40 ; Kawi # Mn KAWI VOWEL SIGN EU
+11F41 ; Kawi # Mc KAWI SIGN KILLER
+11F42 ; Kawi # Mn KAWI CONJOINER
+11F43..11F4F ; Kawi # Po [13] KAWI DANDA..KAWI PUNCTUATION CLOSING SPIRAL
+11F50..11F59 ; Kawi # Nd [10] KAWI DIGIT ZERO..KAWI DIGIT NINE
+
+# Total code points: 86
+
+# ================================================
+
+1E4D0..1E4EA ; Nag_Mundari # Lo [27] NAG MUNDARI LETTER O..NAG MUNDARI
LETTER ELL
+1E4EB ; Nag_Mundari # Lm NAG MUNDARI SIGN OJOD
+1E4EC..1E4EF ; Nag_Mundari # Mn [4] NAG MUNDARI SIGN MUHOR..NAG MUNDARI
SIGN SUTUH
+1E4F0..1E4F9 ; Nag_Mundari # Nd [10] NAG MUNDARI DIGIT ZERO..NAG MUNDARI
DIGIT NINE
+
+# Total code points: 42
+
# EOF
diff --git a/admin/unidata/SpecialCasing.txt b/admin/unidata/SpecialCasing.txt
index 1c2e968a8c..08d04fa942 100644
--- a/admin/unidata/SpecialCasing.txt
+++ b/admin/unidata/SpecialCasing.txt
@@ -1,11 +1,11 @@
-# SpecialCasing-14.0.0.txt
-# Date: 2021-03-08, 19:35:55 GMT
-# © 2021 Unicode®, Inc.
+# SpecialCasing-15.0.0.txt
+# Date: 2022-02-02, 23:35:52 GMT
+# © 2022 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 Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# Special Casing
#
diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt
index b5abef7ed4..ea963a7162 100644
--- a/admin/unidata/UnicodeData.txt
+++ b/admin/unidata/UnicodeData.txt
@@ -2975,6 +2975,7 @@
0CEF;KANNADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
0CF1;KANNADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
0CF2;KANNADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+0CF3;KANNADA SIGN COMBINING ANUSVARA ABOVE RIGHT;Mc;0;L;;;;;N;;;;;
0D00;MALAYALAM SIGN COMBINING ANUSVARA ABOVE;Mn;0;NSM;;;;;N;;;;;
0D01;MALAYALAM SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0D02;MALAYALAM SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
@@ -3339,6 +3340,7 @@
0ECB;LAO TONE MAI CATAWA;Mn;122;NSM;;;;;N;;;;;
0ECC;LAO CANCELLATION MARK;Mn;0;NSM;;;;;N;;;;;
0ECD;LAO NIGGAHITA;Mn;0;NSM;;;;;N;;;;;
+0ECE;LAO YAMAKKAN;Mn;0;NSM;;;;;N;;;;;
0ED0;LAO DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
0ED1;LAO DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
0ED2;LAO DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
@@ -19393,6 +19395,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
10EAD;YEZIDI HYPHENATION MARK;Pd;0;R;;;;;N;;;;;
10EB0;YEZIDI LETTER LAM WITH DOT ABOVE;Lo;0;R;;;;;N;;;;;
10EB1;YEZIDI LETTER YOT WITH CIRCUMFLEX ABOVE;Lo;0;R;;;;;N;;;;;
+10EFD;ARABIC SMALL LOW WORD SAKTA;Mn;220;NSM;;;;;N;;;;;
+10EFE;ARABIC SMALL LOW WORD QASR;Mn;220;NSM;;;;;N;;;;;
+10EFF;ARABIC SMALL LOW WORD MADDA;Mn;220;NSM;;;;;N;;;;;
10F00;OLD SOGDIAN LETTER ALEPH;Lo;0;R;;;;;N;;;;;
10F01;OLD SOGDIAN LETTER FINAL ALEPH;Lo;0;R;;;;;N;;;;;
10F02;OLD SOGDIAN LETTER BETH;Lo;0;R;;;;;N;;;;;
@@ -20058,6 +20063,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1123C;KHOJKI DOUBLE SECTION MARK;Po;0;L;;;;;N;;;;;
1123D;KHOJKI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
1123E;KHOJKI SIGN SUKUN;Mn;0;NSM;;;;;N;;;;;
+1123F;KHOJKI LETTER QA;Lo;0;L;;;;;N;;;;;
+11240;KHOJKI LETTER SHORT I;Lo;0;L;;;;;N;;;;;
+11241;KHOJKI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
11280;MULTANI LETTER A;Lo;0;L;;;;;N;;;;;
11281;MULTANI LETTER I;Lo;0;L;;;;;N;;;;;
11282;MULTANI LETTER U;Lo;0;L;;;;;N;;;;;
@@ -21256,6 +21264,16 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
11AF6;PAU CIN HAU LOW-FALLING TONE LONG FINAL;Lo;0;L;;;;;N;;;;;
11AF7;PAU CIN HAU LOW-FALLING TONE FINAL;Lo;0;L;;;;;N;;;;;
11AF8;PAU CIN HAU GLOTTAL STOP FINAL;Lo;0;L;;;;;N;;;;;
+11B00;DEVANAGARI HEAD MARK;Po;0;L;;;;;N;;;;;
+11B01;DEVANAGARI HEAD MARK WITH HEADSTROKE;Po;0;L;;;;;N;;;;;
+11B02;DEVANAGARI SIGN BHALE;Po;0;L;;;;;N;;;;;
+11B03;DEVANAGARI SIGN BHALE WITH HOOK;Po;0;L;;;;;N;;;;;
+11B04;DEVANAGARI SIGN EXTENDED BHALE;Po;0;L;;;;;N;;;;;
+11B05;DEVANAGARI SIGN EXTENDED BHALE WITH HOOK;Po;0;L;;;;;N;;;;;
+11B06;DEVANAGARI SIGN WESTERN FIVE-LIKE BHALE;Po;0;L;;;;;N;;;;;
+11B07;DEVANAGARI SIGN WESTERN NINE-LIKE BHALE;Po;0;L;;;;;N;;;;;
+11B08;DEVANAGARI SIGN REVERSED NINE-LIKE BHALE;Po;0;L;;;;;N;;;;;
+11B09;DEVANAGARI SIGN MINDU;Po;0;L;;;;;N;;;;;
11C00;BHAIKSUKI LETTER A;Lo;0;L;;;;;N;;;;;
11C01;BHAIKSUKI LETTER AA;Lo;0;L;;;;;N;;;;;
11C02;BHAIKSUKI LETTER I;Lo;0;L;;;;;N;;;;;
@@ -21584,6 +21602,92 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
11EF6;MAKASAR VOWEL SIGN O;Mc;0;L;;;;;N;;;;;
11EF7;MAKASAR PASSIMBANG;Po;0;L;;;;;N;;;;;
11EF8;MAKASAR END OF SECTION;Po;0;L;;;;;N;;;;;
+11F00;KAWI SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11F01;KAWI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11F02;KAWI SIGN REPHA;Lo;0;L;;;;;N;;;;;
+11F03;KAWI SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11F04;KAWI LETTER A;Lo;0;L;;;;;N;;;;;
+11F05;KAWI LETTER AA;Lo;0;L;;;;;N;;;;;
+11F06;KAWI LETTER I;Lo;0;L;;;;;N;;;;;
+11F07;KAWI LETTER II;Lo;0;L;;;;;N;;;;;
+11F08;KAWI LETTER U;Lo;0;L;;;;;N;;;;;
+11F09;KAWI LETTER UU;Lo;0;L;;;;;N;;;;;
+11F0A;KAWI LETTER VOCALIC R;Lo;0;L;;;;;N;;;;;
+11F0B;KAWI LETTER VOCALIC RR;Lo;0;L;;;;;N;;;;;
+11F0C;KAWI LETTER VOCALIC L;Lo;0;L;;;;;N;;;;;
+11F0D;KAWI LETTER VOCALIC LL;Lo;0;L;;;;;N;;;;;
+11F0E;KAWI LETTER E;Lo;0;L;;;;;N;;;;;
+11F0F;KAWI LETTER AI;Lo;0;L;;;;;N;;;;;
+11F10;KAWI LETTER O;Lo;0;L;;;;;N;;;;;
+11F12;KAWI LETTER KA;Lo;0;L;;;;;N;;;;;
+11F13;KAWI LETTER KHA;Lo;0;L;;;;;N;;;;;
+11F14;KAWI LETTER GA;Lo;0;L;;;;;N;;;;;
+11F15;KAWI LETTER GHA;Lo;0;L;;;;;N;;;;;
+11F16;KAWI LETTER NGA;Lo;0;L;;;;;N;;;;;
+11F17;KAWI LETTER CA;Lo;0;L;;;;;N;;;;;
+11F18;KAWI LETTER CHA;Lo;0;L;;;;;N;;;;;
+11F19;KAWI LETTER JA;Lo;0;L;;;;;N;;;;;
+11F1A;KAWI LETTER JHA;Lo;0;L;;;;;N;;;;;
+11F1B;KAWI LETTER NYA;Lo;0;L;;;;;N;;;;;
+11F1C;KAWI LETTER TTA;Lo;0;L;;;;;N;;;;;
+11F1D;KAWI LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11F1E;KAWI LETTER DDA;Lo;0;L;;;;;N;;;;;
+11F1F;KAWI LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11F20;KAWI LETTER NNA;Lo;0;L;;;;;N;;;;;
+11F21;KAWI LETTER TA;Lo;0;L;;;;;N;;;;;
+11F22;KAWI LETTER THA;Lo;0;L;;;;;N;;;;;
+11F23;KAWI LETTER DA;Lo;0;L;;;;;N;;;;;
+11F24;KAWI LETTER DHA;Lo;0;L;;;;;N;;;;;
+11F25;KAWI LETTER NA;Lo;0;L;;;;;N;;;;;
+11F26;KAWI LETTER PA;Lo;0;L;;;;;N;;;;;
+11F27;KAWI LETTER PHA;Lo;0;L;;;;;N;;;;;
+11F28;KAWI LETTER BA;Lo;0;L;;;;;N;;;;;
+11F29;KAWI LETTER BHA;Lo;0;L;;;;;N;;;;;
+11F2A;KAWI LETTER MA;Lo;0;L;;;;;N;;;;;
+11F2B;KAWI LETTER YA;Lo;0;L;;;;;N;;;;;
+11F2C;KAWI LETTER RA;Lo;0;L;;;;;N;;;;;
+11F2D;KAWI LETTER LA;Lo;0;L;;;;;N;;;;;
+11F2E;KAWI LETTER WA;Lo;0;L;;;;;N;;;;;
+11F2F;KAWI LETTER SHA;Lo;0;L;;;;;N;;;;;
+11F30;KAWI LETTER SSA;Lo;0;L;;;;;N;;;;;
+11F31;KAWI LETTER SA;Lo;0;L;;;;;N;;;;;
+11F32;KAWI LETTER HA;Lo;0;L;;;;;N;;;;;
+11F33;KAWI LETTER JNYA;Lo;0;L;;;;;N;;;;;
+11F34;KAWI VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
+11F35;KAWI VOWEL SIGN ALTERNATE AA;Mc;0;L;;;;;N;;;;;
+11F36;KAWI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11F37;KAWI VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
+11F38;KAWI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11F39;KAWI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+11F3A;KAWI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+11F3E;KAWI VOWEL SIGN E;Mc;0;L;;;;;N;;;;;
+11F3F;KAWI VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+11F40;KAWI VOWEL SIGN EU;Mn;0;NSM;;;;;N;;;;;
+11F41;KAWI SIGN KILLER;Mc;9;L;;;;;N;;;;;
+11F42;KAWI CONJOINER;Mn;9;NSM;;;;;N;;;;;
+11F43;KAWI DANDA;Po;0;L;;;;;N;;;;;
+11F44;KAWI DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+11F45;KAWI PUNCTUATION SECTION MARKER;Po;0;L;;;;;N;;;;;
+11F46;KAWI PUNCTUATION ALTERNATE SECTION MARKER;Po;0;L;;;;;N;;;;;
+11F47;KAWI PUNCTUATION FLOWER;Po;0;L;;;;;N;;;;;
+11F48;KAWI PUNCTUATION SPACE FILLER;Po;0;L;;;;;N;;;;;
+11F49;KAWI PUNCTUATION DOT;Po;0;L;;;;;N;;;;;
+11F4A;KAWI PUNCTUATION DOUBLE DOT;Po;0;L;;;;;N;;;;;
+11F4B;KAWI PUNCTUATION TRIPLE DOT;Po;0;L;;;;;N;;;;;
+11F4C;KAWI PUNCTUATION CIRCLE;Po;0;L;;;;;N;;;;;
+11F4D;KAWI PUNCTUATION FILLED CIRCLE;Po;0;L;;;;;N;;;;;
+11F4E;KAWI PUNCTUATION SPIRAL;Po;0;L;;;;;N;;;;;
+11F4F;KAWI PUNCTUATION CLOSING SPIRAL;Po;0;L;;;;;N;;;;;
+11F50;KAWI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+11F51;KAWI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+11F52;KAWI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+11F53;KAWI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+11F54;KAWI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+11F55;KAWI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+11F56;KAWI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+11F57;KAWI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+11F58;KAWI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+11F59;KAWI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
11FB0;LISU LETTER YHA;Lo;0;L;;;;;N;;;;;
11FC0;TAMIL FRACTION ONE THREE-HUNDRED-AND-TWENTIETH;No;0;L;;;;1/320;N;;;;;
11FC1;TAMIL FRACTION ONE ONE-HUNDRED-AND-SIXTIETH;No;0;L;;;;1/160;N;;;;;
@@ -24040,6 +24144,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1342C;EGYPTIAN HIEROGLYPH AA030;Lo;0;L;;;;;N;;;;;
1342D;EGYPTIAN HIEROGLYPH AA031;Lo;0;L;;;;;N;;;;;
1342E;EGYPTIAN HIEROGLYPH AA032;Lo;0;L;;;;;N;;;;;
+1342F;EGYPTIAN HIEROGLYPH V011D;Lo;0;L;;;;;N;;;;;
13430;EGYPTIAN HIEROGLYPH VERTICAL JOINER;Cf;0;L;;;;;N;;;;;
13431;EGYPTIAN HIEROGLYPH HORIZONTAL JOINER;Cf;0;L;;;;;N;;;;;
13432;EGYPTIAN HIEROGLYPH INSERT AT TOP START;Cf;0;L;;;;;N;;;;;
@@ -24049,6 +24154,35 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
13436;EGYPTIAN HIEROGLYPH OVERLAY MIDDLE;Cf;0;L;;;;;N;;;;;
13437;EGYPTIAN HIEROGLYPH BEGIN SEGMENT;Cf;0;L;;;;;N;;;;;
13438;EGYPTIAN HIEROGLYPH END SEGMENT;Cf;0;L;;;;;N;;;;;
+13439;EGYPTIAN HIEROGLYPH INSERT AT MIDDLE;Cf;0;L;;;;;N;;;;;
+1343A;EGYPTIAN HIEROGLYPH INSERT AT TOP;Cf;0;L;;;;;N;;;;;
+1343B;EGYPTIAN HIEROGLYPH INSERT AT BOTTOM;Cf;0;L;;;;;N;;;;;
+1343C;EGYPTIAN HIEROGLYPH BEGIN ENCLOSURE;Cf;0;L;;;;;N;;;;;
+1343D;EGYPTIAN HIEROGLYPH END ENCLOSURE;Cf;0;L;;;;;N;;;;;
+1343E;EGYPTIAN HIEROGLYPH BEGIN WALLED ENCLOSURE;Cf;0;L;;;;;N;;;;;
+1343F;EGYPTIAN HIEROGLYPH END WALLED ENCLOSURE;Cf;0;L;;;;;N;;;;;
+13440;EGYPTIAN HIEROGLYPH MIRROR HORIZONTALLY;Mn;0;NSM;;;;;N;;;;;
+13441;EGYPTIAN HIEROGLYPH FULL BLANK;Lo;0;L;;;;;N;;;;;
+13442;EGYPTIAN HIEROGLYPH HALF BLANK;Lo;0;L;;;;;N;;;;;
+13443;EGYPTIAN HIEROGLYPH LOST SIGN;Lo;0;L;;;;;N;;;;;
+13444;EGYPTIAN HIEROGLYPH HALF LOST SIGN;Lo;0;L;;;;;N;;;;;
+13445;EGYPTIAN HIEROGLYPH TALL LOST SIGN;Lo;0;L;;;;;N;;;;;
+13446;EGYPTIAN HIEROGLYPH WIDE LOST SIGN;Lo;0;L;;;;;N;;;;;
+13447;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT TOP START;Mn;0;NSM;;;;;N;;;;;
+13448;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT BOTTOM START;Mn;0;NSM;;;;;N;;;;;
+13449;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT START;Mn;0;NSM;;;;;N;;;;;
+1344A;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT TOP END;Mn;0;NSM;;;;;N;;;;;
+1344B;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT TOP;Mn;0;NSM;;;;;N;;;;;
+1344C;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT BOTTOM START AND TOP
END;Mn;0;NSM;;;;;N;;;;;
+1344D;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT START AND TOP;Mn;0;NSM;;;;;N;;;;;
+1344E;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT BOTTOM END;Mn;0;NSM;;;;;N;;;;;
+1344F;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT TOP START AND BOTTOM
END;Mn;0;NSM;;;;;N;;;;;
+13450;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT BOTTOM;Mn;0;NSM;;;;;N;;;;;
+13451;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT START AND
BOTTOM;Mn;0;NSM;;;;;N;;;;;
+13452;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT END;Mn;0;NSM;;;;;N;;;;;
+13453;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT TOP AND END;Mn;0;NSM;;;;;N;;;;;
+13454;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED AT BOTTOM AND
END;Mn;0;NSM;;;;;N;;;;;
+13455;EGYPTIAN HIEROGLYPH MODIFIER DAMAGED;Mn;0;NSM;;;;;N;;;;;
14400;ANATOLIAN HIEROGLYPH A001;Lo;0;L;;;;;N;;;;;
14401;ANATOLIAN HIEROGLYPH A002;Lo;0;L;;;;;N;;;;;
14402;ANATOLIAN HIEROGLYPH A003;Lo;0;L;;;;;N;;;;;
@@ -27289,9 +27423,11 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1B120;KATAKANA LETTER ARCHAIC YI;Lo;0;L;;;;;N;;;;;
1B121;KATAKANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;;
1B122;KATAKANA LETTER ARCHAIC WU;Lo;0;L;;;;;N;;;;;
+1B132;HIRAGANA LETTER SMALL KO;Lo;0;L;;;;;N;;;;;
1B150;HIRAGANA LETTER SMALL WI;Lo;0;L;;;;;N;;;;;
1B151;HIRAGANA LETTER SMALL WE;Lo;0;L;;;;;N;;;;;
1B152;HIRAGANA LETTER SMALL WO;Lo;0;L;;;;;N;;;;;
+1B155;KATAKANA LETTER SMALL KO;Lo;0;L;;;;;N;;;;;
1B164;KATAKANA LETTER SMALL WI;Lo;0;L;;;;;N;;;;;
1B165;KATAKANA LETTER SMALL WE;Lo;0;L;;;;;N;;;;;
1B166;KATAKANA LETTER SMALL WO;Lo;0;L;;;;;N;;;;;
@@ -28573,6 +28709,26 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1D243;COMBINING GREEK MUSICAL TETRASEME;Mn;230;NSM;;;;;N;;;;;
1D244;COMBINING GREEK MUSICAL PENTASEME;Mn;230;NSM;;;;;N;;;;;
1D245;GREEK MUSICAL LEIMMA;So;0;ON;;;;;N;;;;;
+1D2C0;KAKTOVIK NUMERAL ZERO;No;0;L;;;;0;N;;;;;
+1D2C1;KAKTOVIK NUMERAL ONE;No;0;L;;;;1;N;;;;;
+1D2C2;KAKTOVIK NUMERAL TWO;No;0;L;;;;2;N;;;;;
+1D2C3;KAKTOVIK NUMERAL THREE;No;0;L;;;;3;N;;;;;
+1D2C4;KAKTOVIK NUMERAL FOUR;No;0;L;;;;4;N;;;;;
+1D2C5;KAKTOVIK NUMERAL FIVE;No;0;L;;;;5;N;;;;;
+1D2C6;KAKTOVIK NUMERAL SIX;No;0;L;;;;6;N;;;;;
+1D2C7;KAKTOVIK NUMERAL SEVEN;No;0;L;;;;7;N;;;;;
+1D2C8;KAKTOVIK NUMERAL EIGHT;No;0;L;;;;8;N;;;;;
+1D2C9;KAKTOVIK NUMERAL NINE;No;0;L;;;;9;N;;;;;
+1D2CA;KAKTOVIK NUMERAL TEN;No;0;L;;;;10;N;;;;;
+1D2CB;KAKTOVIK NUMERAL ELEVEN;No;0;L;;;;11;N;;;;;
+1D2CC;KAKTOVIK NUMERAL TWELVE;No;0;L;;;;12;N;;;;;
+1D2CD;KAKTOVIK NUMERAL THIRTEEN;No;0;L;;;;13;N;;;;;
+1D2CE;KAKTOVIK NUMERAL FOURTEEN;No;0;L;;;;14;N;;;;;
+1D2CF;KAKTOVIK NUMERAL FIFTEEN;No;0;L;;;;15;N;;;;;
+1D2D0;KAKTOVIK NUMERAL SIXTEEN;No;0;L;;;;16;N;;;;;
+1D2D1;KAKTOVIK NUMERAL SEVENTEEN;No;0;L;;;;17;N;;;;;
+1D2D2;KAKTOVIK NUMERAL EIGHTEEN;No;0;L;;;;18;N;;;;;
+1D2D3;KAKTOVIK NUMERAL NINETEEN;No;0;L;;;;19;N;;;;;
1D2E0;MAYAN NUMERAL ZERO;No;0;L;;;;0;N;;;;;
1D2E1;MAYAN NUMERAL ONE;No;0;L;;;;1;N;;;;;
1D2E2;MAYAN NUMERAL TWO;No;0;L;;;;2;N;;;;;
@@ -30404,6 +30560,12 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1DF1C;LATIN SMALL LETTER TESH DIGRAPH WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;;
1DF1D;LATIN SMALL LETTER C WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;;
1DF1E;LATIN SMALL LETTER S WITH CURL;Ll;0;L;;;;;N;;;;;
+1DF25;LATIN SMALL LETTER D WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
+1DF26;LATIN SMALL LETTER L WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
+1DF27;LATIN SMALL LETTER N WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
+1DF28;LATIN SMALL LETTER R WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
+1DF29;LATIN SMALL LETTER S WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
+1DF2A;LATIN SMALL LETTER T WITH MID-HEIGHT LEFT HOOK;Ll;0;L;;;;;N;;;;;
1E000;COMBINING GLAGOLITIC LETTER AZU;Mn;230;NSM;;;;;N;;;;;
1E001;COMBINING GLAGOLITIC LETTER BUKY;Mn;230;NSM;;;;;N;;;;;
1E002;COMBINING GLAGOLITIC LETTER VEDE;Mn;230;NSM;;;;;N;;;;;
@@ -30442,6 +30604,69 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1E028;COMBINING GLAGOLITIC LETTER BIG YUS;Mn;230;NSM;;;;;N;;;;;
1E029;COMBINING GLAGOLITIC LETTER IOTATED BIG YUS;Mn;230;NSM;;;;;N;;;;;
1E02A;COMBINING GLAGOLITIC LETTER FITA;Mn;230;NSM;;;;;N;;;;;
+1E030;MODIFIER LETTER CYRILLIC SMALL A;Lm;0;L;<super> 0430;;;;N;;;;;
+1E031;MODIFIER LETTER CYRILLIC SMALL BE;Lm;0;L;<super> 0431;;;;N;;;;;
+1E032;MODIFIER LETTER CYRILLIC SMALL VE;Lm;0;L;<super> 0432;;;;N;;;;;
+1E033;MODIFIER LETTER CYRILLIC SMALL GHE;Lm;0;L;<super> 0433;;;;N;;;;;
+1E034;MODIFIER LETTER CYRILLIC SMALL DE;Lm;0;L;<super> 0434;;;;N;;;;;
+1E035;MODIFIER LETTER CYRILLIC SMALL IE;Lm;0;L;<super> 0435;;;;N;;;;;
+1E036;MODIFIER LETTER CYRILLIC SMALL ZHE;Lm;0;L;<super> 0436;;;;N;;;;;
+1E037;MODIFIER LETTER CYRILLIC SMALL ZE;Lm;0;L;<super> 0437;;;;N;;;;;
+1E038;MODIFIER LETTER CYRILLIC SMALL I;Lm;0;L;<super> 0438;;;;N;;;;;
+1E039;MODIFIER LETTER CYRILLIC SMALL KA;Lm;0;L;<super> 043A;;;;N;;;;;
+1E03A;MODIFIER LETTER CYRILLIC SMALL EL;Lm;0;L;<super> 043B;;;;N;;;;;
+1E03B;MODIFIER LETTER CYRILLIC SMALL EM;Lm;0;L;<super> 043C;;;;N;;;;;
+1E03C;MODIFIER LETTER CYRILLIC SMALL O;Lm;0;L;<super> 043E;;;;N;;;;;
+1E03D;MODIFIER LETTER CYRILLIC SMALL PE;Lm;0;L;<super> 043F;;;;N;;;;;
+1E03E;MODIFIER LETTER CYRILLIC SMALL ER;Lm;0;L;<super> 0440;;;;N;;;;;
+1E03F;MODIFIER LETTER CYRILLIC SMALL ES;Lm;0;L;<super> 0441;;;;N;;;;;
+1E040;MODIFIER LETTER CYRILLIC SMALL TE;Lm;0;L;<super> 0442;;;;N;;;;;
+1E041;MODIFIER LETTER CYRILLIC SMALL U;Lm;0;L;<super> 0443;;;;N;;;;;
+1E042;MODIFIER LETTER CYRILLIC SMALL EF;Lm;0;L;<super> 0444;;;;N;;;;;
+1E043;MODIFIER LETTER CYRILLIC SMALL HA;Lm;0;L;<super> 0445;;;;N;;;;;
+1E044;MODIFIER LETTER CYRILLIC SMALL TSE;Lm;0;L;<super> 0446;;;;N;;;;;
+1E045;MODIFIER LETTER CYRILLIC SMALL CHE;Lm;0;L;<super> 0447;;;;N;;;;;
+1E046;MODIFIER LETTER CYRILLIC SMALL SHA;Lm;0;L;<super> 0448;;;;N;;;;;
+1E047;MODIFIER LETTER CYRILLIC SMALL YERU;Lm;0;L;<super> 044B;;;;N;;;;;
+1E048;MODIFIER LETTER CYRILLIC SMALL E;Lm;0;L;<super> 044D;;;;N;;;;;
+1E049;MODIFIER LETTER CYRILLIC SMALL YU;Lm;0;L;<super> 044E;;;;N;;;;;
+1E04A;MODIFIER LETTER CYRILLIC SMALL DZZE;Lm;0;L;<super> A689;;;;N;;;;;
+1E04B;MODIFIER LETTER CYRILLIC SMALL SCHWA;Lm;0;L;<super> 04D9;;;;N;;;;;
+1E04C;MODIFIER LETTER CYRILLIC SMALL BYELORUSSIAN-UKRAINIAN I;Lm;0;L;<super>
0456;;;;N;;;;;
+1E04D;MODIFIER LETTER CYRILLIC SMALL JE;Lm;0;L;<super> 0458;;;;N;;;;;
+1E04E;MODIFIER LETTER CYRILLIC SMALL BARRED O;Lm;0;L;<super> 04E9;;;;N;;;;;
+1E04F;MODIFIER LETTER CYRILLIC SMALL STRAIGHT U;Lm;0;L;<super> 04AF;;;;N;;;;;
+1E050;MODIFIER LETTER CYRILLIC SMALL PALOCHKA;Lm;0;L;<super> 04CF;;;;N;;;;;
+1E051;CYRILLIC SUBSCRIPT SMALL LETTER A;Lm;0;L;<sub> 0430;;;;N;;;;;
+1E052;CYRILLIC SUBSCRIPT SMALL LETTER BE;Lm;0;L;<sub> 0431;;;;N;;;;;
+1E053;CYRILLIC SUBSCRIPT SMALL LETTER VE;Lm;0;L;<sub> 0432;;;;N;;;;;
+1E054;CYRILLIC SUBSCRIPT SMALL LETTER GHE;Lm;0;L;<sub> 0433;;;;N;;;;;
+1E055;CYRILLIC SUBSCRIPT SMALL LETTER DE;Lm;0;L;<sub> 0434;;;;N;;;;;
+1E056;CYRILLIC SUBSCRIPT SMALL LETTER IE;Lm;0;L;<sub> 0435;;;;N;;;;;
+1E057;CYRILLIC SUBSCRIPT SMALL LETTER ZHE;Lm;0;L;<sub> 0436;;;;N;;;;;
+1E058;CYRILLIC SUBSCRIPT SMALL LETTER ZE;Lm;0;L;<sub> 0437;;;;N;;;;;
+1E059;CYRILLIC SUBSCRIPT SMALL LETTER I;Lm;0;L;<sub> 0438;;;;N;;;;;
+1E05A;CYRILLIC SUBSCRIPT SMALL LETTER KA;Lm;0;L;<sub> 043A;;;;N;;;;;
+1E05B;CYRILLIC SUBSCRIPT SMALL LETTER EL;Lm;0;L;<sub> 043B;;;;N;;;;;
+1E05C;CYRILLIC SUBSCRIPT SMALL LETTER O;Lm;0;L;<sub> 043E;;;;N;;;;;
+1E05D;CYRILLIC SUBSCRIPT SMALL LETTER PE;Lm;0;L;<sub> 043F;;;;N;;;;;
+1E05E;CYRILLIC SUBSCRIPT SMALL LETTER ES;Lm;0;L;<sub> 0441;;;;N;;;;;
+1E05F;CYRILLIC SUBSCRIPT SMALL LETTER U;Lm;0;L;<sub> 0443;;;;N;;;;;
+1E060;CYRILLIC SUBSCRIPT SMALL LETTER EF;Lm;0;L;<sub> 0444;;;;N;;;;;
+1E061;CYRILLIC SUBSCRIPT SMALL LETTER HA;Lm;0;L;<sub> 0445;;;;N;;;;;
+1E062;CYRILLIC SUBSCRIPT SMALL LETTER TSE;Lm;0;L;<sub> 0446;;;;N;;;;;
+1E063;CYRILLIC SUBSCRIPT SMALL LETTER CHE;Lm;0;L;<sub> 0447;;;;N;;;;;
+1E064;CYRILLIC SUBSCRIPT SMALL LETTER SHA;Lm;0;L;<sub> 0448;;;;N;;;;;
+1E065;CYRILLIC SUBSCRIPT SMALL LETTER HARD SIGN;Lm;0;L;<sub> 044A;;;;N;;;;;
+1E066;CYRILLIC SUBSCRIPT SMALL LETTER YERU;Lm;0;L;<sub> 044B;;;;N;;;;;
+1E067;CYRILLIC SUBSCRIPT SMALL LETTER GHE WITH UPTURN;Lm;0;L;<sub>
0491;;;;N;;;;;
+1E068;CYRILLIC SUBSCRIPT SMALL LETTER BYELORUSSIAN-UKRAINIAN I;Lm;0;L;<sub>
0456;;;;N;;;;;
+1E069;CYRILLIC SUBSCRIPT SMALL LETTER DZE;Lm;0;L;<sub> 0455;;;;N;;;;;
+1E06A;CYRILLIC SUBSCRIPT SMALL LETTER DZHE;Lm;0;L;<sub> 045F;;;;N;;;;;
+1E06B;MODIFIER LETTER CYRILLIC SMALL ES WITH DESCENDER;Lm;0;L;<super>
04AB;;;;N;;;;;
+1E06C;MODIFIER LETTER CYRILLIC SMALL YERU WITH BACK YER;Lm;0;L;<super>
A651;;;;N;;;;;
+1E06D;MODIFIER LETTER CYRILLIC SMALL STRAIGHT U WITH STROKE;Lm;0;L;<super>
04B1;;;;N;;;;;
+1E08F;COMBINING CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN
I;Mn;230;NSM;;;;;N;;;;;
1E100;NYIAKENG PUACHUE HMONG LETTER MA;Lo;0;L;;;;;N;;;;;
1E101;NYIAKENG PUACHUE HMONG LETTER TSA;Lo;0;L;;;;;N;;;;;
1E102;NYIAKENG PUACHUE HMONG LETTER NTA;Lo;0;L;;;;;N;;;;;
@@ -30603,6 +30828,48 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1E2F8;WANCHO DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
1E2F9;WANCHO DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
1E2FF;WANCHO NGUN SIGN;Sc;0;ET;;;;;N;;;;;
+1E4D0;NAG MUNDARI LETTER O;Lo;0;L;;;;;N;;;;;
+1E4D1;NAG MUNDARI LETTER OP;Lo;0;L;;;;;N;;;;;
+1E4D2;NAG MUNDARI LETTER OL;Lo;0;L;;;;;N;;;;;
+1E4D3;NAG MUNDARI LETTER OY;Lo;0;L;;;;;N;;;;;
+1E4D4;NAG MUNDARI LETTER ONG;Lo;0;L;;;;;N;;;;;
+1E4D5;NAG MUNDARI LETTER A;Lo;0;L;;;;;N;;;;;
+1E4D6;NAG MUNDARI LETTER AJ;Lo;0;L;;;;;N;;;;;
+1E4D7;NAG MUNDARI LETTER AB;Lo;0;L;;;;;N;;;;;
+1E4D8;NAG MUNDARI LETTER ANY;Lo;0;L;;;;;N;;;;;
+1E4D9;NAG MUNDARI LETTER AH;Lo;0;L;;;;;N;;;;;
+1E4DA;NAG MUNDARI LETTER I;Lo;0;L;;;;;N;;;;;
+1E4DB;NAG MUNDARI LETTER IS;Lo;0;L;;;;;N;;;;;
+1E4DC;NAG MUNDARI LETTER IDD;Lo;0;L;;;;;N;;;;;
+1E4DD;NAG MUNDARI LETTER IT;Lo;0;L;;;;;N;;;;;
+1E4DE;NAG MUNDARI LETTER IH;Lo;0;L;;;;;N;;;;;
+1E4DF;NAG MUNDARI LETTER U;Lo;0;L;;;;;N;;;;;
+1E4E0;NAG MUNDARI LETTER UC;Lo;0;L;;;;;N;;;;;
+1E4E1;NAG MUNDARI LETTER UD;Lo;0;L;;;;;N;;;;;
+1E4E2;NAG MUNDARI LETTER UK;Lo;0;L;;;;;N;;;;;
+1E4E3;NAG MUNDARI LETTER UR;Lo;0;L;;;;;N;;;;;
+1E4E4;NAG MUNDARI LETTER E;Lo;0;L;;;;;N;;;;;
+1E4E5;NAG MUNDARI LETTER ENN;Lo;0;L;;;;;N;;;;;
+1E4E6;NAG MUNDARI LETTER EG;Lo;0;L;;;;;N;;;;;
+1E4E7;NAG MUNDARI LETTER EM;Lo;0;L;;;;;N;;;;;
+1E4E8;NAG MUNDARI LETTER EN;Lo;0;L;;;;;N;;;;;
+1E4E9;NAG MUNDARI LETTER ETT;Lo;0;L;;;;;N;;;;;
+1E4EA;NAG MUNDARI LETTER ELL;Lo;0;L;;;;;N;;;;;
+1E4EB;NAG MUNDARI SIGN OJOD;Lm;0;L;;;;;N;;;;;
+1E4EC;NAG MUNDARI SIGN MUHOR;Mn;232;NSM;;;;;N;;;;;
+1E4ED;NAG MUNDARI SIGN TOYOR;Mn;232;NSM;;;;;N;;;;;
+1E4EE;NAG MUNDARI SIGN IKIR;Mn;220;NSM;;;;;N;;;;;
+1E4EF;NAG MUNDARI SIGN SUTUH;Mn;230;NSM;;;;;N;;;;;
+1E4F0;NAG MUNDARI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+1E4F1;NAG MUNDARI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+1E4F2;NAG MUNDARI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+1E4F3;NAG MUNDARI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+1E4F4;NAG MUNDARI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+1E4F5;NAG MUNDARI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+1E4F6;NAG MUNDARI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+1E4F7;NAG MUNDARI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+1E4F8;NAG MUNDARI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+1E4F9;NAG MUNDARI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
1E7E0;ETHIOPIC SYLLABLE HHYA;Lo;0;L;;;;;N;;;;;
1E7E1;ETHIOPIC SYLLABLE HHYU;Lo;0;L;;;;;N;;;;;
1E7E2;ETHIOPIC SYLLABLE HHYI;Lo;0;L;;;;;N;;;;;
@@ -32678,6 +32945,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F6D5;HINDU TEMPLE;So;0;ON;;;;;N;;;;;
1F6D6;HUT;So;0;ON;;;;;N;;;;;
1F6D7;ELEVATOR;So;0;ON;;;;;N;;;;;
+1F6DC;WIRELESS;So;0;ON;;;;;N;;;;;
1F6DD;PLAYGROUND SLIDE;So;0;ON;;;;;N;;;;;
1F6DE;WHEEL;So;0;ON;;;;;N;;;;;
1F6DF;RING BUOY;So;0;ON;;;;;N;;;;;
@@ -32823,6 +33091,14 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F771;ALCHEMICAL SYMBOL FOR MONTH;So;0;ON;;;;;N;;;;;
1F772;ALCHEMICAL SYMBOL FOR HALF DRAM;So;0;ON;;;;;N;;;;;
1F773;ALCHEMICAL SYMBOL FOR HALF OUNCE;So;0;ON;;;;;N;;;;;
+1F774;LOT OF FORTUNE;So;0;ON;;;;;N;;;;;
+1F775;OCCULTATION;So;0;ON;;;;;N;;;;;
+1F776;LUNAR ECLIPSE;So;0;ON;;;;;N;;;;;
+1F77B;HAUMEA;So;0;ON;;;;;N;;;;;
+1F77C;MAKEMAKE;So;0;ON;;;;;N;;;;;
+1F77D;GONGGONG;So;0;ON;;;;;N;;;;;
+1F77E;QUAOAR;So;0;ON;;;;;N;;;;;
+1F77F;ORCUS;So;0;ON;;;;;N;;;;;
1F780;BLACK LEFT-POINTING ISOSCELES RIGHT TRIANGLE;So;0;ON;;;;;N;;;;;
1F781;BLACK UP-POINTING ISOSCELES RIGHT TRIANGLE;So;0;ON;;;;;N;;;;;
1F782;BLACK RIGHT-POINTING ISOSCELES RIGHT TRIANGLE;So;0;ON;;;;;N;;;;;
@@ -32912,6 +33188,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F7D6;NEGATIVE CIRCLED TRIANGLE;So;0;ON;;;;;N;;;;;
1F7D7;CIRCLED SQUARE;So;0;ON;;;;;N;;;;;
1F7D8;NEGATIVE CIRCLED SQUARE;So;0;ON;;;;;N;;;;;
+1F7D9;NINE POINTED WHITE STAR;So;0;ON;;;;;N;;;;;
1F7E0;LARGE ORANGE CIRCLE;So;0;ON;;;;;N;;;;;
1F7E1;LARGE YELLOW CIRCLE;So;0;ON;;;;;N;;;;;
1F7E2;LARGE GREEN CIRCLE;So;0;ON;;;;;N;;;;;
@@ -33434,6 +33711,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FA72;BRIEFS;So;0;ON;;;;;N;;;;;
1FA73;SHORTS;So;0;ON;;;;;N;;;;;
1FA74;THONG SANDAL;So;0;ON;;;;;N;;;;;
+1FA75;LIGHT BLUE HEART;So;0;ON;;;;;N;;;;;
+1FA76;GREY HEART;So;0;ON;;;;;N;;;;;
+1FA77;PINK HEART;So;0;ON;;;;;N;;;;;
1FA78;DROP OF BLOOD;So;0;ON;;;;;N;;;;;
1FA79;ADHESIVE BANDAGE;So;0;ON;;;;;N;;;;;
1FA7A;STETHOSCOPE;So;0;ON;;;;;N;;;;;
@@ -33446,6 +33726,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FA84;MAGIC WAND;So;0;ON;;;;;N;;;;;
1FA85;PINATA;So;0;ON;;;;;N;;;;;
1FA86;NESTING DOLLS;So;0;ON;;;;;N;;;;;
+1FA87;MARACAS;So;0;ON;;;;;N;;;;;
+1FA88;FLUTE;So;0;ON;;;;;N;;;;;
1FA90;RINGED PLANET;So;0;ON;;;;;N;;;;;
1FA91;CHAIR;So;0;ON;;;;;N;;;;;
1FA92;RAZOR;So;0;ON;;;;;N;;;;;
@@ -33475,6 +33757,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FAAA;IDENTIFICATION CARD;So;0;ON;;;;;N;;;;;
1FAAB;LOW BATTERY;So;0;ON;;;;;N;;;;;
1FAAC;HAMSA;So;0;ON;;;;;N;;;;;
+1FAAD;FOLDING HAND FAN;So;0;ON;;;;;N;;;;;
+1FAAE;HAIR PICK;So;0;ON;;;;;N;;;;;
+1FAAF;KHANDA;So;0;ON;;;;;N;;;;;
1FAB0;FLY;So;0;ON;;;;;N;;;;;
1FAB1;WORM;So;0;ON;;;;;N;;;;;
1FAB2;BEETLE;So;0;ON;;;;;N;;;;;
@@ -33486,12 +33771,18 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FAB8;CORAL;So;0;ON;;;;;N;;;;;
1FAB9;EMPTY NEST;So;0;ON;;;;;N;;;;;
1FABA;NEST WITH EGGS;So;0;ON;;;;;N;;;;;
+1FABB;HYACINTH;So;0;ON;;;;;N;;;;;
+1FABC;JELLYFISH;So;0;ON;;;;;N;;;;;
+1FABD;WING;So;0;ON;;;;;N;;;;;
+1FABF;GOOSE;So;0;ON;;;;;N;;;;;
1FAC0;ANATOMICAL HEART;So;0;ON;;;;;N;;;;;
1FAC1;LUNGS;So;0;ON;;;;;N;;;;;
1FAC2;PEOPLE HUGGING;So;0;ON;;;;;N;;;;;
1FAC3;PREGNANT MAN;So;0;ON;;;;;N;;;;;
1FAC4;PREGNANT PERSON;So;0;ON;;;;;N;;;;;
1FAC5;PERSON WITH CROWN;So;0;ON;;;;;N;;;;;
+1FACE;MOOSE;So;0;ON;;;;;N;;;;;
+1FACF;DONKEY;So;0;ON;;;;;N;;;;;
1FAD0;BLUEBERRIES;So;0;ON;;;;;N;;;;;
1FAD1;BELL PEPPER;So;0;ON;;;;;N;;;;;
1FAD2;OLIVE;So;0;ON;;;;;N;;;;;
@@ -33502,6 +33793,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FAD7;POURING LIQUID;So;0;ON;;;;;N;;;;;
1FAD8;BEANS;So;0;ON;;;;;N;;;;;
1FAD9;JAR;So;0;ON;;;;;N;;;;;
+1FADA;GINGER ROOT;So;0;ON;;;;;N;;;;;
+1FADB;PEA POD;So;0;ON;;;;;N;;;;;
1FAE0;MELTING FACE;So;0;ON;;;;;N;;;;;
1FAE1;SALUTING FACE;So;0;ON;;;;;N;;;;;
1FAE2;FACE WITH OPEN EYES AND HAND OVER MOUTH;So;0;ON;;;;;N;;;;;
@@ -33510,6 +33803,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FAE5;DOTTED LINE FACE;So;0;ON;;;;;N;;;;;
1FAE6;BITING LIP;So;0;ON;;;;;N;;;;;
1FAE7;BUBBLES;So;0;ON;;;;;N;;;;;
+1FAE8;SHAKING FACE;So;0;ON;;;;;N;;;;;
1FAF0;HAND WITH INDEX FINGER AND THUMB CROSSED;So;0;ON;;;;;N;;;;;
1FAF1;RIGHTWARDS HAND;So;0;ON;;;;;N;;;;;
1FAF2;LEFTWARDS HAND;So;0;ON;;;;;N;;;;;
@@ -33517,6 +33811,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1FAF4;PALM UP HAND;So;0;ON;;;;;N;;;;;
1FAF5;INDEX POINTING AT THE VIEWER;So;0;ON;;;;;N;;;;;
1FAF6;HEART HANDS;So;0;ON;;;;;N;;;;;
+1FAF7;LEFTWARDS PUSHING HAND;So;0;ON;;;;;N;;;;;
+1FAF8;RIGHTWARDS PUSHING HAND;So;0;ON;;;;;N;;;;;
1FB00;BLOCK SEXTANT-1;So;0;ON;;;;;N;;;;;
1FB01;BLOCK SEXTANT-2;So;0;ON;;;;;N;;;;;
1FB02;BLOCK SEXTANT-12;So;0;ON;;;;;N;;;;;
@@ -33732,7 +34028,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
20000;<CJK Ideograph Extension B, First>;Lo;0;L;;;;;N;;;;;
2A6DF;<CJK Ideograph Extension B, Last>;Lo;0;L;;;;;N;;;;;
2A700;<CJK Ideograph Extension C, First>;Lo;0;L;;;;;N;;;;;
-2B738;<CJK Ideograph Extension C, Last>;Lo;0;L;;;;;N;;;;;
+2B739;<CJK Ideograph Extension C, Last>;Lo;0;L;;;;;N;;;;;
2B740;<CJK Ideograph Extension D, First>;Lo;0;L;;;;;N;;;;;
2B81D;<CJK Ideograph Extension D, Last>;Lo;0;L;;;;;N;;;;;
2B820;<CJK Ideograph Extension E, First>;Lo;0;L;;;;;N;;;;;
@@ -34283,6 +34579,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
2FA1D;CJK COMPATIBILITY IDEOGRAPH-2FA1D;Lo;0;L;2A600;;;;N;;;;;
30000;<CJK Ideograph Extension G, First>;Lo;0;L;;;;;N;;;;;
3134A;<CJK Ideograph Extension G, Last>;Lo;0;L;;;;;N;;;;;
+31350;<CJK Ideograph Extension H, First>;Lo;0;L;;;;;N;;;;;
+323AF;<CJK Ideograph Extension H, Last>;Lo;0;L;;;;;N;;;;;
E0001;LANGUAGE TAG;Cf;0;BN;;;;;N;;;;;
E0020;TAG SPACE;Cf;0;BN;;;;;N;;;;;
E0021;TAG EXCLAMATION MARK;Cf;0;BN;;;;;N;;;;;
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/confusables.txt b/admin/unidata/confusables.txt
index c75f78ec3e..24b61d519a 100644
--- a/admin/unidata/confusables.txt
+++ b/admin/unidata/confusables.txt
@@ -1,13 +1,13 @@
-# confusables.txt
-# Date: 2021-05-29, 22:09:29 GMT
-# © 2021 Unicode®, Inc.
+# confusables.txt
+# Date: 2022-08-26, 16:49:08 GMT
+# © 2022 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 Security Mechanisms for UTS #39
-# Version: 14.0.0
+# Version: 15.0.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr39
+# For documentation and usage, see https://www.unicode.org/reports/tr39
#
05AD ; 0596 ; MA # ( ֭ → ֖ ) HEBREW ACCENT DEHI → HEBREW ACCENT TIPEHA
#
@@ -2761,11 +2761,11 @@ FE87 ; 006C 0655 ; MA # ( ﺇ → lٕ ) ARABIC
LETTER ALEF WITH HAMZA BELO
02AB ; 006C 007A ; MA # ( ʫ → lz ) LATIN SMALL LETTER LZ DIGRAPH →
LATIN SMALL LETTER L, LATIN SMALL LETTER Z #
+0675 ; 006C 0674 ; MA # ( ٵ → lٴ ) ARABIC LETTER HIGH HAMZA ALEF
→ LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA # →اٴ→
0623 ; 006C 0674 ; MA # ( أ → lٴ ) ARABIC LETTER ALEF WITH HAMZA
ABOVE → LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA # →ٵ→→اٴ→
FE84 ; 006C 0674 ; MA # ( ﺄ → lٴ ) ARABIC LETTER ALEF WITH HAMZA
ABOVE FINAL FORM → LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA #
→أ→→ٵ→→اٴ→
FE83 ; 006C 0674 ; MA # ( ﺃ → lٴ ) ARABIC LETTER ALEF WITH HAMZA
ABOVE ISOLATED FORM → LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA #
→ٵ→→اٴ→
0672 ; 006C 0674 ; MA # ( ٲ → lٴ ) ARABIC LETTER ALEF WITH WAVY
HAMZA ABOVE → LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA #
→أ→→ٵ→→اٴ→
-0675 ; 006C 0674 ; MA # ( ٵ → lٴ ) ARABIC LETTER HIGH HAMZA ALEF
→ LATIN SMALL LETTER L, ARABIC LETTER HIGH HAMZA # →اٴ→
FDF3 ; 006C 0643 0628 0631 ; MA # ( ﷳ → lكبر ) ARABIC LIGATURE
AKBAR ISOLATED FORM → LATIN SMALL LETTER L, ARABIC LETTER KAF, ARABIC LETTER
BEH, ARABIC LETTER REH # →اكبر→
@@ -5351,10 +5351,10 @@ FBE2 ; 0648 0302 ; MA # ( ﯢ → و̂ ) ARABIC
LETTER KIRGHIZ YU IS
FBDC ; 0648 0670 ; MA # ( ﯜ → وٰ ) ARABIC LETTER YU FINAL FORM →
ARABIC LETTER WAW, ARABIC LETTER SUPERSCRIPT ALEF # →ۈ→
FBDB ; 0648 0670 ; MA # ( ﯛ → وٰ ) ARABIC LETTER YU ISOLATED FORM
→ ARABIC LETTER WAW, ARABIC LETTER SUPERSCRIPT ALEF # →ۈ→
+0676 ; 0648 0674 ; MA # ( ٶ → وٴ ) ARABIC LETTER HIGH HAMZA WAW →
ARABIC LETTER WAW, ARABIC LETTER HIGH HAMZA #
0624 ; 0648 0674 ; MA # ( ؤ → وٴ ) ARABIC LETTER WAW WITH HAMZA
ABOVE → ARABIC LETTER WAW, ARABIC LETTER HIGH HAMZA # →ٶ→
FE86 ; 0648 0674 ; MA # ( ﺆ → وٴ ) ARABIC LETTER WAW WITH HAMZA
ABOVE FINAL FORM → ARABIC LETTER WAW, ARABIC LETTER HIGH HAMZA # →ٶ→
FE85 ; 0648 0674 ; MA # ( ﺅ → وٴ ) ARABIC LETTER WAW WITH HAMZA
ABOVE ISOLATED FORM → ARABIC LETTER WAW, ARABIC LETTER HIGH HAMZA # →ٶ→
-0676 ; 0648 0674 ; MA # ( ٶ → وٴ ) ARABIC LETTER HIGH HAMZA WAW →
ARABIC LETTER WAW, ARABIC LETTER HIGH HAMZA #
0677 ; 0648 0313 0674 ; MA # ( ٷ → و̓ٴ ) ARABIC LETTER U WITH
HAMZA ABOVE → ARABIC LETTER WAW, COMBINING COMMA ABOVE, ARABIC LETTER HIGH
HAMZA # →ۇٴ→
FBDD ; 0648 0313 0674 ; MA # ( ﯝ → و̓ٴ ) ARABIC LETTER U WITH
HAMZA ABOVE ISOLATED FORM → ARABIC LETTER WAW, COMBINING COMMA ABOVE, ARABIC
LETTER HIGH HAMZA # →ۇٴ→
@@ -5446,12 +5446,12 @@ FCF1 ; 0649 006F ; MA # ( ﳱ → ىo ) ARABIC
LIGATURE YEH WITH HEH
FCE6 ; 0649 06DB 006F ; MA # ( ﳦ → ىۛo ) ARABIC LIGATURE THEH
WITH HEH MEDIAL FORM → ARABIC LETTER ALEF MAKSURA, ARABIC SMALL HIGH THREE
DOTS, LATIN SMALL LETTER O # →ثه→
+0678 ; 0649 0674 ; MA # ( ٸ → ىٴ ) ARABIC LETTER HIGH HAMZA YEH →
ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA # →يٴ→
0626 ; 0649 0674 ; MA # ( ئ → ىٴ ) ARABIC LETTER YEH WITH HAMZA
ABOVE → ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA # →ٸ→→يٴ→
FE8B ; 0649 0674 ; MA # ( ﺋ → ىٴ ) ARABIC LETTER YEH WITH HAMZA
ABOVE INITIAL FORM → ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA #
→ئ→→ٸ→→يٴ→
FE8C ; 0649 0674 ; MA # ( ﺌ → ىٴ ) ARABIC LETTER YEH WITH HAMZA
ABOVE MEDIAL FORM → ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA #
→ئ→→ٸ→→يٴ→
FE8A ; 0649 0674 ; MA # ( ﺊ → ىٴ ) ARABIC LETTER YEH WITH HAMZA
ABOVE FINAL FORM → ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA #
→ئ→→ٸ→→يٴ→
FE89 ; 0649 0674 ; MA # ( ﺉ → ىٴ ) ARABIC LETTER YEH WITH HAMZA
ABOVE ISOLATED FORM → ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA
# →ٸ→→يٴ→
-0678 ; 0649 0674 ; MA # ( ٸ → ىٴ ) ARABIC LETTER HIGH HAMZA YEH →
ARABIC LETTER ALEF MAKSURA, ARABIC LETTER HIGH HAMZA # →يٴ→
FBEB ; 0649 0674 006C ; MA # ( ﯫ → ىٴl ) ARABIC LIGATURE YEH
WITH HAMZA ABOVE WITH ALEF FINAL FORM → ARABIC LETTER ALEF MAKSURA, ARABIC
LETTER HIGH HAMZA, LATIN SMALL LETTER L # →ئا→
FBEA ; 0649 0674 006C ; MA # ( ﯪ → ىٴl ) ARABIC LIGATURE YEH
WITH HAMZA ABOVE WITH ALEF ISOLATED FORM → ARABIC LETTER ALEF MAKSURA, ARABIC
LETTER HIGH HAMZA, LATIN SMALL LETTER L # →ئا→
@@ -7535,10 +7535,10 @@ FA7E ; 5944 ; MA # ( 奄 → 奄 ) CJK COMPATIBILITY
IDEOGRAPH-FA7E → CJK UNIF
F90C ; 5948 ; MA # ( 奈 → 奈 ) CJK COMPATIBILITY IDEOGRAPH-F90C → CJK
UNIFIED IDEOGRAPH-5948 #
-F909 ; 5951 ; MA # ( 契 → 契 ) CJK COMPATIBILITY IDEOGRAPH-F909 → CJK
UNIFIED IDEOGRAPH-5951 #
-
FA7F ; 5954 ; MA # ( 奔 → 奔 ) CJK COMPATIBILITY IDEOGRAPH-FA7F → CJK
UNIFIED IDEOGRAPH-5954 #
+F909 ; 5951 ; MA # ( 契 → 契 ) CJK COMPATIBILITY IDEOGRAPH-F909 → CJK
UNIFIED IDEOGRAPH-5951 #
+
2F85F ; 5962 ; MA # ( 奢 → 奢 ) CJK COMPATIBILITY IDEOGRAPH-2F85F →
CJK UNIFIED IDEOGRAPH-5962 #
F981 ; 5973 ; MA # ( 女 → 女 ) CJK COMPATIBILITY IDEOGRAPH-F981 → CJK
UNIFIED IDEOGRAPH-5973 #
diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html
index 66e54b06fc..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>
@@ -82,7 +82,7 @@ pre {
</tr>
<tr>
<td valign="top" class="navColCell">
- <a href="https://www.unicode.org/license.html";>Unicode Data Files and
Software License</a></td>
+ <a href="https://www.unicode.org/license.txt";>Unicode Data Files and
Software License</a></td>
</tr>
<tr>
<td class="navColTitle">Related Links</td>
@@ -112,13 +112,13 @@ 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">
<li><u><a name="1"></a>Unicode Copyright</u>
<ol>
- <li>Copyright © 1991-2021 Unicode, Inc. All rights
reserved.</li>
+ <li>Copyright © 1991-2022 Unicode, Inc. All rights
reserved.</li>
</ol>
</li>
@@ -153,12 +153,12 @@ http://site.icu-project.org/download/
herein.</li>
<li>Further specifications of rights and restrictions
pertaining
to the use of the Unicode DATA FILES and SOFTWARE can be found
in the
- <a href="https://www.unicode.org/license.html";>Unicode Data
Files and Software License</a>.</li>
+ <a href="https://www.unicode.org/license.txt";>Unicode Data
Files and Software License</a>.</li>
<li>Each version of the Unicode Standard has further
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/unidata/emoji-data.txt b/admin/unidata/emoji-data.txt
index 2e9cf75ad4..7942fc89a3 100644
--- a/admin/unidata/emoji-data.txt
+++ b/admin/unidata/emoji-data.txt
@@ -1,13 +1,13 @@
-# emoji-data-14.0.0.txt
-# Date: 2021-08-26, 17:22:22 GMT
-# © 2021 Unicode®, Inc.
+# emoji-data.txt
+# Date: 2022-08-02, 00:26:10 GMT
+# © 2022 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
#
# Emoji Data for UTS #51
-# Used with Emoji Version 14.0 and subsequent minor revisions (if any)
+# Used with Emoji Version 15.0 and subsequent minor revisions (if any)
#
-# For documentation and usage, see http://www.unicode.org/reports/tr51
+# For documentation and usage, see https://www.unicode.org/reports/tr51
#
# Format:
# <codepoint(s)> ; <property> # <comments>
@@ -20,7 +20,6 @@
# ================================================
# All omitted code points have Emoji=No
-# @missing: 0000..10FFFF ; Emoji ; No
0023 ; Emoji # E0.0 [1] (#️) hash sign
002A ; Emoji # E0.0 [1] (*️) asterisk
@@ -341,6 +340,7 @@
1F6D1..1F6D2 ; Emoji # E3.0 [2] (🛑..🛒) stop
sign..shopping cart
1F6D5 ; Emoji # E12.0 [1] (🛕) hindu temple
1F6D6..1F6D7 ; Emoji # E13.0 [2] (🛖..🛗) hut..elevator
+1F6DC ; Emoji # E15.0 [1] (🛜) wireless
1F6DD..1F6DF ; Emoji # E14.0 [3] (🛝..🛟) playground
slide..ring buoy
1F6E0..1F6E5 ; Emoji # E0.7 [6] (🛠️..🛥️) hammer and
wrench..motor boat
1F6E9 ; Emoji # E0.7 [1] (🛩️) small airplane
@@ -401,28 +401,36 @@
1F9E7..1F9FF ; Emoji # E11.0 [25] (🧧..🧿) red
envelope..nazar amulet
1FA70..1FA73 ; Emoji # E12.0 [4] (🩰..🩳) ballet
shoes..shorts
1FA74 ; Emoji # E13.0 [1] (🩴) thong sandal
+1FA75..1FA77 ; Emoji # E15.0 [3] (🩵..🩷) light blue
heart..pink heart
1FA78..1FA7A ; Emoji # E12.0 [3] (🩸..🩺) drop of
blood..stethoscope
1FA7B..1FA7C ; Emoji # E14.0 [2] (🩻..🩼) x-ray..crutch
1FA80..1FA82 ; Emoji # E12.0 [3] (🪀..🪂) yo-yo..parachute
1FA83..1FA86 ; Emoji # E13.0 [4] (🪃..🪆) boomerang..nesting
dolls
+1FA87..1FA88 ; Emoji # E15.0 [2] (🪇..🪈) maracas..flute
1FA90..1FA95 ; Emoji # E12.0 [6] (🪐..🪕) ringed
planet..banjo
1FA96..1FAA8 ; Emoji # E13.0 [19] (🪖..🪨) military
helmet..rock
1FAA9..1FAAC ; Emoji # E14.0 [4] (🪩..🪬) mirror ball..hamsa
+1FAAD..1FAAF ; Emoji # E15.0 [3] (🪭..🪯) folding hand
fan..khanda
1FAB0..1FAB6 ; Emoji # E13.0 [7] (🪰..🪶) fly..feather
1FAB7..1FABA ; Emoji # E14.0 [4] (🪷..🪺) lotus..nest with
eggs
+1FABB..1FABD ; Emoji # E15.0 [3] (🪻..🪽) hyacinth..wing
+1FABF ; Emoji # E15.0 [1] (🪿) goose
1FAC0..1FAC2 ; Emoji # E13.0 [3] (🫀..🫂) anatomical
heart..people hugging
1FAC3..1FAC5 ; Emoji # E14.0 [3] (🫃..🫅) pregnant
man..person with crown
+1FACE..1FACF ; Emoji # E15.0 [2] (🫎..🫏) moose..donkey
1FAD0..1FAD6 ; Emoji # E13.0 [7] (🫐..🫖) blueberries..teapot
1FAD7..1FAD9 ; Emoji # E14.0 [3] (🫗..🫙) pouring liquid..jar
+1FADA..1FADB ; Emoji # E15.0 [2] (🫚..🫛) ginger root..pea
pod
1FAE0..1FAE7 ; Emoji # E14.0 [8] (🫠..🫧) melting
face..bubbles
+1FAE8 ; Emoji # E15.0 [1] (🫨) shaking face
1FAF0..1FAF6 ; Emoji # E14.0 [7] (🫰..🫶) hand with index
finger and thumb crossed..heart hands
+1FAF7..1FAF8 ; Emoji # E15.0 [2] (🫷..🫸) leftwards pushing
hand..rightwards pushing hand
-# Total elements: 1404
+# Total elements: 1424
# ================================================
# All omitted code points have Emoji_Presentation=No
-# @missing: 0000..10FFFF ; Emoji_Presentation ; No
231A..231B ; Emoji_Presentation # E0.6 [2] (⌚..⌛) watch..hourglass
done
23E9..23EC ; Emoji_Presentation # E0.6 [4] (⏩..⏬) fast-forward
button..fast down button
@@ -625,6 +633,7 @@
1F6D1..1F6D2 ; Emoji_Presentation # E3.0 [2] (🛑..🛒) stop
sign..shopping cart
1F6D5 ; Emoji_Presentation # E12.0 [1] (🛕) hindu temple
1F6D6..1F6D7 ; Emoji_Presentation # E13.0 [2] (🛖..🛗) hut..elevator
+1F6DC ; Emoji_Presentation # E15.0 [1] (🛜) wireless
1F6DD..1F6DF ; Emoji_Presentation # E14.0 [3] (🛝..🛟) playground
slide..ring buoy
1F6EB..1F6EC ; Emoji_Presentation # E1.0 [2] (🛫..🛬) airplane
departure..airplane arrival
1F6F4..1F6F6 ; Emoji_Presentation # E3.0 [3] (🛴..🛶) kick scooter..canoe
@@ -681,28 +690,36 @@
1F9E7..1F9FF ; Emoji_Presentation # E11.0 [25] (🧧..🧿) red
envelope..nazar amulet
1FA70..1FA73 ; Emoji_Presentation # E12.0 [4] (🩰..🩳) ballet
shoes..shorts
1FA74 ; Emoji_Presentation # E13.0 [1] (🩴) thong sandal
+1FA75..1FA77 ; Emoji_Presentation # E15.0 [3] (🩵..🩷) light blue
heart..pink heart
1FA78..1FA7A ; Emoji_Presentation # E12.0 [3] (🩸..🩺) drop of
blood..stethoscope
1FA7B..1FA7C ; Emoji_Presentation # E14.0 [2] (🩻..🩼) x-ray..crutch
1FA80..1FA82 ; Emoji_Presentation # E12.0 [3] (🪀..🪂) yo-yo..parachute
1FA83..1FA86 ; Emoji_Presentation # E13.0 [4] (🪃..🪆) boomerang..nesting
dolls
+1FA87..1FA88 ; Emoji_Presentation # E15.0 [2] (🪇..🪈) maracas..flute
1FA90..1FA95 ; Emoji_Presentation # E12.0 [6] (🪐..🪕) ringed
planet..banjo
1FA96..1FAA8 ; Emoji_Presentation # E13.0 [19] (🪖..🪨) military
helmet..rock
1FAA9..1FAAC ; Emoji_Presentation # E14.0 [4] (🪩..🪬) mirror ball..hamsa
+1FAAD..1FAAF ; Emoji_Presentation # E15.0 [3] (🪭..🪯) folding hand
fan..khanda
1FAB0..1FAB6 ; Emoji_Presentation # E13.0 [7] (🪰..🪶) fly..feather
1FAB7..1FABA ; Emoji_Presentation # E14.0 [4] (🪷..🪺) lotus..nest with
eggs
+1FABB..1FABD ; Emoji_Presentation # E15.0 [3] (🪻..🪽) hyacinth..wing
+1FABF ; Emoji_Presentation # E15.0 [1] (🪿) goose
1FAC0..1FAC2 ; Emoji_Presentation # E13.0 [3] (🫀..🫂) anatomical
heart..people hugging
1FAC3..1FAC5 ; Emoji_Presentation # E14.0 [3] (🫃..🫅) pregnant
man..person with crown
+1FACE..1FACF ; Emoji_Presentation # E15.0 [2] (🫎..🫏) moose..donkey
1FAD0..1FAD6 ; Emoji_Presentation # E13.0 [7] (🫐..🫖) blueberries..teapot
1FAD7..1FAD9 ; Emoji_Presentation # E14.0 [3] (🫗..🫙) pouring liquid..jar
+1FADA..1FADB ; Emoji_Presentation # E15.0 [2] (🫚..🫛) ginger root..pea
pod
1FAE0..1FAE7 ; Emoji_Presentation # E14.0 [8] (🫠..🫧) melting
face..bubbles
+1FAE8 ; Emoji_Presentation # E15.0 [1] (🫨) shaking face
1FAF0..1FAF6 ; Emoji_Presentation # E14.0 [7] (🫰..🫶) hand with index
finger and thumb crossed..heart hands
+1FAF7..1FAF8 ; Emoji_Presentation # E15.0 [2] (🫷..🫸) leftwards pushing
hand..rightwards pushing hand
-# Total elements: 1185
+# Total elements: 1205
# ================================================
# All omitted code points have Emoji_Modifier=No
-# @missing: 0000..10FFFF ; Emoji_Modifier ; No
1F3FB..1F3FF ; Emoji_Modifier # E1.0 [5] (🏻..🏿) light skin
tone..dark skin tone
@@ -711,7 +728,6 @@
# ================================================
# All omitted code points have Emoji_Modifier_Base=No
-# @missing: 0000..10FFFF ; Emoji_Modifier_Base ; No
261D ; Emoji_Modifier_Base # E0.6 [1] (☝️) index pointing up
26F9 ; Emoji_Modifier_Base # E0.7 [1] (⛹️) person bouncing
ball
@@ -762,13 +778,13 @@
1F9D1..1F9DD ; Emoji_Modifier_Base # E5.0 [13] (🧑..🧝) person..elf
1FAC3..1FAC5 ; Emoji_Modifier_Base # E14.0 [3] (🫃..🫅) pregnant
man..person with crown
1FAF0..1FAF6 ; Emoji_Modifier_Base # E14.0 [7] (🫰..🫶) hand with index
finger and thumb crossed..heart hands
+1FAF7..1FAF8 ; Emoji_Modifier_Base # E15.0 [2] (🫷..🫸) leftwards pushing
hand..rightwards pushing hand
-# Total elements: 132
+# Total elements: 134
# ================================================
# All omitted code points have Emoji_Component=No
-# @missing: 0000..10FFFF ; Emoji_Component ; No
0023 ; Emoji_Component # E0.0 [1] (#️) hash sign
002A ; Emoji_Component # E0.0 [1] (*️) asterisk
@@ -786,7 +802,6 @@ E0020..E007F ; Emoji_Component # E0.0 [96] (..)
tag space..c
# ================================================
# All omitted code points have Extended_Pictographic=No
-# @missing: 0000..10FFFF ; Extended_Pictographic ; No
00A9 ; Extended_Pictographic# E0.6 [1] (©️) copyright
00AE ; Extended_Pictographic# E0.6 [1] (®️) registered
@@ -1190,7 +1205,8 @@ E0020..E007F ; Emoji_Component # E0.0 [96] (..)
tag space..c
1F6D3..1F6D4 ; Extended_Pictographic# E0.0 [2] (🛓..🛔) STUPA..PAGODA
1F6D5 ; Extended_Pictographic# E12.0 [1] (🛕) hindu temple
1F6D6..1F6D7 ; Extended_Pictographic# E13.0 [2] (🛖..🛗) hut..elevator
-1F6D8..1F6DC ; Extended_Pictographic# E0.0 [5] (..🛜)
<reserved-1F6D8>..<reserved-1F6DC>
+1F6D8..1F6DB ; Extended_Pictographic# E0.0 [4] (..)
<reserved-1F6D8>..<reserved-1F6DB>
+1F6DC ; Extended_Pictographic# E15.0 [1] (🛜) wireless
1F6DD..1F6DF ; Extended_Pictographic# E14.0 [3] (🛝..🛟) playground
slide..ring buoy
1F6E0..1F6E5 ; Extended_Pictographic# E0.7 [6] (🛠️..🛥️) hammer and
wrench..motor boat
1F6E6..1F6E8 ; Extended_Pictographic# E0.0 [3] (🛦..🛨) UP-POINTING
MILITARY AIRPLANE..UP-POINTING SMALL AIRPLANE
@@ -1207,7 +1223,7 @@ E0020..E007F ; Emoji_Component # E0.0 [96] (..)
tag space..c
1F6FA ; Extended_Pictographic# E12.0 [1] (🛺) auto rickshaw
1F6FB..1F6FC ; Extended_Pictographic# E13.0 [2] (🛻..🛼) pickup
truck..roller skate
1F6FD..1F6FF ; Extended_Pictographic# E0.0 [3] (..)
<reserved-1F6FD>..<reserved-1F6FF>
-1F774..1F77F ; Extended_Pictographic# E0.0 [12] (🝴..🝿)
<reserved-1F774>..<reserved-1F77F>
+1F774..1F77F ; Extended_Pictographic# E0.0 [12] (🝴..🝿) LOT OF
FORTUNE..ORCUS
1F7D5..1F7DF ; Extended_Pictographic# E0.0 [11] (🟕..) CIRCLED
TRIANGLE..<reserved-1F7DF>
1F7E0..1F7EB ; Extended_Pictographic# E12.0 [12] (🟠..🟫) orange
circle..brown square
1F7EC..1F7EF ; Extended_Pictographic# E0.0 [4] (..)
<reserved-1F7EC>..<reserved-1F7EF>
@@ -1266,30 +1282,37 @@ E0020..E007F ; Emoji_Component # E0.0 [96]
(..) tag space..c
1FA00..1FA6F ; Extended_Pictographic# E0.0 [112] (🨀..) NEUTRAL CHESS
KING..<reserved-1FA6F>
1FA70..1FA73 ; Extended_Pictographic# E12.0 [4] (🩰..🩳) ballet
shoes..shorts
1FA74 ; Extended_Pictographic# E13.0 [1] (🩴) thong sandal
-1FA75..1FA77 ; Extended_Pictographic# E0.0 [3] (🩵..🩷)
<reserved-1FA75>..<reserved-1FA77>
+1FA75..1FA77 ; Extended_Pictographic# E15.0 [3] (🩵..🩷) light blue
heart..pink heart
1FA78..1FA7A ; Extended_Pictographic# E12.0 [3] (🩸..🩺) drop of
blood..stethoscope
1FA7B..1FA7C ; Extended_Pictographic# E14.0 [2] (🩻..🩼) x-ray..crutch
1FA7D..1FA7F ; Extended_Pictographic# E0.0 [3] (..)
<reserved-1FA7D>..<reserved-1FA7F>
1FA80..1FA82 ; Extended_Pictographic# E12.0 [3] (🪀..🪂) yo-yo..parachute
1FA83..1FA86 ; Extended_Pictographic# E13.0 [4] (🪃..🪆) boomerang..nesting
dolls
-1FA87..1FA8F ; Extended_Pictographic# E0.0 [9] (🪇..)
<reserved-1FA87>..<reserved-1FA8F>
+1FA87..1FA88 ; Extended_Pictographic# E15.0 [2] (🪇..🪈) maracas..flute
+1FA89..1FA8F ; Extended_Pictographic# E0.0 [7] (..)
<reserved-1FA89>..<reserved-1FA8F>
1FA90..1FA95 ; Extended_Pictographic# E12.0 [6] (🪐..🪕) ringed
planet..banjo
1FA96..1FAA8 ; Extended_Pictographic# E13.0 [19] (🪖..🪨) military
helmet..rock
1FAA9..1FAAC ; Extended_Pictographic# E14.0 [4] (🪩..🪬) mirror ball..hamsa
-1FAAD..1FAAF ; Extended_Pictographic# E0.0 [3] (🪭..🪯)
<reserved-1FAAD>..<reserved-1FAAF>
+1FAAD..1FAAF ; Extended_Pictographic# E15.0 [3] (🪭..🪯) folding hand
fan..khanda
1FAB0..1FAB6 ; Extended_Pictographic# E13.0 [7] (🪰..🪶) fly..feather
1FAB7..1FABA ; Extended_Pictographic# E14.0 [4] (🪷..🪺) lotus..nest with
eggs
-1FABB..1FABF ; Extended_Pictographic# E0.0 [5] (🪻..🪿)
<reserved-1FABB>..<reserved-1FABF>
+1FABB..1FABD ; Extended_Pictographic# E15.0 [3] (🪻..🪽) hyacinth..wing
+1FABE ; Extended_Pictographic# E0.0 [1] () <reserved-1FABE>
+1FABF ; Extended_Pictographic# E15.0 [1] (🪿) goose
1FAC0..1FAC2 ; Extended_Pictographic# E13.0 [3] (🫀..🫂) anatomical
heart..people hugging
1FAC3..1FAC5 ; Extended_Pictographic# E14.0 [3] (🫃..🫅) pregnant
man..person with crown
-1FAC6..1FACF ; Extended_Pictographic# E0.0 [10] (..🫏)
<reserved-1FAC6>..<reserved-1FACF>
+1FAC6..1FACD ; Extended_Pictographic# E0.0 [8] (..)
<reserved-1FAC6>..<reserved-1FACD>
+1FACE..1FACF ; Extended_Pictographic# E15.0 [2] (🫎..🫏) moose..donkey
1FAD0..1FAD6 ; Extended_Pictographic# E13.0 [7] (🫐..🫖) blueberries..teapot
1FAD7..1FAD9 ; Extended_Pictographic# E14.0 [3] (🫗..🫙) pouring liquid..jar
-1FADA..1FADF ; Extended_Pictographic# E0.0 [6] (🫚..)
<reserved-1FADA>..<reserved-1FADF>
+1FADA..1FADB ; Extended_Pictographic# E15.0 [2] (🫚..🫛) ginger root..pea
pod
+1FADC..1FADF ; Extended_Pictographic# E0.0 [4] (..)
<reserved-1FADC>..<reserved-1FADF>
1FAE0..1FAE7 ; Extended_Pictographic# E14.0 [8] (🫠..🫧) melting
face..bubbles
-1FAE8..1FAEF ; Extended_Pictographic# E0.0 [8] (🫨..)
<reserved-1FAE8>..<reserved-1FAEF>
+1FAE8 ; Extended_Pictographic# E15.0 [1] (🫨) shaking face
+1FAE9..1FAEF ; Extended_Pictographic# E0.0 [7] (..)
<reserved-1FAE9>..<reserved-1FAEF>
1FAF0..1FAF6 ; Extended_Pictographic# E14.0 [7] (🫰..🫶) hand with index
finger and thumb crossed..heart hands
-1FAF7..1FAFF ; Extended_Pictographic# E0.0 [9] (🫷..)
<reserved-1FAF7>..<reserved-1FAFF>
+1FAF7..1FAF8 ; Extended_Pictographic# E15.0 [2] (🫷..🫸) leftwards pushing
hand..rightwards pushing hand
+1FAF9..1FAFF ; Extended_Pictographic# E0.0 [7] (..)
<reserved-1FAF9>..<reserved-1FAFF>
1FC00..1FFFD ; Extended_Pictographic# E0.0[1022] (..)
<reserved-1FC00>..<reserved-1FFFD>
# Total elements: 3537
diff --git a/admin/unidata/emoji-sequences.txt
b/admin/unidata/emoji-sequences.txt
index dedf7ff543..ffd4066811 100644
--- a/admin/unidata/emoji-sequences.txt
+++ b/admin/unidata/emoji-sequences.txt
@@ -1,13 +1,13 @@
# emoji-sequences.txt
-# Date: 2021-08-26, 17:22:22 GMT
-# © 2021 Unicode®, Inc.
+# Date: 2022-08-15, 23:13:41 GMT
+# © 2022 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
#
# Emoji Sequence Data for UTS #51
-# Version: 14.0
+# Version: 15.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr51
+# For documentation and usage, see https://www.unicode.org/reports/tr51
#
# Format:
# code_point(s) ; type_field ; description # comments
@@ -38,144 +38,145 @@
# Basic_Emoji
-231A..231B ; Basic_Emoji ; watch
# E0.6 [2] (⌚..⌛)
-23E9..23EC ; Basic_Emoji ; fast-forward button
# E0.6 [4] (⏩..⏬)
+
+231A..231B ; Basic_Emoji ; watch..hourglass done
# E0.6 [2] (⌚..⌛)
+23E9..23EC ; Basic_Emoji ; fast-forward button..fast down
button # E0.6 [4] (⏩..⏬)
23F0 ; Basic_Emoji ; alarm clock
# E0.6 [1] (⏰)
23F3 ; Basic_Emoji ; hourglass not done
# E0.6 [1] (⏳)
-25FD..25FE ; Basic_Emoji ; white medium-small square
# E0.6 [2] (◽..◾)
-2614..2615 ; Basic_Emoji ; umbrella with rain drops
# E0.6 [2] (☔..☕)
-2648..2653 ; Basic_Emoji ; Aries
# E0.6 [12] (♈..♓)
+25FD..25FE ; Basic_Emoji ; white medium-small
square..black medium-small square # E0.6 [2] (◽..◾)
+2614..2615 ; Basic_Emoji ; umbrella with rain drops..hot
beverage # E0.6 [2] (☔..☕)
+2648..2653 ; Basic_Emoji ; Aries..Pisces
# E0.6 [12] (♈..♓)
267F ; Basic_Emoji ; wheelchair symbol
# E0.6 [1] (♿)
2693 ; Basic_Emoji ; anchor
# E0.6 [1] (⚓)
26A1 ; Basic_Emoji ; high voltage
# E0.6 [1] (⚡)
-26AA..26AB ; Basic_Emoji ; white circle
# E0.6 [2] (⚪..⚫)
-26BD..26BE ; Basic_Emoji ; soccer ball
# E0.6 [2] (⚽..⚾)
-26C4..26C5 ; Basic_Emoji ; snowman without snow
# E0.6 [2] (⛄..⛅)
+26AA..26AB ; Basic_Emoji ; white circle..black circle
# E0.6 [2] (⚪..⚫)
+26BD..26BE ; Basic_Emoji ; soccer ball..baseball
# E0.6 [2] (⚽..⚾)
+26C4..26C5 ; Basic_Emoji ; snowman without snow..sun
behind cloud # E0.6 [2] (⛄..⛅)
26CE ; Basic_Emoji ; Ophiuchus
# E0.6 [1] (⛎)
26D4 ; Basic_Emoji ; no entry
# E0.6 [1] (⛔)
26EA ; Basic_Emoji ; church
# E0.6 [1] (⛪)
-26F2..26F3 ; Basic_Emoji ; fountain
# E0.6 [2] (⛲..⛳)
+26F2..26F3 ; Basic_Emoji ; fountain..flag in hole
# E0.6 [2] (⛲..⛳)
26F5 ; Basic_Emoji ; sailboat
# E0.6 [1] (⛵)
26FA ; Basic_Emoji ; tent
# E0.6 [1] (⛺)
26FD ; Basic_Emoji ; fuel pump
# E0.6 [1] (⛽)
2705 ; Basic_Emoji ; check mark button
# E0.6 [1] (✅)
-270A..270B ; Basic_Emoji ; raised fist
# E0.6 [2] (✊..✋)
+270A..270B ; Basic_Emoji ; raised fist..raised hand
# E0.6 [2] (✊..✋)
2728 ; Basic_Emoji ; sparkles
# E0.6 [1] (✨)
274C ; Basic_Emoji ; cross mark
# E0.6 [1] (❌)
274E ; Basic_Emoji ; cross mark button
# E0.6 [1] (❎)
-2753..2755 ; Basic_Emoji ; red question mark
# E0.6 [3] (❓..❕)
+2753..2755 ; Basic_Emoji ; red question mark..white
exclamation mark # E0.6 [3] (❓..❕)
2757 ; Basic_Emoji ; red exclamation mark
# E0.6 [1] (❗)
-2795..2797 ; Basic_Emoji ; plus
# E0.6 [3] (➕..➗)
+2795..2797 ; Basic_Emoji ; plus..divide
# E0.6 [3] (➕..➗)
27B0 ; Basic_Emoji ; curly loop
# E0.6 [1] (➰)
27BF ; Basic_Emoji ; double curly loop
# E1.0 [1] (➿)
-2B1B..2B1C ; Basic_Emoji ; black large square
# E0.6 [2] (⬛..⬜)
+2B1B..2B1C ; Basic_Emoji ; black large square..white large
square # E0.6 [2] (⬛..⬜)
2B50 ; Basic_Emoji ; star
# E0.6 [1] (⭐)
2B55 ; Basic_Emoji ; hollow red circle
# E0.6 [1] (⭕)
1F004 ; Basic_Emoji ; mahjong red dragon
# E0.6 [1] (🀄)
1F0CF ; Basic_Emoji ; joker
# E0.6 [1] (🃏)
1F18E ; Basic_Emoji ; AB button (blood type)
# E0.6 [1] (🆎)
-1F191..1F19A ; Basic_Emoji ; CL button
# E0.6 [10] (🆑..🆚)
+1F191..1F19A ; Basic_Emoji ; CL button..VS button
# E0.6 [10] (🆑..🆚)
1F201 ; Basic_Emoji ; Japanese “here” button
# E0.6 [1] (🈁)
1F21A ; Basic_Emoji ; Japanese “free of charge”
button # E0.6 [1] (🈚)
1F22F ; Basic_Emoji ; Japanese “reserved” button
# E0.6 [1] (🈯)
-1F232..1F236 ; Basic_Emoji ; Japanese “prohibited” button
# E0.6 [5] (🈲..🈶)
-1F238..1F23A ; Basic_Emoji ; Japanese “application” button
# E0.6 [3] (🈸..🈺)
-1F250..1F251 ; Basic_Emoji ; Japanese “bargain” button
# E0.6 [2] (🉐..🉑)
-1F300..1F30C ; Basic_Emoji ; cyclone
# E0.6 [13] (🌀..🌌)
-1F30D..1F30E ; Basic_Emoji ; globe showing Europe-Africa
# E0.7 [2] (🌍..🌎)
+1F232..1F236 ; Basic_Emoji ; Japanese “prohibited”
button..Japanese “not free of charge” button#E0.6 [5] (🈲..🈶)
+1F238..1F23A ; Basic_Emoji ; Japanese “application”
button..Japanese “open for business” button#E0.6 [3] (🈸..🈺)
+1F250..1F251 ; Basic_Emoji ; Japanese “bargain”
button..Japanese “acceptable” button # E0.6 [2] (🉐..🉑)
+1F300..1F30C ; Basic_Emoji ; cyclone..milky way
# E0.6 [13] (🌀..🌌)
+1F30D..1F30E ; Basic_Emoji ; globe showing
Europe-Africa..globe showing Americas # E0.7 [2] (🌍..🌎)
1F30F ; Basic_Emoji ; globe showing Asia-Australia
# E0.6 [1] (🌏)
1F310 ; Basic_Emoji ; globe with meridians
# E1.0 [1] (🌐)
1F311 ; Basic_Emoji ; new moon
# E0.6 [1] (🌑)
1F312 ; Basic_Emoji ; waxing crescent moon
# E1.0 [1] (🌒)
-1F313..1F315 ; Basic_Emoji ; first quarter moon
# E0.6 [3] (🌓..🌕)
-1F316..1F318 ; Basic_Emoji ; waning gibbous moon
# E1.0 [3] (🌖..🌘)
+1F313..1F315 ; Basic_Emoji ; first quarter moon..full moon
# E0.6 [3] (🌓..🌕)
+1F316..1F318 ; Basic_Emoji ; waning gibbous moon..waning
crescent moon # E1.0 [3] (🌖..🌘)
1F319 ; Basic_Emoji ; crescent moon
# E0.6 [1] (🌙)
1F31A ; Basic_Emoji ; new moon face
# E1.0 [1] (🌚)
1F31B ; Basic_Emoji ; first quarter moon face
# E0.6 [1] (🌛)
1F31C ; Basic_Emoji ; last quarter moon face
# E0.7 [1] (🌜)
-1F31D..1F31E ; Basic_Emoji ; full moon face
# E1.0 [2] (🌝..🌞)
-1F31F..1F320 ; Basic_Emoji ; glowing star
# E0.6 [2] (🌟..🌠)
-1F32D..1F32F ; Basic_Emoji ; hot dog
# E1.0 [3] (🌭..🌯)
-1F330..1F331 ; Basic_Emoji ; chestnut
# E0.6 [2] (🌰..🌱)
-1F332..1F333 ; Basic_Emoji ; evergreen tree
# E1.0 [2] (🌲..🌳)
-1F334..1F335 ; Basic_Emoji ; palm tree
# E0.6 [2] (🌴..🌵)
-1F337..1F34A ; Basic_Emoji ; tulip
# E0.6 [20] (🌷..🍊)
+1F31D..1F31E ; Basic_Emoji ; full moon face..sun with face
# E1.0 [2] (🌝..🌞)
+1F31F..1F320 ; Basic_Emoji ; glowing star..shooting star
# E0.6 [2] (🌟..🌠)
+1F32D..1F32F ; Basic_Emoji ; hot dog..burrito
# E1.0 [3] (🌭..🌯)
+1F330..1F331 ; Basic_Emoji ; chestnut..seedling
# E0.6 [2] (🌰..🌱)
+1F332..1F333 ; Basic_Emoji ; evergreen tree..deciduous tree
# E1.0 [2] (🌲..🌳)
+1F334..1F335 ; Basic_Emoji ; palm tree..cactus
# E0.6 [2] (🌴..🌵)
+1F337..1F34A ; Basic_Emoji ; tulip..tangerine
# E0.6 [20] (🌷..🍊)
1F34B ; Basic_Emoji ; lemon
# E1.0 [1] (🍋)
-1F34C..1F34F ; Basic_Emoji ; banana
# E0.6 [4] (🍌..🍏)
+1F34C..1F34F ; Basic_Emoji ; banana..green apple
# E0.6 [4] (🍌..🍏)
1F350 ; Basic_Emoji ; pear
# E1.0 [1] (🍐)
-1F351..1F37B ; Basic_Emoji ; peach
# E0.6 [43] (🍑..🍻)
+1F351..1F37B ; Basic_Emoji ; peach..clinking beer mugs
# E0.6 [43] (🍑..🍻)
1F37C ; Basic_Emoji ; baby bottle
# E1.0 [1] (🍼)
-1F37E..1F37F ; Basic_Emoji ; bottle with popping cork
# E1.0 [2] (🍾..🍿)
-1F380..1F393 ; Basic_Emoji ; ribbon
# E0.6 [20] (🎀..🎓)
-1F3A0..1F3C4 ; Basic_Emoji ; carousel horse
# E0.6 [37] (🎠..🏄)
+1F37E..1F37F ; Basic_Emoji ; bottle with popping
cork..popcorn # E1.0 [2] (🍾..🍿)
+1F380..1F393 ; Basic_Emoji ; ribbon..graduation cap
# E0.6 [20] (🎀..🎓)
+1F3A0..1F3C4 ; Basic_Emoji ; carousel horse..person surfing
# E0.6 [37] (🎠..🏄)
1F3C5 ; Basic_Emoji ; sports medal
# E1.0 [1] (🏅)
1F3C6 ; Basic_Emoji ; trophy
# E0.6 [1] (🏆)
1F3C7 ; Basic_Emoji ; horse racing
# E1.0 [1] (🏇)
1F3C8 ; Basic_Emoji ; american football
# E0.6 [1] (🏈)
1F3C9 ; Basic_Emoji ; rugby football
# E1.0 [1] (🏉)
1F3CA ; Basic_Emoji ; person swimming
# E0.6 [1] (🏊)
-1F3CF..1F3D3 ; Basic_Emoji ; cricket game
# E1.0 [5] (🏏..🏓)
-1F3E0..1F3E3 ; Basic_Emoji ; house
# E0.6 [4] (🏠..🏣)
+1F3CF..1F3D3 ; Basic_Emoji ; cricket game..ping pong
# E1.0 [5] (🏏..🏓)
+1F3E0..1F3E3 ; Basic_Emoji ; house..Japanese post office
# E0.6 [4] (🏠..🏣)
1F3E4 ; Basic_Emoji ; post office
# E1.0 [1] (🏤)
-1F3E5..1F3F0 ; Basic_Emoji ; hospital
# E0.6 [12] (🏥..🏰)
+1F3E5..1F3F0 ; Basic_Emoji ; hospital..castle
# E0.6 [12] (🏥..🏰)
1F3F4 ; Basic_Emoji ; black flag
# E1.0 [1] (🏴)
-1F3F8..1F407 ; Basic_Emoji ; badminton
# E1.0 [16] (🏸..🐇)
+1F3F8..1F407 ; Basic_Emoji ; badminton..rabbit
# E1.0 [16] (🏸..🐇)
1F408 ; Basic_Emoji ; cat
# E0.7 [1] (🐈)
-1F409..1F40B ; Basic_Emoji ; dragon
# E1.0 [3] (🐉..🐋)
-1F40C..1F40E ; Basic_Emoji ; snail
# E0.6 [3] (🐌..🐎)
-1F40F..1F410 ; Basic_Emoji ; ram
# E1.0 [2] (🐏..🐐)
-1F411..1F412 ; Basic_Emoji ; ewe
# E0.6 [2] (🐑..🐒)
+1F409..1F40B ; Basic_Emoji ; dragon..whale
# E1.0 [3] (🐉..🐋)
+1F40C..1F40E ; Basic_Emoji ; snail..horse
# E0.6 [3] (🐌..🐎)
+1F40F..1F410 ; Basic_Emoji ; ram..goat
# E1.0 [2] (🐏..🐐)
+1F411..1F412 ; Basic_Emoji ; ewe..monkey
# E0.6 [2] (🐑..🐒)
1F413 ; Basic_Emoji ; rooster
# E1.0 [1] (🐓)
1F414 ; Basic_Emoji ; chicken
# E0.6 [1] (🐔)
1F415 ; Basic_Emoji ; dog
# E0.7 [1] (🐕)
1F416 ; Basic_Emoji ; pig
# E1.0 [1] (🐖)
-1F417..1F429 ; Basic_Emoji ; boar
# E0.6 [19] (🐗..🐩)
+1F417..1F429 ; Basic_Emoji ; boar..poodle
# E0.6 [19] (🐗..🐩)
1F42A ; Basic_Emoji ; camel
# E1.0 [1] (🐪)
-1F42B..1F43E ; Basic_Emoji ; two-hump camel
# E0.6 [20] (🐫..🐾)
+1F42B..1F43E ; Basic_Emoji ; two-hump camel..paw prints
# E0.6 [20] (🐫..🐾)
1F440 ; Basic_Emoji ; eyes
# E0.6 [1] (👀)
-1F442..1F464 ; Basic_Emoji ; ear
# E0.6 [35] (👂..👤)
+1F442..1F464 ; Basic_Emoji ; ear..bust in silhouette
# E0.6 [35] (👂..👤)
1F465 ; Basic_Emoji ; busts in silhouette
# E1.0 [1] (👥)
-1F466..1F46B ; Basic_Emoji ; boy
# E0.6 [6] (👦..👫)
-1F46C..1F46D ; Basic_Emoji ; men holding hands
# E1.0 [2] (👬..👭)
-1F46E..1F4AC ; Basic_Emoji ; police officer
# E0.6 [63] (👮..💬)
+1F466..1F46B ; Basic_Emoji ; boy..woman and man holding
hands # E0.6 [6] (👦..👫)
+1F46C..1F46D ; Basic_Emoji ; men holding hands..women
holding hands # E1.0 [2] (👬..👭)
+1F46E..1F4AC ; Basic_Emoji ; police officer..speech balloon
# E0.6 [63] (👮..💬)
1F4AD ; Basic_Emoji ; thought balloon
# E1.0 [1] (💭)
-1F4AE..1F4B5 ; Basic_Emoji ; white flower
# E0.6 [8] (💮..💵)
-1F4B6..1F4B7 ; Basic_Emoji ; euro banknote
# E1.0 [2] (💶..💷)
-1F4B8..1F4EB ; Basic_Emoji ; money with wings
# E0.6 [52] (💸..📫)
-1F4EC..1F4ED ; Basic_Emoji ; open mailbox with raised flag
# E0.7 [2] (📬..📭)
+1F4AE..1F4B5 ; Basic_Emoji ; white flower..dollar banknote
# E0.6 [8] (💮..💵)
+1F4B6..1F4B7 ; Basic_Emoji ; euro banknote..pound banknote
# E1.0 [2] (💶..💷)
+1F4B8..1F4EB ; Basic_Emoji ; money with wings..closed
mailbox with raised flag # E0.6 [52] (💸..📫)
+1F4EC..1F4ED ; Basic_Emoji ; open mailbox with raised
flag..open mailbox with lowered flag # E0.7 [2] (📬..📭)
1F4EE ; Basic_Emoji ; postbox
# E0.6 [1] (📮)
1F4EF ; Basic_Emoji ; postal horn
# E1.0 [1] (📯)
-1F4F0..1F4F4 ; Basic_Emoji ; newspaper
# E0.6 [5] (📰..📴)
+1F4F0..1F4F4 ; Basic_Emoji ; newspaper..mobile phone off
# E0.6 [5] (📰..📴)
1F4F5 ; Basic_Emoji ; no mobile phones
# E1.0 [1] (📵)
-1F4F6..1F4F7 ; Basic_Emoji ; antenna bars
# E0.6 [2] (📶..📷)
+1F4F6..1F4F7 ; Basic_Emoji ; antenna bars..camera
# E0.6 [2] (📶..📷)
1F4F8 ; Basic_Emoji ; camera with flash
# E1.0 [1] (📸)
-1F4F9..1F4FC ; Basic_Emoji ; video camera
# E0.6 [4] (📹..📼)
-1F4FF..1F502 ; Basic_Emoji ; prayer beads
# E1.0 [4] (📿..🔂)
+1F4F9..1F4FC ; Basic_Emoji ; video camera..videocassette
# E0.6 [4] (📹..📼)
+1F4FF..1F502 ; Basic_Emoji ; prayer beads..repeat single
button # E1.0 [4] (📿..🔂)
1F503 ; Basic_Emoji ; clockwise vertical arrows
# E0.6 [1] (🔃)
-1F504..1F507 ; Basic_Emoji ; counterclockwise arrows button
# E1.0 [4] (🔄..🔇)
+1F504..1F507 ; Basic_Emoji ; counterclockwise arrows
button..muted speaker # E1.0 [4] (🔄..🔇)
1F508 ; Basic_Emoji ; speaker low volume
# E0.7 [1] (🔈)
1F509 ; Basic_Emoji ; speaker medium volume
# E1.0 [1] (🔉)
-1F50A..1F514 ; Basic_Emoji ; speaker high volume
# E0.6 [11] (🔊..🔔)
+1F50A..1F514 ; Basic_Emoji ; speaker high volume..bell
# E0.6 [11] (🔊..🔔)
1F515 ; Basic_Emoji ; bell with slash
# E1.0 [1] (🔕)
-1F516..1F52B ; Basic_Emoji ; bookmark
# E0.6 [22] (🔖..🔫)
-1F52C..1F52D ; Basic_Emoji ; microscope
# E1.0 [2] (🔬..🔭)
-1F52E..1F53D ; Basic_Emoji ; crystal ball
# E0.6 [16] (🔮..🔽)
-1F54B..1F54E ; Basic_Emoji ; kaaba
# E1.0 [4] (🕋..🕎)
-1F550..1F55B ; Basic_Emoji ; one o’clock
# E0.6 [12] (🕐..🕛)
-1F55C..1F567 ; Basic_Emoji ; one-thirty
# E0.7 [12] (🕜..🕧)
+1F516..1F52B ; Basic_Emoji ; bookmark..water pistol
# E0.6 [22] (🔖..🔫)
+1F52C..1F52D ; Basic_Emoji ; microscope..telescope
# E1.0 [2] (🔬..🔭)
+1F52E..1F53D ; Basic_Emoji ; crystal ball..downwards button
# E0.6 [16] (🔮..🔽)
+1F54B..1F54E ; Basic_Emoji ; kaaba..menorah
# E1.0 [4] (🕋..🕎)
+1F550..1F55B ; Basic_Emoji ; one o’clock..twelve o’clock
# E0.6 [12] (🕐..🕛)
+1F55C..1F567 ; Basic_Emoji ; one-thirty..twelve-thirty
# E0.7 [12] (🕜..🕧)
1F57A ; Basic_Emoji ; man dancing
# E3.0 [1] (🕺)
-1F595..1F596 ; Basic_Emoji ; middle finger
# E1.0 [2] (🖕..🖖)
+1F595..1F596 ; Basic_Emoji ; middle finger..vulcan salute
# E1.0 [2] (🖕..🖖)
1F5A4 ; Basic_Emoji ; black heart
# E3.0 [1] (🖤)
-1F5FB..1F5FF ; Basic_Emoji ; mount fuji
# E0.6 [5] (🗻..🗿)
+1F5FB..1F5FF ; Basic_Emoji ; mount fuji..moai
# E0.6 [5] (🗻..🗿)
1F600 ; Basic_Emoji ; grinning face
# E1.0 [1] (😀)
-1F601..1F606 ; Basic_Emoji ; beaming face with smiling eyes
# E0.6 [6] (😁..😆)
-1F607..1F608 ; Basic_Emoji ; smiling face with halo
# E1.0 [2] (😇..😈)
-1F609..1F60D ; Basic_Emoji ; winking face
# E0.6 [5] (😉..😍)
+1F601..1F606 ; Basic_Emoji ; beaming face with smiling
eyes..grinning squinting face # E0.6 [6] (😁..😆)
+1F607..1F608 ; Basic_Emoji ; smiling face with halo..smiling
face with horns # E1.0 [2] (😇..😈)
+1F609..1F60D ; Basic_Emoji ; winking face..smiling face with
heart-eyes # E0.6 [5] (😉..😍)
1F60E ; Basic_Emoji ; smiling face with sunglasses
# E1.0 [1] (😎)
1F60F ; Basic_Emoji ; smirking face
# E0.6 [1] (😏)
1F610 ; Basic_Emoji ; neutral face
# E0.7 [1] (😐)
1F611 ; Basic_Emoji ; expressionless face
# E1.0 [1] (😑)
-1F612..1F614 ; Basic_Emoji ; unamused face
# E0.6 [3] (😒..😔)
+1F612..1F614 ; Basic_Emoji ; unamused face..pensive face
# E0.6 [3] (😒..😔)
1F615 ; Basic_Emoji ; confused face
# E1.0 [1] (😕)
1F616 ; Basic_Emoji ; confounded face
# E0.6 [1] (😖)
1F617 ; Basic_Emoji ; kissing face
# E1.0 [1] (😗)
@@ -183,132 +184,142 @@
1F619 ; Basic_Emoji ; kissing face with smiling eyes
# E1.0 [1] (😙)
1F61A ; Basic_Emoji ; kissing face with closed eyes
# E0.6 [1] (😚)
1F61B ; Basic_Emoji ; face with tongue
# E1.0 [1] (😛)
-1F61C..1F61E ; Basic_Emoji ; winking face with tongue
# E0.6 [3] (😜..😞)
+1F61C..1F61E ; Basic_Emoji ; winking face with
tongue..disappointed face # E0.6 [3] (😜..😞)
1F61F ; Basic_Emoji ; worried face
# E1.0 [1] (😟)
-1F620..1F625 ; Basic_Emoji ; angry face
# E0.6 [6] (😠..😥)
-1F626..1F627 ; Basic_Emoji ; frowning face with open mouth
# E1.0 [2] (😦..😧)
-1F628..1F62B ; Basic_Emoji ; fearful face
# E0.6 [4] (😨..😫)
+1F620..1F625 ; Basic_Emoji ; angry face..sad but relieved
face # E0.6 [6] (😠..😥)
+1F626..1F627 ; Basic_Emoji ; frowning face with open
mouth..anguished face # E1.0 [2] (😦..😧)
+1F628..1F62B ; Basic_Emoji ; fearful face..tired face
# E0.6 [4] (😨..😫)
1F62C ; Basic_Emoji ; grimacing face
# E1.0 [1] (😬)
1F62D ; Basic_Emoji ; loudly crying face
# E0.6 [1] (😭)
-1F62E..1F62F ; Basic_Emoji ; face with open mouth
# E1.0 [2] (😮..😯)
-1F630..1F633 ; Basic_Emoji ; anxious face with sweat
# E0.6 [4] (😰..😳)
+1F62E..1F62F ; Basic_Emoji ; face with open mouth..hushed
face # E1.0 [2] (😮..😯)
+1F630..1F633 ; Basic_Emoji ; anxious face with
sweat..flushed face # E0.6 [4] (😰..😳)
1F634 ; Basic_Emoji ; sleeping face
# E1.0 [1] (😴)
1F635 ; Basic_Emoji ; face with crossed-out eyes
# E0.6 [1] (😵)
1F636 ; Basic_Emoji ; face without mouth
# E1.0 [1] (😶)
-1F637..1F640 ; Basic_Emoji ; face with medical mask
# E0.6 [10] (😷..🙀)
-1F641..1F644 ; Basic_Emoji ; slightly frowning face
# E1.0 [4] (🙁..🙄)
-1F645..1F64F ; Basic_Emoji ; person gesturing NO
# E0.6 [11] (🙅..🙏)
+1F637..1F640 ; Basic_Emoji ; face with medical mask..weary
cat # E0.6 [10] (😷..🙀)
+1F641..1F644 ; Basic_Emoji ; slightly frowning face..face
with rolling eyes # E1.0 [4] (🙁..🙄)
+1F645..1F64F ; Basic_Emoji ; person gesturing NO..folded
hands # E0.6 [11] (🙅..🙏)
1F680 ; Basic_Emoji ; rocket
# E0.6 [1] (🚀)
-1F681..1F682 ; Basic_Emoji ; helicopter
# E1.0 [2] (🚁..🚂)
-1F683..1F685 ; Basic_Emoji ; railway car
# E0.6 [3] (🚃..🚅)
+1F681..1F682 ; Basic_Emoji ; helicopter..locomotive
# E1.0 [2] (🚁..🚂)
+1F683..1F685 ; Basic_Emoji ; railway car..bullet train
# E0.6 [3] (🚃..🚅)
1F686 ; Basic_Emoji ; train
# E1.0 [1] (🚆)
1F687 ; Basic_Emoji ; metro
# E0.6 [1] (🚇)
1F688 ; Basic_Emoji ; light rail
# E1.0 [1] (🚈)
1F689 ; Basic_Emoji ; station
# E0.6 [1] (🚉)
-1F68A..1F68B ; Basic_Emoji ; tram
# E1.0 [2] (🚊..🚋)
+1F68A..1F68B ; Basic_Emoji ; tram..tram car
# E1.0 [2] (🚊..🚋)
1F68C ; Basic_Emoji ; bus
# E0.6 [1] (🚌)
1F68D ; Basic_Emoji ; oncoming bus
# E0.7 [1] (🚍)
1F68E ; Basic_Emoji ; trolleybus
# E1.0 [1] (🚎)
1F68F ; Basic_Emoji ; bus stop
# E0.6 [1] (🚏)
1F690 ; Basic_Emoji ; minibus
# E1.0 [1] (🚐)
-1F691..1F693 ; Basic_Emoji ; ambulance
# E0.6 [3] (🚑..🚓)
+1F691..1F693 ; Basic_Emoji ; ambulance..police car
# E0.6 [3] (🚑..🚓)
1F694 ; Basic_Emoji ; oncoming police car
# E0.7 [1] (🚔)
1F695 ; Basic_Emoji ; taxi
# E0.6 [1] (🚕)
1F696 ; Basic_Emoji ; oncoming taxi
# E1.0 [1] (🚖)
1F697 ; Basic_Emoji ; automobile
# E0.6 [1] (🚗)
1F698 ; Basic_Emoji ; oncoming automobile
# E0.7 [1] (🚘)
-1F699..1F69A ; Basic_Emoji ; sport utility vehicle
# E0.6 [2] (🚙..🚚)
-1F69B..1F6A1 ; Basic_Emoji ; articulated lorry
# E1.0 [7] (🚛..🚡)
+1F699..1F69A ; Basic_Emoji ; sport utility vehicle..delivery
truck # E0.6 [2] (🚙..🚚)
+1F69B..1F6A1 ; Basic_Emoji ; articulated lorry..aerial
tramway # E1.0 [7] (🚛..🚡)
1F6A2 ; Basic_Emoji ; ship
# E0.6 [1] (🚢)
1F6A3 ; Basic_Emoji ; person rowing boat
# E1.0 [1] (🚣)
-1F6A4..1F6A5 ; Basic_Emoji ; speedboat
# E0.6 [2] (🚤..🚥)
+1F6A4..1F6A5 ; Basic_Emoji ; speedboat..horizontal traffic
light # E0.6 [2] (🚤..🚥)
1F6A6 ; Basic_Emoji ; vertical traffic light
# E1.0 [1] (🚦)
-1F6A7..1F6AD ; Basic_Emoji ; construction
# E0.6 [7] (🚧..🚭)
-1F6AE..1F6B1 ; Basic_Emoji ; litter in bin sign
# E1.0 [4] (🚮..🚱)
+1F6A7..1F6AD ; Basic_Emoji ; construction..no smoking
# E0.6 [7] (🚧..🚭)
+1F6AE..1F6B1 ; Basic_Emoji ; litter in bin sign..non-potable
water # E1.0 [4] (🚮..🚱)
1F6B2 ; Basic_Emoji ; bicycle
# E0.6 [1] (🚲)
-1F6B3..1F6B5 ; Basic_Emoji ; no bicycles
# E1.0 [3] (🚳..🚵)
+1F6B3..1F6B5 ; Basic_Emoji ; no bicycles..person mountain
biking # E1.0 [3] (🚳..🚵)
1F6B6 ; Basic_Emoji ; person walking
# E0.6 [1] (🚶)
-1F6B7..1F6B8 ; Basic_Emoji ; no pedestrians
# E1.0 [2] (🚷..🚸)
-1F6B9..1F6BE ; Basic_Emoji ; men’s room
# E0.6 [6] (🚹..🚾)
+1F6B7..1F6B8 ; Basic_Emoji ; no pedestrians..children
crossing # E1.0 [2] (🚷..🚸)
+1F6B9..1F6BE ; Basic_Emoji ; men’s room..water closet
# E0.6 [6] (🚹..🚾)
1F6BF ; Basic_Emoji ; shower
# E1.0 [1] (🚿)
1F6C0 ; Basic_Emoji ; person taking bath
# E0.6 [1] (🛀)
-1F6C1..1F6C5 ; Basic_Emoji ; bathtub
# E1.0 [5] (🛁..🛅)
+1F6C1..1F6C5 ; Basic_Emoji ; bathtub..left luggage
# E1.0 [5] (🛁..🛅)
1F6CC ; Basic_Emoji ; person in bed
# E1.0 [1] (🛌)
1F6D0 ; Basic_Emoji ; place of worship
# E1.0 [1] (🛐)
-1F6D1..1F6D2 ; Basic_Emoji ; stop sign
# E3.0 [2] (🛑..🛒)
+1F6D1..1F6D2 ; Basic_Emoji ; stop sign..shopping cart
# E3.0 [2] (🛑..🛒)
1F6D5 ; Basic_Emoji ; hindu temple
# E12.0 [1] (🛕)
-1F6D6..1F6D7 ; Basic_Emoji ; hut
# E13.0 [2] (🛖..🛗)
-1F6DD..1F6DF ; Basic_Emoji ; playground slide
# E14.0 [3] (🛝..🛟)
-1F6EB..1F6EC ; Basic_Emoji ; airplane departure
# E1.0 [2] (🛫..🛬)
-1F6F4..1F6F6 ; Basic_Emoji ; kick scooter
# E3.0 [3] (🛴..🛶)
-1F6F7..1F6F8 ; Basic_Emoji ; sled
# E5.0 [2] (🛷..🛸)
+1F6D6..1F6D7 ; Basic_Emoji ; hut..elevator
# E13.0 [2] (🛖..🛗)
+1F6DC ; Basic_Emoji ; wireless
# E15.0 [1] (🛜)
+1F6DD..1F6DF ; Basic_Emoji ; playground slide..ring buoy
# E14.0 [3] (🛝..🛟)
+1F6EB..1F6EC ; Basic_Emoji ; airplane departure..airplane
arrival # E1.0 [2] (🛫..🛬)
+1F6F4..1F6F6 ; Basic_Emoji ; kick scooter..canoe
# E3.0 [3] (🛴..🛶)
+1F6F7..1F6F8 ; Basic_Emoji ; sled..flying saucer
# E5.0 [2] (🛷..🛸)
1F6F9 ; Basic_Emoji ; skateboard
# E11.0 [1] (🛹)
1F6FA ; Basic_Emoji ; auto rickshaw
# E12.0 [1] (🛺)
-1F6FB..1F6FC ; Basic_Emoji ; pickup truck
# E13.0 [2] (🛻..🛼)
-1F7E0..1F7EB ; Basic_Emoji ; orange circle
# E12.0 [12] (🟠..🟫)
+1F6FB..1F6FC ; Basic_Emoji ; pickup truck..roller skate
# E13.0 [2] (🛻..🛼)
+1F7E0..1F7EB ; Basic_Emoji ; orange circle..brown square
# E12.0 [12] (🟠..🟫)
1F7F0 ; Basic_Emoji ; heavy equals sign
# E14.0 [1] (🟰)
1F90C ; Basic_Emoji ; pinched fingers
# E13.0 [1] (🤌)
-1F90D..1F90F ; Basic_Emoji ; white heart
# E12.0 [3] (🤍..🤏)
-1F910..1F918 ; Basic_Emoji ; zipper-mouth face
# E1.0 [9] (🤐..🤘)
-1F919..1F91E ; Basic_Emoji ; call me hand
# E3.0 [6] (🤙..🤞)
+1F90D..1F90F ; Basic_Emoji ; white heart..pinching hand
# E12.0 [3] (🤍..🤏)
+1F910..1F918 ; Basic_Emoji ; zipper-mouth face..sign of the
horns # E1.0 [9] (🤐..🤘)
+1F919..1F91E ; Basic_Emoji ; call me hand..crossed fingers
# E3.0 [6] (🤙..🤞)
1F91F ; Basic_Emoji ; love-you gesture
# E5.0 [1] (🤟)
-1F920..1F927 ; Basic_Emoji ; cowboy hat face
# E3.0 [8] (🤠..🤧)
-1F928..1F92F ; Basic_Emoji ; face with raised eyebrow
# E5.0 [8] (🤨..🤯)
+1F920..1F927 ; Basic_Emoji ; cowboy hat face..sneezing face
# E3.0 [8] (🤠..🤧)
+1F928..1F92F ; Basic_Emoji ; face with raised
eyebrow..exploding head # E5.0 [8] (🤨..🤯)
1F930 ; Basic_Emoji ; pregnant woman
# E3.0 [1] (🤰)
-1F931..1F932 ; Basic_Emoji ; breast-feeding
# E5.0 [2] (🤱..🤲)
-1F933..1F93A ; Basic_Emoji ; selfie
# E3.0 [8] (🤳..🤺)
-1F93C..1F93E ; Basic_Emoji ; people wrestling
# E3.0 [3] (🤼..🤾)
+1F931..1F932 ; Basic_Emoji ; breast-feeding..palms up
together # E5.0 [2] (🤱..🤲)
+1F933..1F93A ; Basic_Emoji ; selfie..person fencing
# E3.0 [8] (🤳..🤺)
+1F93C..1F93E ; Basic_Emoji ; people wrestling..person
playing handball # E3.0 [3] (🤼..🤾)
1F93F ; Basic_Emoji ; diving mask
# E12.0 [1] (🤿)
-1F940..1F945 ; Basic_Emoji ; wilted flower
# E3.0 [6] (🥀..🥅)
-1F947..1F94B ; Basic_Emoji ; 1st place medal
# E3.0 [5] (🥇..🥋)
+1F940..1F945 ; Basic_Emoji ; wilted flower..goal net
# E3.0 [6] (🥀..🥅)
+1F947..1F94B ; Basic_Emoji ; 1st place medal..martial arts
uniform # E3.0 [5] (🥇..🥋)
1F94C ; Basic_Emoji ; curling stone
# E5.0 [1] (🥌)
-1F94D..1F94F ; Basic_Emoji ; lacrosse
# E11.0 [3] (🥍..🥏)
-1F950..1F95E ; Basic_Emoji ; croissant
# E3.0 [15] (🥐..🥞)
-1F95F..1F96B ; Basic_Emoji ; dumpling
# E5.0 [13] (🥟..🥫)
-1F96C..1F970 ; Basic_Emoji ; leafy green
# E11.0 [5] (🥬..🥰)
+1F94D..1F94F ; Basic_Emoji ; lacrosse..flying disc
# E11.0 [3] (🥍..🥏)
+1F950..1F95E ; Basic_Emoji ; croissant..pancakes
# E3.0 [15] (🥐..🥞)
+1F95F..1F96B ; Basic_Emoji ; dumpling..canned food
# E5.0 [13] (🥟..🥫)
+1F96C..1F970 ; Basic_Emoji ; leafy green..smiling face with
hearts # E11.0 [5] (🥬..🥰)
1F971 ; Basic_Emoji ; yawning face
# E12.0 [1] (🥱)
1F972 ; Basic_Emoji ; smiling face with tear
# E13.0 [1] (🥲)
-1F973..1F976 ; Basic_Emoji ; partying face
# E11.0 [4] (🥳..🥶)
-1F977..1F978 ; Basic_Emoji ; ninja
# E13.0 [2] (🥷..🥸)
+1F973..1F976 ; Basic_Emoji ; partying face..cold face
# E11.0 [4] (🥳..🥶)
+1F977..1F978 ; Basic_Emoji ; ninja..disguised face
# E13.0 [2] (🥷..🥸)
1F979 ; Basic_Emoji ; face holding back tears
# E14.0 [1] (🥹)
1F97A ; Basic_Emoji ; pleading face
# E11.0 [1] (🥺)
1F97B ; Basic_Emoji ; sari
# E12.0 [1] (🥻)
-1F97C..1F97F ; Basic_Emoji ; lab coat
# E11.0 [4] (🥼..🥿)
-1F980..1F984 ; Basic_Emoji ; crab
# E1.0 [5] (🦀..🦄)
-1F985..1F991 ; Basic_Emoji ; eagle
# E3.0 [13] (🦅..🦑)
-1F992..1F997 ; Basic_Emoji ; giraffe
# E5.0 [6] (🦒..🦗)
-1F998..1F9A2 ; Basic_Emoji ; kangaroo
# E11.0 [11] (🦘..🦢)
-1F9A3..1F9A4 ; Basic_Emoji ; mammoth
# E13.0 [2] (🦣..🦤)
-1F9A5..1F9AA ; Basic_Emoji ; sloth
# E12.0 [6] (🦥..🦪)
-1F9AB..1F9AD ; Basic_Emoji ; beaver
# E13.0 [3] (🦫..🦭)
-1F9AE..1F9AF ; Basic_Emoji ; guide dog
# E12.0 [2] (🦮..🦯)
-1F9B0..1F9B9 ; Basic_Emoji ; red hair
# E11.0 [10] (🦰..🦹)
-1F9BA..1F9BF ; Basic_Emoji ; safety vest
# E12.0 [6] (🦺..🦿)
+1F97C..1F97F ; Basic_Emoji ; lab coat..flat shoe
# E11.0 [4] (🥼..🥿)
+1F980..1F984 ; Basic_Emoji ; crab..unicorn
# E1.0 [5] (🦀..🦄)
+1F985..1F991 ; Basic_Emoji ; eagle..squid
# E3.0 [13] (🦅..🦑)
+1F992..1F997 ; Basic_Emoji ; giraffe..cricket
# E5.0 [6] (🦒..🦗)
+1F998..1F9A2 ; Basic_Emoji ; kangaroo..swan
# E11.0 [11] (🦘..🦢)
+1F9A3..1F9A4 ; Basic_Emoji ; mammoth..dodo
# E13.0 [2] (🦣..🦤)
+1F9A5..1F9AA ; Basic_Emoji ; sloth..oyster
# E12.0 [6] (🦥..🦪)
+1F9AB..1F9AD ; Basic_Emoji ; beaver..seal
# E13.0 [3] (🦫..🦭)
+1F9AE..1F9AF ; Basic_Emoji ; guide dog..white cane
# E12.0 [2] (🦮..🦯)
+1F9B0..1F9B9 ; Basic_Emoji ; red hair..supervillain
# E11.0 [10] (🦰..🦹)
+1F9BA..1F9BF ; Basic_Emoji ; safety vest..mechanical leg
# E12.0 [6] (🦺..🦿)
1F9C0 ; Basic_Emoji ; cheese wedge
# E1.0 [1] (🧀)
-1F9C1..1F9C2 ; Basic_Emoji ; cupcake
# E11.0 [2] (🧁..🧂)
-1F9C3..1F9CA ; Basic_Emoji ; beverage box
# E12.0 [8] (🧃..🧊)
+1F9C1..1F9C2 ; Basic_Emoji ; cupcake..salt
# E11.0 [2] (🧁..🧂)
+1F9C3..1F9CA ; Basic_Emoji ; beverage box..ice
# E12.0 [8] (🧃..🧊)
1F9CB ; Basic_Emoji ; bubble tea
# E13.0 [1] (🧋)
1F9CC ; Basic_Emoji ; troll
# E14.0 [1] (🧌)
-1F9CD..1F9CF ; Basic_Emoji ; person standing
# E12.0 [3] (🧍..🧏)
-1F9D0..1F9E6 ; Basic_Emoji ; face with monocle
# E5.0 [23] (🧐..🧦)
-1F9E7..1F9FF ; Basic_Emoji ; red envelope
# E11.0 [25] (🧧..🧿)
-1FA70..1FA73 ; Basic_Emoji ; ballet shoes
# E12.0 [4] (🩰..🩳)
+1F9CD..1F9CF ; Basic_Emoji ; person standing..deaf person
# E12.0 [3] (🧍..🧏)
+1F9D0..1F9E6 ; Basic_Emoji ; face with monocle..socks
# E5.0 [23] (🧐..🧦)
+1F9E7..1F9FF ; Basic_Emoji ; red envelope..nazar amulet
# E11.0 [25] (🧧..🧿)
+1FA70..1FA73 ; Basic_Emoji ; ballet shoes..shorts
# E12.0 [4] (🩰..🩳)
1FA74 ; Basic_Emoji ; thong sandal
# E13.0 [1] (🩴)
-1FA78..1FA7A ; Basic_Emoji ; drop of blood
# E12.0 [3] (🩸..🩺)
-1FA7B..1FA7C ; Basic_Emoji ; x-ray
# E14.0 [2] (🩻..🩼)
-1FA80..1FA82 ; Basic_Emoji ; yo-yo
# E12.0 [3] (🪀..🪂)
-1FA83..1FA86 ; Basic_Emoji ; boomerang
# E13.0 [4] (🪃..🪆)
-1FA90..1FA95 ; Basic_Emoji ; ringed planet
# E12.0 [6] (🪐..🪕)
-1FA96..1FAA8 ; Basic_Emoji ; military helmet
# E13.0 [19] (🪖..🪨)
-1FAA9..1FAAC ; Basic_Emoji ; mirror ball
# E14.0 [4] (🪩..🪬)
-1FAB0..1FAB6 ; Basic_Emoji ; fly
# E13.0 [7] (🪰..🪶)
-1FAB7..1FABA ; Basic_Emoji ; lotus
# E14.0 [4] (🪷..🪺)
-1FAC0..1FAC2 ; Basic_Emoji ; anatomical heart
# E13.0 [3] (🫀..🫂)
-1FAC3..1FAC5 ; Basic_Emoji ; pregnant man
# E14.0 [3] (🫃..🫅)
-1FAD0..1FAD6 ; Basic_Emoji ; blueberries
# E13.0 [7] (🫐..🫖)
-1FAD7..1FAD9 ; Basic_Emoji ; pouring liquid
# E14.0 [3] (🫗..🫙)
-1FAE0..1FAE7 ; Basic_Emoji ; melting face
# E14.0 [8] (🫠..🫧)
-1FAF0..1FAF6 ; Basic_Emoji ; hand with index finger and
thumb crossed # E14.0 [7] (🫰..🫶)
+1FA75..1FA77 ; Basic_Emoji ; light blue heart..pink heart
# E15.0 [3] (🩵..🩷)
+1FA78..1FA7A ; Basic_Emoji ; drop of blood..stethoscope
# E12.0 [3] (🩸..🩺)
+1FA7B..1FA7C ; Basic_Emoji ; x-ray..crutch
# E14.0 [2] (🩻..🩼)
+1FA80..1FA82 ; Basic_Emoji ; yo-yo..parachute
# E12.0 [3] (🪀..🪂)
+1FA83..1FA86 ; Basic_Emoji ; boomerang..nesting dolls
# E13.0 [4] (🪃..🪆)
+1FA87..1FA88 ; Basic_Emoji ; maracas..flute
# E15.0 [2] (🪇..🪈)
+1FA90..1FA95 ; Basic_Emoji ; ringed planet..banjo
# E12.0 [6] (🪐..🪕)
+1FA96..1FAA8 ; Basic_Emoji ; military helmet..rock
# E13.0 [19] (🪖..🪨)
+1FAA9..1FAAC ; Basic_Emoji ; mirror ball..hamsa
# E14.0 [4] (🪩..🪬)
+1FAAD..1FAAF ; Basic_Emoji ; folding hand fan..khanda
# E15.0 [3] (🪭..🪯)
+1FAB0..1FAB6 ; Basic_Emoji ; fly..feather
# E13.0 [7] (🪰..🪶)
+1FAB7..1FABA ; Basic_Emoji ; lotus..nest with eggs
# E14.0 [4] (🪷..🪺)
+1FABB..1FABD ; Basic_Emoji ; hyacinth..wing
# E15.0 [3] (🪻..🪽)
+1FABF ; Basic_Emoji ; goose
# E15.0 [1] (🪿)
+1FAC0..1FAC2 ; Basic_Emoji ; anatomical heart..people
hugging # E13.0 [3] (🫀..🫂)
+1FAC3..1FAC5 ; Basic_Emoji ; pregnant man..person with crown
# E14.0 [3] (🫃..🫅)
+1FACE..1FACF ; Basic_Emoji ; moose..donkey
# E15.0 [2] (🫎..🫏)
+1FAD0..1FAD6 ; Basic_Emoji ; blueberries..teapot
# E13.0 [7] (🫐..🫖)
+1FAD7..1FAD9 ; Basic_Emoji ; pouring liquid..jar
# E14.0 [3] (🫗..🫙)
+1FADA..1FADB ; Basic_Emoji ; ginger root..pea pod
# E15.0 [2] (🫚..🫛)
+1FAE0..1FAE7 ; Basic_Emoji ; melting face..bubbles
# E14.0 [8] (🫠..🫧)
+1FAE8 ; Basic_Emoji ; shaking face
# E15.0 [1] (🫨)
+1FAF0..1FAF6 ; Basic_Emoji ; hand with index finger and
thumb crossed..heart hands # E14.0 [7] (🫰..🫶)
+1FAF7..1FAF8 ; Basic_Emoji ; leftwards pushing
hand..rightwards pushing hand # E15.0 [2] (🫷..🫸)
00A9 FE0F ; Basic_Emoji ; copyright
# E0.6 [1] (©️)
00AE FE0F ; Basic_Emoji ; registered
# E0.6 [1] (®️)
203C FE0F ; Basic_Emoji ; double exclamation mark
# E0.6 [1] (‼️)
@@ -517,12 +528,13 @@
1F6F0 FE0F ; Basic_Emoji ; satellite
# E0.7 [1] (🛰️)
1F6F3 FE0F ; Basic_Emoji ; passenger ship
# E0.7 [1] (🛳️)
-# Total elements: 1366
+# Total elements: 1386
# ================================================
# Emoji_Keycap_Sequence
+
0023 FE0F 20E3; Emoji_Keycap_Sequence ; keycap: \x{23}
# E0.6 [1] (#️⃣)
002A FE0F 20E3; Emoji_Keycap_Sequence ; keycap: *
# E2.0 [1] (*️⃣)
0030 FE0F 20E3; Emoji_Keycap_Sequence ; keycap: 0
# E0.6 [1] (0️⃣)
@@ -543,6 +555,7 @@
# RGI_Emoji_Flag_Sequence: This list does not include deprecated or
macroregion flags, except for UN and EU.
# See Annex B of TR51 for more information.
+
1F1E6 1F1E8 ; RGI_Emoji_Flag_Sequence ; flag: Ascension Island
# E2.0 [1] (🇦🇨)
1F1E6 1F1E9 ; RGI_Emoji_Flag_Sequence ; flag: Andorra
# E2.0 [1] (🇦🇩)
1F1E6 1F1EA ; RGI_Emoji_Flag_Sequence ; flag: United Arab Emirates
# E2.0 [1] (🇦🇪)
@@ -808,6 +821,7 @@
# RGI_Emoji_Tag_Sequence: See Annex C of TR51 for more information.
+
1F3F4 E0067 E0062 E0065 E006E E0067 E007F; RGI_Emoji_Tag_Sequence; flag:
England # E5.0 [1] (🏴)
1F3F4 E0067 E0062 E0073 E0063 E0074 E007F; RGI_Emoji_Tag_Sequence; flag:
Scotland # E5.0 [1] (🏴)
1F3F4 E0067 E0062 E0077 E006C E0073 E007F; RGI_Emoji_Tag_Sequence; flag: Wales
# E5.0 [1] (🏴)
@@ -818,6 +832,7 @@
# RGI_Emoji_Modifier_Sequence
+
261D 1F3FB ; RGI_Emoji_Modifier_Sequence ; index pointing up: light skin
tone # E1.0 [1] (☝🏻)
261D 1F3FC ; RGI_Emoji_Modifier_Sequence ; index pointing up: medium-light
skin tone # E1.0 [1] (☝🏼)
261D 1F3FD ; RGI_Emoji_Modifier_Sequence ; index pointing up: medium skin
tone # E1.0 [1] (☝🏽)
@@ -1223,11 +1238,11 @@
1F91C 1F3FD ; RGI_Emoji_Modifier_Sequence ; right-facing fist: medium skin
tone # E3.0 [1] (🤜🏽)
1F91C 1F3FE ; RGI_Emoji_Modifier_Sequence ; right-facing fist: medium-dark
skin tone # E3.0 [1] (🤜🏾)
1F91C 1F3FF ; RGI_Emoji_Modifier_Sequence ; right-facing fist: dark skin
tone # E3.0 [1] (🤜🏿)
-1F91D 1F3FB ; RGI_Emoji_Modifier_Sequence ; handshake: light skin tone
# E3.0 [1] (🤝🏻)
-1F91D 1F3FC ; RGI_Emoji_Modifier_Sequence ; handshake: medium-light skin
tone # E3.0 [1] (🤝🏼)
-1F91D 1F3FD ; RGI_Emoji_Modifier_Sequence ; handshake: medium skin tone
# E3.0 [1] (🤝🏽)
-1F91D 1F3FE ; RGI_Emoji_Modifier_Sequence ; handshake: medium-dark skin
tone # E3.0 [1] (🤝🏾)
-1F91D 1F3FF ; RGI_Emoji_Modifier_Sequence ; handshake: dark skin tone
# E3.0 [1] (🤝🏿)
+1F91D 1F3FB ; RGI_Emoji_Modifier_Sequence ; handshake: light skin tone
# E14.0 [1] (🤝🏻)
+1F91D 1F3FC ; RGI_Emoji_Modifier_Sequence ; handshake: medium-light skin
tone # E14.0 [1] (🤝🏼)
+1F91D 1F3FD ; RGI_Emoji_Modifier_Sequence ; handshake: medium skin tone
# E14.0 [1] (🤝🏽)
+1F91D 1F3FE ; RGI_Emoji_Modifier_Sequence ; handshake: medium-dark skin
tone # E14.0 [1] (🤝🏾)
+1F91D 1F3FF ; RGI_Emoji_Modifier_Sequence ; handshake: dark skin tone
# E14.0 [1] (🤝🏿)
1F91E 1F3FB ; RGI_Emoji_Modifier_Sequence ; crossed fingers: light skin
tone # E3.0 [1] (🤞🏻)
1F91E 1F3FC ; RGI_Emoji_Modifier_Sequence ; crossed fingers: medium-light
skin tone # E3.0 [1] (🤞🏼)
1F91E 1F3FD ; RGI_Emoji_Modifier_Sequence ; crossed fingers: medium skin
tone # E3.0 [1] (🤞🏽)
@@ -1463,7 +1478,17 @@
1FAF6 1F3FD ; RGI_Emoji_Modifier_Sequence ; heart hands: medium skin tone
# E14.0 [1] (🫶🏽)
1FAF6 1F3FE ; RGI_Emoji_Modifier_Sequence ; heart hands: medium-dark skin
tone # E14.0 [1] (🫶🏾)
1FAF6 1F3FF ; RGI_Emoji_Modifier_Sequence ; heart hands: dark skin tone
# E14.0 [1] (🫶🏿)
+1FAF7 1F3FB ; RGI_Emoji_Modifier_Sequence ; leftwards pushing hand: light
skin tone # E15.0 [1] (🫷🏻)
+1FAF7 1F3FC ; RGI_Emoji_Modifier_Sequence ; leftwards pushing hand:
medium-light skin tone # E15.0 [1] (🫷🏼)
+1FAF7 1F3FD ; RGI_Emoji_Modifier_Sequence ; leftwards pushing hand: medium
skin tone # E15.0 [1] (🫷🏽)
+1FAF7 1F3FE ; RGI_Emoji_Modifier_Sequence ; leftwards pushing hand:
medium-dark skin tone # E15.0 [1] (🫷🏾)
+1FAF7 1F3FF ; RGI_Emoji_Modifier_Sequence ; leftwards pushing hand: dark
skin tone # E15.0 [1] (🫷🏿)
+1FAF8 1F3FB ; RGI_Emoji_Modifier_Sequence ; rightwards pushing hand: light
skin tone # E15.0 [1] (🫸🏻)
+1FAF8 1F3FC ; RGI_Emoji_Modifier_Sequence ; rightwards pushing hand:
medium-light skin tone # E15.0 [1] (🫸🏼)
+1FAF8 1F3FD ; RGI_Emoji_Modifier_Sequence ; rightwards pushing hand: medium
skin tone # E15.0 [1] (🫸🏽)
+1FAF8 1F3FE ; RGI_Emoji_Modifier_Sequence ; rightwards pushing hand:
medium-dark skin tone # E15.0 [1] (🫸🏾)
+1FAF8 1F3FF ; RGI_Emoji_Modifier_Sequence ; rightwards pushing hand: dark
skin tone # E15.0 [1] (🫸🏿)
-# Total elements: 645
+# Total elements: 655
#EOF
diff --git a/admin/unidata/emoji-test.txt b/admin/unidata/emoji-test.txt
index 42e6210cd2..bc8b52c2fb 100644
--- a/admin/unidata/emoji-test.txt
+++ b/admin/unidata/emoji-test.txt
@@ -1,13 +1,13 @@
# emoji-test.txt
-# Date: 2021-08-26, 17:22:23 GMT
-# © 2021 Unicode®, Inc.
+# Date: 2022-08-12, 20:24:39 GMT
+# © 2022 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
#
# Emoji Keyboard/Display Test Data for UTS #51
-# Version: 14.0
+# Version: 15.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr51
+# For documentation and usage, see https://www.unicode.org/reports/tr51
#
# This file provides data for testing which emoji forms should be in keyboards
and which should also be displayed/processed.
# Format: code points; status # emoji name
@@ -92,6 +92,7 @@
1F62C ; fully-qualified #
😬 E1.0 grimacing face
1F62E 200D 1F4A8 ; fully-qualified #
😮💨 E13.1 face exhaling
1F925 ; fully-qualified #
🤥 E3.0 lying face
+1FAE8 ; fully-qualified #
🫨 E15.0 shaking face
# subgroup: face-sleepy
1F60C ; fully-qualified #
😌 E0.6 relieved face
@@ -155,7 +156,7 @@
# subgroup: face-negative
1F624 ; fully-qualified #
😤 E0.6 face with steam from nose
-1F621 ; fully-qualified #
😡 E0.6 pouting face
+1F621 ; fully-qualified #
😡 E0.6 enraged face
1F620 ; fully-qualified #
😠 E0.6 angry face
1F92C ; fully-qualified #
🤬 E5.0 face with symbols on mouth
1F608 ; fully-qualified #
😈 E1.0 smiling face with horns
@@ -190,8 +191,7 @@
1F649 ; fully-qualified #
🙉 E0.6 hear-no-evil monkey
1F64A ; fully-qualified #
🙊 E0.6 speak-no-evil monkey
-# subgroup: emotion
-1F48B ; fully-qualified #
💋 E0.6 kiss mark
+# subgroup: heart
1F48C ; fully-qualified #
💌 E0.6 love letter
1F498 ; fully-qualified #
💘 E0.6 heart with arrow
1F49D ; fully-qualified #
💝 E0.6 heart with ribbon
@@ -210,14 +210,20 @@
2764 200D 1FA79 ; unqualified #
❤🩹 E13.1 mending heart
2764 FE0F ; fully-qualified #
❤️ E0.6 red heart
2764 ; unqualified #
❤ E0.6 red heart
+1FA77 ; fully-qualified #
🩷 E15.0 pink heart
1F9E1 ; fully-qualified #
🧡 E5.0 orange heart
1F49B ; fully-qualified #
💛 E0.6 yellow heart
1F49A ; fully-qualified #
💚 E0.6 green heart
1F499 ; fully-qualified #
💙 E0.6 blue heart
+1FA75 ; fully-qualified #
🩵 E15.0 light blue heart
1F49C ; fully-qualified #
💜 E0.6 purple heart
1F90E ; fully-qualified #
🤎 E12.0 brown heart
1F5A4 ; fully-qualified #
🖤 E3.0 black heart
+1FA76 ; fully-qualified #
🩶 E15.0 grey heart
1F90D ; fully-qualified #
🤍 E12.0 white heart
+
+# subgroup: emotion
+1F48B ; fully-qualified #
💋 E0.6 kiss mark
1F4AF ; fully-qualified #
💯 E0.6 hundred points
1F4A2 ; fully-qualified #
💢 E0.6 anger symbol
1F4A5 ; fully-qualified #
💥 E0.6 collision
@@ -226,21 +232,20 @@
1F4A8 ; fully-qualified #
💨 E0.6 dashing away
1F573 FE0F ; fully-qualified #
🕳️ E0.7 hole
1F573 ; unqualified #
🕳 E0.7 hole
-1F4A3 ; fully-qualified #
💣 E0.6 bomb
1F4AC ; fully-qualified #
💬 E0.6 speech balloon
1F441 FE0F 200D 1F5E8 FE0F ; fully-qualified #
👁️🗨️ E2.0 eye in speech bubble
1F441 200D 1F5E8 FE0F ; unqualified #
👁🗨️ E2.0 eye in speech bubble
-1F441 FE0F 200D 1F5E8 ; unqualified #
👁️🗨 E2.0 eye in speech bubble
+1F441 FE0F 200D 1F5E8 ; minimally-qualified #
👁️🗨 E2.0 eye in speech bubble
1F441 200D 1F5E8 ; unqualified #
👁🗨 E2.0 eye in speech bubble
1F5E8 FE0F ; fully-qualified #
🗨️ E2.0 left speech bubble
1F5E8 ; unqualified #
🗨 E2.0 left speech bubble
1F5EF FE0F ; fully-qualified #
🗯️ E0.7 right anger bubble
1F5EF ; unqualified #
🗯 E0.7 right anger bubble
1F4AD ; fully-qualified #
💭 E1.0 thought balloon
-1F4A4 ; fully-qualified #
💤 E0.6 zzz
+1F4A4 ; fully-qualified #
💤 E0.6 ZZZ
-# Smileys & Emotion subtotal: 177
-# Smileys & Emotion subtotal: 177 w/o modifiers
+# Smileys & Emotion subtotal: 180
+# Smileys & Emotion subtotal: 180 w/o modifiers
# group: People & Body
@@ -300,6 +305,18 @@
1FAF4 1F3FD ; fully-qualified #
🫴🏽 E14.0 palm up hand: medium skin tone
1FAF4 1F3FE ; fully-qualified #
🫴🏾 E14.0 palm up hand: medium-dark skin tone
1FAF4 1F3FF ; fully-qualified #
🫴🏿 E14.0 palm up hand: dark skin tone
+1FAF7 ; fully-qualified #
🫷 E15.0 leftwards pushing hand
+1FAF7 1F3FB ; fully-qualified #
🫷🏻 E15.0 leftwards pushing hand: light skin tone
+1FAF7 1F3FC ; fully-qualified #
🫷🏼 E15.0 leftwards pushing hand: medium-light skin tone
+1FAF7 1F3FD ; fully-qualified #
🫷🏽 E15.0 leftwards pushing hand: medium skin tone
+1FAF7 1F3FE ; fully-qualified #
🫷🏾 E15.0 leftwards pushing hand: medium-dark skin tone
+1FAF7 1F3FF ; fully-qualified #
🫷🏿 E15.0 leftwards pushing hand: dark skin tone
+1FAF8 ; fully-qualified #
🫸 E15.0 rightwards pushing hand
+1FAF8 1F3FB ; fully-qualified #
🫸🏻 E15.0 rightwards pushing hand: light skin tone
+1FAF8 1F3FC ; fully-qualified #
🫸🏼 E15.0 rightwards pushing hand: medium-light skin tone
+1FAF8 1F3FD ; fully-qualified #
🫸🏽 E15.0 rightwards pushing hand: medium skin tone
+1FAF8 1F3FE ; fully-qualified #
🫸🏾 E15.0 rightwards pushing hand: medium-dark skin tone
+1FAF8 1F3FF ; fully-qualified #
🫸🏿 E15.0 rightwards pushing hand: dark skin tone
# subgroup: hand-fingers-partial
1F44C ; fully-qualified #
👌 E0.6 OK hand
@@ -473,11 +490,11 @@
1F932 1F3FE ; fully-qualified #
🤲🏾 E5.0 palms up together: medium-dark skin tone
1F932 1F3FF ; fully-qualified #
🤲🏿 E5.0 palms up together: dark skin tone
1F91D ; fully-qualified #
🤝 E3.0 handshake
-1F91D 1F3FB ; fully-qualified #
🤝🏻 E3.0 handshake: light skin tone
-1F91D 1F3FC ; fully-qualified #
🤝🏼 E3.0 handshake: medium-light skin tone
-1F91D 1F3FD ; fully-qualified #
🤝🏽 E3.0 handshake: medium skin tone
-1F91D 1F3FE ; fully-qualified #
🤝🏾 E3.0 handshake: medium-dark skin tone
-1F91D 1F3FF ; fully-qualified #
🤝🏿 E3.0 handshake: dark skin tone
+1F91D 1F3FB ; fully-qualified #
🤝🏻 E14.0 handshake: light skin tone
+1F91D 1F3FC ; fully-qualified #
🤝🏼 E14.0 handshake: medium-light skin tone
+1F91D 1F3FD ; fully-qualified #
🤝🏽 E14.0 handshake: medium skin tone
+1F91D 1F3FE ; fully-qualified #
🤝🏾 E14.0 handshake: medium-dark skin tone
+1F91D 1F3FF ; fully-qualified #
🤝🏿 E14.0 handshake: dark skin tone
1FAF1 1F3FB 200D 1FAF2 1F3FC ; fully-qualified #
🫱🏻🫲🏼 E14.0 handshake: light skin tone, medium-light skin tone
1FAF1 1F3FB 200D 1FAF2 1F3FD ; fully-qualified #
🫱🏻🫲🏽 E14.0 handshake: light skin tone, medium skin tone
1FAF1 1F3FB 200D 1FAF2 1F3FE ; fully-qualified #
🫱🏻🫲🏾 E14.0 handshake: light skin tone, medium-dark skin tone
@@ -1455,7 +1472,7 @@
1F575 1F3FF ; fully-qualified #
🕵🏿 E2.0 detective: dark skin tone
1F575 FE0F 200D 2642 FE0F ; fully-qualified #
🕵️♂️ E4.0 man detective
1F575 200D 2642 FE0F ; unqualified #
🕵♂️ E4.0 man detective
-1F575 FE0F 200D 2642 ; unqualified #
🕵️♂ E4.0 man detective
+1F575 FE0F 200D 2642 ; minimally-qualified #
🕵️♂ E4.0 man detective
1F575 200D 2642 ; unqualified #
🕵♂ E4.0 man detective
1F575 1F3FB 200D 2642 FE0F ; fully-qualified #
🕵🏻♂️ E4.0 man detective: light skin tone
1F575 1F3FB 200D 2642 ; minimally-qualified #
🕵🏻♂ E4.0 man detective: light skin tone
@@ -1469,7 +1486,7 @@
1F575 1F3FF 200D 2642 ; minimally-qualified #
🕵🏿♂ E4.0 man detective: dark skin tone
1F575 FE0F 200D 2640 FE0F ; fully-qualified #
🕵️♀️ E4.0 woman detective
1F575 200D 2640 FE0F ; unqualified #
🕵♀️ E4.0 woman detective
-1F575 FE0F 200D 2640 ; unqualified #
🕵️♀ E4.0 woman detective
+1F575 FE0F 200D 2640 ; minimally-qualified #
🕵️♀ E4.0 woman detective
1F575 200D 2640 ; unqualified #
🕵♀ E4.0 woman detective
1F575 1F3FB 200D 2640 FE0F ; fully-qualified #
🕵🏻♀️ E4.0 woman detective: light skin tone
1F575 1F3FB 200D 2640 ; minimally-qualified #
🕵🏻♀ E4.0 woman detective: light skin tone
@@ -2302,7 +2319,7 @@
1F3CC 1F3FF ; fully-qualified #
🏌🏿 E4.0 person golfing: dark skin tone
1F3CC FE0F 200D 2642 FE0F ; fully-qualified #
🏌️♂️ E4.0 man golfing
1F3CC 200D 2642 FE0F ; unqualified #
🏌♂️ E4.0 man golfing
-1F3CC FE0F 200D 2642 ; unqualified #
🏌️♂ E4.0 man golfing
+1F3CC FE0F 200D 2642 ; minimally-qualified #
🏌️♂ E4.0 man golfing
1F3CC 200D 2642 ; unqualified #
🏌♂ E4.0 man golfing
1F3CC 1F3FB 200D 2642 FE0F ; fully-qualified #
🏌🏻♂️ E4.0 man golfing: light skin tone
1F3CC 1F3FB 200D 2642 ; minimally-qualified #
🏌🏻♂ E4.0 man golfing: light skin tone
@@ -2316,7 +2333,7 @@
1F3CC 1F3FF 200D 2642 ; minimally-qualified #
🏌🏿♂ E4.0 man golfing: dark skin tone
1F3CC FE0F 200D 2640 FE0F ; fully-qualified #
🏌️♀️ E4.0 woman golfing
1F3CC 200D 2640 FE0F ; unqualified #
🏌♀️ E4.0 woman golfing
-1F3CC FE0F 200D 2640 ; unqualified #
🏌️♀ E4.0 woman golfing
+1F3CC FE0F 200D 2640 ; minimally-qualified #
🏌️♀ E4.0 woman golfing
1F3CC 200D 2640 ; unqualified #
🏌♀ E4.0 woman golfing
1F3CC 1F3FB 200D 2640 FE0F ; fully-qualified #
🏌🏻♀️ E4.0 woman golfing: light skin tone
1F3CC 1F3FB 200D 2640 ; minimally-qualified #
🏌🏻♀ E4.0 woman golfing: light skin tone
@@ -2427,7 +2444,7 @@
26F9 1F3FF ; fully-qualified #
⛹🏿 E2.0 person bouncing ball: dark skin tone
26F9 FE0F 200D 2642 FE0F ; fully-qualified #
⛹️♂️ E4.0 man bouncing ball
26F9 200D 2642 FE0F ; unqualified #
⛹♂️ E4.0 man bouncing ball
-26F9 FE0F 200D 2642 ; unqualified #
⛹️♂ E4.0 man bouncing ball
+26F9 FE0F 200D 2642 ; minimally-qualified #
⛹️♂ E4.0 man bouncing ball
26F9 200D 2642 ; unqualified #
⛹♂ E4.0 man bouncing ball
26F9 1F3FB 200D 2642 FE0F ; fully-qualified #
⛹🏻♂️ E4.0 man bouncing ball: light skin tone
26F9 1F3FB 200D 2642 ; minimally-qualified #
⛹🏻♂ E4.0 man bouncing ball: light skin tone
@@ -2441,7 +2458,7 @@
26F9 1F3FF 200D 2642 ; minimally-qualified #
⛹🏿♂ E4.0 man bouncing ball: dark skin tone
26F9 FE0F 200D 2640 FE0F ; fully-qualified #
⛹️♀️ E4.0 woman bouncing ball
26F9 200D 2640 FE0F ; unqualified #
⛹♀️ E4.0 woman bouncing ball
-26F9 FE0F 200D 2640 ; unqualified #
⛹️♀ E4.0 woman bouncing ball
+26F9 FE0F 200D 2640 ; minimally-qualified #
⛹️♀ E4.0 woman bouncing ball
26F9 200D 2640 ; unqualified #
⛹♀ E4.0 woman bouncing ball
26F9 1F3FB 200D 2640 FE0F ; fully-qualified #
⛹🏻♀️ E4.0 woman bouncing ball: light skin tone
26F9 1F3FB 200D 2640 ; minimally-qualified #
⛹🏻♀ E4.0 woman bouncing ball: light skin tone
@@ -2462,7 +2479,7 @@
1F3CB 1F3FF ; fully-qualified #
🏋🏿 E2.0 person lifting weights: dark skin tone
1F3CB FE0F 200D 2642 FE0F ; fully-qualified #
🏋️♂️ E4.0 man lifting weights
1F3CB 200D 2642 FE0F ; unqualified #
🏋♂️ E4.0 man lifting weights
-1F3CB FE0F 200D 2642 ; unqualified #
🏋️♂ E4.0 man lifting weights
+1F3CB FE0F 200D 2642 ; minimally-qualified #
🏋️♂ E4.0 man lifting weights
1F3CB 200D 2642 ; unqualified #
🏋♂ E4.0 man lifting weights
1F3CB 1F3FB 200D 2642 FE0F ; fully-qualified #
🏋🏻♂️ E4.0 man lifting weights: light skin tone
1F3CB 1F3FB 200D 2642 ; minimally-qualified #
🏋🏻♂ E4.0 man lifting weights: light skin tone
@@ -2476,7 +2493,7 @@
1F3CB 1F3FF 200D 2642 ; minimally-qualified #
🏋🏿♂ E4.0 man lifting weights: dark skin tone
1F3CB FE0F 200D 2640 FE0F ; fully-qualified #
🏋️♀️ E4.0 woman lifting weights
1F3CB 200D 2640 FE0F ; unqualified #
🏋♀️ E4.0 woman lifting weights
-1F3CB FE0F 200D 2640 ; unqualified #
🏋️♀ E4.0 woman lifting weights
+1F3CB FE0F 200D 2640 ; minimally-qualified #
🏋️♀ E4.0 woman lifting weights
1F3CB 200D 2640 ; unqualified #
🏋♀ E4.0 woman lifting weights
1F3CB 1F3FB 200D 2640 FE0F ; fully-qualified #
🏋🏻♀️ E4.0 woman lifting weights: light skin tone
1F3CB 1F3FB 200D 2640 ; minimally-qualified #
🏋🏻♀ E4.0 woman lifting weights: light skin tone
@@ -3262,8 +3279,8 @@
1FAC2 ; fully-qualified #
🫂 E13.0 people hugging
1F463 ; fully-qualified #
👣 E0.6 footprints
-# People & Body subtotal: 2986
-# People & Body subtotal: 506 w/o modifiers
+# People & Body subtotal: 2998
+# People & Body subtotal: 508 w/o modifiers
# group: Component
@@ -3306,6 +3323,8 @@
1F405 ; fully-qualified #
🐅 E1.0 tiger
1F406 ; fully-qualified #
🐆 E1.0 leopard
1F434 ; fully-qualified #
🐴 E0.6 horse face
+1FACE ; fully-qualified #
🫎 E15.0 moose
+1FACF ; fully-qualified #
🫏 E15.0 donkey
1F40E ; fully-qualified #
🐎 E0.6 horse
1F984 ; fully-qualified #
🦄 E1.0 unicorn
1F993 ; fully-qualified #
🦓 E5.0 zebra
@@ -3373,6 +3392,9 @@
1F9A9 ; fully-qualified #
🦩 E12.0 flamingo
1F99A ; fully-qualified #
🦚 E11.0 peacock
1F99C ; fully-qualified #
🦜 E11.0 parrot
+1FABD ; fully-qualified #
🪽 E15.0 wing
+1F426 200D 2B1B ; fully-qualified #
🐦⬛ E15.0 black bird
+1FABF ; fully-qualified #
🪿 E15.0 goose
# subgroup: animal-amphibian
1F438 ; fully-qualified #
🐸 E0.6 frog
@@ -3399,6 +3421,7 @@
1F419 ; fully-qualified #
🐙 E0.6 octopus
1F41A ; fully-qualified #
🐚 E0.6 spiral shell
1FAB8 ; fully-qualified #
🪸 E14.0 coral
+1FABC ; fully-qualified #
🪼 E15.0 jellyfish
# subgroup: animal-bug
1F40C ; fully-qualified #
🐌 E0.6 snail
@@ -3433,6 +3456,7 @@
1F33B ; fully-qualified #
🌻 E0.6 sunflower
1F33C ; fully-qualified #
🌼 E0.6 blossom
1F337 ; fully-qualified #
🌷 E0.6 tulip
+1FABB ; fully-qualified #
🪻 E15.0 hyacinth
# subgroup: plant-other
1F331 ; fully-qualified #
🌱 E0.6 seedling
@@ -3451,9 +3475,10 @@
1F343 ; fully-qualified #
🍃 E0.6 leaf fluttering in wind
1FAB9 ; fully-qualified #
🪹 E14.0 empty nest
1FABA ; fully-qualified #
🪺 E14.0 nest with eggs
+1F344 ; fully-qualified #
🍄 E0.6 mushroom
-# Animals & Nature subtotal: 151
-# Animals & Nature subtotal: 151 w/o modifiers
+# Animals & Nature subtotal: 159
+# Animals & Nature subtotal: 159 w/o modifiers
# group: Food & Drink
@@ -3492,10 +3517,11 @@
1F966 ; fully-qualified #
🥦 E5.0 broccoli
1F9C4 ; fully-qualified #
🧄 E12.0 garlic
1F9C5 ; fully-qualified #
🧅 E12.0 onion
-1F344 ; fully-qualified #
🍄 E0.6 mushroom
1F95C ; fully-qualified #
🥜 E3.0 peanuts
1FAD8 ; fully-qualified #
🫘 E14.0 beans
1F330 ; fully-qualified #
🌰 E0.6 chestnut
+1FADA ; fully-qualified #
🫚 E15.0 ginger root
+1FADB ; fully-qualified #
🫛 E15.0 pea pod
# subgroup: food-prepared
1F35E ; fully-qualified #
🍞 E0.6 bread
@@ -3607,8 +3633,8 @@
1FAD9 ; fully-qualified #
🫙 E14.0 jar
1F3FA ; fully-qualified #
🏺 E1.0 amphora
-# Food & Drink subtotal: 134
-# Food & Drink subtotal: 134 w/o modifiers
+# Food & Drink subtotal: 135
+# Food & Drink subtotal: 135 w/o modifiers
# group: Travel & Places
@@ -3974,11 +4000,10 @@
1F3AF ; fully-qualified #
🎯 E0.6 bullseye
1FA80 ; fully-qualified #
🪀 E12.0 yo-yo
1FA81 ; fully-qualified #
🪁 E12.0 kite
+1F52B ; fully-qualified #
🔫 E0.6 water pistol
1F3B1 ; fully-qualified #
🎱 E0.6 pool 8 ball
1F52E ; fully-qualified #
🔮 E0.6 crystal ball
1FA84 ; fully-qualified #
🪄 E13.0 magic wand
-1F9FF ; fully-qualified #
🧿 E11.0 nazar amulet
-1FAAC ; fully-qualified #
🪬 E14.0 hamsa
1F3AE ; fully-qualified #
🎮 E0.6 video game
1F579 FE0F ; fully-qualified #
🕹️ E0.7 joystick
1F579 ; unqualified #
🕹 E0.7 joystick
@@ -4013,8 +4038,8 @@
1F9F6 ; fully-qualified #
🧶 E11.0 yarn
1FAA2 ; fully-qualified #
🪢 E13.0 knot
-# Activities subtotal: 97
-# Activities subtotal: 97 w/o modifiers
+# Activities subtotal: 96
+# Activities subtotal: 96 w/o modifiers
# group: Objects
@@ -4040,6 +4065,7 @@
1FA73 ; fully-qualified #
🩳 E12.0 shorts
1F459 ; fully-qualified #
👙 E0.6 bikini
1F45A ; fully-qualified #
👚 E0.6 woman’s clothes
+1FAAD ; fully-qualified #
🪭 E15.0 folding hand fan
1F45B ; fully-qualified #
👛 E0.6 purse
1F45C ; fully-qualified #
👜 E0.6 handbag
1F45D ; fully-qualified #
👝 E0.6 clutch bag
@@ -4055,6 +4081,7 @@
1F461 ; fully-qualified #
👡 E0.6 woman’s sandal
1FA70 ; fully-qualified #
🩰 E12.0 ballet shoes
1F462 ; fully-qualified #
👢 E0.6 woman’s boot
+1FAAE ; fully-qualified #
🪮 E15.0 hair pick
1F451 ; fully-qualified #
👑 E0.6 crown
1F452 ; fully-qualified #
👒 E0.6 woman’s hat
1F3A9 ; fully-qualified #
🎩 E0.6 top hat
@@ -4103,6 +4130,8 @@
1FA95 ; fully-qualified #
🪕 E12.0 banjo
1F941 ; fully-qualified #
🥁 E3.0 drum
1FA98 ; fully-qualified #
🪘 E13.0 long drum
+1FA87 ; fully-qualified #
🪇 E15.0 maracas
+1FA88 ; fully-qualified #
🪈 E15.0 flute
# subgroup: phone
1F4F1 ; fully-qualified #
📱 E0.6 mobile phone
@@ -4275,7 +4304,7 @@
1F5E1 ; unqualified #
🗡 E0.7 dagger
2694 FE0F ; fully-qualified #
⚔️ E1.0 crossed swords
2694 ; unqualified #
⚔ E1.0 crossed swords
-1F52B ; fully-qualified #
🔫 E0.6 water pistol
+1F4A3 ; fully-qualified #
💣 E0.6 bomb
1FA83 ; fully-qualified #
🪃 E13.0 boomerang
1F3F9 ; fully-qualified #
🏹 E1.0 bow and arrow
1F6E1 FE0F ; fully-qualified #
🛡️ E0.7 shield
@@ -4354,12 +4383,14 @@
1FAA6 ; fully-qualified #
🪦 E13.0 headstone
26B1 FE0F ; fully-qualified #
⚱️ E1.0 funeral urn
26B1 ; unqualified #
⚱ E1.0 funeral urn
+1F9FF ; fully-qualified #
🧿 E11.0 nazar amulet
+1FAAC ; fully-qualified #
🪬 E14.0 hamsa
1F5FF ; fully-qualified #
🗿 E0.6 moai
1FAA7 ; fully-qualified #
🪧 E13.0 placard
1FAAA ; fully-qualified #
🪪 E14.0 identification card
-# Objects subtotal: 304
-# Objects subtotal: 304 w/o modifiers
+# Objects subtotal: 310
+# Objects subtotal: 310 w/o modifiers
# group: Symbols
@@ -4455,6 +4486,7 @@
262E ; unqualified #
☮ E1.0 peace symbol
1F54E ; fully-qualified #
🕎 E1.0 menorah
1F52F ; fully-qualified #
🔯 E0.6 dotted six-pointed star
+1FAAF ; fully-qualified #
🪯 E15.0 khanda
# subgroup: zodiac
2648 ; fully-qualified #
♈ E0.6 Aries
@@ -4503,6 +4535,7 @@
1F505 ; fully-qualified #
🔅 E1.0 dim button
1F506 ; fully-qualified #
🔆 E1.0 bright button
1F4F6 ; fully-qualified #
📶 E0.6 antenna bars
+1F6DC ; fully-qualified #
🛜 E15.0 wireless
1F4F3 ; fully-qualified #
📳 E0.6 vibration mode
1F4F4 ; fully-qualified #
📴 E0.6 mobile phone off
@@ -4693,8 +4726,8 @@
1F533 ; fully-qualified #
🔳 E0.6 white square button
1F532 ; fully-qualified #
🔲 E0.6 black square button
-# Symbols subtotal: 302
-# Symbols subtotal: 302 w/o modifiers
+# Symbols subtotal: 304
+# Symbols subtotal: 304 w/o modifiers
# group: Flags
@@ -4709,7 +4742,7 @@
1F3F3 200D 1F308 ; unqualified #
🏳🌈 E4.0 rainbow flag
1F3F3 FE0F 200D 26A7 FE0F ; fully-qualified #
🏳️⚧️ E13.0 transgender flag
1F3F3 200D 26A7 FE0F ; unqualified #
🏳⚧️ E13.0 transgender flag
-1F3F3 FE0F 200D 26A7 ; unqualified #
🏳️⚧ E13.0 transgender flag
+1F3F3 FE0F 200D 26A7 ; minimally-qualified #
🏳️⚧ E13.0 transgender flag
1F3F3 200D 26A7 ; unqualified #
🏳⚧ E13.0 transgender flag
1F3F4 200D 2620 FE0F ; fully-qualified #
🏴☠️ E11.0 pirate flag
1F3F4 200D 2620 ; minimally-qualified #
🏴☠ E11.0 pirate flag
@@ -4983,9 +5016,9 @@
# Flags subtotal: 275 w/o modifiers
# Status Counts
-# fully-qualified : 3624
-# minimally-qualified : 817
-# unqualified : 252
+# fully-qualified : 3655
+# minimally-qualified : 827
+# unqualified : 242
# component : 9
#EOF
diff --git a/admin/unidata/emoji-zwj-sequences.txt
b/admin/unidata/emoji-zwj-sequences.txt
index 6f94721a73..4125bec62e 100644
--- a/admin/unidata/emoji-zwj-sequences.txt
+++ b/admin/unidata/emoji-zwj-sequences.txt
@@ -1,13 +1,13 @@
# emoji-zwj-sequences.txt
-# Date: 2021-06-08, 05:19:16 GMT
-# © 2021 Unicode®, Inc.
+# Date: 2022-05-06, 16:14:52 GMT
+# © 2022 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
#
# Emoji ZWJ Sequences for UTS #51
-# Version: 14.0
+# Version: 15.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr51
+# For documentation and usage, see https://www.unicode.org/reports/tr51
#
# Format:
# code_point(s) ; type_field ; description # comments
@@ -1398,6 +1398,7 @@
1F3F4 200D 2620 FE0F ; RGI_Emoji_ZWJ_Sequence ; pirate
flag # E11.0 [1] (🏴☠️)
1F408 200D 2B1B ; RGI_Emoji_ZWJ_Sequence ; black
cat # E13.0 [1] (🐈⬛)
1F415 200D 1F9BA ; RGI_Emoji_ZWJ_Sequence ;
service dog # E12.0 [1]
(🐕🦺)
+1F426 200D 2B1B ; RGI_Emoji_ZWJ_Sequence ; black
bird # E15.0 [1] (🐦⬛)
1F43B 200D 2744 FE0F ; RGI_Emoji_ZWJ_Sequence ; polar
bear # E13.0 [1] (🐻❄️)
1F441 FE0F 200D 1F5E8 FE0F ; RGI_Emoji_ZWJ_Sequence ; eye in
speech bubble # E2.0 [1] (👁️🗨️)
1F62E 200D 1F4A8 ; RGI_Emoji_ZWJ_Sequence ; face
exhaling # E13.1 [1] (😮💨)
@@ -1405,6 +1406,6 @@
1F636 200D 1F32B FE0F ; RGI_Emoji_ZWJ_Sequence ; face
in clouds # E13.1 [1] (😶🌫️)
1F9D1 200D 1F384 ; RGI_Emoji_ZWJ_Sequence ; mx
claus # E13.0 [1] (🧑🎄)
-# Total elements: 13
+# Total elements: 14
#EOF
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 78dd1c3728..5927760ad5 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -212,12 +212,12 @@ Property value is one of the following symbols:
;; Character Database (UCD).
(L (#x0600 #x07BF AL) (#x0860 #x08FF AL) (#xFB50 #xFDCF AL)
(#xFDF0 #xFDFF AL) (#xFE70 #xFEFF AL) (#x10D00 #x10D3F AL)
- (#x10F30 #x10F6F AL) (#x1EC70 #x1ECBF AL) (#x1ED00 #x1ED4F AL)
- (#x1EE00 #x1EEFF AL)
+ (#x10EC0 #x10EFF AL) (#x10F30 #x10F6F AL) (#x1EC70 #x1ECBF AL)
+ (#x1ED00 #x1ED4F AL) (#x1EE00 #x1EEFF AL)
(#x0590 #x05FF R) (#x07C0 #x085F R) (#xFB1D #xFB4F R)
- (#x10800 #x10CFF R) (#x10D40 #x10F2F R) (#x10F70 #x10FFF R)
- (#x1E800 #x1EC6F R) (#x1ECC0 #x1ECFF R) (#x1ED50 #x1EDFF R)
- (#x1EF00 #x1EFFF R)
+ (#x10800 #x10CFF R) (#x10D40 #x10EBF R) (#x10F00 #x10F2F R)
+ (#x10F70 #x10FFF R) (#x1E800 #x1EC6F R) (#x1ECC0 #x1ECFF R)
+ (#x1ED50 #x1EDFF R) (#x1EF00 #x1EFFF R)
(#x20A0 #x20CF ET))
;; The order of elements must be in sync with bidi_type_t in
;; src/dispextern.h.
diff --git a/admin/update-copyright b/admin/update-copyright
index 5a04847a66..8b7c05749d 100755
--- a/admin/update-copyright
+++ b/admin/update-copyright
@@ -31,6 +31,8 @@
# updated and some should not be, due to registration numbers, so
# this script leaves these copyright years alone for now.
+set -o nounset
+
: ${UPDATE_COPYRIGHT_USE_INTERVALS=1}
export UPDATE_COPYRIGHT_USE_INTERVALS
diff --git a/admin/update_autogen b/admin/update_autogen
index 2451367171..55e11be95c 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -32,16 +32,7 @@
### Code:
-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
@@ -93,16 +84,14 @@ genfiles="
## msdos-only:
genfiles="src/config.in"
+basegen=""
for g in $genfiles; do
basegen="$basegen ${g##*/}"
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
@@ -144,6 +133,7 @@ status ()
local stat file modified
+ modified=""
while read stat file; do
[ "$stat" != "M" ] && \
@@ -308,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 1b7950ede8..04f7c3acc7 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -36,14 +36,7 @@
### Code:
-
-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/build-aux/config.guess b/build-aux/config.guess
index 1817bdce90..a419d8643b 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -4,7 +4,7 @@
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-05-25'
+timestamp='2022-08-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -1036,7 +1036,7 @@ EOF
k1om:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
- loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*)
+ loongarch32:Linux:*:* | loongarch64:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
m32r*:Linux:*:*)
diff --git a/build-aux/config.sub b/build-aux/config.sub
index dba16e84c7..fbaa37f235 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -4,7 +4,7 @@
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-01-03'
+timestamp='2022-08-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -1207,7 +1207,7 @@ case $cpu-$vendor in
| k1om \
| le32 | le64 \
| lm32 \
- | loongarch32 | loongarch64 | loongarchx32 \
+ | loongarch32 | loongarch64 \
| m32c | m32r | m32rle \
| m5200 | m68000 | m680[012346]0 | m68360 | m683?2 |
m68k \
| m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
diff --git a/config.bat b/config.bat
index 4adc477bc9..7f2060ce00 100644
--- a/config.bat
+++ b/config.bat
@@ -276,6 +276,7 @@ cd lib
Rem Rename files like djtar on plain DOS filesystem would.
If Exist c++defs.h update c++defs.h cxxdefs.h
If Exist alloca.in.h update alloca.in.h alloca.in-h
+If Exist assert.in.h update assert.in.h assert.in-h
If Exist byteswap.in.h update byteswap.in.h byteswap.in-h
If Exist dirent.in.h update dirent.in.h dirent.in-h
If Exist errno.in.h update errno.in.h errno.in-h
diff --git a/configure.ac b/configure.ac
index 7616e450d0..63cb9c412e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -494,7 +494,6 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS
support])
OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support])
OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
-OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native
compiler support])
OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on
32-bit Cygwin])
OPTION_DEFAULT_ON([xinput2],[don't use version 2 of the X Input Extension for
input])
OPTION_DEFAULT_OFF([small-ja-dic],[generate a smaller-size Japanese
dictionary])
@@ -1009,6 +1008,29 @@ AC_ARG_ENABLE([gcc-warnings],
[gl_GCC_VERSION_IFELSE([5], [3], [gl_gcc_warnings=warn-only])])
fi])
+NATIVE_COMPILATION_AOT=no
+AC_ARG_WITH([native-compilation],
+ [AS_HELP_STRING([--with-native-compilation@<:@=TYPE@:>@],
+ [compile with Emacs Lisp native compiler support. The TYPE
+ 'yes' (or empty) means to enable it and compile natively
+ preloaded Lisp files; 'no' means to disable it;
+ 'aot' will make the build process compile all the Lisp
+ files in the tree natively ahead of time. (This will
+ usually be quite slow.)])],
+ [
+ case $withval in
+ aot)
+ withval=yes
+ NATIVE_COMPILATION_AOT=yes
+ ;;
+ yes|no) ;;
+ *) AC_MSG_ERROR([bad value $withval for native-compilation option])
;;
+ esac
+ with_native_compilation=$withval],
+ [with_native_compilation=no]
+)
+AC_SUBST([NATIVE_COMPILATION_AOT])
+
AC_ARG_ENABLE([check-lisp-object-type],
[AS_HELP_STRING([--enable-check-lisp-object-type],
[Enable compile time checks for the Lisp_Object data type,
@@ -2155,17 +2177,16 @@ AC_SUBST([NS_OBJ])
AC_SUBST([NS_OBJC_OBJ])
if test "${HAVE_NS}" = yes; then
+ AC_LANG_PUSH([Objective C])
AC_CACHE_CHECK(
[if the Objective C compiler supports instancetype],
[emacs_cv_objc_instancetype],
- [AC_LANG_PUSH([Objective C])
- AC_COMPILE_IFELSE(
+ [AC_COMPILE_IFELSE(
[AC_LANG_SOURCE([[@interface Test
+ (instancetype)test;
@end]])],
[emacs_cv_objc_instancetype=yes],
- [emacs_cv_objc_instancetype=no])
- AC_LANG_POP([Objective C])])
+ [emacs_cv_objc_instancetype=no])])
if test x$emacs_cv_objc_instancetype = xyes ; then
AC_DEFINE([NATIVE_OBJC_INSTANCETYPE], [1],
@@ -2175,16 +2196,15 @@ if test "${HAVE_NS}" = yes; then
AC_CACHE_CHECK(
[if the Objective C compiler defaults to C99],
[emacs_cv_objc_c99],
- [AC_LANG_PUSH([Objective C])
- AC_COMPILE_IFELSE(
+ [AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([], [[for (int i = 0;;);]])],
[emacs_cv_objc_c99=yes],
- [emacs_cv_objc_c99=no])
- AC_LANG_POP([Objective C])])
+ [emacs_cv_objc_c99=no])])
- if test x$emacs_cv_objc_c99 = xno ; then
- GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99"
- fi
+ if test x$emacs_cv_objc_c99 = xno ; then
+ GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99"
+ fi
+ AC_LANG_POP([Objective C])
fi
HAVE_BE_APP=no
@@ -2775,12 +2795,9 @@ if test "${with_webp}" != "no"; then
|| test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes" \
|| test "${HAVE_BE_APP}" = "yes" || test "${HAVE_PGTK}" = "yes"; then
WEBP_REQUIRED=0.6.0
- WEBP_MODULE="libwebp >= $WEBP_REQUIRED"
+ WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED"
EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE])
- if test "$HAVE_WEBP" = "yes"; then
- WEBP_LIBS="-lwebp -lwebpdemux"
- fi
AC_SUBST([WEBP_CFLAGS])
AC_SUBST([WEBP_LIBS])
fi
@@ -6691,6 +6708,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/ack.texi b/doc/emacs/ack.texi
index d0f2cc343b..f0a45fd315 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -244,6 +244,11 @@ into Emacs.
Theresa O'Connor wrote @file{json.el}, a file for parsing and
generating JSON files.
+@item
+Andrea Corallo wrote the native compilation support in @file{comp.c}
+and @file{comp.el}, for compiling Emacs Lisp to native code using
+@samp{libgccjit}.
+
@item
Georges Brun-Cottan and Stefan Monnier wrote @file{easy-mmode.el}, a
package for easy definition of major and minor modes.
@@ -519,8 +524,9 @@ Denis Howe wrote @file{browse-url.el}, a package for
invoking a WWW
browser to display a URL.
@item
-Lars Magne Ingebrigtsen did a major redesign of the Gnus news-reader and
-wrote many of its parts. Several of these are now general components of
+Lars Magne Ingebrigtsen was the Emacs (co-)maintainer from Emacs 27.2
+onwards. He did a major redesign of the Gnus news-reader and wrote
+many of its parts. Several of these are now general components of
Emacs, including: @file{dns.el} for Domain Name Service lookups;
@file{format-spec.el} for formatting arbitrary format strings;
@file{netrc.el} for parsing of @file{.netrc} files; and
@@ -1435,7 +1441,8 @@ Victor Zandy wrote @file{zone.el}, a package for people
who like to
zone out in front of Emacs.
@item
-Eli Zaretskii made many standard Emacs features work on MS-DOS and
+Eli Zaretskii was the Emacs (co-)maintainer from Emacs 25
+onwards. He made many standard Emacs features work on MS-DOS and
Microsoft Windows. He also wrote @file{tty-colors.el}, which
implements transparent mapping of X colors to tty colors; and
@file{rxvt.el}. He implemented support for bidirectional text, menus
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 120c957ff8..8b21b6457c 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -631,13 +631,11 @@ buffer, but killing an indirect buffer has no effect on
its base buffer.
outline. @xref{Outline Views}.
A quick and handy way to make an indirect buffer is with the command
-@kbd{M-x clone-indirect-buffer}. It creates and selects an indirect
-buffer whose base buffer is the current buffer. With a numeric
-argument, it prompts for the name of the indirect buffer; otherwise it
-uses the name of the current buffer, with a @samp{<@var{n}>} suffix
-added. @kbd{C-x 4 c} (@code{clone-indirect-buffer-other-window})
-works like @kbd{M-x clone-indirect-buffer}, but it selects the new
-buffer in another window.
+@kbd{C-x 4 c} (@code{clone-indirect-buffer-other-window}). It creates
+and selects an indirect buffer whose base buffer is the current
+buffer. With a numeric argument, it prompts for the name of the
+indirect buffer; otherwise it uses the name of the current buffer,
+with a @samp{<@var{n}>} suffix added.
The more general way to make an indirect buffer is with the command
@kbd{M-x make-indirect-buffer}. It creates an indirect buffer
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/commands.texi b/doc/emacs/commands.texi
index 431cc2e5ce..df3c47504a 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -24,8 +24,8 @@ input.
GNU Emacs is primarily designed for use with the keyboard. While it
is possible to use the mouse to issue editing commands through the
-menu bar and tool bar, that is not as efficient as using the keyboard.
-Therefore, this manual mainly documents how to edit with the keyboard.
+menu bar and tool bar, that is usually not as efficient as using the
+keyboard.
@cindex control character
Keyboard input into Emacs is based on a heavily-extended version of
@@ -67,6 +67,10 @@ where the @key{Meta} key does not function reliably.
Emacs supports 3 additional modifier keys, see @ref{Modifier Keys}.
+ Emacs has extensive support for using mouse buttons, mouse wheels
+and other pointing devices like touchpads and touch screens.
+@xref{Mouse Input}, for details.
+
@cindex keys stolen by window manager
@cindex window manager, keys stolen by
On graphical displays, the window manager might block some keyboard
@@ -135,6 +139,47 @@ exception to this rule is @key{ESC}: @kbd{@key{ESC} C-h}
is equivalent
to @kbd{C-M-h}, which does something else entirely. You can, however,
use @key{F1} to display a list of commands starting with @key{ESC}.
+@node Mouse Input
+@section Mouse Input
+@cindex mouse input
+
+ By default, Emacs supports all the normal mouse actions like setting
+the cursor by clicking on the left mouse button, and selecting an area
+by dragging the mouse pointer. All mouse actions can be used to bind
+commands in the same way you bind them to keyboard events
+(@pxref{Keys}). This section provides a general overview of using the
+mouse in Emacs; @pxref{Mouse Commands}, and the sections that follow
+it, for more details about mouse commands in Emacs.
+
+ When you click the left mouse button, Emacs receives a
+@code{mouse-1} event. To see what command is bound to that event, you
+can type @kbd{C-h c} and then press the left mouse button. Similarly,
+the middle mouse button is @code{mouse-2} and the right mouse button is
+@code{mouse-3}. If you have a mouse with a wheel, the wheel events
+are commonly bound to either @code{wheel-down} or @code{wheel-up}, or
+@code{mouse-4} and @code{mouse-5}, but that depends on the operating
+system configuration.
+
+ In general, legacy X systems and terminals (@pxref{Text-Only Mouse})
+will report @code{mouse-4} and @code{mouse-5}, while all other systems
+will report @code{wheel-down} and @code{wheel-up}.
+
+ Some mice also have a horizontal scroll wheel, and touchpads usually
+support scrolling horizontally as well. These events are reported as
+@code{wheel-left} and @code{wheel-right} on all systems other than
+terminals and legacy X systems, where they are @code{mouse-6} and
+@code{mouse-7}.
+
+ You can also combine keyboard modifiers with mouse events, so you
+can bind a special command that triggers when you, for instance, holds
+down the Meta key and then uses the middle mouse button. In that
+case, the event name will be @code{M-mouse-2}.
+
+@cindex touchscreen events
+ On some systems, you can also bind commands for handling touch
+screen events. In that case, the events are called
+@code{touchscreen-update} and @code{touchscreen-end}.
+
@node Commands
@section Keys and Commands
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index efaf0dfd38..08ada2a70b 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
@@ -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.
@@ -2303,6 +2313,8 @@ as a function from Lisp programs.
@cindex startup (init file)
@cindex XDG_CONFIG_HOME
+@c When updating this, also update ``Setting up a customization file''
+@c in efaq.texi.
When Emacs is started, it normally tries to load a Lisp program from
an @dfn{initialization file}, or @dfn{init file} for short. This
file, if it exists, specifies how to initialize Emacs for you.
@@ -2809,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 33e9270d42..a9b4ff783d 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1641,7 +1641,7 @@ or through an external viewer. This is different from
Image mode
To enter Image-Dired, mark the image files you want to look at in
the Dired buffer, using @kbd{m} as usual. Then type @kbd{C-t d}
(@code{image-dired-display-thumbs}). This creates and switches to a
-buffer containing image-dired, corresponding to the marked files.
+buffer containing Image-Dired, corresponding to the marked files.
You can also enter Image-Dired directly by typing @kbd{M-x
image-dired}. This prompts for a directory; specify one that has
@@ -1650,20 +1650,21 @@ directory, and displays them all in the thumbnail
buffer. The
thumbnails are generated in the background and are loaded as they
become available.
+@findex image-dired-display-this
+@findex image-dired-display-next
+@findex image-dired-display-previous
With point in the thumbnail buffer, you can type @key{RET}
-(@code{image-dired-display-thumbnail-original-image}) to display the
-image in another window. Use the arrow keys to move around in the
-thumbnail buffer. For easy browsing, use @key{SPC}
-(@code{image-dired-display-next-thumbnail-original}) to advance and
-display the next image. Typing @key{DEL}
-(@code{image-dired-display-previous-thumbnail-original}) backs up to
-the previous thumbnail and displays that instead.
+(@code{image-dired-display-this}) to display the image in another
+window. Use the arrow keys to move around in the thumbnail buffer.
+For easy browsing, use @key{SPC} (@code{image-dired-display-next}) to
+advance and display the next image. Typing @key{DEL}
+(@code{image-dired-display-previous}) backs up to the previous
+thumbnail and displays that instead.
@vindex image-dired-external-viewer
- To view the image in its original size, either provide a prefix
-argument (@kbd{C-u}) before pressing @key{RET}, or type
-@kbd{C-@key{RET}} (@code{image-dired-thumbnail-display-external}) to
-display the image in an external viewer. You must first configure
+ Type @kbd{C-@key{RET}}
+(@code{image-dired-thumbnail-display-external}) to display the image
+in an external viewer. You must first configure
@code{image-dired-external-viewer}.
You can delete images through Image-Dired also. Type @kbd{d}
@@ -1674,9 +1675,9 @@ image from the thumbnail buffer with @kbd{C-d}
More advanced features include @dfn{image tags}, which are metadata
used to categorize image files. The tags are stored in a plain text
-file configured by @code{image-dired-db-file}.
+file configured by @code{image-dired-tags-db-file}.
- To tag image files, mark them in the dired buffer (you can also mark
+ To tag image files, mark them in the Dired buffer (you can also mark
files in Dired from the thumbnail buffer by typing @kbd{m}) and type
@kbd{C-t t} (@code{image-dired-tag-files}). This reads the tag name
in the minibuffer. To mark files having a certain tag, type @kbd{C-t f}
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 b43c966f87..5c81641bf6 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -148,6 +148,7 @@ Important General Concepts
function keys).
* Keys:: Key sequences: what you type to request one
editing action.
+* Mouse Input:: Using the mouse and keypads.
* Commands:: Named functions run by key sequences to do editing.
* Entering Emacs:: Starting Emacs from the shell.
* Exiting:: Stopping or killing Emacs.
@@ -717,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
@@ -852,6 +853,7 @@ Miscellaneous Commands and Features of VC
* VC Delete/Rename:: Deleting and renaming version-controlled files.
* 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.
Customizing VC
@@ -1414,23 +1416,23 @@ USA
@c It's hard to update this fairly.
@c I wonder if it would be better to drop it in favor of AUTHORS?
-Contributors to GNU Emacs include Jari Aalto, Per Abrahamsen, Tomas
+Contributors to GNU Emacs include Jari Aalto, Eric Abrahamsen, Per Abrahamsen,
Tomas
Abrahamsson, Jay K. Adams, Alon Albert, Michael Albinus, Nagy
Andras, Benjamin Andresen, Ralf Angeli, Dmitry Antipov, Joe Arceneaux, Emil
Åström,
Miles Bader, David Bakhash, Juanma Barranquero, Eli Barzilay, Thomas
Baumann, Steven L. Baur, Jay Belanger, Alexander L. Belikoff,
-Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Stephen Berman,
Karl
+Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Stephen Berman,
Jonas Bernoulli, Karl
Berry, Anna M. Bigatti, Ray Blaak, Martin Blais, Jim Blandy, Johan
Bockgård, Jan Böcker, Joel Boehland, Lennart Borgman, Per Bothner,
Terrence Brannon, Frank Bresz, Peter Breton, Emmanuel Briot, Kevin
Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Ken Brown, Stefan
Bruda,
-Daniel Colascione,
+Damien Cassou, Daniel Colascione,
Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl, Tino Calancha,
Bill Carpenter, Per Cederqvist, Hans Chalupsky, Chris Chase, Bob
Chassell, Andrew Choi, Chong Yidong, Sacha Chua, Stewart Clamen, James
-Clark, Mike Clarkson, Glynn Clements, Andrew Cohen, Daniel Colascione,
+Clark, Mike Clarkson, Glynn Clements, Andrea Corallo, Andrew Cohen, Daniel
Colascione,
Christoph Conrad, Ludovic Courtès, Andrew Csillag,
-Toby Cubitt, Baoqiu Cui, Doug Cutting, Mathias Dahl, Julien Danjou, Satyaki
+Toby Cubitt, Baoqiu Cui, Doug Cutting, Mathias Dahl, Yue Daian, Julien Danjou,
Satyaki
Das, Vivek Dasmohapatra, Dan Davison, Michael DeCorte, Gary Delp, Nachum
Dershowitz, Dave Detlefs, Matthieu Devin, Christophe de Dinechin, Eri
Ding, Jan Djärv, Lawrence R. Dodd, Carsten Dominik, Scott Draves,
@@ -1438,36 +1440,36 @@ Benjamin Drieu, Viktor Dukhovni, Jacques Duthen, Dmitry
Dzhus, John
Eaton, Rolf Ebert, Carl Edman, David Edmondson, Paul Eggert, Stephen
Eglen, Christian Egli, Torbjörn Einarsson, Tsugutomo Enami, David
Engster, Hans Henrik Eriksen, Michael Ernst, Ata Etemadi, Frederick
-Farnbach, Oscar Figueiredo, Fred Fish, Steve Fisk, Karl Fogel, Gary
+Farnbach, Oscar Figueiredo, Fred Fish, Steve Fisk, Thomas Fitzsimmons, Karl
Fogel, Gary
Foster, Eric S. Fraga, Romain Francoise, Noah Friedman, Andreas
Fuchs, Shigeru Fukaya, Xue Fuqiao, Hallvard Furuseth, Keith Gabryelski, Peter
S.
Galbraith, Kevin Gallagher, Fabián E. Gallina, Kevin Gallo, Juan León Lahoz
García,
Howard Gayle, Daniel German, Stephen Gildea, Julien Gilles, David
-Gillespie, Bob Glickstein, Deepak Goel, David De La Harpe Golden, Boris
+Gillespie, Bob Glickstein, Nicolas Goaziou, Deepak Goel, David De La Harpe
Golden, Boris
Goldowsky, David Goodger, Chris Gray, Kevin Greiner, Michelangelo Grigni, Odd
Gripenstam, Kai Großjohann, Michael Gschwind, Bastien Guerry, Henry
Guillaume, Dmitry Gutov, Doug Gwyn, Bruno Haible, Ken'ichi Handa, Lars Hansen,
Chris
Hanson, Jesper Harder, Alexandru Harsanyi, K. Shane Hartman, John
Heidemann, Jon K. Hellan, Magnus Henoch, Markus Heritsch, Dirk
-Herrmann, Karl Heuer, Manabu Higashida, Konrad Hinsen, Anders Holst,
-Jeffrey C. Honig, Tassilo Horn, Kurt Hornik, Khaled Hosny, Tom Houlder, Joakim
+Herrmann, Karl Heuer, Manabu Higashida, Konrad Hinsen, Torsten Hilbrich,
Anders Holst,
+Jeffrey C. Honig, Jürgen Hötzel, Tassilo Horn, Kurt Hornik, Khaled Hosny, Tom
Houlder, Joakim
Hove, Denis Howe, Lars Ingebrigtsen, Andrew Innes, Seiichiro Inoue,
Philip Jackson, Martyn Jago, Pavel Janik, Paul Jarc, Ulf Jasper,
Thorsten Jolitz, Michael K. Johnson, Kyle Jones, Terry Jones, Simon
Josefsson, Alexandre Julliard, Arne Jørgensen, Tomoji Kagatani,
-Brewster Kahle, Tokuya Kameshima, Lute Kamstra, Ivan Kanis, David
+Brewster Kahle, Tokuya Kameshima, Lute Kamstra, Stefan Kangas, Ivan Kanis,
David
Kastrup, David Kaufman, Henry Kautz, Taichi Kawabata, Taro Kawagishi,
Howard Kaye, Michael Kifer, Richard King, Peter Kleiweg, Karel
Klíč, Shuhei Kobayashi, Pavel Kobyakov, Larry K. Kolodney, David
M. Koppelman, Koseki Yoshinori, Robert Krawitz, Sebastian Kremer,
-Ryszard Kubiak, Igor Kuzmin, David Kågedal, Daniel LaLiberte, Karl
-Landstrom, Mario Lang, Aaron Larson, James R. Larus, Vinicius Jose
+Ryszard Kubiak, Tak Kunihiro, Igor Kuzmin, David Kågedal, Daniel LaLiberte,
Karl
+Landstrom, Mario Lang, Aaron Larson, James R. Larus, Gemini Lasswell, Vinicius
Jose
Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Christian
Limpach, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link,
Juri Linkov, Francis Litterio, Sergey Litvinov, Leo Liu, Emilio C. Lopes,
-Martin Lorentzon, Dave Love, Eric Ludlam, Károly Lőrentey, Sascha
+Martin Lorentzson, Dave Love, Eric Ludlam, Károly Lőrentey, Sascha
Lüdecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie,
-Christopher J. Madsen, Neil M. Mager, Artur Malabarba, Ken Manheimer, Bill
Mann,
+Christopher J. Madsen, Neil M. Mager, Arni Magnusson, Artur Malabarba, Ken
Manheimer, Bill Mann,
Brian Marick, Simon Marshall, Bengt Martensson, Charlie Martin,
Yukihiro Matsumoto, Tomohiro Matsuyama, David Maus, Thomas May, Will
Mengarini, David
Megginson, Jimmy Aguilar Mena, Stefan Merten, Ben A. Mesander, Wayne Mesard,
Brad
@@ -1483,7 +1485,7 @@ Jeff Peck, Damon Anton Permezel, Tom Perrine, William M.
Perry, Per
Persson, Jens Petersen, Nicolas Petton, Daniel Pfeiffer, Justus Piater,
Richard L.
Pieri, Fred Pierresteguy, François Pinard, Daniel Pittman, Christian
Plaunt, Alexander Pohoyda, David Ponce, Noam Postavsky, Francesco A. Potortì,
-Michael D. Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa, Ashwin
+Michael D. Prange, Mukesh Prasad, Steve Purcell, Ken Raeburn, Marko Rahamaa,
Ashwin
Ram, Eric S. Raymond, Paul Reilly, Edward M. Reingold, David
Reitter, Alex Rezinsky, Rob Riepel, Lara Rios, Adrian Robert, Nick
Roberts, Roland B. Roberts, John Robinson, Denis B. Roegel, Danny
@@ -1497,7 +1499,7 @@ Rainer Schöpf, Raymond Scholz, Eric Schulte, Andreas
Schwab, Randal
Schwartz, Oliver Seidel, Manuel Serrano, Paul Sexton, Hovav Shacham,
Stanislav Shalunov, Marc Shapiro, Richard Sharman, Olin Shivers, Tibor
Šimko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith,
-David Smith, Paul D. Smith, Wilson Snyder, William Sommerfeld, Simon
+David Smith, JD Smith, Paul D. Smith, Wilson Snyder, William Sommerfeld, Simon
South, Andre Spiegel, Michael Staats, Thomas Steffen, Ulf Stegemann,
Reiner Steib, Sam Steingold, Ake Stenhoff, Philipp Stephani, Peter Stephenson,
Ken
Stevens, Andy Stewart, Jonathan Stigelman, Martin Stjernholm, Kim F.
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 5b3b15cd38..1717c5c25b 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -2270,17 +2270,20 @@ behavior by using the options @code{image-auto-resize}
and
@code{image-auto-resize-on-window-resize}.
@findex image-transform-fit-to-window
+@findex image-transform-set-percent
@findex image-transform-set-scale
-@findex image-transform-reset
+@findex image-transform-reset-to-initial
+@findex image-transform-reset-to-original
To resize the image manually you can use the command
@code{image-transform-fit-to-window} bound to @kbd{s w} that fits the
image to both the window height and width. To scale the image to a
percentage of its original size, use the command
-@code{image-transform-set-percent} bound to @kbd{s p}. To scale
-the image specifying a scale factor, use the command
+@code{image-transform-set-percent} bound to @kbd{s p}. To scale the
+image specifying a scale factor, use the command
@code{image-transform-set-scale} bound to @kbd{s s}. To reset all
-transformations to the initial state, use @code{image-transform-reset}
-bound to @kbd{s 0}.
+transformations to the initial state, use
+@code{image-transform-reset-to-initial} bound to @kbd{s 0}, or
+@code{image-transform-reset-to-original} bound to @kbd{s o}.
@findex image-next-file
@findex image-previous-file
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index d78cbffaa7..3ff47c6ffc 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -215,6 +215,10 @@ deactivating the mark. @xref{Shift Selection}.
@vindex mouse-wheel-follow-mouse
@vindex mouse-wheel-scroll-amount
@vindex mouse-wheel-progressive-speed
+@cindex wheel-up, a mouse event
+@cindex wheel-down, a mouse event
+@cindex wheel-left, a mouse event
+@cindex wheel-right, a mouse event
Some mice have a ``wheel'' which can be used for scrolling. Emacs
supports scrolling windows with the mouse wheel, by default, on most
graphical displays. To toggle this feature, use @kbd{M-x
@@ -224,7 +228,11 @@ buffers are scrolled. The variable
@code{mouse-wheel-progressive-speed} determines whether the scroll
speed is linked to how fast you move the wheel. This mode also
supports increasing or decreasing the font size, by default bound to
-scrolling with the @key{Ctrl} modifier.
+scrolling with the @key{Ctrl} modifier. When this mode is enabled,
+mouse wheel produces special events like @code{wheel-up} and
+@code{wheel-down}. (Some older systems report them as @code{mouse-4}
+and @code{mouse-5}.) If the mouse has a horizontal scroll wheel, it
+produces @code{wheel-left} and @code{wheel-right} events as well.
@vindex mouse-wheel-scroll-amount-horizontal
Emacs also supports horizontal scrolling with the @key{Shift}
@@ -644,14 +652,15 @@ resources file to take effect. @xref{Resources}. Do not
quote
font names in X resource files.
@item
-If you are running Emacs on the GNOME desktop, you can tell Emacs to
-use the default system font by setting the variable
+If you are running Emacs on the GNOME desktop or Haiku, you can tell
+Emacs to adjust the frame's default font along with changes to the
+default system font by setting the variable
@code{font-use-system-font} to @code{t} (the default is @code{nil}).
For this to work, Emacs must have been compiled with support for
Gsettings (or the older Gconf). (To be specific, the Gsettings
-configuration names used are
-@samp{org.gnome.desktop.interface monospace-font-name} and
-@samp{org.gnome.desktop.interface font-name}.)
+configuration names used are @samp{org.gnome.desktop.interface
+monospace-font-name} and @samp{org.gnome.desktop.interface
+font-name}.)
@item
Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font
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/help.texi b/doc/emacs/help.texi
index d206dee385..6d9c028b74 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -47,7 +47,7 @@ window displaying the @samp{*Help*} buffer will be reused
instead.
If you are looking for a certain feature, but don't know what it is
called or where to look, we recommend three methods. First, try an
apropos command, then try searching the manual index, then look in the
-FAQ and the package keywords.
+FAQ and the package keywords, and finally try listing external packages.
@table @kbd
@item C-h a @var{topics} @key{RET}
@@ -70,6 +70,9 @@ This displays the Emacs FAQ, using Info.
@item C-h p
This displays the available Emacs packages based on keywords.
@xref{Package Keywords}.
+
+@item M-x list-packages
+This displays a list of external packages. @xref{Packages}.
@end table
@kbd{C-h} or @key{F1} mean ``help'' in various other contexts as
@@ -308,12 +311,11 @@ doc string to display. In that case, if
to load the file in which the function is defined to see whether
there's a doc string there.
-@findex shortdoc-display-group
+@findex shortdoc
You can get an overview of functions relevant for a particular topic
-by using the @kbd{M-x shortdoc-display-group} command. This will
-prompt you for an area of interest, e.g., @code{string}, and pop you
-to a buffer where many of the functions relevant for handling strings
-are listed.
+by using the @kbd{M-x shortdoc} command. This will prompt you for an
+area of interest, e.g., @code{string}, and pop you to a buffer where
+many of the functions relevant for handling strings are listed.
@kindex C-h v
@findex describe-variable
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 60169d8d8c..3e03bd817a 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:
@@ -170,26 +172,12 @@ which it refers to as @dfn{back ends}:
@itemize @bullet
-@cindex SCCS
-@item
-SCCS was the first version control system ever built, and was long ago
-superseded by more advanced ones. VC compensates for certain features
-missing in SCCS (e.g., tag names for releases) by implementing them
-itself. Other VC features, such as multiple branches, are simply
-unavailable. Since SCCS is non-free, we recommend avoiding it.
-
-@cindex CSSC
-@item
-CSSC is a free replacement for SCCS@. You should use CSSC only if, for
-some reason, you cannot use a more recent and better-designed version
-control system.
-
-@cindex RCS
+@cindex git
@item
-RCS is the free version control system around which VC was initially
-built. It is relatively primitive: it cannot be used over the
-network, and works at the level of individual files. Almost
-everything you can do with RCS can be done through VC.
+Git is a decentralized version control system originally invented by
+Linus Torvalds to support development of Linux (his kernel). VC
+supports many common Git operations, but others, such as repository
+syncing, must be done from the command line.
@cindex CVS
@item
@@ -208,12 +196,26 @@ similar to CVS but without its problems (e.g., it
supports atomic
commits of filesets, and versioning of directories, symbolic links,
meta-data, renames, copies, and deletes).
-@cindex git
+@cindex SCCS
@item
-Git is a decentralized version control system originally invented by
-Linus Torvalds to support development of Linux (his kernel). VC
-supports many common Git operations, but others, such as repository
-syncing, must be done from the command line.
+SCCS was the first version control system ever built, and was long ago
+superseded by more advanced ones. VC compensates for certain features
+missing in SCCS (e.g., tag names for releases) by implementing them
+itself. Other VC features, such as multiple branches, are simply
+unavailable. Since SCCS is non-free, we recommend avoiding it.
+
+@cindex CSSC
+@item
+CSSC is a free replacement for SCCS@. You should use CSSC only if, for
+some reason, you cannot use a more recent and better-designed version
+control system.
+
+@cindex RCS
+@item
+RCS is the free version control system around which VC was initially
+built. It is relatively primitive: it cannot be used over the
+network, and works at the level of individual files. Almost
+everything you can do with RCS can be done through VC.
@cindex hg
@cindex Mercurial
@@ -690,11 +692,15 @@ started editing (@pxref{Old Revisions}), type @kbd{C-c
C-d}
@kindex C-c C-w @r{(Log Edit mode)}
@findex log-edit-generate-changelog-from-diff
+@vindex diff-add-log-use-relative-names
To help generate ChangeLog entries, type @kbd{C-c C-w}
(@code{log-edit-generate-changelog-from-diff}), to generate skeleton
ChangeLog entries, listing all changed file and function names based
on the diff of the VC fileset. Consecutive entries left empty will be
-combined by @kbd{C-q} (@code{fill-paragraph}).
+combined by @kbd{C-q} (@code{fill-paragraph}). By default the
+skeleton will just include the file name, without any leading
+directories. If you wish to prepend the leading directories up to the
+VC root, customize @code{diff-add-log-use-relative-names}.
@kindex C-c C-a @r{(Log Edit mode)}
@findex log-edit-insert-changelog
@@ -897,7 +903,14 @@ is non-@code{nil}, the colors expressing the age of each
line are
applied to the background color, leaving the foreground at its default
color.
- When you give a prefix argument to this command, Emacs reads two
+@vindex vc-annotate-switches
+ You can customize the @code{annotate} options that @kbd{C-x v g}
+uses by customizing @code{vc-@var{backend}-annotate-switches} and
+@code{vc-annotate-switches}. They function similarly to
+@code{vc-@var{backend}-diff-switches} and @code{vc-diff-switches},
+described above.
+
+ When you give a prefix argument to @kbd{C-x v g}, Emacs reads two
arguments using the minibuffer: the revision to display and annotate
(instead of the current file contents), and the time span in days the
color range should cover.
@@ -1030,13 +1043,14 @@ revision at point. A second @key{RET} hides it again.
(@code{vc-log-incoming}) command displays a log buffer showing the
changes that will be applied, the next time you run the version
control system's pull command to get new revisions from another
-repository (@pxref{Pulling / Pushing}). This other repository is the default
+remote location (@pxref{Pulling / Pushing}). This other remote location is
the default
one from which changes are pulled, as defined by the version control
system; with a prefix argument, @code{vc-log-incoming} prompts for a
-specific repository. Similarly, @kbd{C-x v O}
+specific remote location. Similarly, @kbd{C-x v O}
(@code{vc-log-outgoing}) shows the changes that will be sent to
-another repository, the next time you run the push command; with a
-prefix argument, it prompts for a specific destination repository.
+another remote location, the next time you run the push command; with a
+prefix argument, it prompts for a specific destination that
+in case of some version control system can be a branch name.
@cindex VC log buffer, commands in
@cindex vc-log buffer
@@ -1394,18 +1408,19 @@ Apart from acting on multiple files, these commands
behave much like
their single-buffer counterparts (@pxref{Search}).
The VC Directory buffer additionally defines some branch-related
-commands starting with the prefix @kbd{B}:
+commands starting with the prefix @kbd{b}:
@table @kbd
-@item B c
-Create a new branch (@code{vc-create-tag}).
+@item b c
+Create a new branch (@code{vc-create-branch}). @xref{Creating
+Branches}.
-@item B l
+@item b l
Prompt for the name of a branch and display the change history of that
branch (@code{vc-print-branch-log}).
-@item B s
-Switch to a branch (@code{vc-retrieve-tag}). @xref{Switching
+@item b s
+Switch to a branch (@code{vc-switch-branch}). @xref{Switching
Branches}.
@item d
@@ -1469,7 +1484,7 @@ Mercurial, command @kbd{hg update} is used to switch to
another
branch.
The VC command to switch to another branch in the current directory
-is @kbd{C-x v r @var{branch-name} @key{RET}} (@code{vc-retrieve-tag}).
+is @kbd{C-x v b s @var{branch-name} @key{RET}} (@code{vc-switch-branch}).
On centralized version control systems, you can also switch between
branches by typing @kbd{C-u C-x v v} in an up-to-date work file
@@ -1619,8 +1634,8 @@ if the current revision is 2.5, the branch ID should be
2.5.1, 2.5.2,
and so on, depending on the number of existing branches at that point.
This procedure will not work for distributed version control systems
-like git or Mercurial. For those systems you should use the prefix
-argument to @code{vc-create-tag} (@kbd{C-u C-x v s}) instead.
+like git or Mercurial. For those systems you should use the command
+@code{vc-create-branch} (@kbd{C-x v b c}) instead.
To create a new branch at an older revision (one that is no longer
the head of a branch), first select that revision (@pxref{Switching
@@ -2081,6 +2096,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
@@ -2289,7 +2311,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
@@ -2323,7 +2347,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.
@@ -2369,16 +2394,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
@@ -3271,7 +3298,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 ad25ed6a8a..db96093a17 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -8,26 +8,29 @@
@cindex setting a mark
@cindex region
- Many Emacs commands operate on an arbitrary contiguous part of the
-current buffer. To specify the text for such a command to operate on,
-you set @dfn{the mark} at one end of it, and move point to the other
-end. The text between point and the mark is called @dfn{the region}.
-The region always extends between point and the mark, no matter which
-one comes earlier in the text; each time you move point, the region
-changes.
+ Emacs, like many other applications, lets you select some arbitrary
+part of the buffer text and invoke commands that operate on such
+@dfn{selected text}. In Emacs, we call the selected text @dfn{the
+region}; its handling is very similar to that of selected text in
+other programs, but there are also important differences.
@cindex active region
@cindex activating the mark
- Setting the mark at a position in the text also @dfn{activates} it.
-When the mark is active, we say also that the region is active; Emacs
+ The region is the portion of the buffer between @dfn{the mark} and
+the current @dfn{point}. You define a region by setting the mark
+somewhere (with, for instance, the @kbd{C-SPC} command), and then
+moving point to where you want the region to end. (Or you can use the
+mouse to define a region.)
+
+ The region always extends between point and the mark, no matter
+which of them comes earlier in the text; each time you move point, the
+region changes.
+
+ Setting the mark at a position in the text @dfn{activates} it. When
+the mark is active, we say also that the region is active; Emacs
indicates its extent by highlighting the text within it, using the
@code{region} face (@pxref{Face Customization}).
-This is one of the few faces that has the @code{:extend t} attribute
-by default, which implies that the same face is used to highlight the
-text and space between end of line and the window border. To
-highlight only the text you could set this attribute to @code{nil}.
-
@cindex deactivating the mark
After certain non-motion commands, including any command that
changes the text in the buffer, Emacs automatically @dfn{deactivates}
@@ -35,6 +38,18 @@ the mark; this turns off the highlighting. You can also
explicitly
deactivate the mark at any time, by typing @kbd{C-g}
(@pxref{Quitting}).
+ Many commands limit the text on which they operate to the active
+region. For instance, the @kbd{M-%} command (which replaces matching
+text) normally works on the entire accessible portion of the buffer,
+but if you have an active region, it'll work only on that region
+instead.
+
+ The mark is useful even if it is not active. For example, you can
+move to previous mark locations using the mark ring. @xref{Mark
+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.
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index e71d653210..90e50a41d5 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -58,12 +58,8 @@ the default argument is shown with the user option
Emacs hides the default argument as soon as you modify the contents of
the minibuffer (since typing @key{RET} would no longer submit that
default). If you ever bring back the original minibuffer text, the
-prompt again shows the default. Furthermore, if you change the
-variable @code{minibuffer-eldef-shorten-default} to a non-@code{nil}
-value, the default argument is displayed as @samp{[@var{default-arg}]}
-instead of @samp{(default @var{default-arg})}, saving some screen
-space. To enable this minor mode, type @kbd{M-x
-minibuffer-electric-default-mode}.
+prompt again shows the default. To enable this minor mode, type
+@kbd{M-x minibuffer-electric-default-mode}.
Since the minibuffer appears in the echo area, it can conflict with
other uses of the echo area. If an error message or an informative
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index da1b87b48b..29c0bed19c 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -162,12 +162,12 @@ List killed groups (@code{gnus-group-list-killed}).
List zombie groups (@code{gnus-group-list-zombies}).
@kindex u @r{(Gnus Group mode)}
-@findex gnus-group-toggle-subscription
+@findex gnus-group-toggle-subscription-at-point
@cindex subscribe groups
@cindex unsubscribe groups
@item u
Toggle the subscription status of the group
-(@code{gnus-group-toggle-subscription}) on the current line.
+(@code{gnus-group-toggle-subscription-at-point}) on the current line.
Invoking this on a killed or zombie group turns it into an
unsubscribed group.
@@ -245,7 +245,7 @@ buffer and typed @kbd{C-s} (@pxref{Incremental Search}).
@kindex M-s M-s @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-forward
-@item M-s @var{regexp} @key{RET}
+@item M-s M-s @var{regexp} @key{RET}
Search forward for articles containing a match for @var{regexp}
(@code{gnus-summary-search-article-forward}).
@@ -584,6 +584,18 @@ you instead want the image to be re-rendered at the new
size, set
default size for DocView, customize the variable
@code{doc-view-resolution}.
+@vindex doc-view-imenu-enabled
+@vindex doc-view-imenu-flatten
+@vindex doc-view-imenu-format
+ When the @command{mutool} program is available, DocView will use it
+to generate entries for an outline menu, making it accessible via the
+@code{imenu} facility (@pxref{Imenu}). To disable this functionality
+even when @command{mutool} can be found on your system, customize the
+variable @code{doc-view-imenu-enabled} to the @code{nil} value. You
+can further customize how @code{imenu} items are formatted and
+displayed using the variables @code{doc-view-imenu-format} and
+@code{doc-view-flatten}.
+
@node DocView Searching
@subsection DocView Searching
@@ -936,7 +948,7 @@ Coding}.
@cindex @env{INSIDE_EMACS} environment variable
Emacs sets the environment variable @env{INSIDE_EMACS} in the
subshell to @samp{@var{version},comint}, where @var{version} is the
-Emacs version (e.g., @samp{24.1}). Programs can check this variable
+Emacs version (e.g., @samp{28.1}). Programs can check this variable
to determine whether they are running inside an Emacs subshell.
@node Shell Mode
@@ -1528,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
@@ -2089,7 +2101,14 @@ all server buffers are finished. You can take as long
as you like to
edit the server buffers within Emacs, and they are @emph{not} killed
when you type @kbd{C-x #} in them.
-@item --parent-id @var{id}
+@item -w
+@itemx --timeout=@var{N}
+Wait for a response from Emacs for @var{N} seconds before giving up.
+If there is no response within that time, @command{emacsclient} will
+display a warning and exit. The default is @samp{0}, which means to
+wait forever.
+
+@item --parent-id=@var{id}
Open an @command{emacsclient} frame as a client frame in the parent X
window with id @var{id}, via the XEmbed protocol. Currently, this
option is mainly useful for developers.
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index c348130807..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)
@@ -454,6 +454,13 @@ only @emph{after} @code{auto-mode-alist}. By default,
files, HTML/XML/SGML files, PostScript files, and Unix style Conf
files.
+@vindex major-mode-remap-alist
+ Once a major mode is found, Emacs does a final check to see if the
+mode has been remapped by @code{major-mode-remap-alist}, in which case
+it uses the remapped mode instead. This is used when several
+different major modes can be used for the same file type, so you can
+specify which mode you prefer.
+
@findex normal-mode
If you have changed the major mode of a buffer, you can return to
the major mode Emacs would have chosen automatically, by typing
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 5f30341838..1bbd7440f3 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -61,7 +61,7 @@ can also be input by using the @kbd{C-x 8} prefix, see
@ref{Unibyte Mode}.
With the X Window System, your locale should be set to an appropriate
value to make sure Emacs interprets keyboard input correctly; see
-@ref{Language Environments, locales}.
+@ref{Language Environments, locales}, and @ref{X Coding}.
@end itemize
The rest of this chapter describes these issues in detail.
@@ -79,6 +79,7 @@ value to make sure Emacs interprets keyboard input correctly;
see
* Text Coding:: Choosing conversion to use for file text.
* Communication Coding:: Coding systems for interprocess communication.
* File Name Coding:: Coding systems for file @emph{names}.
+* X Coding:: Coding systems for X input methods.
* Terminal Coding:: Specifying coding systems for converting
terminal input and output.
* Fontsets:: Fontsets are collections of fonts
@@ -1241,15 +1242,14 @@ current language environment.
The variable @code{locale-coding-system} specifies a coding system
to use when encoding and decoding system strings such as system error
messages and @code{format-time-string} formats and time stamps. That
-coding system is also used for decoding non-@acronym{ASCII} keyboard
-input on the X Window System and for encoding text sent to the
-standard output and error streams when in batch mode. You should
-choose a coding system that is compatible
-with the underlying system's text representation, which is normally
-specified by one of the environment variables @env{LC_ALL},
-@env{LC_CTYPE}, and @env{LANG}. (The first one, in the order
-specified above, whose value is nonempty is the one that determines
-the text representation.)
+coding system might also be used for decoding non-@acronym{ASCII}
+keyboard input on the X Window System and will also be used to encode
+text sent to the standard output and error streams in batch mode. You
+should choose a coding system that is compatible with the underlying
+system's text representation, which is normally specified by one of
+the environment variables @env{LC_ALL}, @env{LC_CTYPE}, and
+@env{LANG}. (The first one, in the order specified above, whose value
+is nonempty is the one that determines the text representation.)
@node File Name Coding
@section Coding Systems for File Names
@@ -1311,6 +1311,26 @@ C-w} to specify a new file name for that buffer.
system. This prompts for an existing file name, its old coding
system, and the coding system to which you wish to convert.
+@node X Coding
+@section Coding Systems for X Keyboard Input
+@cindex X input method coding systems
+ Input methods under the X Window System specify their own coding
+systems that must be used to decode keyboard input. By default, Emacs
+determines the coding system used for each input method automatically
+upon establishing the connection to the input method server, and uses
+that specific coding system to decode keyboard input. However, that
+determination can sometimes fail; in that situation, the locale coding
+system (@pxref{Communication Coding}) is used instead.
+
+@cindex X input method coding systems, overriding
+@vindex x-input-coding-system
+ If the input method does not correctly announce the coding system it
+uses to encode text, then the coding system used by Emacs to decode
+text from input methods must be manually specified. The value of the
+variable @code{x-input-coding-system}, when set to a symbol, is
+unconditionally used as the coding system used to decode keyboard
+input from input methods.
+
@node Terminal Coding
@section Coding Systems for Terminal I/O
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 7e16c82cf5..420da09097 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -421,13 +421,13 @@ lower-priority archives will not be shown in the menu, if
the same
package is available from a higher-priority archive. (This is
controlled by the value of @code{package-menu-hide-low-priority}.)
- Once a package is downloaded and installed, it is made available to
-the current Emacs session. Making a package available adds its
-directory to @code{load-path} and loads its autoloads. The effect of
-a package's autoloads varies from package to package. Most packages
-just make some new commands available, while others have more
-wide-ranging effects on the Emacs session. For such information,
-consult the package's help buffer.
+ Once a package is downloaded, byte-compiled and installed, it is
+made available to the current Emacs session. Making a package
+available adds its directory to @code{load-path} and loads its
+autoloads. The effect of a package's autoloads varies from package to
+package. Most packages just make some new commands available, while
+others have more wide-ranging effects on the Emacs session. For such
+information, consult the package's help buffer.
Installed packages are automatically made available by Emacs in all
subsequent sessions. This happens at startup, before processing the
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 795aabee74..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}).
@@ -508,9 +515,9 @@ Reindent each line in the balanced expression that follows
point
about invalid syntax.
@item @key{TAB}
-@findex c-indent-command
-Reindent the current line, and/or in some cases insert a tab character
-(@code{c-indent-command}).
+@findex c-indent-line-or-region
+Reindent the current line, active region, or block starting on this
+line (@code{c-indent-line-or-region}).
@vindex c-tab-always-indent
If @code{c-tab-always-indent} is @code{t}, this command always reindents
@@ -834,10 +841,16 @@ of automatic matching. Whenever point is before an
opening delimiter
or after a closing delimiter, the delimiter, its matching delimiter,
and optionally the text between them are highlighted. To toggle Show
Paren mode globally, type @kbd{M-x show-paren-mode}. To toggle it
-only in the current buffer, type @kbd{M-x show-paren-local-mode}. To
-customize it, type @w{@kbd{M-x customize-group @key{RET} paren-showing}}.
-The customizable options which control the operation of this mode
-include:
+only in the current buffer, type @kbd{M-x show-paren-local-mode}.
+
+@vindex show-paren-predicate
+ By default, this mode is switched on in all buffers that are meant
+for editing, but is not enabled in buffers that show data. This is
+controlled by the @code{show-paren-predicate} user option.
+
+ To customize the mode, type @w{@kbd{M-x customize-group @key{RET}
+paren-showing}}. The customizable options which control the operation
+of this mode include:
@itemize @bullet
@item
@@ -979,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.
@@ -1074,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.
@@ -1184,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
@@ -1285,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})
@@ -1294,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
@@ -1359,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
@@ -1376,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}).
@@ -1416,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/regs.texi b/doc/emacs/regs.texi
index fb93601879..ef9187bb9a 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -381,7 +381,8 @@ jump to the bookmark.
@code{bookmark-jump} can find the proper position even if the file is
modified slightly. The variable @code{bookmark-search-size} says how
many characters of context to record on each side of the bookmark's
-position.
+position. (In buffers that are visiting encrypted files, no context
+is saved in the bookmarks file no matter the value of this variable.)
Here are some additional commands for working with bookmarks:
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index fa8eaf0924..0f1c4da0c6 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -998,10 +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.
+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
@@ -1509,15 +1513,15 @@ etc.
@subsection Org as an authoring system
@cindex Org exporting
-@findex org-export
+@findex org-export-dispatch
@kindex C-c C-e @r{(Org mode)}
You may want to format your Org notes nicely and to prepare them for
export and publication. To export the current buffer, type @kbd{C-c
-C-e} (@code{org-export}) anywhere in an Org buffer. This command
-prompts for an export format; currently supported formats include
-HTML, @LaTeX{}, Texinfo, OpenDocument (@file{.odt}), iCalendar,
-Markdown, man-page, and PDF@. Some formats, such as PDF, require
-certain system tools to be installed.
+C-e} (@code{org-export-dispatch}) anywhere in an Org buffer. This
+command prompts for an export format; currently supported formats
+include HTML, @LaTeX{}, Texinfo, OpenDocument (@file{.odt}),
+iCalendar, Markdown, man-page, and PDF@. Some formats, such as PDF,
+require certain system tools to be installed.
@vindex org-publish-project-alist
To export several files at once to a specific directory, either
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 3ccad50715..23d5f50432 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -15,6 +15,8 @@
* VC Delete/Rename:: Deleting and renaming version-controlled files.
* 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
@@ -263,6 +265,55 @@ elements of the form @code{(@var{regexp} . @var{format})}.
Whenever
part of the version header. A @samp{%s} in @var{format} is replaced
with the file's version control type.
+@node Editing VC Commands
+@subsubsection Editing VC Commands
+
+@findex vc-edit-next-command
+@kindex C-x v !
+You can use the @kbd{C-x v !} (@code{vc-edit-next-command}) prefix
+command to edit the shell command line that VC is about to run. This
+is primarily intended to make it possible to add optional command-line
+arguments to VCS commands without unnecessary complications of the VC
+command set and its interfaces with the backend.
+
+For example, Git can produce logs of more than one branch, but
+@kbd{C-x v b l} (@code{vc-print-branch-log}) prompts for the name of
+just one branch. To obtain a log of more than one branch, you can
+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/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index 47a5a870fd..df8fa2f8e7 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -10100,9 +10100,8 @@ resources; as it happens, methods that people find
easy---that are
frugal of mental resources---sometimes use considerable computer
resources. Emacs was designed to run on machines that we now consider
limited and its default settings are conservative. You may want to
-increase the values of @code{max-specpdl-size} and
-@code{max-lisp-eval-depth}. In my @file{.emacs} file, I set them to
-15 and 30 times their default value.}.
+increase the value of @code{max-lisp-eval-depth}. In my @file{.emacs}
+file, I set it to 30 times its default value.}.
@menu
* while:: Causing a stretch of code to repeat.
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 60fc11a22e..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.
@@ -973,6 +981,24 @@ whether native-compilation is available should use this
predicate.
This section documents the variables that control
native-compilation.
+@defvar inhibit-automatic-native-compilation
+If your Emacs has support for native compilation, Emacs will (by
+default) compile the Lisp files you're loading in the background, and
+then install the native-compiled versions of the functions. If you
+wish to disable this, you can set this variable to non-@code{nil}. If
+you want to set it permanently, this should probably be done from the
+early init file, since setting it in the normal init file is probably
+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 your cache directory.
+
+You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION}
+environment variable to disable native compilation.
+@end defvar
+
@defopt native-comp-speed
This variable specifies the optimization level for native compilation.
Its value should be a number between @minus{}1 and 3. Values between
@@ -1051,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 d4520ebdee..9035e7f6bb 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -294,6 +294,48 @@ For example:
@end group
@end example
+It can be convenient to bind variables in conjunction with using a
+conditional. It's often the case that you compute a value, and then
+want to do something with that value if it's non-@code{nil}. The
+straightforward way to do that is to just write, for instance:
+
+@example
+(let ((result1 (do-computation)))
+ (when result1
+ (let ((result2 (do-more result1)))
+ (when result2
+ (do-something result2)))))
+@end example
+
+Since this is a very common pattern, Emacs provides a number of macros
+to make this easier and more readable. The above can be written the
+following way instead:
+
+@example
+(when-let ((result1 (do-computation))
+ (result2 (do-more result1)))
+ (do-something result2))
+@end example
+
+There's a number of variations on this theme, and they're briefly
+described below.
+
+@defmac if-let spec then-form else-forms...
+Evaluate each binding in @var{spec} in turn, like in @code{let*}
+(@pxref{Local Variables}, stopping if a binding value is @code{nil}.
+If all are non-@code{nil}, return the value of @var{then-form},
+otherwise the last form in @var{else-forms}.
+@end defmac
+
+@defmac when-let spec then-forms...
+Like @code{if-let}, but without @var{else-forms}.
+@end defmac
+
+@defmac while-let spec then-forms...
+Like @code{when-let}, but repeat until a binding in @var{spec} is
+@code{nil}. The return value is always @code{nil}.
+@end defmac
+
@node Combining Conditions
@section Constructs for Combining Conditions
@cindex combining conditions
@@ -2366,11 +2408,6 @@ of the @var{cleanup-forms} themselves exits nonlocally
(via a
guaranteed to evaluate the rest of them. If the failure of one of the
@var{cleanup-forms} has the potential to cause trouble, then protect
it with another @code{unwind-protect} around that form.
-
-The number of currently active @code{unwind-protect} forms counts,
-together with the number of local variable bindings, against the limit
-@code{max-specpdl-size} (@pxref{Definition of max-specpdl-size,, Local
-Variables}).
@end defspec
For example, here we make an invisible buffer for temporary use, and
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 d336cda674..c75107fb58 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},
@@ -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.
@@ -2623,14 +2623,17 @@ Draw a box with lines of width 1, in the foreground
color.
Draw a box with lines of width 1, in color @var{color}.
@item @code{(:line-width (@var{vwidth} . @var{hwidth}) :color @var{color}
:style @var{style})}
-This way you can explicitly specify all aspects of the box. The values
-@var{vwidth} and @var{hwidth} specifies respectively the width of the
-vertical and horizontal lines to draw; they default to (1 . 1).
-A negative horizontal or vertical width @minus{}@var{n} means to draw a line
-of width @var{n} that occupies the space of the underlying text, thus
-avoiding any increase in the character height or width. For simplification
-the width could be specified with only a single number @var{n} instead
-of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
+You can explicitly specify all aspects of the box with a plist on this
+form. Any element in this plist can be omitted.
+
+The values @var{vwidth} and @var{hwidth} specifies respectively the
+width of the vertical and horizontal lines to draw; they default to (1
+. 1). A negative horizontal or vertical width @minus{}@var{n} means
+to draw a line of width @var{n} that occupies the space of the
+underlying text, thus avoiding any increase in the character height or
+width. For simplification the width could be specified with only a
+single number @var{n} instead of a list, such case is equivalent to
+@code{((abs @var{n}) . @var{n})}.
The value @var{style} specifies whether to draw a 3D box. If it is
@code{released-button}, the box looks like a 3D button that is not
@@ -5643,10 +5646,9 @@ Every image descriptor must include this property.
@item :file @var{file}
This says to load the image from file @var{file}. If @var{file} is
-not an absolute file name, it is expanded relative to the
-@file{images} subdirectory of @code{data-directory}, and failing that,
-relative to the directories listed by @code{x-bitmap-file-path}
-(@pxref{Face Attributes}).
+not an absolute file name, it is expanded relative to each of the
+directories mentioned by @code{image-load-path} (@pxref{Defining
+Images}).
@item :data @var{data}
This specifies the raw image data. Each image descriptor must have
@@ -5886,6 +5888,14 @@ When you click the mouse when the mouse pointer is over
a hot-spot, an
event is composed by combining the @var{id} of the hot-spot with the
mouse event; for instance, @code{[area4 mouse-1]} if the hot-spot's
@var{id} is @code{area4}.
+
+Note that the map's coordinates should reflect the displayed image
+after all transforms have been done (rotation, scaling and so on), and
+also note that Emacs (by default) performs auto-scaling of images, so
+to make things match up, you should either specify @code{:scale 1.0}
+when creating the image, or use the result of
+@code{image-compute-scaling-factor} to compute the elements of the
+map.
@end table
@defun image-mask-p spec &optional frame
@@ -6585,7 +6595,9 @@ Image type @code{webp}.
This function creates and returns an image descriptor which uses the
data in @var{file-or-data}. @var{file-or-data} can be a file name or
a string containing the image data; @var{data-p} should be @code{nil}
-for the former case, non-@code{nil} for the latter case.
+for the former case, non-@code{nil} for the latter case. If
+@var{file-or-data} is a relative file name, the function will search
+for it in directories mentioned in @code{image-load-path}.
The optional argument @var{type} is a symbol specifying the image type.
If @var{type} is omitted or @code{nil}, @code{create-image} tries to
@@ -6838,22 +6850,37 @@ keymap installed in the text properties (or overlays)
that span the
displayed image. This keymap defines the following commands:
@table @kbd
-@item +
+@item i +
Increase the image size (@code{image-increase-size}). A prefix value
of @samp{4} means to increase the size by 40%. The default is 20%.
-@item -
+@item i -
Decrease the image size (@code{image-increase-size}). A prefix value
of @samp{4} means to decrease the size by 40%. The default is 20%.
-@item r
+@item i r
Rotate the image by 90 degrees clockwise (@code{image-rotate}).
A prefix means to rotate by 90 degrees counter-clockwise instead.
-@item o
+@item i h
+Flip the image horizontally (@code{image-flip-horizontally}).
+
+@item i v
+Flip the image vertically (@code{image-flip-vertically}).
+
+@item i o
Save the image to a file (@code{image-save}).
+
+@item i c
+Crop the image interactively (@code{image-crop}).
+
+@item i x
+Cut a rectangle from the image interactively (@code{image-cut}).
@end table
+The size and rotation commands are ``repeating'', which means that you
+can continue adjusting the image without using the @kbd{i} prefix.
+
@node Multi-Frame Images
@subsection Multi-Frame Images
@cindex multi-frame images
@@ -7320,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
@@ -7330,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
@@ -8531,7 +8558,11 @@ hexadecimal notation.
@item an @acronym{ASCII} string
Display a box containing that string. The string should contain at
-most 6 @acronym{ASCII} characters.
+most 6 @acronym{ASCII} characters. As an exception, if the string
+includes just one character, on text-mode terminals that character
+will be displayed without a box; this allows to handle such
+``acronyms'' as a replacement character for characters that cannot be
+displayed by the terminal.
@item a cons cell @code{(@var{graphical} . @var{text})}
Display with @var{graphical} on graphical displays, and with
@@ -8539,6 +8570,7 @@ Display with @var{graphical} on graphical displays, and
with
must be one of the display methods described above.
@end table
+@vindex glyphless-char@r{ face}
@noindent
The @code{thin-space}, @code{empty-box}, @code{hex-code}, and
@acronym{ASCII} string display methods are drawn with the
@@ -8548,7 +8580,7 @@ square brackets, @samp{[]}.
The char-table has one extra slot, which determines how to display any
character that cannot be displayed with any available font, or cannot
be encoded by the terminal's coding system. Its value should be one
-of the above display methods, except @code{zero-width} or a cons cell.
+of the above display methods, except @code{zero-width}.
If a character has a non-@code{nil} entry in an active display table,
the display table takes effect; in this case, Emacs does not consult
@@ -8603,7 +8635,8 @@ codepoints (typically emojis).
@item no-font
Characters for which there is no suitable font, or which cannot be
-encoded by the terminal's coding system.
+encoded by the terminal's coding system, or those for which the
+text-mode terminal has no glyphs.
@end table
@c FIXME: this can also be 'acronym', but that's not currently
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 56f7b7bdfa..6a51489d8a 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1032,9 +1032,8 @@ program.
@itemize @bullet
@item
@vindex edebug-max-depth
-@code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size}
-(@pxref{Local Variables}) are both increased to reduce Edebug's impact
-on the stack. You could, however, still run out of stack space when
+@code{max-lisp-eval-depth} (@pxref{Eval}) is increased to reduce Edebug's
+impact on the stack. You could, however, still run out of stack space when
using Edebug. You can also enlarge the value of
@code{edebug-max-depth} if Edebug reaches the limit of recursion depth
instrumenting code that contains very large quoted lists.
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index ed3cf56e09..11c321b32e 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -830,7 +830,7 @@ This variable defines the maximum depth allowed in calls to
@code{eval},
@code{apply}, and @code{funcall} before an error is signaled (with error
message @code{"Lisp nesting exceeds max-lisp-eval-depth"}).
-This limit, with the associated error when it is exceeded, is one way
+This limit, with the associated error when it is exceeded, is how
Emacs Lisp avoids infinite recursion on an ill-defined function. If
you increase the value of @code{max-lisp-eval-depth} too much, such
code can cause stack overflow instead. On some systems, this overflow
@@ -846,14 +846,11 @@ The depth limit counts internal uses of @code{eval},
@code{apply}, and
expressions, and recursive evaluation of function call arguments and
function body forms, as well as explicit calls in Lisp code.
-The default value of this variable is 800. If you set it to a value
+The default value of this variable is 1600. If you set it to a value
less than 100, Lisp will reset it to 100 if the given value is
reached. Entry to the Lisp debugger increases the value, if there is
little room left, to make sure the debugger itself has room to
execute.
-
-@code{max-specpdl-size} provides another limit on nesting.
-@xref{Definition of max-specpdl-size,, Local Variables}.
@end defopt
@defvar values
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 986fb22c75..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
@@ -2445,7 +2440,7 @@ You can use this function for directory names and for
file names,
because it recognizes abbreviations even as part of the name.
@end defun
-@defun file-parent-directory filename
+@defun file-name-parent-directory filename
This function returns the directory name of the parent directory of
@var{filename}. If @var{filename} is at the root directory of the
filesystem, it returns @code{nil}. A relative @var{filename} is
@@ -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 262b86672d..b3f1a29ae8 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -407,7 +407,7 @@ Name of the physical monitor as @var{string}.
@item source
Source of the multi-monitor information as @var{string};
-e.g., @samp{XRandr} or @samp{Xinerama}.
+e.g., @samp{XRandR 1.5}, @samp{XRandr} or @samp{Xinerama}.
@end table
@var{x}, @var{y}, @var{width}, and @var{height} are integers.
@@ -2997,17 +2997,25 @@ explicit focus notifications.)
@end defun
@defvar after-focus-change-function
-This function is an extension point that code can use to receive a
-notification that focus has changed.
-
-This function is called with no arguments when Emacs notices that the
-set of focused frames may have changed. Code wanting to do something
-when frame focus changes should use @code{add-function} to add a
-function to this one, and in this added function, re-scan the set of
-focused frames, calling @code{frame-focus-state} to retrieve the last
-known focus state of each frame. Focus events are delivered
-asynchronously, and frame input focus according to an external system
-may not correspond to the notion of the Emacs selected frame.
+This function is called with no arguments when Emacs notices that a
+frame may have gotten or lost focus. Focus events are delivered
+asynchronously, and may not be delivered in the expected order, so
+code that wants to do something depending on the state of focused
+frames have go through all the frames and check.
+
+For instance, here's a simple example function that sets the
+background color based on whether the frame has focus or not:
+
+@lisp
+(add-function :after after-focus-change-function
+ #'my-change-background)
+(defun my-change-background ()
+ (dolist (frame (frame-list))
+ (pcase (frame-focus-state frame)
+ (`t (set-face-background 'default "black" frame))
+ (`nil (set-face-background 'default "#404040" frame)))))
+@end lisp
+
Multiple frames may appear to have input focus simultaneously due to
focus event delivery differences, the presence of multiple Emacs
terminals, and other factors, and code should be robust in the face of
@@ -4050,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 983dfe2ec5..7ffde7d43d 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
@@ -2476,11 +2514,12 @@ function, of the form @code{(@var{function}
@var{args}@dots{})}, the macro
expander will call @var{expander} with that form as well as with
@var{args}@dots{}, and @var{expander} can either return a new expression to use
instead of the function call, or it can return just the form unchanged,
-to indicate that the function call should be left alone. @var{expander} can
-be a symbol, or it can be a form @code{(lambda (@var{arg}) @var{body})} in
-which case @var{arg} will hold the original function call expression, and the
-(unevaluated) arguments to the function can be accessed using the function's
-formal arguments.
+to indicate that the function call should be left alone.
+
+When @var{expander} is a lambda form it should be written with
+a single argument (i.e., be of the form @code{(lambda (@var{arg})
+@var{body})}) because the function's formal arguments are
+automatically added to the lambda's list of arguments for you.
@item (gv-expander @var{expander})
Declare @var{expander} to be the function to handle calls to the macro (or
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 463039c5a0..65ad5f0554 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -374,25 +374,6 @@ as link in the @file{*Help*} buffer.
@strong{Please note:} Each @samp{\} must be doubled when written in a
string in Emacs Lisp.
-@defopt text-quoting-style
-@cindex curved quotes
-@cindex curly quotes
-The value of this variable is a symbol that specifies the style Emacs
-should use for single quotes in the wording of help and messages. If
-the variable's value is @code{curve}, the style is @t{‘like this’}
-with curved single quotes. If the value is @code{straight}, the style
-is @t{'like this'} with straight apostrophes. If the value is
-@code{grave}, quotes are not translated and the style is @t{`like
-this'} with grave accent and apostrophe, the standard style before
-Emacs version 25. The default value @code{nil} acts like @code{curve}
-if curved single quotes seem to be displayable, and like @code{grave}
-otherwise.
-
-This option is useful on platforms that have problems with curved
-quotes. You can customize it freely according to your personal
-preference.
-@end defopt
-
@defun substitute-command-keys string &optional no-face include-menus
@vindex help-key-binding@r{ (face)}
This function scans @var{string} for the above special sequences and
@@ -403,6 +384,11 @@ given a special face @code{help-key-binding}, but if the
optional
argument @var{no-face} is non-@code{nil}, the function doesn't add
this face to the produced string.
+@defun substitute-quotes string
+This function works like @code{substitute-command-keys}, but only
+replaces quote characters.
+@end defun
+
@cindex advertised binding
If a command has multiple bindings, this function normally uses the
first one it finds. You can specify one particular key binding by
@@ -505,6 +491,13 @@ quotes. You can customize it freely according to your
personal
preference.
@end defopt
+@defun text-quoting-style
+You should not read the value of the variable
+@code{text-quoting-style} directly. Instead, use this function with
+the same name to dynamically compute the correct quoting style on the
+current terminal in the @code{nil} case described above.
+@end defun
+
@node Describing Characters
@section Describing Characters for Help Messages
@cindex describe characters and events
@@ -834,7 +827,7 @@ if the user types the help character again.
Emacs can list functions based on various groupings. For instance,
@code{string-trim} and @code{mapconcat} are ``string'' functions, so
-@kbd{M-x shortdoc-display-group RET string RET} will give an overview
+@kbd{M-x shortdoc RET string RET} will give an overview
of functions that operate on strings.
The documentation groups are created with the
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 8d2089bad8..ea1679f693 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -3004,8 +3004,8 @@ Using @code{bool} can make programs easier to read and a
bit faster than
using @code{int}. Although it is also OK to use @code{int}, @code{0}
and @code{1}, this older style is gradually being phased out. When
using @code{bool}, respect the limitations of the replacement
-implementation of @code{bool}, as documented in the source file
-@file{lib/stdbool.in.h}. In particular, boolean bitfields should be of type
+implementation of @code{bool}. In particular,
+boolean bitfields should be of type
@code{bool_bf}, not @code{bool}, so that they work correctly even when
compiling Objective C with standard GCC.
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 2be31d63a6..1e4bf4eb86 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2911,6 +2911,10 @@ The @code{:rtl} property specifies an alternative image
to use for
right-to-left languages. Only the GTK+ version of Emacs supports this
at present.
+Some toolkits display both an image and a text in the toolbar. If you
+want to force using only the image, use a @code{:vert-only}
+non-@code{nil} property.
+
Like the menu bar, the tool bar can display separators (@pxref{Menu
Separators}). Tool bar separators are vertical rather than
horizontal, though, and only a single style is supported. They are
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 f2adc01c8f..089ae41f32 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -490,6 +490,9 @@ If @var{default} is @code{nil}, there is no default value,
and
therefore no ``default value'' string is included in the result value.
If @var{default} is a non-@code{nil} list, the first element of the
list is used in the prompt.
+
+Both @var{prompt} and @code{minibuffer-default-prompt-format} are run
+through @code{substitute-command-keys} (@pxref{Keys in Documentation}).
@end defun
@defvar read-minibuffer-restore-windows
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 75eb21522f..9527df33b8 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
@@ -3146,9 +3148,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/nonascii.texi b/doc/lispref/nonascii.texi
index 6dc23637a7..006966daed 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -404,9 +404,12 @@ This returns @code{t} if @var{charcode} is a valid
character, and
@cindex maximum value of character codepoint
@cindex codepoint, largest value
-@defun max-char
+@defun max-char &optional unicode
This function returns the largest value that a valid character
-codepoint can have.
+codepoint can have in Emacs. If the optional argument @var{unicode}
+is non-@code{nil}, it returns the largest character codepoint defined
+by the Unicode Standard (which is smaller than the maximum codepoint
+supported by Emacs).
@example
@group
@@ -460,7 +463,7 @@ of character properties. In particular, Emacs supports the
@uref{https://www.unicode.org/reports/tr23/, Unicode Character Property
Model}, and the Emacs character property database is derived from the
Unicode Character Database (@acronym{UCD}). See the
-@uref{https://www.unicode.org/versions/Unicode14.0.0/ch04.pdf, Character
+@uref{https://www.unicode.org/versions/Unicode15.0.0/ch04.pdf, Character
Properties chapter of the Unicode Standard}, for a detailed
description of Unicode character properties and their meaning. This
section assumes you are already familiar with that chapter of the
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/os.texi b/doc/lispref/os.texi
index 3582801841..3e16ac0eb4 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -3175,6 +3175,9 @@ This is not detected by this function, and so a
non-@code{nil} return
value does not guarantee that changes on @var{file} will be actually
notified.
+If @var{file} is a symlink, it doesn't follow that link. Just
+@var{file} itself will be watched.
+
@var{flags} is a list of conditions to set what will be watched for.
It can include the following symbols:
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index db6b4c35ef..da8df96854 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
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 5ee139a11d..743718b560 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1052,11 +1052,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 +1294,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/sequences.texi b/doc/lispref/sequences.texi
index 39230d0adc..bc5a4cf24a 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -446,8 +446,7 @@ useful example of @code{sort}.
@cindex seq library
@cindex sequences, generalized
The @file{seq.el} library provides the following additional sequence
-manipulation macros and functions, prefixed with @code{seq-}. To use
-them, you must first load the @file{seq} library.
+manipulation macros and functions, prefixed with @code{seq-}.
All functions defined in this library are free of side-effects;
i.e., they do not modify any sequence (list, vector, or string) that
@@ -681,6 +680,37 @@ for which @var{predicate} returns @code{nil}.
@end example
@end defun
+@defun seq-remove-at-position sequence n
+@cindex removing from sequences
+This function returns a copy of @var{sequence} where the element at
+(zero-based) index @var{n} got removed. The result is a sequence of
+the same type as @var{sequence}.
+
+@example
+@group
+(seq-remove-at-position [1 -1 3 -3 5] 0)
+@result{} [-1 3 -3 5]
+@end group
+@group
+(seq-remove-at-position [1 -1 3 -3 5] 3)
+@result{} [1 -1 3 5]
+@end group
+@end example
+@end defun
+
+@defun seq-keep function sequence
+ This function returns a list of all non-@code{nil} results from
+calling @var{function} on the elements in @var{sequence}.
+
+@example
+@group
+(seq-keep #'cl-digit-char-p '(?6 ?a ?7))
+@result{} (6 7)
+@end group
+@end example
+
+@end defun
+
@defun seq-reduce function sequence initial-value
@cindex reducing sequences
This function returns the result of calling @var{function} with
@@ -864,7 +894,7 @@ arguments to use instead of the default @code{equal}.
@end defun
@defun seq-position sequence elt &optional function
- This function returns the index of the first element in
+ This function returns the (zero-based) index of the first element in
@var{sequence} that is equal to @var{elt}. If the optional argument
@var{function} is non-@code{nil}, it is a function of two arguments to
use instead of the default @code{equal}.
@@ -881,6 +911,27 @@ use instead of the default @code{equal}.
@end example
@end defun
+@defun seq-positions sequence elt &optional testfn
+ This function returns a list of the (zero-based) indices of the
+elements in @var{sequence} for which @var{testfn} returns
+non-@code{nil} when passed the element and @var{elt} as
+arguments. @var{testfn} defaults to @code{equal}.
+
+@example
+@group
+(seq-positions '(a b c a d) 'a)
+@result{} (0 3)
+@end group
+@group
+(seq-positions '(a b c a d) 'z)
+@result{} nil
+@end group
+@group
+(seq-positions '(11 5 7 12 9 15) 10 #'>=)
+@result{} (0 3 5)
+@end group
+@end example
+@end defun
@defun seq-uniq sequence &optional function
This function returns a list of the elements of @var{sequence} with
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 374381e595..cf961e9e7c 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -539,21 +539,10 @@ string or symbol, @code{string=} signals an error.
@result{} nil
@end example
-For technical reasons, a unibyte and a multibyte string are
-@code{equal} if and only if they contain the same sequence of
-character codes and all these codes are either in the range 0 through
-127 (@acronym{ASCII}) or 160 through 255 (@code{eight-bit-graphic}).
-However, when a unibyte string is converted to a multibyte string, all
-characters with codes in the range 160 through 255 are converted to
-characters with higher codes, whereas @acronym{ASCII} characters
-remain unchanged. Thus, a unibyte string and its conversion to
-multibyte are only @code{equal} if the string is all @acronym{ASCII}.
-Character codes 160 through 255 are not entirely proper in multibyte
-text, even though they can occur. As a consequence, the situation
-where a unibyte and a multibyte string are @code{equal} without both
-being all @acronym{ASCII} is a technical oddity that very few Emacs
-Lisp programmers ever get confronted with. @xref{Text
-Representations}.
+A unibyte and a multibyte string are equal in the sense of
+@code{string=} if and only if they contain the same sequence of
+character codes all being in the range 0--127 (@acronym{ASCII}).
+@xref{Text Representations}.
@end defun
@defun string-equal string1 string2
@@ -1293,6 +1282,11 @@ The order of specifications in @var{template} need not
correspond to
the order of associations in @var{spec-alist}.
@end itemize
+REPLACEMENT can also be a function taking no arguments, and returning
+a string to be used for the replacement. It will only be called when
+the corresponding LETTER is used in the TEMPLATE. This is useful, for
+example, to avoid prompting for input unless it is needed.
+
The optional argument @var{ignore-missing} indicates how to handle
specification characters in @var{template} that are not found in
@var{spec-alist}. If it is @code{nil} or omitted, the function
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 336fa9c918..2ef4f8c291 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -613,7 +613,10 @@ file-local evaluation forms. @xref{File Local Variables}.
@item safe-local-variable
The value specifies a function for determining safe file-local values
-for the named variable. @xref{File Local Variables}.
+for the named variable. @xref{File Local Variables}. Since this
+value is consulted when loading files, the function should be
+efficient and should ideally not lead to loading any libraries to
+determine the safeness (e.g., it should not be an autoloaded function).
@item side-effect-free
@cindex @code{side-effect-free} property
@@ -715,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
@@ -791,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 ed119a709c..7206f2acd2 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -358,27 +358,6 @@ Variables}); a few variables have terminal-local bindings
like ordinary local bindings, but they are localized depending on
where you are in Emacs.
-@defopt max-specpdl-size
-@anchor{Definition of max-specpdl-size}
-@cindex variable limit error
-@cindex evaluation error
-@cindex infinite recursion
-This variable defines the limit on the total number of local variable
-bindings and @code{unwind-protect} cleanups (@pxref{Cleanups,,
-Cleaning Up from Nonlocal Exits}) that are allowed before Emacs
-signals an error (with data @code{"Variable binding depth exceeds
-max-specpdl-size"}).
-
-This limit, with the associated error when it is exceeded, is one way
-that Lisp avoids infinite recursion on an ill-defined function.
-@code{max-lisp-eval-depth} provides another limit on depth of nesting.
-@xref{Definition of max-lisp-eval-depth,, Eval}.
-
-The default value is 1600. Entry to the Lisp debugger increases the
-value, if there is little room left, to make sure the debugger itself
-has room to execute.
-@end defopt
-
@node Void Variables
@section When a Variable is Void
@cindex @code{void-variable} error
@@ -1204,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)
@@ -2260,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
@@ -2332,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
@@ -2350,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
@@ -2377,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
@@ -2386,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
@@ -2405,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:
@@ -2415,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
@@ -2437,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
@@ -2635,15 +2668,15 @@ is a set of forms that can be generalized variables in
Lisp.
The @code{setf} macro is the most basic way to operate on generalized
variables. The @code{setf} form is like @code{setq}, except that it
-accepts arbitrary place forms on the left side rather than just
-symbols. For example, @code{(setf (car a) b)} sets the car of
-@code{a} to @code{b}, doing the same operation as @code{(setcar a b)},
-but without you having to use two separate functions for setting and
-accessing this type of place.
+accepts arbitrary place forms in the first (left) argument of each
+pair rather than just symbols. For example, @code{(setf (car a) b)}
+sets the car of @code{a} to @code{b}, doing the same operation as
+@code{(setcar a b)}, but without you having to use two separate
+functions for setting and accessing this type of place.
@defmac setf [place form]@dots{}
-This macro evaluates @var{form} and stores it in @var{place}, which
-must be a valid generalized variable form. If there are several
+This macro evaluates @var{form} and stores its value in @var{place},
+which must be a valid generalized variable form. If there are several
@var{place} and @var{form} pairs, the assignments are done sequentially
just as with @code{setq}. @code{setf} returns the value of the last
@var{form}.
@@ -2679,17 +2712,56 @@ cdar nthcdr
A call to any of the following Emacs-specific functions:
@smallexample
-alist-get process-get
-frame-parameter process-sentinel
-terminal-parameter window-buffer
-keymap-parent window-display-table
-match-data window-dedicated-p
-overlay-get window-hscroll
-overlay-start window-parameter
-overlay-end window-point
-process-buffer window-start
-process-filter default-value
+alist-get overlay-start
+default-value overlay-get
+face-background process-buffer
+face-font process-filter
+face-foreground process-get
+face-stipple process-sentinel
+face-underline-p terminal-parameter
+file-modes window-buffer
+frame-parameter window-dedicated-p
+frame-parameters window-display-table
+get-register window-hscroll
+getenv window-parameter
+keymap-parent window-point
+match-data window-start
+overlay-end
@end smallexample
+
+@item
+A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])},
+where @var{subplace} is itself a valid generalized variable whose
+current value is a string, and where the value stored is also a
+string. The new string is spliced into the specified part of the
+destination string. For example:
+
+@example
+(setq a (list "hello" "world"))
+ @result{} ("hello" "world")
+(cadr a)
+ @result{} "world"
+(substring (cadr a) 2 4)
+ @result{} "rl"
+(setf (substring (cadr a) 2 4) "o")
+ @result{} "o"
+(cadr a)
+ @result{} "wood"
+a
+ @result{} ("hello" "wood")
+@end example
+
+@item
+The @code{if} and @code{cond} conditionals will work as generalized
+variables. For instance, this will set either the @code{foo} or the
+@code{bar} variable to @code{zot}:
+
+@example
+(setf (if (zerop (random 2))
+ foo
+ bar)
+ 'zot)
+@end example
@end itemize
@noindent
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index c7f014e2f3..37884faec7 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -1472,20 +1472,36 @@ the new root window.
For interactive use, Emacs provides two commands which always split
the selected window. These call @code{split-window} internally.
-@deffn Command split-window-right &optional size
-This function splits the selected window into two side-by-side
-windows, putting the selected window on the left. If @var{size} is
-positive, the left window gets @var{size} columns; if @var{size} is
+@deffn Command split-window-right &optional size window-to-split
+This function splits the window @var{window-to-split} into two
+side-by-side windows, putting @var{window-to-split} on the left.
+@var{window-to-split} defaults to the selected window. If @var{size}
+is positive, the left window gets @var{size} columns; if @var{size} is
negative, the right window gets @minus{}@var{size} columns.
@end deffn
-@deffn Command split-window-below &optional size
-This function splits the selected window into two windows, one above
-the other, leaving the upper window selected. If @var{size} is
-positive, the upper window gets @var{size} lines; if @var{size} is
+@deffn Command split-window-below &optional size window-to-split
+This function splits the window @var{window-to-split} into two
+windows, one above the other, leaving the upper window selected.
+@var{window-to-split} defaults to the selected window. If @var{size}
+is positive, the upper window gets @var{size} lines; if @var{size} is
negative, the lower window gets @minus{}@var{size} lines.
@end deffn
+@deffn Command split-root-window-below &optional size
+This function splits the whole frame in two. The current window
+configuration is retained on the top, and a new window is created
+below, taking up the whole width of the frame. @var{size} is treated
+as by @code{split-window-below}.
+@end deffn
+
+@deffn Command split-root-window-right &optional size
+This function splits the whole frame in two. The current window
+configuration is retained on the left, and a new window is created on
+the right, taking up the whole height of the frame. @var{size} is treated
+as by @code{split-window-right}.
+@end deffn
+
@defopt split-window-keep-point
If the value of this variable is non-@code{nil} (the default),
@code{split-window-below} behaves as described above.
@@ -2608,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
@@ -6476,7 +6492,7 @@ during redisplay provided a significant, non-scrolling
change of a
window has been detected. For simplicity, these hooks and the
functions they call will be collectively referred to as @dfn{window
change functions}. As any hook, these hooks can be set either
-globally of buffer-locally via the @var{local} argument of
+globally or buffer-locally via the @var{local} argument of
@code{add-hook} (@pxref{Setting Hooks}) when the hook is installed.
@cindex window buffer change
@@ -6668,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/man/emacsclient.1 b/doc/man/emacsclient.1
index e5d1bbe09a..83c8a366f8 100644
--- a/doc/man/emacsclient.1
+++ b/doc/man/emacsclient.1
@@ -1,5 +1,5 @@
.\" See section COPYING for conditions for redistribution.
-.TH EMACSCLIENT 1 "2021-11-05" "GNU Emacs" "GNU"
+.TH EMACSCLIENT 1 "2022-09-05" "GNU Emacs" "GNU"
.\" NAME should be all caps, SECTION should be 1-8, maybe w/ subsection
.\" other params are allowed: see man(7), man(1)
.SH NAME
@@ -87,9 +87,12 @@ Use TCP configuration file FILENAME for communication.
This can also be specified via the EMACS_SERVER_FILE environment variable.
.TP
.B \-n, \-\-no-wait
-Return
-immediately without waiting for you to "finish" the buffer in Emacs.
-If combined with --eval, this option is ignored.
+Return immediately without waiting for you to "finish" the buffer in
+Emacs. If combined with --eval, this option is ignored.
+.TP
+.B \-w, \-\-timeout=N
+How long to wait, in seconds, for Emacs to respond before giving up.
+The default is 0, which means to wait forever.
.TP
.B \-nw, \-t, \-\-tty
Open a new Emacs frame on the current terminal.
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 1d881a5fc7..b6eef7ea79 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -68,7 +68,7 @@ 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 \
+ dbus dired-x ebrowse ede ediff edt eglot 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 \
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 98f59b89c0..89a340e734 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -10392,7 +10392,6 @@ memory than it would otherwise, but it's guaranteed to
fix the problem.
@cindex Recursion depth
@cindex ``Computation got stuck'' message
@cindex @code{max-lisp-eval-depth}
-@cindex @code{max-specpdl-size}
Calc uses recursion in many of its calculations. Emacs Lisp keeps a
variable @code{max-lisp-eval-depth} which limits the amount of recursion
possible in an attempt to recover from program bugs. If a calculation
@@ -10406,9 +10405,6 @@ is also an @kbd{I M} (@code{calc-less-recursion-depth})
command which
decreases this limit by a factor of two, down to a minimum value of 200.
The default value is 1000.
-These commands also double or halve @code{max-specpdl-size}, another
-internal Lisp recursion limit. The minimum value for this limit is 600.
-
@node Caches
@subsection Caches
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 b2f43ad051..e4b344f267 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -920,69 +920,6 @@ cl-caaar@dots{}cl-cddddr cl-first@dots{}cl-tenth
Note that for @code{cl-getf} (as for @code{nthcdr}), the list argument
of the function must itself be a valid @var{place} form.
-@item
-General Emacs Lisp functions:
-@example
-buffer-file-name getenv
-buffer-modified-p global-key-binding
-buffer-name local-key-binding
-buffer-string mark
-buffer-substring mark-marker
-current-buffer marker-position
-current-case-table mouse-position
-current-column point
-current-global-map point-marker
-current-input-mode point-max
-current-local-map point-min
-current-window-configuration read-mouse-position
-default-file-modes screen-height
-documentation-property screen-width
-face-background selected-window
-face-font selected-screen
-face-foreground selected-frame
-face-stipple standard-case-table
-face-underline-p syntax-table
-file-modes visited-file-modtime
-frame-height window-height
-frame-parameters window-width
-frame-visible-p x-get-secondary-selection
-frame-width x-get-selection
-get-register
-@end example
-
-Most of these have directly corresponding ``set'' functions, like
-@code{use-local-map} for @code{current-local-map}, or @code{goto-char}
-for @code{point}. A few, like @code{point-min}, expand to longer
-sequences of code when they are used with @code{setf}
-(@code{(narrow-to-region x (point-max))} in this case).
-
-@item
-A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])},
-where @var{subplace} is itself a valid generalized variable whose
-current value is a string, and where the value stored is also a
-string. The new string is spliced into the specified part of the
-destination string. For example:
-
-@example
-(setq a (list "hello" "world"))
- @result{} ("hello" "world")
-(cadr a)
- @result{} "world"
-(substring (cadr a) 2 4)
- @result{} "rl"
-(setf (substring (cadr a) 2 4) "o")
- @result{} "o"
-(cadr a)
- @result{} "wood"
-a
- @result{} ("hello" "wood")
-@end example
-
-The generalized variable @code{buffer-substring}, listed above,
-also works in this way by replacing a portion of the current buffer.
-
-@c FIXME? Also 'eq'? (see cl-lib.el)
-
@c Currently commented out in cl.el.
@ignore
@item
@@ -4114,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 9867883b24..c0c2ef93d9 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -1031,8 +1031,9 @@ superclasses. In this way, specific behaviors such as
how a project
is saved, or how a target is compiled can be customized by a project
author in detail. @ede{} communicates to these project objects via an
API using methods. The commands you use in @ede{} mode are high-level
-functional wrappers over these methods. @xref{Top,,, eieio, EIEIO manual}. For
-details on using @eieio{} to extending classes, and writing methods.
+functional wrappers over these methods. @xref{Top,,, eieio, EIEIO
+manual} for details on using @eieio{} to extending classes, and
+writing methods.
If you intend to extend @ede{}, it is most likely that a new target type is
needed in one of the existing project types. The rest of this chapter
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index cbc7556aa8..23334479b0 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -50,7 +50,7 @@ modify this GNU manual.''
@titlepage
@title Ediff User's Manual
@sp 4
-@subtitle Ediff version 2.81.2
+@subtitle Ediff version 2.81.6
@sp 1
@subtitle November 2008
@sp 5
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 c29e4fe487..23e3b086a3 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -27,9 +27,6 @@ latest version of the FAQ is archived.
The FAQ may be copied and redistributed under these conditions, except that
the FAQ may not be embedded in a larger literary work unless that work
itself allows free copying and redistribution.
-
-[This version has been heavily edited since it was included in the Emacs
-distribution in 1999.]
@end quotation
@end copying
@@ -545,11 +542,11 @@ printed manual}.
@cindex Reference cards, in other languages
@item
You can get a printed reference card listing commands and keys to
-invoke them. You can order one from the FSF for $2 (or 10 for $18),
-or you can print your own from the @file{etc/refcards/refcard.tex} or
-@file{etc/refcards/refcard.pdf} files in the Emacs distribution.
-The Emacs distribution comes with translations of the reference card
-into several languages; look for files named
+invoke them. You can order one from the FSF, or you can print your
+own from the @file{etc/refcards/refcard.tex} or
+@file{etc/refcards/refcard.pdf} files in the Emacs distribution. The
+Emacs distribution comes with translations of the reference card into
+several languages; look for files named
@file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} is a
two-letter code of the language. For example, the German version of
the reference card is in the files @file{etc/refcards/de-refcard.tex}
@@ -696,9 +693,10 @@ of the file in parentheses, like this:
@item
You can create your own Info directory. You can tell Emacs where that
Info directory is by adding its pathname to the value of the variable
-@code{Info-default-directory-list}. For example, to use a private Info
-directory which is a subdirectory of your home directory named @file{Info},
-you could put this in your @file{.emacs} file:
+@code{Info-default-directory-list}. For example, to use a private
+Info directory which is a subdirectory of your home directory named
+@file{Info}, you could put this in your init file (@pxref{Setting up a
+customization file}):
@lisp
(add-to-list 'Info-default-directory-list "~/Info/")
@@ -1604,38 +1602,42 @@ is better to write ``Emacs and XEmacs.''
* Filling paragraphs with a single space::
* Escape sequences in shell output::
* Fullscreen mode on MS-Windows::
+* Emacs in a Linux console::
@end menu
@node Setting up a customization file
-@section How do I set up a @file{.emacs} file properly?
+@section How do I set up an init file properly?
@cindex @file{.emacs} file, setting up
-@cindex @file{.emacs} file, locating
+@cindex @file{.emacs.d/init.el} file, setting up
@cindex Init file, setting up
+@cindex Init file, locating
@cindex Customization file, setting up
+When Emacs is started, it normally tries to load a Lisp program from
+an @dfn{initialization file}, or @dfn{init file} for short. This
+file, if it exists, specifies how to initialize Emacs for you.
+Traditionally, file @file{~/.emacs} is used as the init file, although
+Emacs also looks at @file{~/.emacs.el}, @file{~/.emacs.d/init.el},
+@file{~/.config/emacs/init.el}, or other locations.
@xref{Init File,,, emacs, The GNU Emacs Manual}.
-In general, new Emacs users should not be provided with @file{.emacs}
-files, because this can cause confusing non-standard behavior. Then
-they send questions to
-@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
-the help-gnu-emacs mailing list} asking why Emacs
-isn't behaving as documented.
-
Emacs includes the Customize facility (@pxref{Using Customize}). This
allows users who are unfamiliar with Emacs Lisp to modify their
-@file{.emacs} files in a relatively straightforward way, using menus
+init files in a relatively straightforward way, using menus
rather than Lisp code.
While Customize might indeed make it easier to configure Emacs,
consider taking a bit of time to learn Emacs Lisp and modifying your
-@file{.emacs} directly. Simple configuration options are described
+init file directly. Simple configuration options are described
rather completely in @ref{Init File,,, emacs, The GNU Emacs Manual},
for users interested in performing frequently requested, basic tasks.
-Sometimes users are unsure as to where their @file{.emacs} file should
-be found. Visiting the file as @file{~/.emacs} from Emacs will find
-the correct file.
+In general, new Emacs users should not be provided with init
+files, because this can cause confusing non-standard behavior. Then
+they send questions to
+@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
+the help-gnu-emacs mailing list} asking why Emacs
+isn't behaving as documented.
@node Using Customize
@section How do I start using Customize?
@@ -1743,21 +1745,22 @@ always use custom terminal definition with
@samp{setb24} and
@samp{setf24}.
@node Debugging a customization file
-@section How do I debug a @file{.emacs} file?
-@cindex Debugging @file{.emacs} file
-@cindex @file{.emacs} debugging
+@section How do I debug an init file?
+@cindex Debugging @file{.emacs.d/init.el} file
+@cindex Debugging init file
+@cindex @file{.emacs.d/init.el} debugging
@cindex Init file debugging
@cindex @samp{-debug-init} option
Start Emacs with the @samp{-debug-init} command-line option. This
-enables the Emacs Lisp debugger before evaluating your @file{.emacs}
+enables the Emacs Lisp debugger before evaluating your init
file, and places you in the debugger if something goes wrong. The top
line in the @file{trace-back} buffer will be the error message, and the
second or third line of that buffer will display the Lisp code from your
-@file{.emacs} file that caused the problem.
+init file that caused the problem.
You can also evaluate an individual function or argument to a function
-in your @file{.emacs} file by moving the cursor to the end of the
+in your init file by moving the cursor to the end of the
function or argument and typing @kbd{C-x C-e} (@kbd{M-x
eval-last-sexp}).
@@ -1787,7 +1790,8 @@ You can similarly display the current column with
@end lisp
@noindent
-in your @file{.emacs} file. This feature is off by default.
+in your init file (@pxref{Setting up a customization file}). This
+feature is off by default.
The @code{"%c"} format specifier in the variable @code{mode-line-format}
will insert the current column's value into the mode line. See the
@@ -1806,10 +1810,6 @@ optional display. Alternatively, you can use the
customize @code{display-line-numbers-type} with the same value as you
would use with @code{display-line-numbers}.
-There is also the @samp{linum} package (distributed with Emacs since
-version 23.1) which will henceforth become obsolete. Users and
-developers are encouraged to use @samp{display-line-numbers} instead.
-
@node Displaying the current file name in the titlebar
@section How can I modify the titlebar to contain the current file name?
@cindex Titlebar, displaying the current file name in
@@ -1834,7 +1834,7 @@ machine at which Emacs was invoked. This is done by
setting
To modify the behavior such that frame titlebars contain the buffer's
name regardless of the number of existing frames, include the following
-in your @file{.emacs}:
+in your init file (@pxref{Setting up a customization file}):
@lisp
(setq frame-title-format "%b")
@@ -1844,9 +1844,10 @@ in your @file{.emacs}:
@section How do I turn on abbrevs by default just in mode @var{mymode}?
@cindex Abbrevs, turning on by default
-Abbrev mode expands abbreviations as you type them. To turn it on in a
-specific buffer, use @kbd{M-x abbrev-mode}. To turn it on in every
-buffer by default, put this in your @file{.emacs} file:
+Abbrev mode expands abbreviations as you type them. To turn it on in
+a specific buffer, use @kbd{M-x abbrev-mode}. To turn it on in every
+buffer by default, put this in your init file (@pxref{Setting up a
+customization file}):
@lisp
(setq-default abbrev-mode t)
@@ -1896,7 +1897,8 @@ the script. Use @kbd{C-h v} (or @kbd{M-x
describe-variable}) on
@cindex Highlighting and replacing text
Use @code{delete-selection-mode}, which you can start automatically by
-placing the following Lisp form in your @file{.emacs} file:
+placing the following Lisp form in your init file (@pxref{Setting up a
+customization file}):
@lisp
(delete-selection-mode 1)
@@ -2034,9 +2036,10 @@ The default maximum line width is 70, determined by the
variable
To turn on @code{auto-fill-mode} just once for one buffer, use @kbd{M-x
auto-fill-mode}.
-To turn it on for every buffer in a certain mode, you must use the hook
-for that mode. For example, to turn on @code{auto-fill} mode for all
-text buffers, including the following in your @file{.emacs} file:
+To turn it on for every buffer in a certain mode, you must use the
+hook for that mode. For example, to turn on @code{auto-fill} mode for
+all text buffers, including the following in your init file
+(@pxref{Setting up a customization file}):
@lisp
(add-hook 'text-mode-hook 'turn-on-auto-fill)
@@ -2091,7 +2094,8 @@ option:
emacs -f server-start
@end example
-or by invoking @code{server-start} from @file{.emacs}:
+or by invoking @code{server-start} from init file (@pxref{Setting up a
+customization file}):
@lisp
(if (@var{some conditions are met}) (server-start))
@@ -2162,7 +2166,8 @@ f()
@}
@end example
-@noindent To achieve this, add the following line to your @file{.emacs}:
+@noindent To achieve this, add the following line to your init file
+(@pxref{Setting up a customization file}):
@lisp
(c-set-offset 'case-label '+)
@@ -2213,7 +2218,8 @@ the line or the block according to what you just
specified.
@item
If you don't like the result, go back to step 1. Otherwise, add the
-following line to your @file{.emacs}:
+following line to your init file (@pxref{Setting up a customization
+file}):
@lisp
(c-set-offset '@var{syntactic-symbol} @var{offset})
@@ -2243,8 +2249,8 @@ customizations inside a C mode hook, like this:
@noindent
Using @code{c-mode-hook} avoids the need to put a @w{@code{(require
-'cc-mode)}} into your @file{.emacs} file, because @code{c-set-offset}
-might be unavailable when @code{cc-mode} is not loaded.
+'cc-mode)}} into your init file, because @code{c-set-offset} might be
+unavailable when @code{cc-mode} is not loaded.
Note that @code{c-mode-hook} runs for C source files only; use
@code{c++-mode-hook} for C@t{++} sources, @code{java-mode-hook} for
@@ -2316,8 +2322,8 @@ usage: xset [-display host:dpy] option ...
@cindex Previous line, indenting according to
@cindex Text indentation
-Such behavior is automatic (in Text mode) in Emacs 20 and later. From the
-@file{etc/NEWS} file for Emacs 20.2:
+Such behavior is automatic (in Text mode). From the @file{etc/NEWS}
+file for Emacs 20.2:
@example
** In Text mode, now only blank lines separate paragraphs. This makes
@@ -2355,15 +2361,7 @@ new paragraph. There are many packages available to
deal with this
@cindex Pairs of parentheses, highlighting
@cindex Matching parentheses
-Call @code{show-paren-mode} in your @file{.emacs} file:
-
-@lisp
-(show-paren-mode 1)
-@end lisp
-
-You can also enable this mode by selecting the @samp{Paren Match
-Highlighting} option from the @samp{Options} menu of the Emacs menu bar
-at the top of any Emacs frame.
+By default, @code{show-paren-mode} is enabled in all editing buffers.
Alternatives to this mode include:
@@ -2460,8 +2458,9 @@ Emacs Lisp @dfn{form}:
@item
If you want it evaluated every time you run Emacs, put it in a file
-named @file{.emacs} in your home directory. This is known as ``your
-@file{.emacs} file,'' and contains all of your personal customizations.
+named @file{.emacs.d/init.el} in your home directory. This is known
+as ``your init file,'' and contains all of your personal
+customizations (@pxref{Setting up a customization file}).
@item
You can type the form in the @file{*scratch*} buffer, and then type
@@ -2499,7 +2498,7 @@ about them.
Set the default value of the variable @code{tab-width}. For example, to set
@key{TAB} stops every 10 characters, insert the following in your
-@file{.emacs} file:
+init file (@pxref{Setting up a customization file}):
@lisp
(setq-default tab-width 10)
@@ -2641,8 +2640,9 @@ Quick command-line switch descriptions are also
available. For example,
You probably don't want to do this, since backups are useful, especially
when something goes wrong.
-To avoid seeing backup files (and other ``uninteresting'' files) in Dired,
-load @code{dired-x} by adding the following to your @file{.emacs} file:
+To avoid seeing backup files (and other ``uninteresting'' files) in
+Dired, load @code{dired-x} by adding the following to your init file
+(@pxref{Setting up a customization file}):
@lisp
(with-eval-after-load 'dired
@@ -2651,7 +2651,7 @@ load @code{dired-x} by adding the following to your
@file{.emacs} file:
With @code{dired-x} loaded, @kbd{C-x M-o} toggles omitting in each dired
buffer.
You can make omitting the default for new dired buffers by putting the
-following in your @file{.emacs}:
+following in your init file:
@lisp
(add-hook 'dired-mode-hook 'dired-omit-mode)
@@ -2905,17 +2905,18 @@ Different levels of decoration are available, from
slight to gaudy.
More decoration means you need to wait more time for a buffer to be
fontified (or a faster machine). To control how decorated your
buffers should become, set the value of
-@code{font-lock-maximum-decoration} in your @file{.emacs} file, with a
-@code{nil} value indicating default (usually minimum) decoration, and a
-@code{t} value indicating the maximum decoration. For the gaudiest
-possible look, then, include the line
+@code{font-lock-maximum-decoration} in your init file (@pxref{Setting
+up a customization file}), with a @code{nil} value indicating default
+(usually minimum) decoration, and a @code{t} value indicating the
+maximum decoration. For the gaudiest possible look, then, include the
+line
@lisp
(setq font-lock-maximum-decoration t)
@end lisp
@noindent
-in your @file{.emacs} file. You can also set this variable such that
+in your init file. You can also set this variable such that
different modes are highlighted in a different ways; for more
information, see the documentation for
@code{font-lock-maximum-decoration} with @kbd{C-h v} (or @kbd{M-x
@@ -2942,7 +2943,8 @@ customize-variable @key{RET} scroll-conservatively
@key{RET}} and set it
to a large value like, say, 10000. For an explanation of what this
means, @pxref{Auto Scrolling,,, emacs, The GNU Emacs Manual}.
-Alternatively, use the following Lisp form in your @file{.emacs}:
+Alternatively, use the following Lisp form in your init file
+(@pxref{Setting up a customization file}):
@lisp
(setq scroll-conservatively most-positive-fixnum)
@@ -2971,7 +2973,8 @@ default, a backslash (@samp{\}) will appear in the mode
line.
@cindex Single space following periods
@cindex Periods, one space following
-Add the following line to your @file{.emacs} file:
+Add the following line to your init file (@pxref{Setting up a
+customization file}):
@lisp
(setq sentence-end-double-space nil)
@@ -2993,15 +2996,15 @@ escape sequences. It is enabled by default.
@cindex Fullscreen mode
Beginning with Emacs 24.4 either run Emacs with the @samp{--maximized}
-command-line option or put the following form in your @file{.emacs}
-file:
+command-line option or put the following form in your init file
+(@pxref{Setting up a customization file}):
@lisp
(add-hook 'emacs-startup-hook 'toggle-frame-maximized)
@end lisp
With older versions use the function @code{w32-send-sys-command}. For
-example, you can put the following in your @file{.emacs} file:
+example, you can put the following in your init file:
@lisp
(add-hook 'emacs-startup-hook
@@ -3017,6 +3020,115 @@ To compute the correct values for width and height,
first maximize the
Emacs frame and then evaluate @code{(frame-height)} and
@code{(frame-width)} with @kbd{M-:}.
+@node Emacs in a Linux console
+@section How can I alleviate the limitations of the Linux console?
+@cindex Console, Linux console, TTY, fbterm
+
+If possible, we recommend running Emacs inside @command{fbterm}, when
+in a Linux console. This brings the Linux console on par with most
+terminal emulators under X. To do this, install @command{fbterm}, for
+example with the package manager of your GNU/Linux distribution, and
+execute the command
+
+@example
+$ fbterm
+@end example
+
+This will create a sample configuration file @file{~/.fbtermrc} in
+your home directory. Edit that file and change the options
+@code{font-names} and @code{font-size} if necessary. For the former,
+you can choose one or more of the lines in the output of the following
+command, separated by commas:
+
+@example
+$ fc-list :spacing=mono family | sed 's/ /\\ /g'
+@end example
+
+@noindent
+Note that you can fine-tune the appearance of the fonts by adding
+attribute-value pairs, separated by colons, after each font name. For
+example,
+
+@example
+font-names=DejaVu\ Sans\ Mono:style=bold:antialias=false
+@end example
+
+@noindent
+selects the bold style of the DejaVu Sans Mono font, and disables
+anti-aliasing.
+
+You can now start Emacs inside @command{fbterm} with the command
+
+@example
+$ fbterm -- env TERM=fbterm emacs
+@end example
+
+In some versions of @command{fbterm}, setting @env{TERM} to
+@samp{fbterm} can be omitted. To check whether it is needed, start
+Emacs inside @command{fbterm} with the command
+
+@example
+$ fbterm -- emacs
+@end example
+
+@noindent
+and type @kbd{M-x list-colors-display}. If only 8 colors are
+displayed, it is necessary; if 256 colors are displayed, it isn't.
+
+You may want to add an alias for that command in your shell
+configuration file. For example, if you use Bash, you can add the
+following line to your @file{~/.bashrc} file:
+
+@example
+alias emacs="fbterm -- env TERM=fbterm emacs"
+@end example
+
+@noindent
+or, if you use Emacs both in the Linux console and under X:
+
+@example
+[[ "$(tty)" =~ "/dev/tty" ]] && alias emacs="fbterm -- env TERM=fbterm emacs"
+@end example
+
+The @command{fbterm} terminal emulator may define a number of key
+bindings for its own use, some of which conflict with those that Emacs
+uses. Execute the following two commands as root to ensure that
+@command{fbterm} does not define these key bindings:
+
+@example
+# chmod a-s `which fbterm`
+# setcap cap_sys_tty_config=-ep `which fbterm`
+@end example
+
+If you use Emacs as root, the above is not enough however, because the
+root user has all privileges. You can use the following command to
+start Emacs inside @command{fbterm} as root while ensuring that
+@command{fbterm} does not define any key bindings for its own use:
+
+@example
+# capsh --drop=cap_sys_tty_config -- -c "fbterm -- env TERM=fbterm emacs"
+@end example
+
+Again you may want to add a shortcut for that command in the shell
+configuration file of the root user. In this case however, it is not
+possible to use an alias, because the command line arguments passed to
+Emacs need to be inserted in the string at the end of the command. A
+wrapper script or a function can be used to do that. For example, if
+you use Bash, you can add the following function in the root user
+@file{~/.bashrc} file:
+
+@example
+function emacs ()
+@{
+ CMD="fbterm -- env TERM=fbterm emacs "
+ for ARG in "$@@"
+ do
+ CMD="$CMD '$ARG' "
+ done
+ capsh --drop=cap_sys_tty_config -- -c "$CMD"
+@}
+@end example
+
@c ------------------------------------------------------------
@node Bugs and problems
@chapter Bugs and problems
@@ -3059,10 +3171,9 @@ Emacs has an inherent fixed limitation on the size of
buffers. This
limit is stricter than the maximum size of objects supported by other
programs on the same architecture.
-The maximum buffer size on 32-bit machines is 512 MBytes beginning
-with version 23.2. If Emacs was built using the
-@code{--with-wide-int} flag, the maximum buffer size on 32-bit
-machines is 2 GB.
+The maximum buffer size on 32-bit machines is 512 MBytes. If Emacs
+was built using the @code{--with-wide-int} flag, the maximum buffer
+size on 32-bit machines is 2 GB.
Emacs compiled on a 64-bit machine can handle much larger buffers; up
to @code{most-positive-fixnum} (2.3 exabytes).
@@ -3126,8 +3237,8 @@ with the following Lisp form,
The above solutions try to prevent the shell from producing the
@samp{^M} characters in the first place. If this is not possible
(e.g., if you use a Windows shell), you can get Emacs to remove these
-characters from the buffer by adding this to your @file{.emacs} init
-file:
+characters from the buffer by adding this to your init file
+(@pxref{Setting up a customization file}):
@smalllisp
(add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m)
@@ -3149,8 +3260,8 @@ stty -icrnl -onlcr -echo susp ^Z
@cindex @code{explicit-shell-file-name}
This might happen because Emacs tries to look for the shell in a wrong
place. If you know where your shell executable is, set the variable
-@code{explicit-shell-file-name} in your @file{.emacs} file to point to
-its full file name.
+@code{explicit-shell-file-name} in your init file (@pxref{Setting up a
+customization file}) to point to its full file name.
@cindex Antivirus programs, and Shell Mode
Some people have trouble with Shell Mode on MS-Windows because of
@@ -3192,18 +3303,18 @@ if ("$term" == emacs) set term=dumb
@node Errors with init files
@section Why does Emacs say @samp{Error in init file}?
-@cindex Error in @file{.emacs}
+@cindex Error in @file{.emacs.d/init.el}
@cindex Error in init file
@cindex Init file, errors in
-@cindex @file{.emacs} file, errors in
-@cindex Debugging @file{.emacs} file
+@cindex @file{.emacs.d/init.el} file, errors in
+@cindex Debugging init file
-An error occurred while loading either your @file{.emacs} file or the
+An error occurred while loading either your init file or the
system-wide file @file{site-lisp/default.el}. Emacs pops the
@file{*Messages*} buffer, and puts there some additional information
about the error, to provide some hints for debugging.
-For information on how to debug your @file{.emacs} file, see
+For information on how to debug your init file, see
@ref{Debugging a customization file}.
It may be the case that you need to load some package first, or use a
@@ -3489,8 +3600,8 @@ and any Emacs Info files that might be in
@file{/usr/local/share/info/}.
@cindex Apple computers, Emacs for
@cindex Macintosh, Emacs for
@cindex macOS, Emacs for
-Beginning with version 22.1, Emacs supports macOS natively.
-See the file @file{nextstep/INSTALL} in the distribution.
+Emacs supports macOS natively. See the file @file{nextstep/INSTALL}
+in the distribution.
@cindex FAQ for Emacs on MS-Windows
@cindex Emacs for MS-Windows
@@ -3499,8 +3610,8 @@ There is a separate FAQ for Emacs on MS-Windows,
@pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}.
@cindex GNUstep, Emacs for
-Beginning with version 23.1, Emacs supports GNUstep natively.
-See the file @file{nextstep/INSTALL} in the distribution.
+Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL}
+in the distribution.
@cindex MS-DOS, Emacs for
@cindex DOS, Emacs for
@@ -3511,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.
@@ -3646,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/}
@@ -3716,9 +3827,10 @@ information is available from
@cindex Keys, binding to commands
@cindex Commands, binding keys to
-Keys can be bound to commands either interactively or in your
-@file{.emacs} file. To interactively bind keys for all modes, type
-@kbd{M-x global-set-key @key{RET} @var{key} @var{cmd} @key{RET}}.
+Keys can be bound to commands either interactively or in your init
+file (@pxref{Setting up a customization file}). To interactively bind
+keys for all modes, type @kbd{M-x global-set-key @key{RET} @var{key}
+@var{cmd} @key{RET}}.
To bind a key just in the current major mode, type @kbd{M-x
local-set-key @key{RET} @var{key} @var{cmd} @key{RET}}.
@@ -3729,7 +3841,7 @@ To make the process of binding keys interactively easier,
use the
following ``trick'': First bind the key interactively, then immediately
type @kbd{C-x @key{ESC} @key{ESC} C-a C-k C-g}. Now, the command needed
to bind the key is in the kill ring, and can be yanked into your
-@file{.emacs} file. If the key binding is global, no changes to the
+init file. If the key binding is global, no changes to the
command are required. For example,
@lisp
@@ -3737,9 +3849,9 @@ command are required. For example,
@end lisp
@noindent
-can be placed directly into the @file{.emacs} file. If the key binding is
-local, the command is used in conjunction with the @samp{add-hook} function.
-For example, in TeX mode, a local binding might be
+can be placed directly into your init file. If the key binding is
+local, the command is used in conjunction with the @samp{add-hook}
+function. For example, in TeX mode, a local binding might be
@lisp
(add-hook 'tex-mode-hook
@@ -3797,14 +3909,15 @@ of these forms before attempting to bind the key
sequence:
@end lisp
@node Terminal setup code works after Emacs has begun
-@section Why doesn't this [terminal or window-system setup] code work in my
@file{.emacs} file, but it works just fine after Emacs starts up?
-@cindex Terminal setup code in @file{.emacs}
+@section Why doesn't this [terminal or window-system setup] code work in my
init file, but it works just fine after Emacs starts up?
+@cindex Terminal setup code in init file
-During startup, Emacs initializes itself according to a given code/file
-order. If some of the code executed in your @file{.emacs} file needs to
-be postponed until the initial terminal or window-system setup code has
-been executed but is not, then you will experience this problem (this
-code/file execution order is not enforced after startup).
+During startup, Emacs initializes itself according to a given
+code/file order. If some of the code executed in your init file
+(@pxref{Setting up a customization file}) needs to be postponed until
+the initial terminal or window-system setup code has been executed but
+is not, then you will experience this problem (this code/file
+execution order is not enforced after startup).
To postpone the execution of Emacs Lisp code until after terminal or
window-system setup, treat the code as a @dfn{lambda list} and add it to
@@ -4225,8 +4338,7 @@ Emacs Manual}. For more sophisticated methods,
@cindex bidirectional scripts
Emacs supports display and editing of bidirectional scripts, such as
-Arabic, Farsi, and Hebrew, since version 24.1.
-@xref{New in Emacs 24, bidirectional display}.
+Arabic, Farsi, and Hebrew.
@node How to add fonts
@@ -4254,7 +4366,8 @@ arrange for these two commands to run whenever you log
in, e.g., by
adding them to your window-system startup file, such as
@file{~/.xsessionrc} or @file{~/.gnomerc}.
-Now, add the following line to your @file{~/.emacs} init file:
+Now, add the following line to your init file (@pxref{Setting up a
+customization file}):
@lisp
(add-to-list 'bdf-directory-list "/usr/share/emacs/fonts/bdf")
@@ -4264,15 +4377,15 @@ Now, add the following line to your @file{~/.emacs}
init file:
(Again, modify the file name if you installed the fonts elsewhere.)
Finally, if you wish to use the installed fonts with @code{ps-print},
-add the following line to your @file{~/.emacs}:
+add the following line to your init file:
@lisp
(setq ps-multibyte-buffer 'bdf-font-except-latin)
@end lisp
-You can now use the Emacs font menu to select the @samp{bdf: 16-dot medium}
-fontset, or you can select it by setting the default font in your
-@file{~/.emacs}:
+You can now use the Emacs font menu to select the @samp{bdf: 16-dot
+medium} fontset, or you can select it by setting the default font in
+your init file:
@lisp
(set-frame-font "fontset-bdf")
@@ -4334,9 +4447,9 @@ yourself by putting
@end lisp
@noindent
-in your @file{.emacs} file. You can automatically include an @samp{FCC}
-field by putting something like the following in your @file{.emacs}
-file:
+in your init file (@pxref{Setting up a customization file}). You can
+automatically include an @samp{FCC} field by putting something like
+the following in your init file:
@lisp
(setq mail-archive-file-name (expand-file-name "~/outgoing"))
@@ -4368,8 +4481,7 @@ To expand them before this, use @kbd{M-x
expand-mail-aliases}.
Emacs normally only reads the @file{.mailrc} file once per session, when
you start to compose your first mail message. If you edit the file
after this, you can use @kbd{M-x build-mail-aliases} to make Emacs
-reread it. Prior to Emacs 24.1, this is not an interactive command, so
-you must instead type @kbd{M-: (build-mail-aliases) @key{RET}}.
+reread it.
@item
If you like, you can expand mail aliases as abbrevs, as soon as you
@@ -4467,7 +4579,7 @@ gnus
@end example
It is probably unwise to automatically start your mail or news reader
-from your @file{.emacs} file. This would cause problems if you needed to run
+from your init file. This would cause problems if you needed to run
two copies of Emacs at the same time. Also, this would make it difficult for
you to start Emacs quickly when you needed to.
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
new file mode 100644
index 0000000000..5a20028702
--- /dev/null
+++ b/doc/misc/eglot.texi
@@ -0,0 +1,1139 @@
+\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
+(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.
+
+@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-error}.
+
+@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 portion of the
+settings contained in this variable to each server for which such
+settings were defined in the variable. 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; Eglot will use for each server only
+the section of the parameters intended for that server.
+
+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
+(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/eieio.texi b/doc/misc/eieio.texi
index 18a2b74033..b1ec5c0dce 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -193,7 +193,7 @@ also differs in some other aspects which are mentioned
below (also
@enumerate
@item
A structured framework for the creation of basic classes with attributes
-and methods using singular inheritance similar to CLOS.
+and methods using inheritance similar to CLOS.
@item
Type checking, and slot unbinding.
@item
@@ -225,11 +225,6 @@ lacks:
@table @asis
-@item Method dispatch
-EIEO does not support method dispatch for built-in types and multiple
-arguments types. In other words, method dispatch only looks at the
-first argument, and this one must be an @eieio{} type.
-
@item Support for metaclasses
There is just one default metaclass, @code{eieio-default-superclass},
and you cannot define your own. The @code{:metaclass} tag in
@@ -856,11 +851,6 @@ You can also create a generic method with
@code{cl-defmethod}
(@pxref{Methods}). When a method is created and there is no generic
method in place with that name, then a new generic will be created,
and the new method will use it.
-
-In CLOS, a generic method can also be used to provide an argument list
-and dispatch precedence for all the arguments. In @eieio{},
-dispatching only occurs for the first argument, so the @var{arglist}
-is not used.
@end defmac
@node Methods
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 13f13163dd..ff368c9dc4 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -256,7 +256,6 @@ as an argument will ``spread'' the elements into multiple
arguments:
@end example
@subsection Quoting and escaping
-
As with other shells, you can escape special characters and spaces
with by prefixing the character with a backslash (@code{\}), or by
surrounding the string with apostrophes (@code{''}) or double quotes
@@ -268,6 +267,40 @@ When using expansions (@pxref{Expansion}) in an Eshell
command, the
result may potentially be of any data type. To ensure that the result
is always a string, the expansion can be surrounded by double quotes.
+@subsection Special argument types
+In addition to strings and numbers, Eshell supports a number of
+special argument types. These let you refer to various other Emacs
+Lisp data types, such as lists or buffers.
+
+@table @code
+
+@item #'@var{lisp-form}
+This refers to the quoted Emacs Lisp form @var{lisp-form}. Though
+this looks similar to the ``sharp quote'' syntax for functions
+(@pxref{Special Read Syntax, , , elisp, The Emacs Lisp Reference
+Manual}), it instead corresponds to @code{quote} and can be used for
+any quoted form.@footnote{Eshell would interpret a bare apostrophe
+(@code{'}) as the start of a single-quoted string.}
+
+@item `@var{lisp-form}
+This refers to the backquoted Emacs Lisp form @var{lisp-form}
+(@pxref{Backquote, , , elisp, The Emacs Lisp Reference Manual}). As
+in Emacs Lisp, you can use @samp{,} and @samp{,@@} to refer to
+non-constant values.
+
+@item #<buffer @var{name}>
+@itemx #<@var{name}>
+Return the buffer named @var{name}. This is equivalent to
+@samp{$(get-buffer-create "@var{name}")} (@pxref{Creating Buffers, , ,
+elisp, The Emacs Lisp Reference Manual}).
+
+@item #<process @var{name}>
+Return the process named @var{name}. This is equivalent to
+@samp{$(get-process "@var{name}")} (@pxref{Process Information, , ,
+elisp, The Emacs Lisp Reference Manual}).
+
+@end table
+
@node Built-ins
@section Built-in commands
Several commands are built-in in Eshell. In order to call the
@@ -406,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
@@ -666,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
@@ -715,7 +751,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
@@ -762,12 +800,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
@@ -853,12 +891,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:
@@ -881,6 +942,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
@@ -1105,7 +1176,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
@@ -1560,6 +1631,13 @@ Reverses the order of a list of values.
Since Eshell does not communicate with a terminal like most command
shells, IO is a little different.
+@menu
+* Visual Commands::
+* Redirection::
+* Pipelines::
+@end menu
+
+@node Visual Commands
@section Visual Commands
If you try to run programs from within Eshell that are not
line-oriented, such as programs that use ncurses, you will just get
@@ -1592,40 +1670,142 @@ program exits, customize the variable
@code{eshell-destroy-buffer-when-process-dies} to a non-@code{nil}
value; the default is @code{nil}.
+@node Redirection
@section Redirection
-Redirection is mostly the same in Eshell as it is in other command
-shells. The output redirection operators @code{>} and @code{>>} as
-well as pipes are supported, but there is not yet any support for
-input redirection. Output can also be redirected to buffers, using
-the @code{>>>} redirection operator, and Elisp functions, using
-virtual devices.
-
-The buffer redirection operator, @code{>>>}, expects a buffer object
-on the right-hand side, into which it inserts the output of the
-left-hand side. e.g., @samp{echo hello >>> #<buffer *scratch*>}
-inserts the string @code{"hello"} into the @file{*scratch*} buffer.
-The convenience shorthand variant @samp{#<@var{buffer-name}>}, as in
-@samp{#<*scratch*>}, is also accepted.
-
-@code{eshell-virtual-targets} is a list of mappings of virtual device
-names to functions. Eshell comes with two virtual devices:
-@file{/dev/kill}, which sends the text to the kill ring, and
-@file{/dev/clip}, which sends text to the clipboard.
+Redirection in Eshell is similar to that of other command shells. You
+can use the output redirection operators @code{>} and @code{>>}, but
+there is not yet any support for input redirection. In the cases
+below, @var{fd} specifies the file descriptor to redirect; if not
+specified, file descriptor 1 (standard output) will be used by
+default.
+
+@table @code
+
+@item > @var{dest}
+@itemx @var{fd}> @var{dest}
+Redirect output to @var{dest}, overwriting its contents with the new
+output.
+
+@item >> @var{dest}
+@itemx @var{fd}>> @var{dest}
+Redirect output to @var{dest}, appending it to the existing contents
+of @var{dest}.
+
+@item >>> @var{buffer}
+@itemx @var{fd}>>> @var{buffer}
+Redirect output to @var{dest}, inserting it at the current mark if
+@var{dest} is a buffer, at the beginning of the file if @var{dest} is
+a file, or otherwise behaving the same as @code{>>}.
+
+@item &> @var{file}
+@itemx >& @var{file}
+Redirect both standard output and standard error to @var{dest},
+overwriting its contents with the new output.
+
+@item &>> @var{file}
+@itemx >>& @var{file}
+Redirect both standard output and standard error to @var{dest},
+appending it to the existing contents of @var{dest}.
+
+@item &>>> @var{file}
+@itemx >>>& @var{file}
+Redirect both standard output and standard error to @var{dest},
+inserting it like with @code{>>> @var{file}}.
+
+@item >&@var{other-fd}
+@itemx @var{fd}>&@var{other-fd}
+Duplicate the file descriptor @var{other-fd} to @var{fd} (or 1 if
+unspecified). The order in which this is used is significant, so
+
+@example
+@var{command} > @var{file} 2>&1
+@end example
+
+redirects both standard output and standard error to @var{file},
+whereas
+
+@example
+@var{command} 2>&1 > @var{file}
+@end example
+
+only redirects standard output to @var{file} (and sends standard error
+to the display via standard output's original handle).
+
+@end table
+Eshell supports redirecting output to several different types of
+targets:
+
+@itemize @bullet
+
+@item
+files, including virtual targets (see below);
+
+@item
+buffers (@pxref{Buffers, , , elisp, GNU Emacs Lisp Reference Manual});
+
+@item
+markers (@pxref{Markers, , , elisp, GNU Emacs Lisp Reference Manual});
+
+@item
+processes (@pxref{Processes, , , elisp, GNU Emacs Lisp Reference
+Manual}); and
+
+@item
+symbols (@pxref{Symbols, , , elisp, GNU Emacs Lisp Reference Manual}).
+
+@end itemize
+
+@subsection Virtual Targets
+Virtual targets are mapping of device names to functions. Eshell
+comes with four virtual devices:
+
+@table @file
+
+@item /dev/null
+Does nothing with the output passed to it.
+
+@item /dev/eshell
+Writes the text passed to it to the display.
+
+@item /dev/kill
+Adds the text passed to it to the kill ring.
+
+@item /dev/clip
+Adds the text passed to it to the clipboard.
+
+@end table
+
+@vindex eshell-virtual-targets
You can, of course, define your own virtual targets. They are defined
-by adding a list of the form @samp{("/dev/name" @var{function} @var{mode})} to
-@code{eshell-virtual-targets}. The first element is the device name;
-@var{function} may be either a lambda or a function name. If
-@var{mode} is @code{nil}, then the function is the output function; if it is
-non-@code{nil}, then the function is passed the redirection mode as a
-symbol--@code{overwrite} for @code{>}, @code{append} for @code{>>}, or
-@code{insert} for @code{>>>}--and the function is expected to return
-the output function.
+by adding a list of the form @samp{("/dev/name" @var{function}
+@var{mode})} to @code{eshell-virtual-targets}. The first element is
+the device name; @var{function} may be either a lambda or a function
+name. If @var{mode} is @code{nil}, then the function is the output
+function; if it is non-@code{nil}, then the function is passed the
+redirection mode as a symbol--@code{overwrite} for @code{>},
+@code{append} for @code{>>}, or @code{insert} for @code{>>>}--and the
+function is expected to return the output function.
The output function is called once on each line of output until
@code{nil} is passed, indicating end of output.
-@section Running Shell Pipelines Natively
+@node Pipelines
+@section Pipelines
+As with most other shells, Eshell supports pipelines to pass the
+output of one command the input of the next command. You can send the
+standard output of one command to the standard input of another using
+the @code{|} operator. For example,
+
+@example
+~ $ echo hello | rev
+olleh
+@end example
+
+To send both the standard output and standard error of a command to
+another command's input, you can use the @code{|&} operator.
+
+@subsection Running Shell Pipelines Natively
When constructing shell pipelines that will move a lot of data, it is
a good idea to bypass Eshell's own pipelining support and use the
operating system shell's instead. This is especially relevant when
@@ -2113,10 +2293,9 @@ current being used.
@item How can Eshell learn if a background process has requested input?
-@item Support @samp{2>&1} and @samp{>&} and @samp{2>} and @samp{|&}
+@item Make a customizable syntax table for redirects
-The syntax table for parsing these should be customizable, such that the
-user could change it to use rc syntax: @samp{>[2=1]}.
+This way, the user could change it to use rc syntax: @samp{>[2=1]}.
@item Allow @samp{$_[-1]}, which would indicate the last element of the array
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 953e4605e9..da1695099a 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -1,8 +1,8 @@
\input texinfo @c -*- mode: texinfo; coding: utf-8 -*-
@comment %**start of header
@setfilename ../../info/flymake.info
-@set VERSION 1.2
-@set UPDATED September 2021
+@set VERSION 1.2.2
+@set UPDATED November 2021
@settitle GNU Flymake @value{VERSION}
@include docstyle.texi
@syncodeindex pg cp
@@ -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
@@ -801,6 +801,7 @@ Binding,,, elisp, The Emacs Lisp Reference Manual}) to be
active.
for type = (if (string-match "^warning" msg)
:warning
:error)
+ when (and beg end)
collect (flymake-make-diagnostic source
beg
end
@@ -877,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
diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi
deleted file mode 100644
index 0858432acf..0000000000
--- a/doc/misc/gnus-coding.texi
+++ /dev/null
@@ -1,227 +0,0 @@
-\input texinfo
-
-@setfilename gnus-coding.info
-@settitle Gnus Coding Style and Maintenance Guide
-@include docstyle.texi
-@syncodeindex fn cp
-@syncodeindex vr cp
-@syncodeindex pg cp
-
-@copying
-Copyright @copyright{} 2004--2005, 2007--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
-
-
-@titlepage
-@title Gnus Coding Style and Maintenance Guide
-
-@author by Reiner Steib <Reiner.Steib@@gmx.de>
-
-@insertcopying
-@end titlepage
-
-@c Obviously this is only a very rudimentary draft. We put it in the
-@c repository anyway hoping that it might annoy someone enough to fix
-@c it. ;-) Fixing only a paragraph also is appreciated.
-
-@ifnottex
-@node Top
-@top Gnus Coding Style and Maintenance Guide
-This manual describes @dots{}
-
-@insertcopying
-@end ifnottex
-
-@menu
-* Gnus Coding Style:: Gnus Coding Style
-* Gnus Maintenance Guide:: Gnus Maintenance Guide
-* GNU Free Documentation License:: The license for this documentation.
-@end menu
-
-@c @ref{Gnus Reference Guide, ,Gnus Reference Guide, gnus, The Gnus Newsreader}
-
-@node Gnus Coding Style
-@chapter Gnus Coding Style
-@section Dependencies
-
-The Gnus distribution contains a lot of libraries that have been written
-for Gnus and used intensively for Gnus. But many of those libraries are
-useful on their own. E.g., other Emacs Lisp packages might use the
-@acronym{MIME} library @xref{Top, ,Top, emacs-mime, The Emacs MIME
-Manual}.
-
-@subsection General purpose libraries
-
-@table @file
-
-@item netrc.el
-@file{.netrc} parsing functionality.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item format-spec.el
-Functions for formatting arbitrary formatting strings.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item hex-util.el
-Functions to encode/decode hexadecimal string.
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-@end table
-
-@subsection Encryption and security
-
-@table @file
-@item encrypt.el
-File encryption routines
-@c As of 2005-10-25...
-There are no Gnus dependencies in this file.
-
-@item password.el
-Read passwords from user, possibly using a password cache.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item sha1.el
-SHA1 Secure Hash Algorithm.
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-@end table
-
-@subsection Networking
-
-@table @file
-@item dig.el
-Domain Name System dig interface.
-@c As of 2005-10-21...
-There are no serious Gnus dependencies in this file. Uses
-@code{gnus-run-mode-hooks} (a wrapper function).
-
-@item dns.el, dns-mode.el
-Domain Name Service lookups.
-@c As of 2005-10-21...
-There are no Gnus dependencies in these files.
-@end table
-
-@subsection Mail and News related RFCs
-
-@table @file
-@item pop3.el
-Post Office Protocol (RFC 1460) interface.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item imap.el
-@acronym{IMAP} library.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item ietf-drums.el
-Functions for parsing RFC 2822 headers.
-@c As of 2005-10-21...
-There are no Gnus dependencies in this file.
-
-@item rfc1843.el
-HZ (rfc1843) decoding. HZ is a data format for exchanging files of
-arbitrarily mixed Chinese and @acronym{ASCII} characters.
-@c As of 2005-10-21...
-@code{rfc1843-gnus-setup} seem to be useful only for Gnus. Maybe this
-function should be relocated to remove dependencies on Gnus. Other
-minor dependencies: @code{gnus-newsgroup-name} could be eliminated by
-using an optional argument to @code{rfc1843-decode-article-body}.
-
-@item rfc2045.el
-Functions for decoding rfc2045 headers
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-
-@item rfc2047.el
-Functions for encoding and decoding rfc2047 messages
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-@c
-Only a couple of tests for gnusy symbols.
-
-@item rfc2104.el
-RFC2104 Hashed Message Authentication Codes
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-
-@item rfc2231.el
-Functions for decoding rfc2231 headers
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-
-@item flow-fill.el
-Interpret RFC2646 "flowed" text.
-@c As of 2005-10-27...
-There are no Gnus dependencies in this file.
-
-@item uudecode.el
-Elisp native uudecode.
-@c As of 2005-12-06...
-There are no Gnus dependencies in this file.
-@c ... but the custom group is gnus-extract.
-
-@item canlock.el
-Functions for Cancel-Lock feature
-@c Cf. draft-ietf-usefor-cancel-lock-01.txt
-@c Although this draft has expired, Canlock-Lock revived in 2007 when
-@c major news providers (e.g., news.individual.org) started to use it.
-@c As of 2007-08-25...
-There are no Gnus dependencies in these files.
-
-@end table
-
-@subsection message
-
-All message composition from Gnus (both mail and news) takes place in
-Message mode buffers. Message mode is intended to be a replacement for
-Emacs mail mode. There should be no Gnus dependencies in
-@file{message.el}. Alas it is not anymore. Patches and suggestions to
-remove the dependencies are welcome.
-
-@c message.el requires nnheader which requires gnus-util.
-
-@subsection Emacs @acronym{MIME}
-
-The files @file{mml*.el} and @file{mm-*.el} provide @acronym{MIME}
-functionality for Emacs.
-
-@acronym{MML} (@acronym{MIME} Meta Language) is supposed to be
-independent from Gnus. Alas it is not anymore. Patches and suggestions
-to remove the dependencies are welcome.
-
-@subsection Gnus backends
-
-The files @file{nn*.el} provide functionality for accessing NNTP
-(@file{nntp.el}), IMAP (@file{nnimap.el}) and several other Mail back
-ends (probably @file{nnml.el}, @file{nnfolder.el} and
-@file{nnmaildir.el} are the most widely used mail back ends).
-
-@c mm-uu requires nnheader which requires gnus-util. message.el also
-@c requires nnheader.
-
-
-@node GNU Free Documentation License
-@appendix GNU Free Documentation License
-@include doclicense.texi
-
-@c Local Variables:
-@c mode: texinfo
-@c coding: utf-8
-@c End:
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 6d09fd4ec9..7cb5621b69 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -49,23 +49,23 @@ This is the Gnus Frequently Asked Questions list.
Gnus is a Usenet Newsreader and Electronic Mail User Agent implemented
as a part of Emacs. It's been around in some form since the early
1990s, and has been distributed as a standard part of Emacs for much
-of that time. Gnus 5 is the latest (and greatest) incarnation. The
+of that time. Gnus 5 is the latest (and greatest) incarnation. The
original version was called GNUS, and was written by Masanobu UMEDA@.
When autumn crept up in 1994, Lars Magne Ingebrigtsen grew bored and
decided to rewrite Gnus.
Its biggest strength is the fact that it is extremely
-customizable. It is somewhat intimidating at first glance, but
+customizable. It is somewhat intimidating at first glance, but
most of the complexity can be ignored until you're ready to take
-advantage of it. If you receive a reasonable volume of e-mail
+advantage of it. If you receive a reasonable volume of e-mail
(you're on various mailing lists), or you would like to read
high-volume mailing lists but cannot keep up with them, or read
high volume newsgroups or are just bored, then Gnus is what you
want.
-This FAQ was maintained by Justin Sheehy until March 2002. He
+This FAQ was maintained by Justin Sheehy until March 2002. He
would like to thank Steve Baur and Per Abrahamsen for doing a wonderful
-job with this FAQ before him. We would like to do the same: thanks,
+job with this FAQ before him. We would like to do the same: thanks,
Justin!
The information contained here was compiled with the assistance
@@ -117,7 +117,7 @@ development version that became Gnus 5.12.
@menu
* FAQ 2-1:: Every time I start Gnus I get a message "Gnus auto-save
- file exists. Do you want to read it?", what does this mean and
+ file exists. Do you want to read it?", what does this mean and
how to prevent it?
* FAQ 2-2:: Gnus doesn't remember which groups I'm subscribed to,
what's this?
@@ -133,7 +133,7 @@ development version that became Gnus 5.12.
@subsubheading Question 2.1
Every time I start Gnus I get a message "Gnus auto-save
-file exists. Do you want to read it?", what does this mean
+file exists. Do you want to read it?", what does this mean
and how to prevent it?
@subsubheading Answer
@@ -168,8 +168,8 @@ How to change the format of the lines in Group buffer?
@subsubheading Answer
You've got to tweak the value of the variable
-gnus-group-line-format. See the manual node "Group Line
-Specification" for information on how to do this. An
+gnus-group-line-format. See the manual node "Group Line
+Specification" for information on how to do this. An
example for this (guess from whose .gnus :-)):
@example
@@ -192,11 +192,11 @@ Linux under the topic linux, all dealing with music under
the topic music and all dealing with scottish music under
the topic scottish which is a subtopic of music.
-To enter topic mode, just hit t while in Group buffer. Now
+To enter topic mode, just hit t while in Group buffer. Now
you can use @samp{T n} to create a topic
at point and @samp{T m} to move a group to
-a specific topic. For more commands see the manual or the
-menu. You might want to include the %P specifier at the
+a specific topic. For more commands see the manual or the
+menu. You might want to include the %P specifier at the
beginning of your gnus-group-line-format variable to have
the groups nicely indented.
@@ -231,7 +231,7 @@ hit @samp{C-y}.
possible?
* FAQ 3-7:: And how about local spool files?
* FAQ 3-8:: OK, reading news works now, but I want to be able to
- read my mail with Gnus, too. How to do it?
+ read my mail with Gnus, too. How to do it?
* FAQ 3-9:: And what about IMAP?
* FAQ 3-10:: At the office we use one of those MS Exchange servers,
can I use Gnus to read my mail from it?
@@ -248,8 +248,8 @@ but it only says "nntp (news) open error", what to do?
@subsubheading Answer
-You've got to tell Gnus where to fetch the news from. Read
-the documentation for information on how to do this. As a
+You've got to tell Gnus where to fetch the news from. Read
+the documentation for information on how to do this. As a
first start, put those lines in @file{~/.gnus.el}:
@example
@@ -279,7 +279,7 @@ directory Emacs chooses will most certainly not be what
you want, so let's do it the correct way.
The first thing you've got to do is to
create a suitable directory (no blanks in names
-please), e.g., c:\myhome. Then you must set the environment
+please), e.g., c:\myhome. Then you must set the environment
variable HOME to this directory. To do this under Windows 9x
or Me include the line
@@ -290,7 +290,7 @@ SET HOME=C:\myhome
in your autoexec.bat and reboot. Under NT, 2000 and XP, hit
Winkey+Pause/Break to enter system options (if it doesn't work, go
-to Control Panel -> System -> Advanced). There you'll find the
+to Control Panel -> System -> Advanced). There you'll find the
possibility to set environment variables. Create a new one with
name HOME and value C:\myhome. Rebooting is not necessary.
@@ -333,8 +333,8 @@ subscribe to a group.
If you know the name of the group say @samp{U
name.of.group @key{RET}} in group buffer (use the
-tab-completion Luke). Otherwise hit ^ in group buffer,
-this brings you to the server buffer. Now place point (the
+tab-completion Luke). Otherwise hit ^ in group buffer,
+this brings you to the server buffer. Now place point (the
cursor) over the server which carries the group you want,
hit @samp{@key{RET}}, move point to the group
you want to subscribe to and say @samp{u}
@@ -349,7 +349,7 @@ post on this server as well as I am, what's that?
@subsubheading Answer
Some providers allow restricted anonymous access and full
-access only after authorization. To make Gnus send authinfo
+access only after authorization. To make Gnus send authinfo
to those servers append
@example
@@ -366,8 +366,8 @@ I want Gnus to fetch news from several servers, is this
possible?
@subsubheading Answer
-Of course. You can specify more sources for articles in the
-variable gnus-secondary-select-methods. Add something like
+Of course. You can specify more sources for articles in the
+variable gnus-secondary-select-methods. Add something like
this in @file{~/.gnus.el}:
@example
@@ -418,25 +418,25 @@ to post articles, see the Gnus manual on how to do this.
@subsubheading Question 3.8
OK, reading news works now, but I want to be able to read my mail
-with Gnus, too. How to do it?
+with Gnus, too. How to do it?
@subsubheading Answer
That's a bit harder since there are many possible sources
for mail, many possible ways for storing mail and many
-different ways for sending mail. The most common cases are
+different ways for sending mail. The most common cases are
these: 1: You want to read your mail from a pop3 server and
send them directly to a SMTP Server 2: Some program like
fetchmail retrieves your mail and stores it on disk from
-where Gnus shall read it. Outgoing mail is sent by
-Sendmail, Postfix or some other MTA@. Sometimes, you even
+where Gnus shall read it. Outgoing mail is sent by
+Sendmail, Postfix or some other MTA@. Sometimes, you even
need a combination of the above cases.
However, the first thing to do is to tell Gnus in which way
it should store the mail, in Gnus terminology which back end
-to use. Gnus supports many different back ends, the most
-commonly used one is nnml. It stores every mail in one file
-and is therefore quite fast. However you might prefer a one
+to use. Gnus supports many different back ends, the most
+commonly used one is nnml. It stores every mail in one file
+and is therefore quite fast. However you might prefer a one
file per group approach if your file system has problems with
many small files, the nnfolder back end is then probably the
choice for you. To use nnml add the following to @file{~/.gnus.el}:
@@ -453,7 +453,7 @@ As you might have guessed, if you want nnfolder, it's
@end example
@noindent
-Now we need to tell Gnus, where to get its mail from. If
+Now we need to tell Gnus, where to get its mail from. If
it's a POP3 server, then you need something like this:
@example
@@ -465,7 +465,7 @@ it's a POP3 server, then you need something like this:
@noindent
Make sure @file{~/.gnus.el} isn't readable to others if you store
-your password there. If you want to read your mail from a
+your password there. If you want to read your mail from a
traditional spool file on your local machine, it's
@example
@@ -499,10 +499,10 @@ mail, it's
Where :suffix ".prcml" tells Gnus only to use files with the
suffix .prcml.
-OK, now you only need to tell Gnus how to send mail. If you
+OK, now you only need to tell Gnus how to send mail. If you
want to send mail via sendmail (or whichever MTA is playing
the role of sendmail on your system), you don't need to do
-anything. However, if you want to send your mail to an
+anything. However, if you want to send your mail to an
SMTP Server you need the following in your @file{~/.gnus.el}
@example
@@ -519,9 +519,9 @@ And what about IMAP?
@subsubheading Answer
-There are two ways of using IMAP with Gnus. The first one is
+There are two ways of using IMAP with Gnus. The first one is
to use IMAP like POP3, that means Gnus fetches the mail from
-the IMAP server and stores it on disk. If you want to do
+the IMAP server and stores it on disk. If you want to do
this (you don't really want to do this) add the following to
@file{~/.gnus.el}
@@ -586,7 +586,7 @@ each POP3 mail source. @xref{Mail Source Specifiers}, for
details on
@subsection Reading messages
@menu
-* FAQ 4-1:: When I enter a group, all read messages are gone. How to
+* FAQ 4-1:: When I enter a group, all read messages are gone. How to
view them again?
* FAQ 4-2:: How to tell Gnus to show an important message every time
I enter a group, even when it's read?
@@ -595,7 +595,7 @@ each POP3 mail source. @xref{Mail Source Specifiers}, for
details on
* FAQ 4-5:: How can I change the headers Gnus displays by default at
the top of the article buffer?
* FAQ 4-6:: I'd like Gnus NOT to render HTML-mails but show me the
- text part if it's available. How to do it?
+ text part if it's available. How to do it?
* FAQ 4-7:: Can I use some other browser than shr to render my
HTML-mails?
* FAQ 4-8:: Is there anything I can do to make poorly formatted
@@ -609,7 +609,7 @@ each POP3 mail source. @xref{Mail Source Specifiers}, for
details on
those?
* FAQ 4-12:: The number of total messages in a group which Gnus
displays in group buffer is by far to high, especially in mail
- groups. Is this a bug?
+ groups. Is this a bug?
* FAQ 4-13:: I don't like the layout of summary and article buffer,
how to change it? Perhaps even a three pane display?
* FAQ 4-14:: I don't like the way the Summary buffer looks, how to
@@ -621,15 +621,15 @@ each POP3 mail source. @xref{Mail Source Specifiers},
for details on
@node FAQ 4-1
@subsubheading Question 4.1
-When I enter a group, all read messages are gone. How to view them again?
+When I enter a group, all read messages are gone. How to view them again?
@subsubheading Answer
If you enter the group by saying
@samp{@key{RET}}
-in group buffer with point over the group, only unread and ticked messages are
loaded. Say
+in group buffer with point over the group, only unread and ticked messages are
loaded. Say
@samp{C-u @key{RET}}
-instead to load all available messages. If you want only the 300 newest say
+instead to load all available messages. If you want only the 300 newest say
@samp{C-u 300 @key{RET}}
Loading only unread messages can be annoying if you have threaded view
enabled, say
@@ -658,9 +658,9 @@ enter a group, even when it's read?
@subsubheading Answer
-You can tick important messages. To do this hit
+You can tick important messages. To do this hit
@samp{u} while point is in summary buffer
-over the message. When you want to remove the mark, hit
+over the message. When you want to remove the mark, hit
either @samp{d} (this deletes the tick
mark and set's unread mark) or @samp{M c}
(which deletes all marks for the message).
@@ -700,7 +700,7 @@ the top of the article buffer?
The variable gnus-visible-headers controls which headers
are shown, its value is a regular expression, header lines
-which match it are shown. So if you want author, subject,
+which match it are shown. So if you want author, subject,
date, and if the header exists, Followup-To and MUA / NUA
say this in @file{~/.gnus.el}:
@@ -715,7 +715,7 @@ say this in @file{~/.gnus.el}:
@subsubheading Question 4.6
I'd like Gnus NOT to render HTML-mails but show me the
-text part if it's available. How to do it?
+text part if it's available. How to do it?
@subsubheading Answer
@@ -728,7 +728,7 @@ Say
@end example
@noindent
-in @file{~/.gnus.el}. If you don't want HTML rendered, even if there's no text
alternative add
+in @file{~/.gnus.el}. If you don't want HTML rendered, even if there's no
text alternative add
@example
(setq mm-automatic-display (remove "text/html" mm-automatic-display))
@@ -764,7 +764,7 @@ more readable?
Gnus offers you several functions to ``wash'' incoming mail, you can
find them if you browse through the menu, item
-Article->Washing. The most interesting ones are probably ``Wrap
+Article->Washing. The most interesting ones are probably ``Wrap
long lines'' (@samp{W w}), ``Decode ROT13''
(@samp{W r}) and ``Outlook Deuglify'' which repairs
the dumb quoting used by many users of Microsoft products
@@ -781,40 +781,40 @@ highlight more interesting ones in some way?
@subsubheading Answer
-You want Scoring. Scoring means, that you define rules
-which assign each message an integer value. Depending on
+You want Scoring. Scoring means, that you define rules
+which assign each message an integer value. Depending on
the value the message is highlighted in summary buffer (if
it's high, say +2000) or automatically marked read (if the
value is low, say @minus{}800) or some other action happens.
There are basically three ways of setting up rules which assign
-the scoring-value to messages. The first and easiest way is to set
-up rules based on the article you are just reading. Say you're
+the scoring-value to messages. The first and easiest way is to set
+up rules based on the article you are just reading. Say you're
reading a message by a guy who always writes nonsense and you want
-to ignore his messages in the future. Hit
+to ignore his messages in the future. Hit
@samp{L}, to set up a rule which lowers the score.
Now Gnus asks you which the criteria for lowering the Score shall
-be. Hit @samp{?} twice to see all possibilities,
+be. Hit @samp{?} twice to see all possibilities,
we want @samp{a} which means the author (the from
-header). Now Gnus wants to know which kind of matching we want.
+header). Now Gnus wants to know which kind of matching we want.
Hit either @samp{e} for an exact match or
@samp{s} for substring-match and delete afterwards
everything but the name to score down all authors with the given
-name no matter which email address is used. Now you need to tell
+name no matter which email address is used. Now you need to tell
Gnus when to apply the rule and how long it should last, hit
@samp{p} to apply the rule now and let it last
-forever. If you want to raise the score instead of lowering it say
+forever. If you want to raise the score instead of lowering it say
@samp{I} instead of @samp{L}.
-You can also set up rules by hand. To do this say @samp{V
-f} in summary buffer. Then you are asked for the name
+You can also set up rules by hand. To do this say @samp{V
+f} in summary buffer. Then you are asked for the name
of the score file, it's name.of.group.SCORE for rules valid in
-only one group or all.Score for rules valid in all groups. See the
+only one group or all.Score for rules valid in all groups. See the
Gnus manual for the exact syntax, basically it's one big list
whose elements are lists again. the first element of those lists
is the header to score on, then one more list with what to match,
which score to assign, when to expire the rule and how to do the
-matching. If you find me very interesting, you could add the
+matching. If you find me very interesting, you could add the
following to your all.Score:
@example
@@ -825,14 +825,14 @@ following to your all.Score:
This would add 999 to the score of messages written by me
and 500 to the score of messages which are a (possibly
-indirect) answer to a message written by me. Of course
+indirect) answer to a message written by me. Of course
nobody with a sane mind would do this :-)
-The third alternative is adaptive scoring. This means Gnus
+The third alternative is adaptive scoring. This means Gnus
watches you and tries to find out what you find
interesting and what annoying and sets up rules
-which reflect this. Adaptive scoring can be a huge help
-when reading high traffic groups. If you want to activate
+which reflect this. Adaptive scoring can be a huge help
+when reading high traffic groups. If you want to activate
adaptive scoring say
@example
@@ -852,11 +852,11 @@ set other variables specific for some groups?
While in group buffer move point over the group and hit
@samp{G c}, this opens a buffer where you
-can set options for the group. At the bottom of the buffer
+can set options for the group. At the bottom of the buffer
you'll find an item that allows you to set variables
-locally for the group. To disable threading enter
+locally for the group. To disable threading enter
gnus-show-threads as name of variable and @code{nil} as
-value. Hit button done at the top of the buffer when
+value. Hit button done at the top of the buffer when
you're ready.
@node FAQ 4-11
@@ -868,7 +868,7 @@ those?
@subsubheading Answer
Stop those "Can I ..." questions, the answer is always yes
-in Gnus Country :-). It's a three step process: First we
+in Gnus Country :-). It's a three step process: First we
make faces (specifications of how summary-line shall look
like) for those postings, then we'll give them some
special score and finally we'll tell Gnus to use the new
@@ -879,16 +879,16 @@ faces.
The number of total messages in a group which Gnus
displays in group buffer is by far to high, especially in
-mail groups. Is this a bug?
+mail groups. Is this a bug?
@subsubheading Answer
No, that's a matter of design of Gnus, fixing this would
mean reimplementation of major parts of Gnus'
-back ends. Gnus thinks ``highest-article-number @minus{}
-lowest-article-number = total-number-of-articles''. This
+back ends. Gnus thinks ``highest-article-number @minus{}
+lowest-article-number = total-number-of-articles''. This
works OK for Usenet groups, but if you delete and move
-many messages in mail groups, this fails. To cure the
+many messages in mail groups, this fails. To cure the
symptom, enter the group via @samp{C-u @key{RET}}
(this makes Gnus get all messages), then
hit @samp{M P b} to mark all messages and
@@ -907,9 +907,9 @@ to change it? Perhaps even a three pane display?
@subsubheading Answer
You can control the windows configuration by calling the
-function gnus-add-configuration. The syntax is a bit
+function gnus-add-configuration. The syntax is a bit
complicated but explained very well in the manual node
-"Window Layout". Some popular examples:
+"Window Layout". Some popular examples:
Instead 25% summary 75% article buffer 35% summary and 65%
article (the 1.0 for article means "take the remaining
@@ -951,11 +951,11 @@ I don't like the way the Summary buffer looks, how to
tweak it?
@subsubheading Answer
You've got to play around with the variable
-gnus-summary-line-format. Its value is a string of
+gnus-summary-line-format. Its value is a string of
symbols which stand for things like author, date, subject
-etc. A list of the available specifiers can be found in the
+etc. A list of the available specifiers can be found in the
manual node ``Summary Buffer Lines'' and the often forgotten
-node ``Formatting Variables'' and its sub-nodes. There
+node ``Formatting Variables'' and its sub-nodes. There
you'll find useful things like positioning the cursor and
tabulators which allow you a summary in table form, but
sadly hard tabulators are broken in 5.8.8.
@@ -963,7 +963,7 @@ sadly hard tabulators are broken in 5.8.8.
Gnus offers you some very nice new specifiers,
e.g., %B which draws a thread-tree and %&user-date which
gives you a date where the details are dependent of the
-articles age. Here's an example which uses both:
+articles age. Here's an example which uses both:
@example
(setq gnus-summary-line-format ":%U%R %B %s %-60=|%4L |%-20,20f |%&user-date;
\n")
@@ -997,19 +997,19 @@ How to split incoming mails in several groups?
Gnus offers two possibilities for splitting mail, the easy
nnmail-split-methods and the more powerful Fancy Mail
-Splitting. I'll only talk about the first one, refer to
+Splitting. I'll only talk about the first one, refer to
the manual, node "Fancy Mail Splitting" for the latter.
The value of nnmail-split-methods is a list, each element
-is a list which stands for a splitting rule. Each rule has
+is a list which stands for a splitting rule. Each rule has
the form "group where matching articles should go to",
"regular expression which has to be matched", the first
-rule which matches wins. The last rule must always be a
+rule which matches wins. The last rule must always be a
general rule (regular expression .*) which denotes where
-articles should go which don't match any other rule. If
+articles should go which don't match any other rule. If
the folder doesn't exist yet, it will be created as soon
as an article lands there. By default the mail will be
-send to all groups whose rules match. If you
+send to all groups whose rules match. If you
don't want that (you probably don't want), say
@example
@@ -1020,11 +1020,11 @@ don't want that (you probably don't want), say
in @file{~/.gnus.el}.
An example might be better than thousand words, so here's
-my nnmail-split-methods. Note that I send duplicates in a
+my nnmail-split-methods. Note that I send duplicates in a
special group and that the default group is spam, since I
filter all mails out which are from some list I'm
subscribed to or which are addressed directly to me
-before. Those rules kill about 80% of the Spam which
+before. Those rules kill about 80% of the Spam which
reaches me (Email addresses are changed to prevent spammers
from using them):
@@ -1089,10 +1089,10 @@ of the variables @code{shr-color-visible-distance-min}
and
* FAQ 5-7:: Is there some kind of address-book, so I needn't
remember all those email addresses?
* FAQ 5-8:: Sometimes I see little images at the top of article
- buffer. What's that and how can I send one with my postings,
+ buffer. What's that and how can I send one with my postings,
too?
* FAQ 5-9:: Sometimes I accidentally hit r instead of f in
- newsgroups. Can Gnus warn me, when I'm replying by mail in
+ newsgroups. Can Gnus warn me, when I'm replying by mail in
newsgroups?
* FAQ 5-10:: How to tell Gnus not to generate a sender header?
* FAQ 5-11:: I want Gnus to locally store copies of my send mail and
@@ -1115,18 +1115,18 @@ either in Group or Summary buffer, for a posting, it's
either @samp{a} in Group buffer and
filling the Newsgroups header manually
or @samp{a} in the Summary buffer of the
-group where the posting shall be send to. Replying by mail
+group where the posting shall be send to. Replying by mail
is
@samp{r} if you don't want to cite the
author, or import the cited text manually and
@samp{R} to cite the text of the original
-message. For a follow up to a newsgroup, it's
+message. For a follow up to a newsgroup, it's
@samp{f} and @samp{F}
(analogously to @samp{r} and
@samp{R}).
Enter new headers above the line saying "--text follows
-this line--", enter the text below the line. When ready
+this line--", enter the text below the line. When ready
hit @samp{C-c C-c}, to send the message,
if you want to finish it later hit @samp{C-c
C-d} to save it in the drafts group, where you
@@ -1189,7 +1189,7 @@ organization, address, name or body. The attribute name
can also be a string. In that case, this will be used as
a header name, and the value will be inserted in the
headers of the article; if the value is @code{nil}, the header
-name will be removed. You can also say (eval (foo bar)),
+name will be removed. You can also say (eval (foo bar)),
then the function foo will be evaluated with argument bar
and the result will be thrown away.
@@ -1200,8 +1200,8 @@ Can I set things like From, Signature etc group based on
the group I post too?
@subsubheading Answer
-That's the strength of posting styles. Before, we used ".*"
-to set the default for all groups. You can use a regexp
+That's the strength of posting styles. Before, we used ".*"
+to set the default for all groups. You can use a regexp
like "^gmane" and the following settings are only applied
to postings you send to the gmane hierarchy, use
".*binaries" instead and they will be applied to postings
@@ -1210,7 +1210,7 @@ name etc.
You can instead of specifying a regexp specify a function
which is evaluated, only if it returns true, the
-corresponding settings take effect. Two interesting
+corresponding settings take effect. Two interesting
candidates for this are message-news-p which returns t if
the current Group is a newsgroup and the corresponding
message-mail-p.
@@ -1220,7 +1220,7 @@ the example below, when I post to
gmane.mail.spam.spamassassin.general, the settings under
".*" are applied and the settings under message-news-p and
those under "^gmane" and those under
-"^gmane\\.mail\\.spam\\.spamassassin\\.general$". Because
+"^gmane\\.mail\\.spam\\.spamassassin\\.general$". Because
of this put general settings at the top and specific ones
at the bottom.
@@ -1302,7 +1302,7 @@ Yes, say something like
@end example
@noindent
-in @file{~/.gnus.el}. Change "^de\\." and "deutsch8" to something
+in @file{~/.gnus.el}. Change "^de\\." and "deutsch8" to something
that suits your needs.
@node FAQ 5-7
@@ -1324,13 +1324,13 @@ alias al "Al <al@@english-heritage.invalid>"
Then typing your alias (followed by a space or punctuation
character) on a To: or Cc: line in the message buffer will
-cause Gnus to insert the full address for you. See the
+cause Gnus to insert the full address for you. See the
node "Mail Aliases" in Message (not Gnus) manual for
details.
However, what you really want is the Insidious Big Brother
-Database bbdb. Get it from
-@uref{http://bbdb.sourceforge.net/, bbdb's website}.
+Database bbdb. Get it from
+@uref{https://bbdb.sourceforge.net/, bbdb's website}.
Now place the following in @file{~/.gnus.el}, to activate bbdb for Gnus:
@example
@@ -1358,14 +1358,14 @@ place them in ~/.emacs:
@end example
@noindent
-Now you should be ready to go. Say @samp{M-x bbdb @key{RET}
+Now you should be ready to go. Say @samp{M-x bbdb @key{RET}
@key{RET}} to open a bbdb buffer showing all
-entries. Say @samp{c} to create a new
+entries. Say @samp{c} to create a new
entry, @samp{b} to search your BBDB and
@samp{C-o} to add a new field to an
-entry. If you want to add a sender to the BBDB you can
+entry. If you want to add a sender to the BBDB you can
also just hit @kbd{:} on the posting in the summary buffer and
-you are done. When you now compose a new mail,
+you are done. When you now compose a new mail,
hit @samp{TAB} to cycle through know
recipients.
@@ -1373,18 +1373,18 @@ recipients.
@subsubheading Question 5.8
Sometimes I see little images at the top of article
-buffer. What's that and how can I send one with my
+buffer. What's that and how can I send one with my
postings, too?
@subsubheading Answer
-Those images are called X-Faces. They are 48*48 pixel b/w
-pictures, encoded in a header line. If you want to include
+Those images are called X-Faces. They are 48*48 pixel b/w
+pictures, encoded in a header line. If you want to include
one in your posts, you've got to convert some image to a
-X-Face. So fire up some image manipulation program (say
+X-Face. So fire up some image manipulation program (say
Gimp), open the image you want to include, cut out the
relevant part, reduce color depth to 1 bit, resize to
-48*48 and save as bitmap. Now you should get the compface
+48*48 and save as bitmap. Now you should get the compface
package from
@uref{ftp://ftp.cs.indiana.edu/pub/faces/, this site}.
and create the actual X-face by saying
@@ -1424,7 +1424,7 @@ to @code{gnus-posting-styles}.
@subsubheading Question 5.9
Sometimes I accidentally hit r instead of f in
-newsgroups. Can Gnus warn me, when I'm replying by mail in
+newsgroups. Can Gnus warn me, when I'm replying by mail in
newsgroups?
@subsubheading Answer
@@ -1454,7 +1454,7 @@ news, how to do it?
@subsubheading Answer
You must set the variable gnus-message-archive-group to do
-this. You can set it to a string giving the name of the
+this. You can set it to a string giving the name of the
group where the copies shall go or like in the example
below use a function which is evaluated and which returns
the group to use.
@@ -1491,8 +1491,8 @@ aren't they and how to fix it?
@subsubheading Answer
The message-ID is a unique identifier for messages you
-send. To make it unique, Gnus need to know which machine
-name to put after the "@@". If the name of the machine
+send. To make it unique, Gnus need to know which machine
+name to put after the "@@". If the name of the machine
where Gnus is running isn't suitable (it probably isn't
at most private machines) you can tell Gnus what to use
by saying:
@@ -1519,7 +1519,7 @@ instead (works for newer versions as well):
If you have no idea what to insert for
"yourmachine.yourdomain.tld", you've got several
-choices. You can either ask your provider if he allows
+choices. You can either ask your provider if he allows
you to use something like
yourUserName.userfqdn.provider.net, or you can use
somethingUnique.yourdomain.tld if you own the domain
@@ -1556,7 +1556,7 @@ correctly by sending yourself a Mail and looking at the
Message-ID.
* FAQ 6-3:: How to search for a specific message?
* FAQ 6-4:: How to get rid of old unwanted mail?
* FAQ 6-5:: I want that all read messages are expired (at least in
- some groups). How to do it?
+ some groups). How to do it?
* FAQ 6-6:: I don't want expiration to delete my mails but to move
them to another group.
@end menu
@@ -1569,16 +1569,16 @@ How to import my old mail into Gnus?
@subsubheading Answer
The easiest way is to tell your old mail program to
-export the messages in mbox format. Most Unix mailers
+export the messages in mbox format. Most Unix mailers
are able to do this, if you come from the MS Windows
world, you may find tools at
@uref{https://sourceforge.net/projects/mbx2mbox/}.
-Now you've got to import this mbox file into Gnus. To do
+Now you've got to import this mbox file into Gnus. To do
this, create a nndoc group based on the mbox file by
saying @samp{G f /path/file.mbox @key{RET}} in
-Group buffer. You now have read-only access to your
-mail. If you want to import the messages to your normal
+Group buffer. You now have read-only access to your
+mail. If you want to import the messages to your normal
Gnus mail groups hierarchy, enter the nndoc group you've
just created by saying @samp{C-u @key{RET}}
(thus making sure all messages are retrieved), mark all
@@ -1597,8 +1597,8 @@ How to archive interesting messages?
If you stumble across an interesting message, say in
gnu.emacs.gnus and want to archive it there are several
-solutions. The first and easiest is to save it to a file
-by saying @samp{O f}. However, wouldn't
+solutions. The first and easiest is to save it to a file
+by saying @samp{O f}. However, wouldn't
it be much more convenient to have more direct access to
the archived message from Gnus? If you say yes, put this
snippet by Frank Haun <pille3003@@fhaun.de> in
@@ -1607,7 +1607,7 @@ snippet by Frank Haun <pille3003@@fhaun.de> in
@example
(defun my-archive-article (&optional n)
"Copies one or more article(s) to a corresponding `nnml:' group, e.g.,
-`gnus.ding' goes to `nnml:1.gnus.ding'. And `nnml:List-gnus.ding' goes
+`gnus.ding' goes to `nnml:1.gnus.ding'. And `nnml:List-gnus.ding' goes
to `nnml:1.List-gnus-ding'.
Use process marks or mark a region in the summary buffer to archive
@@ -1644,7 +1644,7 @@ How to search for a specific message?
@subsubheading Answer
-There are several ways for this, too. For a posting from
+There are several ways for this, too. For a posting from
a Usenet group the easiest solution is probably to ask
@uref{https://groups.google.com, groups.google.com},
if you found the posting there, tell Google to display
@@ -1659,9 +1659,9 @@ Another idea which works for both mail and news groups
is to enter the group where the message you are
searching is and use the standard Emacs search
@samp{C-s}, it's smart enough to look at
-articles in collapsed threads, too. If you want to
+articles in collapsed threads, too. If you want to
search bodies, too try @samp{M-s}
-instead. Further on there are the
+instead. Further on there are the
gnus-summary-limit-to-foo functions, which can help you,
too.
@@ -1675,17 +1675,17 @@ How to get rid of old unwanted mail?
You can of course just mark the mail you don't need
anymore by saying @samp{#} with point
over the mail and then say @samp{B @key{DEL}}
-to get rid of them forever. You could also instead of
+to get rid of them forever. You could also instead of
actually deleting them, send them to a junk-group by
saying @samp{B m nnml:trash-bin} which
you clear from time to time, but both are not the intended
way in Gnus.
In Gnus, we let mail expire like news expires on a news
-server. That means you tell Gnus the message is
+server. That means you tell Gnus the message is
expirable (you tell Gnus "I don't need this mail
anymore") by saying @samp{E} with point
-over the mail in summary buffer. Now when you leave the
+over the mail in summary buffer. Now when you leave the
group, Gnus looks at all messages which you marked as
expirable before and if they are old enough (default is
older than a week) they are deleted.
@@ -1694,24 +1694,24 @@ older than a week) they are deleted.
@subsubheading Question 6.5
I want that all read messages are expired (at least in
-some groups). How to do it?
+some groups). How to do it?
@subsubheading Answer
If you want all read messages to be expired (e.g., in
mailing lists where there's an online archive), you've
got two choices: auto-expire and
-total-expire. Auto-expire means, that every article
+total-expire. Auto-expire means, that every article
which has no marks set and is selected for reading is
marked as expirable, Gnus hits @samp{E}
-for you every time you read a message. Total-expire
+for you every time you read a message. Total-expire
follows a slightly different approach, here all article
where the read mark is set are expirable.
To activate auto-expire, include auto-expire in the
Group parameters for the group. (Hit @samp{G
c} in summary buffer with point over the
-group to change group parameters). For total-expire add
+group to change group parameters). For total-expire add
total-expire to the group-parameters.
Which method you choose is merely a matter of taste:
@@ -1753,7 +1753,7 @@ variables specific for some groups?")
* FAQ 7-1:: I don't have a permanent connection to the net, how can I
minimize the time I've got to be connected?
* FAQ 7-2:: So what was this thing about the Agent?
-* FAQ 7-3:: I want to store article bodies on disk, too. How to do
+* FAQ 7-3:: I want to store article bodies on disk, too. How to do
it?
* FAQ 7-4:: How to tell Gnus not to try to send mails / postings
while I'm offline?
@@ -1782,15 +1782,15 @@ 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
+Gnus to read it from there. Last but not least the mail
sending part: This can be done with every MTA like
@uref{https://www.proofpoint.com/us/open-source-email-solution, sendmail} or
@uref{https://www.exim.org/, exim}.
@@ -1800,7 +1800,7 @@ On windows boxes I'd vote for
it's a small freeware, open-source program which fetches
your mail and news from remote servers and offers them
to Gnus (or any other mail and/or news reader) via nntp
-respectively POP3 or IMAP@. It also includes a smtp
+respectively POP3 or IMAP@. It also includes a smtp
server for receiving mails from Gnus.
@node FAQ 7-2
@@ -1812,7 +1812,7 @@ So what was this thing about the Agent?
The Gnus agent is part of Gnus, it allows you to fetch
mail and news and store them on disk for reading them
-later when you're offline. It kind of mimics offline
+later when you're offline. It kind of mimics offline
newsreaders like Forte Agent. It is enabled by default.
You've got to select the servers whose groups can be
@@ -1831,7 +1831,7 @@ there the next time you enter the group.
@node FAQ 7-3
@subsubheading Question 7.3
-I want to store article bodies on disk, too. How to do it?
+I want to store article bodies on disk, too. How to do it?
@subsubheading Answer
@@ -1839,16 +1839,16 @@ You can tell the agent to automatically fetch the bodies
of articles which fulfill certain predicates, this is
done in a special buffer which can be reached by
saying @samp{J c} in group
-buffer. Please refer to the documentation for
+buffer. Please refer to the documentation for
information which predicates are possible and how
exactly to do it.
Further on you can tell the agent manually which
-articles to store on disk. There are two ways to do
+articles to store on disk. There are two ways to do
this: Number one: In the summary buffer, process mark a
set of articles that shall be stored in the agent by
saying @samp{#} with point over the
-article and then type @samp{J s}. The
+article and then type @samp{J s}. The
other possibility is to set, again in the summary
buffer, downloadable (%) marks for the articles you
want by typing @samp{@@} with point over
@@ -1873,11 +1873,11 @@ while I'm offline?
All you've got to do is to tell Gnus when you are online
(plugged) and when you are offline (unplugged), the rest
-works automatically. You can toggle plugged/unplugged
+works automatically. You can toggle plugged/unplugged
state by saying @samp{J j} in group
-buffer. To start Gnus unplugged say @samp{M-x
+buffer. To start Gnus unplugged say @samp{M-x
gnus-unplugged} instead of
-@samp{M-x gnus}. Note that for this to
+@samp{M-x gnus}. Note that for this to
work, the agent must be active.
@node FAQ 8 - Getting help
@@ -1903,10 +1903,10 @@ How to find information and help inside Emacs?
The first stop should be the Gnus manual (Say
@samp{C-h i d m Gnus @key{RET}} to start the
Gnus manual, then walk through the menus or do a
-full-text search with @samp{s}). Then
+full-text search with @samp{s}). Then
there are the general Emacs help commands starting with
C-h, type @samp{C-h ? ?} to get a list
-of all available help commands and their meaning. Finally
+of all available help commands and their meaning. Finally
@samp{M-x apropos-command} lets you
search through all available functions and @samp{M-x
apropos} searches the bound variables.
@@ -1999,10 +1999,10 @@ active file, see the node "The Active File" in the Gnus
manual for things you might try to speed the process up.
An other idea would be to byte compile your @file{~/.gnus.el} (say
@samp{M-x byte-compile-file @key{RET} ~/.gnus.el
-@key{RET}} to do it). Finally, if you have require
+@key{RET}} to do it). Finally, if you have require
statements in your .gnus, you could replace them with
@code{with-eval-after-load}, which loads the stuff not at startup
-time, but when it's needed. Say you've got this in your
+time, but when it's needed. Say you've got this in your
@file{~/.gnus.el}:
@example
@@ -2011,7 +2011,7 @@ time, but when it's needed. Say you've got this in your
@end example
@noindent
-then as soon as you start Gnus, message.el is loaded. If
+then as soon as you start Gnus, message.el is loaded. If
you replace it with
@example
@@ -2052,7 +2052,7 @@ Sending mail becomes slower and slower, what's up?
The reason could be that you told Gnus to archive the
messages you wrote by setting
-gnus-message-archive-group. Try to use a nnml group
+gnus-message-archive-group. Try to use a nnml group
instead of an archive group, this should bring you back
to normal speed.
@@ -2063,7 +2063,7 @@ to normal speed.
@item ~/.gnus.el
When the term @file{~/.gnus.el} is used it just means your Gnus
-configuration file. You might as well call it @file{~/.gnus} or
+configuration file. You might as well call it @file{~/.gnus} or
specify another name.
@item Back End
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 738ff94b9f..7bcf334297 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
@@ -23794,7 +23794,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 +26329,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 +26429,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 +26508,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 +26633,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 +26911,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 +29087,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 +29119,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
@@ -30580,7 +30590,6 @@ Below is a slightly shortened version of the
@code{nndir} back end.
(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
(defvoo nndir-status-string "" nil nnmh-status-string)
-(defconst nndir-version "nndir 1.0")
;;; @r{Interface functions.}
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index 0ba87b2e58..4bdbd5c219 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -4162,8 +4162,8 @@ tried to install the optional modules
@file{idlw-roprompt.el} or
load file}}.
The problem is that your Emacs is not finding the version of IDLWAVE you
-installed. Many Emacsen come with an older bundled copy of IDLWAVE
-(e.g., v4.7 for Emacs 21.x), which is likely what's being used instead.
+installed. Emacs might come with an older bundled copy of IDLWAVE
+which is likely what's being used instead.
You need to make sure your Emacs @emph{load-path} contains the directory
where IDLWAVE is installed (@file{/usr/local/share/emacs/site-lisp}, by
default), @emph{before} Emacs's default search directories. You can
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 2106c674f3..1a80c62edb 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -213,13 +213,12 @@ more niceties about GNU Emacs and MH@. Now I'm fully
hooked on both of
them.
The MH-E package is distributed with Emacs@footnote{Version
-@value{VERSION} of MH-E appeared in Emacs 24.4.
-It is compatible with MH versions 6.8.4 and
-higher, all versions of nmh, and GNU mailutils 1.0 and higher}, so you
-shouldn't have to do anything special to use it. Gnus is also
-required; version 5.10 or higher is recommended. This manual covers
-MH-E version @value{VERSION}. To help you decide which version you
-have, see @ref{Getting Started}.
+@value{VERSION} of MH-E appeared in Emacs 24.4. It is compatible with
+MH versions 6.8.4 and higher, all versions of nmh, and GNU mailutils
+1.0 and higher}, so you shouldn't have to do anything special to use
+it. Gnus is also required; it is bundled with Emacs. This manual
+covers MH-E version @value{VERSION}. To help you decide which version
+you have, see @ref{Getting Started}.
@findex help-with-tutorial
@kindex C-h t
@@ -331,8 +330,7 @@ Press the @key{TAB} key.
Press the @key{DELETE} key.
@c -------------------------
@item @key{BS}
-Press the @key{BACKSPACE} key@footnote{If you are using Version 20 or
-earlier of Emacs, you will need to use the @key{DEL} key.}.
+Press the @key{BACKSPACE} key.
@end table
@cindex Emacs, prefix argument
@@ -1480,11 +1478,9 @@ and click on the @samp{INS} button. Enter a @samp{Spool
File} of
Binding} of @samp{m}.
@cindex @command{emacsclient}
-@cindex @command{gnuclient}
@cindex @command{xbuffy}
@cindex @samp{gnuserv}
@cindex Unix commands, @command{emacsclient}
-@cindex Unix commands, @command{gnuclient}
@cindex Unix commands, @command{xbuffy}
You can use @command{xbuffy} to automate the incorporation of this
@@ -2712,8 +2708,7 @@ Drafts}).
@cindex signed messages
You can read encrypted or signed PGP or GPG messages with
-MH-E@footnote{This feature depends on post-5.10 versions of Gnus.
-@cite{MIME Security with OpenPGP} is documented in
+MH-E@footnote{@cite{MIME Security with OpenPGP} is documented in
@uref{https://www.rfc-editor.org/rfc/rfc3156.txt, RFC 3156}. However,
MH-E can also decrypt old-style PGP messages that are not in MIME
format.}. This section assumes that you already have a good
@@ -3087,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
@@ -3369,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 -------------------------
@@ -7545,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.
@@ -7726,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:
@@ -7796,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}:
@@ -8538,9 +8533,7 @@ If you're on a mailing list that is so voluminous that it
is
impossible to read every message, it usually better to read the
mailing list like a newsgroup in a news reader. Emacs has a built-in
newsreader called Gnus. The remainder of this appendix talks about how
-to use Gnus with an MH message store. The version of Gnus that was
-used to prepare this manual was 5.10. Versions 5.8 through 5.10 should
-work but versions prior to 5.8 use different options.
+to use Gnus with an MH message store.
This table contains a list of Gnus options that you will have to
modify. Note that for them to become accessible, you'll have to load
@@ -8640,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
@@ -8660,28 +8653,11 @@ question, file a ticket and your question will become a
new FAQ!
@cindex getting MH-E
@cindex obtaining MH-E
-Because MH-E is undergoing a phase of sustained growth, the version of
-MH-E in your Emacs is likely to be out of date although it is most
-likely to be more up to date than the copy that comes with the MH
-distribution in @file{miscellany/mh-e}.
-
-@cindex change log
-@cindex release notes
-
-New MH-E releases are always available for downloading at
-@uref{https://sourceforge.net/projects/mh-e/files/, SourceForge}
-before they appear in an Emacs release. You can read the release notes
-on that page to determine if the given release of MH-E is already
-installed in your version of Emacs. You can also read the change log
-to see if you are interested in what the given release of MH-E has to
-offer (although we have no doubt that you will be extremely interested
-in all new releases).
-
-@cindex Debian
-
-If you use Debian, you can install the Debian
-@uref{https://packages.debian.org/unstable/mail/mh-e, mh-e package}
-instead.
+Since MH-E 8.6 was released in 2016, its development migrated to the
+Emacs repository. MH-E is now only supported in the version of Emacs
+in which it appears. Old releases of MH-E are still available for
+download at @uref{https://sourceforge.net/projects/mh-e/files/,
+SourceForge}.
@cindex files, @samp{MH-E-NEWS}
@cindex files, @samp{README}
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 1b4bf88a0c..c5accd0789 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.6.0
-#+macro: release-date 2022-08-19
-#+macro: development-version 2.7.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]].
@@ -3902,6 +3897,7 @@ package:
(use-package circadian ; you need to install this
:ensure
:after solar
+ :config
(setq circadian-themes '((:sunrise . modus-operandi)
(:sunset . modus-vivendi)))
(circadian-setup))
@@ -4514,6 +4510,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ calendar and diary
+ calfw
+ calibredb
++ centaur-tabs
+ cfrs
+ change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~)
+ chart
@@ -4533,6 +4530,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ counsel-css
+ cov
+ cperl-mode
++ crontab-mode
+ css-mode
+ csv-mode
+ ctrlf
@@ -4678,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
@@ -4705,6 +4704,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ powerline
+ powerline-evil
+ prism ([[#h:a94272e0-99da-4149-9e80-11a7e67a2cf2][Note for prism.el]])
++ prescient
+ proced
+ prodigy
+ pulse
@@ -4738,6 +4738,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ smerge
+ spaceline
+ speedbar
++ spell-fu
+ stripes
+ suggest
+ switch-window
@@ -4748,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
@@ -4763,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
@@ -4788,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:
@@ -5392,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:
@@ -5448,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]].
@@ -5538,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.
@@ -5596,6 +5596,32 @@ those buttons. Disabling the logo fixes the problem:
(setq notmuch-show-logo nil)
#+end_src
+** Note on goto-address-mode faces
+:PROPERTIES:
+:CUSTOM_ID: h:2d74236a-e41c-4616-8735-75f949a67334
+:END:
+
+The built-in ~goto-address-mode~ uses heuristics to identify URLs and
+email addresses in the current buffer. It then applies a face to them
+to change their style. Some packages, such as =notmuch=, use this
+minor-mode automatically.
+
+The faces are not declared with ~defface~, meaning that it is better
+that the theme does not modify them. The user is thus encouraged to
+consider including (or equivalent) this in their setup:
+
+#+begin_src emacs-lisp
+(setq goto-address-url-face 'link
+ goto-address-url-mouse-face 'highlight
+ goto-address-mail-face 'link
+ goto-address-mail-mouse-face 'highlight)
+#+end_src
+
+My personal preference is to set ~goto-address-mail-face~ to nil, as
+it otherwise adds too much visual noise to the buffer (email addresses
+stand out more, due to the use of the uncommon =@= character but also
+because they are often enclosed in angled brackets).
+
* Frequently Asked Questions
:properties:
:custom_id: h:b3384767-30d3-4484-ba7f-081729f03a47
@@ -5785,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.
@@ -5868,11 +5894,11 @@ usability beyond matters of color---they would be
making a
not-so-obvious error of treating different cases as if they were the
same.
-The Modus themes prioritise "thematic consistency" over abstract harmony
+The Modus themes prioritize "thematic consistency" over abstract harmony
or regularity among their applicable colors. In concrete terms, we do
not claim that, say, our yellows are the best complements for our blues
because we generally avoid using complementary colors side-by-side, so
-it is wrong to optimise for a decontextualised blue+yellow combination.
+it is wrong to optimize for a decontextualised blue+yellow combination.
Not to imply that our colors do not work well together because they do,
just to clarify that consistency of context is what themes must strive
for, and that requires widening the scope of the design beyond the
@@ -5925,7 +5951,7 @@ the themes, which is partially fleshed out in this manual.
With regard to the artistic aspect (where "art" qua skill may amount to
an imprecise science), there is no hard-and-fast rule in effect as it
-requires one to exercise discretion and make decisions based on
+requires one to exercize discretion and make decisions based on
context-dependent information or constraints. As is true with most
things in life, when in doubt, do not cling on to the letter of the law
but try to understand its spirit.
@@ -6072,42 +6098,44 @@ The Modus themes are a collective effort. Every bit of
work matters.
+ Author/maintainer :: Protesilaos Stavrou.
+ Contributions to code or documentation :: Alex Griffin, Anders
- Johansson, Basil L.{{{space()}}} Contovounesios, Björn Lindström,
- Carlo Zancanaro, Christian Tietze, Daniel Mendler, Eli Zaretskii,
- Fritz Grabo, Illia Ostapyshyn, Kévin Le Gouguec, Kostadin Ninev,
- Madhavan Krishnan, Manuel Giraud, Markus Beppler, Matthew Stevenson,
- Mauro Aranda, Nicolas De Jaeghere, Paul David, Philip Kaludercic,
- Pierre Téchoueyres, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan,
- Stefan Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen
- Xie.
+ Johansson, Antonio Ruiz, Basil L.{{{space()}}} Contovounesios, Björn
+ Lindström, Carlo Zancanaro, Christian Tietze, Daniel Mendler, Eli
+ Zaretskii, Fritz Grabo, Illia Ostapyshyn, Kévin Le Gouguec, Koen van
+ Greevenbroek, Kostadin Ninev, Madhavan Krishnan, Manuel Giraud,
+ Markus Beppler, Matthew Stevenson, Mauro Aranda, Nicolas De
+ Jaeghere, Paul David, Philip Kaludercic, Pierre Téchoueyres, Rudolf
+ Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan Kangas, Utkarsh
+ Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie, okamsn.
+ Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers,
- Adrian Manea, Alex Griffin, Alex Koen, Alex Peitsinis, Alexey Shmalko,
- Alok Singh, Anders Johansson, André Alexandre Gomes, Andrew Tropin,
- Antonio Hernández Blas, Arif Rezai, Augusto Stoffel, Basil
+ Adrian Manea, Alex Griffin, Alex Koen, Alex Peitsinis, Alexey
+ Shmalko, Alok Singh, Anders Johansson, André Alexandre Gomes, Andrew
+ Tropin, Antonio Hernández Blas, Arif Rezai, Augusto Stoffel, Basil
L.{{{space()}}} Contovounesios, Burgess Chang, Christian Tietze,
- Christopher Dimech, Christopher League, Damien Cassou, Daniel Mendler,
- Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Eliraz
- Kedmi, Emanuele Michele Alberto Monterosso, Farasha Euker, Feng Shu,
- Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia, Gonçalo Marrafa,
- Guilherme Semente, Gustavo Barros, Hörmetjan 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, Magne Hov, Manuel Uberti, Mark
- Bestley, Mark Burton, 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,
+ Christopher Dimech, Christopher League, Damien Cassou, Daniel
+ Mendler, Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan
+ Santana, Eliraz Kedmi, Emanuele Michele Alberto Monterosso, Farasha
+ Euker, Feng Shu, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia,
+ Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan
+ 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, 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.
+ 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 7971c417a5..ae3ca0b64f 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
@@ -11042,7 +11042,7 @@ a major LaTeX mode like AUCTeX in order to speed-up
insertion of
environments and math templates. Inside Org mode, you can make use of
some of the features of CDLaTeX mode. You need to install
=cdlatex.el= and =texmathp.el= (the latter comes also with AUCTeX)
-using [[https://melpa.org/][MELPA]] with the
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Package-Installation.html][Emacs
packaging system]] or alternatively from
+from [[https://elpa.nongnu.org/][NonGNU ELPA]] with the
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Package-Installation.html][Emacs
packaging system]] or alternatively from
[[https://staff.fnwi.uva.nl/c.dominik/Tools/cdlatex/]]. Do not use
CDLaTeX mode itself under Org mode, but use the special version Org
CDLaTeX minor mode that comes as part of Org. Turn it on for the
@@ -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
@@ -22024,7 +22024,7 @@ a deadline string. See ~org-agenda-entry-types~ on how
to set what
planning information is taken into account.
[fn:104] For HTML you need to install Hrvoje Nikšić's =htmlize.el=
-as an Emacs package from MELPA or from
[[https://github.com/hniksic/emacs-htmlize][Hrvoje Nikšić's repository]].
+as an Emacs package from [[https://elpa.nongnu.org/][NonGNU ELPA]] or from
[[https://github.com/hniksic/emacs-htmlize][Hrvoje Nikšić's repository]].
[fn:105] To create PDF output, the Ghostscript ps2pdf utility must be
installed on the system. Selecting a PDF file also creates the
@@ -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 8c798d6c33..84933a9ca7 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -177,7 +177,7 @@ using a different nick. This will prompt you for four
things:
@cindex server, connecting
@cindex Libera.Chat network
@item IRC Server
-What server do you want to connect to? All the servers in a particular
+What server do you want to connect to? All the servers in a particular
network are equivalent. Some networks use a round-robin system where
a single server redirects new connections to a random server in the
network. @code{irc.libera.chat} is such a server for the Libera.Chat
@@ -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
@@ -531,7 +531,7 @@ This variable is used for the default nick. It defaults to
the login
name returned by @code{user-login-name}.
@example
-(setq rcirc-default-nick "kensanata")
+(setopt rcirc-default-nick "kensanata")
@end example
@item rcirc-default-port
@@ -557,7 +557,7 @@ to the name returned by @code{user-full-name}. If you want
to hide
your full name, you might want to set it to some pseudonym.
@example
-(setq rcirc-default-full-name "Curious Minds Want To Know")
+(setopt rcirc-default-full-name "Curious Minds Want To Know")
@end example
@item rcirc-authinfo
@@ -575,10 +575,10 @@ followed by the arguments this method requires.
Here is an example to illustrate how you would set it:
@example
-(setq rcirc-authinfo
- '(("Libera.Chat" nickserv "bob" "p455w0rd")
- ("Libera.Chat" chanserv "bob" "#bobland" "passwd99")
- ("bitlbee" bitlbee "robert" "sekrit")))
+(setopt rcirc-authinfo
+ '(("Libera.Chat" nickserv "bob" "p455w0rd")
+ ("Libera.Chat" chanserv "bob" "#bobland" "passwd99")
+ ("bitlbee" bitlbee "robert" "sekrit")))
@end example
And here are the valid method symbols and the arguments they require:
@@ -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.
@@ -821,7 +821,7 @@ You can control which notices get omitted via the
omit away messages:
@example
-(setq rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK" "AWAY"))
+(setopt rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK" "AWAY"))
@end example
@vindex rcirc-omit-threshold
@@ -840,7 +840,7 @@ and @code{NAMES} messages, after reconnecting, you can
configure
@code{rcirc-omit-unless-requested} to hide:
@example
-(setq rcirc-omit-unless-requested '("TOPIC" "NAMES"))
+(setopt rcirc-omit-unless-requested '("TOPIC" "NAMES"))
@end example
Now NAMES will only be displayed, after it has been requested via the
@@ -859,6 +859,7 @@ Here are some examples of stuff you can do to configure
@code{rcirc}.
* Changing the time stamp format::
* Defining a new command::
* Using rcirc with bouncers::
+* Dealing with Bridge Bots::
@end menu
@node Skipping /away messages using handlers
@@ -933,7 +934,7 @@ Manual}, for details.
how to include the date in the time stamp:
@example
-(setq rcirc-time-format "%Y-%m-%d %H:%M ")
+(setopt rcirc-time-format "%Y-%m-%d %H:%M ")
@end example
@findex rcirc-when
@@ -969,16 +970,16 @@ because @code{rcirc-define-command} is not yet available,
and without
@cindex bouncer
Some bouncers multiplex connections to various servers, but have to
-modify nicks and channel names to make this work. The channel
+modify nicks and channel names to make this work. The channel
@code{#emacs} on @code{irc.libera.chat} becomes
@code{#emacs/irc.libera.chat}.
@vindex rcirc-nick-filter
@vindex rcirc-channel-filter
The options @code{rcirc-nick-filter} and @code{rcirc-channel-filter}
-can be used to make this feel more natural. When set to functions,
+can be used to make this feel more natural. When set to functions,
these will be used to change how nicks and channel names are
-displayed. A simple configuration to fix the above example might be:
+displayed. A simple configuration to fix the above example might be:
@smallexample
(defun my/rcirc-remove-suffix (STR)
@@ -988,10 +989,50 @@ displayed. A simple configuration to fix the above
example might be:
(substring str 0 (match-beginning 0))
str)))
-(setq rcirc-nick-filter #'my/rcirc-remove-suffix
- rcirc-channel-filter #'local/rcirc-soju-suffix)
+(setopt rcirc-nick-filter #'my/rcirc-remove-suffix
+ rcirc-channel-filter #'local/rcirc-soju-suffix)
@end smallexample
+@node Dealing with Bridge Bots
+@section Dealing with Bridge Bots
+@cindex bridge
+
+It is increasingly common for IRC channels to be ``bridged'' onto
+other networks such as XMPP, Matrix, etc. Sometimes the software does
+a good job at mapping each non-IRC user into an IRC user, but more
+often than not it doesn't. In that case you might receive a message
+like:
+
+@example
+@verbatim
+09:47 <bridge> <john> I am not on IRC
+@end verbatim
+@end example
+
+where @samp{bridge} is a bot responsible for sending messages back and
+forth between networks, and @samp{john} is the user name of someone on
+a different network. Note that the bot indicates this within the
+message (@verb{|<john> I am not on IRC|}) that appears in your chat
+buffer.
+
+@vindex rcirc-bridge-bot-alist
+If this annoys you, the user option @code{rcirc-bridge-bot-alist} may
+be of use. It consists of descriptions of what users are these kinds
+of ``bridge bots'' and how they format their messages. To handle the
+above example, we might set the user option to:
+
+@example
+(setopt rcirc-bridge-bot-alist
+ '(("bridge" . "<\\(.+?\\)>[[:space:]]+")))
+@end example
+
+If there is an entry for the current user, @code{rcirc} will take the
+associated regular expression and try to find a match in the message
+string. If it manages to find anything, the matching expression is
+deleted from the message. The regular expression must contain at
+least one group that will match the user name of the bridged message.
+This will then be used to replace the username of the bridge bot.
+
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 0c95b388cb..b30e5aeaa4 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -3539,18 +3539,6 @@ as a label of type @code{?p}. Argument count for this
macro starts only
after the @samp{@{step+@}}, also when specifying how to get
context.
-@item
-@b{Viper mode}@*
-@cindex Viper mode
-@cindex Key bindings, problems with Viper mode
-@findex viper-harness-minor-mode
-With @i{Viper} mode prior to Vipers version 3.01, you need to protect
-@RefTeX{}'s keymaps with
-
-@lisp
-(viper-harness-minor-mode "reftex")
-@end lisp
-
@end itemize
@page
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 eb5c7e0e67..b23e4c36fe 100644
--- a/doc/misc/semantic.texi
+++ b/doc/misc/semantic.texi
@@ -25,8 +25,7 @@
@copying
This manual documents the Semantic library and utilities.
-Copyright @copyright{} 1999--2005, 2007, 2009--2022 Free Software
-Foundation, Inc.
+Copyright @copyright{} 1999--2022 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -65,13 +64,6 @@ modify this GNU manual.''
@b{\kw\}
@end macro
-@macro obsolete{old,new}
-@sp 1
-@strong{Compatibility}:
-@code{\new\} introduced in @semantic{} version 2.0 supersedes
-@code{\old\} which is now obsolete.
-@end macro
-
@c *************************************************************************
@c @ Document
@c *************************************************************************
@@ -90,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/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/texinfo.tex b/doc/misc/texinfo.tex
index 8872e5e055..09f2d28c2f 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2022-04-09.08}
+\def\texinfoversion{2022-09-21.15}
%
% Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc.
%
@@ -241,9 +241,6 @@
%
\def\finalout{\overfullrule=0pt }
-\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines
-\newdimen\topandbottommargin \topandbottommargin=.75in
-
% Output a mark which sets \thischapter, \thissection and \thiscolor.
% We dump everything together because we only have one kind of mark.
% This works because we only use \botmark / \topmark, not \firstmark.
@@ -317,16 +314,8 @@
\newbox\footlinebox
% When outputting the double column layout for indices, an output routine
-% is run several times, which hides the original value of \topmark. This
-% can lead to a page heading being output and duplicating the chapter heading
-% of the index. Hence, save the contents of \topmark at the beginning of
-% the output routine. The saved contents are valid until we actually
-% \shipout a page.
-%
-% (We used to run a short output routine to actually set \topmark and
-% \firstmark to the right values, but if this was called with an empty page
-% containing whatsits for writing index entries, the whatsits would be thrown
-% away and the index auxiliary file would remain empty.)
+% is run several times, hiding the original value of \topmark. Hence, save
+% \topmark at the beginning.
%
\newtoks\savedtopmark
\newif\iftopmarksaved
@@ -351,15 +340,9 @@
%
\checkchapterpage
%
- % Retrieve the information for the headings from the marks in the page,
- % and call Plain TeX's \makeheadline and \makefootline, which use the
- % values in \headline and \footline.
- %
- % Common context changes for both heading and footing.
- % Do this outside of the \shipout so @code etc. will be expanded in
- % the headline as they should be, not taken literally (outputting ''code).
+ % Make the heading and footing. \makeheadline and \makefootline
+ % use the contents of \headline and \footline.
\def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars}
- %
\ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
\global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}%
\ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi
@@ -617,21 +600,6 @@
% @? is an end-of-sentence query.
\def\?{?\spacefactor=\endofsentencespacefactor\space}
-% @frenchspacing on|off says whether to put extra space after punctuation.
-%
-\def\onword{on}
-\def\offword{off}
-%
-\parseargdef\frenchspacing{%
- \def\temp{#1}%
- \ifx\temp\onword \plainfrenchspacing
- \else\ifx\temp\offword \plainnonfrenchspacing
- \else
- \errhelp = \EMsimple
- \errmessage{Unknown @frenchspacing option `\temp', must be on|off}%
- \fi\fi
-}
-
% @w prevents a word break. Without the \leavevmode, @w at the
% beginning of a paragraph, when TeX is still in vertical mode, would
% produce a whole line of output instead of starting the paragraph.
@@ -725,32 +693,22 @@ where each line of input produces a line of output.}
\dimen2 = \ht\strutbox
\advance\dimen2 by \dp\strutbox
\ifdim\dimen0 > \dimen2
+ % This is similar to the 'needspace' module in LaTeX.
+ % The first penalty allows a break if the end of the page is
+ % not too far away. Following penalties and skips are discarded.
+ % Otherwise, require at least \dimen0 of vertical space.
%
- % Do a \strut just to make the height of this box be normal, so the
- % normal leading is inserted relative to the preceding line.
- % And a page break here is fine.
- \vtop to #1\mil{\strut\vfil}%
- %
- % TeX does not even consider page breaks if a penalty added to the
- % main vertical list is 10000 or more. But in order to see if the
- % empty box we just added fits on the page, we must make it consider
- % page breaks. On the other hand, we don't want to actually break the
- % page after the empty box. So we use a penalty of 9999.
- %
- % There is an extremely small chance that TeX will actually break the
- % page at this \penalty, if there are no other feasible breakpoints in
- % sight. (If the user is using lots of big @group commands, which
- % almost-but-not-quite fill up a page, TeX will have a hard time doing
- % good page breaking, for example.) However, I could not construct an
- % example where a page broke at this \penalty; if it happens in a real
- % document, then we can reconsider our strategy.
+ % (We used to use a \vtop to reserve space, but this had spacing issues
+ % when followed by a section heading, as it was not a "discardable item".
+ % This also has the benefit of providing glue before the page break if
+ % there isn't enough space.)
+ \vskip0pt plus \dimen0
+ \penalty-100
+ \vskip0pt plus -\dimen0
+ \vskip \dimen0
\penalty9999
- %
- % Back up by the size of the box, whether we did a page break or not.
- \kern -#1\mil
- %
- % Do not allow a page break right after this kern.
- \nobreak
+ \vskip -\dimen0
+ \penalty0\relax % this hides the above glue from \safewhatsit and \dobreak
\fi
}
@@ -2558,7 +2516,7 @@ end
\def\it{\fam=\itfam \setfontstyle{it}}
\def\sl{\fam=\slfam \setfontstyle{sl}}
\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
-\def\tt{\fam=\ttfam \setfontstyle{tt}}\def\ttstylename{tt}
+\def\tt{\fam=\ttfam \setfontstyle{tt}}
% Texinfo sort of supports the sans serif font style, which plain TeX does not.
% So we set up a \sf.
@@ -2691,6 +2649,14 @@ end
%
\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
+% Check if internal flag is clear, i.e. has not been @set.
+\def\ifflagclear#1#2#3{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ #2\else#3\fi
+}
+
+
+
{
\catcode`\'=\active
\catcode`\`=\active
@@ -2707,14 +2673,14 @@ end
%
\def\codequoteright{%
\ifmonospace
- \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax
- \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax
+ \ifflagclear{txicodequoteundirected}{%
+ \ifflagclear{codequoteundirected}{%
'%
- \else \char'15 \fi
- \else \char'15 \fi
- \else
- '%
- \fi
+ }{\char'15 }%
+ }{\char'15 }%
+ \else
+ '%
+ \fi
}
%
% and a similar option for the left quote char vs. a grave accent.
@@ -2723,16 +2689,16 @@ end
%
\def\codequoteleft{%
\ifmonospace
- \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax
- \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax
+ \ifflagclear{txicodequotebacktick}{%
+ \ifflagclear{codequotebacktick}{%
% [Knuth] pp. 380,381,391
% \relax disables Spanish ligatures ?` and !` of \tt font.
\relax`%
- \else \char'22 \fi
- \else \char'22 \fi
- \else
- \relax`%
- \fi
+ }{\char'22 }%
+ }{\char'22 }%
+ \else
+ \relax`%
+ \fi
}
% Commands to set the quote options.
@@ -2779,15 +2745,16 @@ end
\def\dosmartslant#1#2{%
\ifusingtt
{{\ttsl #2}\let\next=\relax}%
- {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}%
+ {\def\next{{#1#2}\smartitaliccorrection}}%
\next
}
\def\smartslanted{\dosmartslant\sl}
\def\smartitalic{\dosmartslant\it}
-% Output an italic correction unless \next (presumed to be the following
-% character) is such as not to need one.
-\def\smartitaliccorrection{%
+% Output an italic correction unless the following character is such as
+% not to need one.
+\def\smartitaliccorrection{\futurelet\next\smartitaliccorrectionx}
+\def\smartitaliccorrectionx{%
\ifx\next,%
\else\ifx\next-%
\else\ifx\next.%
@@ -2798,27 +2765,41 @@ end
\aftersmartic
}
-% Unconditional use \ttsl, and no ic. @var is set to this for defuns.
-\def\ttslanted#1{{\ttsl #1}}
-
-% @cite is like \smartslanted except unconditionally use \sl. We never want
-% ttsl for book titles, do we?
-\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection}
+% @cite unconditionally uses \sl with \smartitaliccorrection.
+\def\cite#1{{\sl #1}\smartitaliccorrection}
+% @var unconditionally uses \sl. This gives consistency for
+% parameter names whether they are in @def, @table @code or a
+% regular paragraph.
+% To get ttsl font for @var when used in code context, @set txicodevaristt.
+% The \null is to reset \spacefactor.
\def\aftersmartic{}
\def\var#1{%
\let\saveaftersmartic = \aftersmartic
\def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}%
- \smartslanted{#1}%
+ %
+ \ifflagclear{txicodevaristt}%
+ {\def\varnext{{{\sl #1}}\smartitaliccorrection}}%
+ {\def\varnext{\smartslanted{#1}}}%
+ \varnext
}
+% To be removed after next release
+\def\SETtxicodevaristt{}% @set txicodevaristt
+
\let\i=\smartitalic
\let\slanted=\smartslanted
\let\dfn=\smartslanted
\let\emph=\smartitalic
-% Explicit font changes: @r, @sc, undocumented @ii.
-\def\r#1{{\rm #1}} % roman font
+% @r for roman font, used for code comment
+\def\r#1{{%
+ \usenormaldash % get --, --- ligatures even if in @code
+ \defcharsdefault % in case on def line
+ \rm #1}}
+{\catcode`-=\active \gdef\usenormaldash{\let-\normaldash}}
+
+% @sc, undocumented @ii.
\def\sc#1{{\smallcaps#1}} % smallcaps font
\def\ii#1{{\it #1}} % italic font
@@ -2854,9 +2835,27 @@ end
\catcode`@=\other
\def\endofsentencespacefactor{3000}% default
+% @frenchspacing on|off says whether to put extra space after punctuation.
+%
+\def\onword{on}
+\def\offword{off}
+%
+\let\frenchspacingsetting\plainnonfrenchspacing % used in output routine
+\parseargdef\frenchspacing{%
+ \def\temp{#1}%
+ \ifx\temp\onword \let\frenchspacingsetting\plainfrenchspacing
+ \else\ifx\temp\offword \let\frenchspacingsetting\plainnonfrenchspacing
+ \else
+ \errhelp = \EMsimple
+ \errmessage{Unknown @frenchspacing option `\temp', must be on|off}%
+ \fi\fi
+ \frenchspacingsetting
+}
+
+
% @t, explicit typewriter.
\def\t#1{%
- {\tt \plainfrenchspacing #1}%
+ {\tt \defcharsdefault \plainfrenchspacing #1}%
\null
}
@@ -3445,8 +3444,13 @@ $$%
% Revert to plain's \scriptsize, which is 7pt.
\count255=\the\fam $\fam\count255 \scriptstyle A$%
\else
- % For 11pt, we can use our lllsize.
- \switchtolllsize A%
+ \ifx\curfontsize\smallword
+ % For footnotes and indices
+ \count255=\the\fam $\fam\count255 \scriptstyle A$%
+ \else
+ % For 11pt, we can use our lllsize.
+ \switchtolllsize A%
+ \fi
\fi
}%
\vss
@@ -3454,6 +3458,7 @@ $$%
\kern-.15em
\TeX
}
+\def\smallword{small}
% Some math mode symbols. Define \ensuremath to switch into math mode
% unless we are already there. Expansion tricks may not be needed here,
@@ -3824,15 +3829,16 @@ $$%
\newtoks\oddfootline % footline on odd pages
% Now make \makeheadline and \makefootline in Plain TeX use those variables
-\headline={{\textfonts\rm
+\headline={{\textfonts\rm\frenchspacingsetting
\ifchapterpage
\ifodd\pageno\the\oddchapheadline\else\the\evenchapheadline\fi
\else
\ifodd\pageno\the\oddheadline\else\the\evenheadline\fi
\fi}}
-\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
- \else \the\evenfootline \fi}\HEADINGShook}
+\footline={{\textfonts\rm\frenchspacingsetting
+ \ifodd\pageno \the\oddfootline \else \the\evenfootline \fi}%
+ \HEADINGShook}
\let\HEADINGShook=\relax
% Commands to set those variables.
@@ -3958,7 +3964,7 @@ $$%
\global\oddfootline={\hfil}
\global\evenheadline={\line{\folio\hfil\thistitle}}
\global\oddheadline={\line{\thischapter\hfil\folio}}
-\global\evenchapheadline={\line{\folio\hfil}}
+\global\evenchapheadline={\line{\folio\hfil\thistitle}}
\global\oddchapheadline={\line{\hfil\folio}}
\global\let\contentsalignmacro = \chapoddpage
}
@@ -4346,8 +4352,7 @@ $$%
% undo it ourselves.
\def\headitemfont{\b}% for people to use in the template row; not changeable
\def\headitem{%
- \checkenv\multitable
- \crcr
+ \crcr % must appear first
\gdef\headitemcrhook{\nobreak}% attempt to avoid page break after headings
\global\everytab={\bf}% can't use \headitemfont since the parsing differs
\the\everytab % for the first item
@@ -4432,7 +4437,7 @@ $$%
\message{conditionals,}
-% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext,
+% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotlatex, @ifnotplaintext,
% @ifnotxml always succeed. They currently do nothing; we don't
% attempt to check whether the conditionals are properly nested. But we
% have to remember that they are conditionals, so that @end doesn't
@@ -4446,6 +4451,7 @@ $$%
\makecond{ifnotdocbook}
\makecond{ifnothtml}
\makecond{ifnotinfo}
+\makecond{ifnotlatex}
\makecond{ifnotplaintext}
\makecond{ifnotxml}
@@ -4458,10 +4464,12 @@ $$%
\def\ifdocbook{\doignore{ifdocbook}}
\def\ifhtml{\doignore{ifhtml}}
\def\ifinfo{\doignore{ifinfo}}
+\def\iflatex{\doignore{iflatex}}
\def\ifnottex{\doignore{ifnottex}}
\def\ifplaintext{\doignore{ifplaintext}}
\def\ifxml{\doignore{ifxml}}
\def\ignore{\doignore{ignore}}
+\def\latex{\doignore{latex}}
\def\menu{\doignore{menu}}
\def\xml{\doignore{xml}}
@@ -4985,25 +4993,24 @@ $$%
\catcode`\-=13
\catcode`\`=13
\gdef\indexnonalnumdisappear{%
- \expandafter\ifx\csname SETtxiindexlquoteignore\endcsname\relax\else
+ \ifflagclear{txiindexlquoteignore}{}{%
% @set txiindexlquoteignore makes us ignore left quotes in the sort term.
% (Introduced for FSFS 2nd ed.)
\let`=\empty
- \fi
+ }%
%
- \expandafter\ifx\csname SETtxiindexbackslashignore\endcsname\relax\else
+ \ifflagclear{txiindexbackslashignore}{}{%
\backslashdisappear
- \fi
- %
- \expandafter\ifx\csname SETtxiindexhyphenignore\endcsname\relax\else
+ }%
+ \ifflagclear{txiindexhyphenignore}{}{%
\def-{}%
- \fi
- \expandafter\ifx\csname SETtxiindexlessthanignore\endcsname\relax\else
+ }%
+ \ifflagclear{txiindexlessthanignore}{}{%
\def<{}%
- \fi
- \expandafter\ifx\csname SETtxiindexatsignignore\endcsname\relax\else
+ }%
+ \ifflagclear{txiindexatsignignore}{}{%
\def\@{}%
- \fi
+ }%
}
\gdef\indexnonalnumreappear{%
@@ -5295,9 +5302,7 @@ $$%
%
\atdummies
%
- \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax\else
- \escapeisbackslash
- \fi
+ \ifflagclear{txiindexescapeisbackslash}{}{\escapeisbackslash}%
%
% For texindex which always views { and } as separators.
\def\{{\lbracechar{}}%
@@ -5481,9 +5486,9 @@ $$%
% old index files using \ as the escape character. Reading this would
% at best lead to typesetting garbage, at worst a TeX syntax error.
\def\printindexzz#1#2\finish{%
- \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax
+ \ifflagclear{txiindexescapeisbackslash}{%
\uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1
- \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax
+ \ifflagclear{txiskipindexfileswithbackslash}{%
\errmessage{%
ERROR: A sorted index file in an obsolete format was skipped.
To fix this problem, please upgrade your version of 'texi2dvi'
@@ -5499,15 +5504,15 @@ this, Texinfo will try to use index files in the old
format.
If you continue to have problems, deleting the index files and starting again
might help (with 'rm \jobname.?? \jobname.??s')%
}%
- \else
+ }{%
(Skipped sorted index file in obsolete format)
- \fi
+ }%
\else
\begindoublecolumns
\input \jobname.\indexname s
\enddoublecolumns
\fi
- \else
+ }{%
\begindoublecolumns
\catcode`\\=0\relax
%
@@ -5517,7 +5522,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\catcode`\@=0\relax
\input \jobname.\indexname s
\enddoublecolumns
- \fi
+ }%
}
% These macros are used by the sorted index file itself.
@@ -6750,6 +6755,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\ifnum\romancount=0 \global\romancount=\pagecount \fi
}
+% \raggedbottom in plain.tex hardcodes \topskip so override it
+\catcode`\@=11
+\def\raggedbottom{\advance\topskip by 0pt plus60pt \r@ggedbottomtrue}
+\catcode`\@=\other
+
% redefined for the two-volume lispref. We always output on
% \jobname.toc even if this is redefined.
%
@@ -7110,7 +7120,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% collide with the section heading.
\ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi
%
- \setbox\groupbox=\vbox\bgroup
+ \setbox\groupbox=\vtop\bgroup
\baselineskip=0pt\parskip=0pt\lineskip=0pt
\carttop
\hbox\bgroup
@@ -7277,22 +7287,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
\let\Eraggedright\par
-\envdef\raggedleft{%
- \parindent=0pt \leftskip0pt plus2em
- \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt
- \hbadness=10000 % Last line will usually be underfull, so turn off
- % badness reporting.
-}
-\let\Eraggedleft\par
-
-\envdef\raggedcenter{%
- \parindent=0pt \rightskip0pt plus1em \leftskip0pt plus1em
- \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt
- \hbadness=10000 % Last line will usually be underfull, so turn off
- % badness reporting.
-}
-\let\Eraggedcenter\par
-
% @quotation does normal linebreaking (hence we can't use \nonfillstart)
% and narrows the margins. We keep \parskip nonzero in general, since
@@ -7515,9 +7509,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% file; b) letting users define the frontmatter in as flexible order as
% possible is desirable.
%
-\def\copying{\checkenv{}\begingroup\scanargctxt\docopying}
-\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}}
-%
+\def\copying{\checkenv{}\begingroup\macrobodyctxt\docopying}
+{\catcode`\ =\other
+\gdef\docopying#1@end copying{\endgroup\def\copyingtext{#1}}
+}
+
\def\insertcopying{%
\begingroup
\parindent = 0pt % paragraph indentation looks wrong on title page
@@ -7599,21 +7595,15 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\Edefun{\endgraf\medbreak}
-% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn;
-% the only thing remaining is to define \deffnheader.
+% \makedefun{deffoo}{ (definition of \deffooheader) }
%
+% Define \deffoo, \deffoox \Edeffoo and \deffooheader.
\def\makedefun#1{%
\expandafter\let\csname E#1\endcsname = \Edefun
\edef\temp{\noexpand\domakedefun
\makecsname{#1}\makecsname{#1x}\makecsname{#1header}}%
\temp
}
-
-% \domakedefun \deffn \deffnx \deffnheader { (defn. of \deffnheader) }
-%
-% Define \deffn and \deffnx, without parameters.
-% \deffnheader has to be defined explicitly.
-%
\def\domakedefun#1#2#3{%
\envdef#1{%
\startdefun
@@ -7646,74 +7636,51 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi\fi
}
-% \dosubind {index}{topic}{subtopic}
-%
-% If SUBTOPIC is present, precede it with a space, and call \doind.
-% (At some time during the 20th century, this made a two-level entry in an
-% index such as the operation index. Nobody seemed to notice the change in
-% behaviour though.)
-\def\dosubind#1#2#3{%
- \def\thirdarg{#3}%
- \ifx\thirdarg\empty
- \doind{#1}{#2}%
- \else
- \doind{#1}{#2\space#3}%
- \fi
-}
-
% Untyped functions:
% @deffn category name args
-\makedefun{deffn}{\deffngeneral{}}
-
-% @deffn category class name args
-\makedefun{defop}#1 {\defopon{#1\ \putwordon}}
-
-% \defopon {category on}class name args
-\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
+\makedefun{deffn}#1 #2 #3\endheader{%
+ \doind{fn}{\code{#2}}%
+ \defname{#1}{}{#2}\magicamp\defunargs{#3\unskip}%
+}
-% \deffngeneral {subind}category name args
-%
-\def\deffngeneral#1#2 #3 #4\endheader{%
- \dosubind{fn}{\code{#3}}{#1}%
- \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}%
+% @defop category class name args
+\makedefun{defop}#1 {\defopheaderx{#1\ \putwordon}}
+\def\defopheaderx#1#2 #3 #4\endheader{%
+ \doind{fn}{\code{#3}\space\putwordon\ \code{#2}}%
+ \defname{#1\ \code{#2}}{}{#3}\magicamp\defunargs{#4\unskip}%
}
% Typed functions:
% @deftypefn category type name args
-\makedefun{deftypefn}{\deftypefngeneral{}}
+\makedefun{deftypefn}#1 #2 #3 #4\endheader{%
+ \doind{fn}{\code{#3}}%
+ \doingtypefntrue
+ \defname{#1}{#2}{#3}\defunargs{#4\unskip}%
+}
% @deftypeop category class type name args
-\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}}
-
-% \deftypeopon {category on}class type name args
-\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
-
-% \deftypefngeneral {subind}category type name args
-%
-\def\deftypefngeneral#1#2 #3 #4 #5\endheader{%
- \dosubind{fn}{\code{#4}}{#1}%
+\makedefun{deftypeop}#1 {\deftypeopheaderx{#1\ \putwordon}}
+\def\deftypeopheaderx#1#2 #3 #4 #5\endheader{%
+ \doind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}%
\doingtypefntrue
- \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+ \defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}%
}
% Typed variables:
% @deftypevr category type var args
-\makedefun{deftypevr}{\deftypecvgeneral{}}
+\makedefun{deftypevr}#1 #2 #3 #4\endheader{%
+ \doind{vr}{\code{#3}}%
+ \defname{#1}{#2}{#3}\defunargs{#4\unskip}%
+}
% @deftypecv category class type var args
-\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}}
-
-% \deftypecvof {category of}class type var args
-\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} }
-
-% \deftypecvgeneral {subind}category type var args
-%
-\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{%
- \dosubind{vr}{\code{#4}}{#1}%
- \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+\makedefun{deftypecv}#1 {\deftypecvheaderx{#1\ \putwordof}}
+\def\deftypecvheaderx#1#2 #3 #4 #5\endheader{%
+ \doind{vr}{\code{#4}\space\putwordof\ \code{#2}}%
+ \defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}%
}
% Untyped variables:
@@ -7722,10 +7689,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\makedefun{defvr}#1 {\deftypevrheader{#1} {} }
% @defcv category class var args
-\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}}
-
-% \defcvof {category of}class var args
-\def\defcvof#1#2 {\deftypecvof{#1}#2 {} }
+\makedefun{defcv}#1 {\defcvheaderx{#1\ \putwordof}}
+\def\defcvheaderx#1#2 {\deftypecvheaderx{#1}#2 {} }
% Types:
@@ -7743,10 +7708,10 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\makedefun{defvar}{\defvrheader{\putwordDefvar} }
\makedefun{defopt}{\defvrheader{\putwordDefopt} }
\makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} }
-\makedefun{defmethod}{\defopon\putwordMethodon}
-\makedefun{deftypemethod}{\deftypeopon\putwordMethodon}
-\makedefun{defivar}{\defcvof\putwordInstanceVariableof}
-\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof}
+\makedefun{defmethod}{\defopheaderx\putwordMethodon}
+\makedefun{deftypemethod}{\deftypeopheaderx\putwordMethodon}
+\makedefun{defivar}{\defcvheaderx\putwordInstanceVariableof}
+\makedefun{deftypeivar}{\deftypecvheaderx\putwordInstanceVariableof}
% \defname, which formats the name of the @def (not the args).
% #1 is the category, such as "Function".
@@ -7765,9 +7730,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\rettypeownlinefalse
\ifdoingtypefn % doing a typed function specifically?
% then check user option for putting return type on its own line:
- \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else
- \rettypeownlinetrue
- \fi
+ \ifflagclear{txideftypefnnl}{}{\rettypeownlinetrue}%
\fi
%
% How we'll format the category name. Putting it in brackets helps
@@ -7832,30 +7795,20 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi % no return type
#3% output function name
}%
- {\rm\enskip}% hskip 0.5 em of \rmfont
+ \ifflagclear{txidefnamenospace}{%
+ {\rm\enskip}% hskip 0.5 em of \rmfont
+ }{}%
%
\boldbrax
% arguments will be output next, if any.
}
-% Print arguments in slanted roman (not ttsl), inconsistently with using
-% tt for the name. This is because literal text is sometimes needed in
-% the argument list (groff manual), and ttsl and tt are not very
-% distinguishable. Prevent hyphenation at `-' chars.
-%
+% Print arguments. Use slanted for @def*, typewriter for @deftype*.
\def\defunargs#1{%
- % use sl by default (not ttsl),
- % tt for the names.
- \df \sl \hyphenchar\font=0
- %
- % On the other hand, if an argument has two dashes (for instance), we
- % want a way to get ttsl. We used to recommend @var for that, so
- % leave the code in, but it's strange for @var to lead to typewriter.
- % Nowadays we recommend @code, since the difference between a ttsl hyphen
- % and a tt hyphen is pretty tiny. @code also disables ?` !`.
- \def\var##1{{\setregularquotes\ttslanted{##1}}}%
+ \df \ifdoingtypefn \tt \else \sl \fi
+ \ifflagclear{txicodevaristt}{}%
+ {\def\var##1{{\setregularquotes \ttsl ##1}}}%
#1%
- \sl\hyphenchar\font=45
}
% We want ()&[] to print specially on the defun line.
@@ -7874,9 +7827,12 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% so TeX would otherwise complain about undefined control sequence.
{
\activeparens
- \global\let(=\lparen \global\let)=\rparen
- \global\let[=\lbrack \global\let]=\rbrack
- \global\let& = \&
+ \gdef\defcharsdefault{%
+ \let(=\lparen \let)=\rparen
+ \let[=\lbrack \let]=\rbrack
+ \let& = \&%
+ }
+ \globaldefs=1 \defcharsdefault
\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
\gdef\magicamp{\let&=\amprm}
@@ -8060,24 +8016,17 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\catcode`\_=\other
\catcode`\|=\other
\catcode`\~=\other
- \passthroughcharstrue
-}
-
-\def\scanargctxt{% used for copying and captions, not macros.
- \scanctxt
\catcode`\@=\other
- \catcode`\\=\other
\catcode`\^^M=\other
+ \catcode`\\=\active
+ \passthroughcharstrue
}
-\def\macrobodyctxt{% used for @macro definitions
+\def\macrobodyctxt{% used for @macro definitions and @copying
\scanctxt
\catcode`\ =\other
- \catcode`\@=\other
\catcode`\{=\other
\catcode`\}=\other
- \catcode`\^^M=\other
- \usembodybackslash
}
% Used when scanning braced macro arguments. Note, however, that catcode
@@ -8086,14 +8035,10 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\macroargctxt{%
\scanctxt
\catcode`\ =\active
- \catcode`\@=\other
- \catcode`\^^M=\other
- \catcode`\\=\active
}
\def\macrolineargctxt{% used for whole-line arguments without braces
\scanctxt
- \catcode`\@=\other
\catcode`\{=\other
\catcode`\}=\other
}
@@ -8137,7 +8082,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\global\expandafter\let\csname ismacro.\the\macname\endcsname=1%
\addtomacrolist{\the\macname}%
\fi
- \begingroup \macrobodyctxt
+ \begingroup \macrobodyctxt \usembodybackslash
\ifrecursive \expandafter\parsermacbody
\else \expandafter\parsemacbody
\fi}
@@ -8941,7 +8886,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
- \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax
+ \ifflagclear{txiomitxrefpg}{%
% But we always want a comma and a space:
,\space
%
@@ -8956,7 +8901,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\tokenafterxref ,% @NL
\else\ifx\tie\tokenafterxref ,% @tie
\fi\fi\fi\fi\fi\fi
- \fi
+ }{}%
\fi\fi
\fi
\endlink
@@ -9373,6 +9318,12 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\imagexxx #1,,,,,\finish
\fi
}
+
+% Approximate height of a line in the standard text font.
+\newdimen\capheight
+\setbox0=\vbox{\tenrm H}
+\capheight=\ht0
+
%
% Arguments to @image:
% #1 is (mandatory) image filename; we tack on .eps extension.
@@ -9402,7 +9353,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
% Place image in a \vtop for a top page margin that is (close to) correct,
% as \topskip glue is relative to the first baseline.
- \vtop\bgroup\hrule height 0pt\vskip-\parskip
+ \vtop\bgroup \kern -\capheight \vskip-\parskip
\fi
%
% Enter horizontal mode so that indentation from an enclosing
@@ -9604,7 +9555,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
\def\caption{\docaption\thiscaption}
\def\shortcaption{\docaption\thisshortcaption}
-\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption}
+\def\docaption{\checkenv\float \bgroup\scanctxt\defcaption}
\def\defcaption#1#2{\egroup \def#1{#2}}
% The parameter is the control sequence identifying the counter we are
@@ -10324,9 +10275,9 @@ directory should work if nowhere else does.}
% Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp
% to the corresponding UTF-8 sequence.
\gdef\parseXMLCharref{%
- \ifnum\countUTFz < "A0\relax
+ \ifnum\countUTFz < "20\relax
\errhelp = \EMsimple
- \errmessage{Cannot define Unicode char value < 00A0}%
+ \errmessage{Cannot define Unicode char value < 0020}%
\else\ifnum\countUTFz < "800\relax
\parseUTFviiiA,%
\parseUTFviiiB C\UTFviiiTwoOctetsName.,%
@@ -10396,6 +10347,103 @@ directory should work if nowhere else does.}
% least make most of the characters not bomb out.
%
\def\unicodechardefs{%
+ \DeclareUnicodeCharacter{0020}{ } % space
+ \DeclareUnicodeCharacter{0021}{\char"21 }% % space to terminate number
+ \DeclareUnicodeCharacter{0022}{\char"22 }%
+ \DeclareUnicodeCharacter{0023}{\char"23 }%
+ \DeclareUnicodeCharacter{0024}{\char"24 }%
+ \DeclareUnicodeCharacter{0025}{\char"25 }%
+ \DeclareUnicodeCharacter{0026}{\char"26 }%
+ \DeclareUnicodeCharacter{0027}{\char"27 }%
+ \DeclareUnicodeCharacter{0028}{\char"28 }%
+ \DeclareUnicodeCharacter{0029}{\char"29 }%
+ \DeclareUnicodeCharacter{002A}{\char"2A }%
+ \DeclareUnicodeCharacter{002B}{\char"2B }%
+ \DeclareUnicodeCharacter{002C}{\char"2C }%
+ \DeclareUnicodeCharacter{002D}{\char"2D }%
+ \DeclareUnicodeCharacter{002E}{\char"2E }%
+ \DeclareUnicodeCharacter{002F}{\char"2F }%
+ \DeclareUnicodeCharacter{0030}{0}%
+ \DeclareUnicodeCharacter{0031}{1}%
+ \DeclareUnicodeCharacter{0032}{2}%
+ \DeclareUnicodeCharacter{0033}{3}%
+ \DeclareUnicodeCharacter{0034}{4}%
+ \DeclareUnicodeCharacter{0035}{5}%
+ \DeclareUnicodeCharacter{0036}{6}%
+ \DeclareUnicodeCharacter{0037}{7}%
+ \DeclareUnicodeCharacter{0038}{8}%
+ \DeclareUnicodeCharacter{0039}{9}%
+ \DeclareUnicodeCharacter{003A}{\char"3A }%
+ \DeclareUnicodeCharacter{003B}{\char"3B }%
+ \DeclareUnicodeCharacter{003C}{\char"3C }%
+ \DeclareUnicodeCharacter{003D}{\char"3D }%
+ \DeclareUnicodeCharacter{003E}{\char"3E }%
+ \DeclareUnicodeCharacter{003F}{\char"3F }%
+ \DeclareUnicodeCharacter{0040}{\char"40 }%
+ \DeclareUnicodeCharacter{0041}{A}%
+ \DeclareUnicodeCharacter{0042}{B}%
+ \DeclareUnicodeCharacter{0043}{C}%
+ \DeclareUnicodeCharacter{0044}{D}%
+ \DeclareUnicodeCharacter{0045}{E}%
+ \DeclareUnicodeCharacter{0046}{F}%
+ \DeclareUnicodeCharacter{0047}{G}%
+ \DeclareUnicodeCharacter{0048}{H}%
+ \DeclareUnicodeCharacter{0049}{I}%
+ \DeclareUnicodeCharacter{004A}{J}%
+ \DeclareUnicodeCharacter{004B}{K}%
+ \DeclareUnicodeCharacter{004C}{L}%
+ \DeclareUnicodeCharacter{004D}{M}%
+ \DeclareUnicodeCharacter{004E}{N}%
+ \DeclareUnicodeCharacter{004F}{O}%
+ \DeclareUnicodeCharacter{0050}{P}%
+ \DeclareUnicodeCharacter{0051}{Q}%
+ \DeclareUnicodeCharacter{0052}{R}%
+ \DeclareUnicodeCharacter{0053}{S}%
+ \DeclareUnicodeCharacter{0054}{T}%
+ \DeclareUnicodeCharacter{0055}{U}%
+ \DeclareUnicodeCharacter{0056}{V}%
+ \DeclareUnicodeCharacter{0057}{W}%
+ \DeclareUnicodeCharacter{0058}{X}%
+ \DeclareUnicodeCharacter{0059}{Y}%
+ \DeclareUnicodeCharacter{005A}{Z}%
+ \DeclareUnicodeCharacter{005B}{\char"5B }%
+ \DeclareUnicodeCharacter{005C}{\char"5C }%
+ \DeclareUnicodeCharacter{005D}{\char"5D }%
+ \DeclareUnicodeCharacter{005E}{\char"5E }%
+ \DeclareUnicodeCharacter{005F}{\char"5F }%
+ \DeclareUnicodeCharacter{0060}{\char"60 }%
+ \DeclareUnicodeCharacter{0061}{a}%
+ \DeclareUnicodeCharacter{0062}{b}%
+ \DeclareUnicodeCharacter{0063}{c}%
+ \DeclareUnicodeCharacter{0064}{d}%
+ \DeclareUnicodeCharacter{0065}{e}%
+ \DeclareUnicodeCharacter{0066}{f}%
+ \DeclareUnicodeCharacter{0067}{g}%
+ \DeclareUnicodeCharacter{0068}{h}%
+ \DeclareUnicodeCharacter{0069}{i}%
+ \DeclareUnicodeCharacter{006A}{j}%
+ \DeclareUnicodeCharacter{006B}{k}%
+ \DeclareUnicodeCharacter{006C}{l}%
+ \DeclareUnicodeCharacter{006D}{m}%
+ \DeclareUnicodeCharacter{006E}{n}%
+ \DeclareUnicodeCharacter{006F}{o}%
+ \DeclareUnicodeCharacter{0070}{p}%
+ \DeclareUnicodeCharacter{0071}{q}%
+ \DeclareUnicodeCharacter{0072}{r}%
+ \DeclareUnicodeCharacter{0073}{s}%
+ \DeclareUnicodeCharacter{0074}{t}%
+ \DeclareUnicodeCharacter{0075}{u}%
+ \DeclareUnicodeCharacter{0076}{v}%
+ \DeclareUnicodeCharacter{0077}{w}%
+ \DeclareUnicodeCharacter{0078}{x}%
+ \DeclareUnicodeCharacter{0079}{y}%
+ \DeclareUnicodeCharacter{007A}{z}%
+ \DeclareUnicodeCharacter{007B}{\char"7B }%
+ \DeclareUnicodeCharacter{007C}{\char"7C }%
+ \DeclareUnicodeCharacter{007D}{\char"7D }%
+ \DeclareUnicodeCharacter{007E}{\char"7E }%
+ % \DeclareUnicodeCharacter{007F}{} % DEL
+ %
\DeclareUnicodeCharacter{00A0}{\tie}%
\DeclareUnicodeCharacter{00A1}{\exclamdown}%
\DeclareUnicodeCharacter{00A2}{{\tcfont \char162}}% 0242=cent
@@ -11080,24 +11128,26 @@ directory should work if nowhere else does.}
% provide a definition macro to replace/pass-through a Unicode character
%
\def\DeclareUnicodeCharacterNative#1#2{%
- \catcode"#1=\active
- \def\dodeclareunicodecharacternative##1##2##3{%
+ \ifnum"#1>"7F % only make non-ASCII chars active
+ \catcode"#1=\active
+ \def\dodeclareunicodecharacternative##1##2##3{%
+ \begingroup
+ \uccode`\~="##2\relax
+ \uppercase{\gdef~}{%
+ \ifpassthroughchars
+ ##1%
+ \else
+ ##3%
+ \fi
+ }
+ \endgroup
+ }
\begingroup
- \uccode`\~="##2\relax
- \uppercase{\gdef~}{%
- \ifpassthroughchars
- ##1%
- \else
- ##3%
- \fi
- }
+ \uccode`\.="#1\relax
+ \uppercase{\def\UTFNativeTmp{.}}%
+ \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}%
\endgroup
- }
- \begingroup
- \uccode`\.="#1\relax
- \uppercase{\def\UTFNativeTmp{.}}%
- \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}%
- \endgroup
+ \fi
}
% Native Unicode handling (XeTeX and LuaTeX) character replacing definition.
@@ -11180,13 +11230,9 @@ directory should work if nowhere else does.}
%
\vsize = #1\relax
\advance\vsize by \topskip
- \outervsize = \vsize
- \advance\outervsize by 2\topandbottommargin
\txipageheight = \vsize
%
\hsize = #2\relax
- \outerhsize = \hsize
- \advance\outerhsize by 0.5in
\txipagewidth = \hsize
%
\normaloffset = #4\relax
@@ -11276,7 +11322,7 @@ directory should work if nowhere else does.}
\textleading = 12.5pt
%
\internalpagesizes{160mm}{120mm}%
- {\voffset}{\hoffset}%
+ {\voffset}{-11.4mm}%
{\bindingoffset}{8pt}%
{210mm}{148mm}%
%
@@ -11358,6 +11404,7 @@ directory should work if nowhere else does.}
\message{and turning on texinfo input format.}
\def^^L{\par} % remove \outer, so ^L can appear in an @comment
+\catcode`\^^K = 10 % treat vertical tab as whitespace
% DEL is a comment character, in case @c does not suffice.
\catcode`\^^? = 14
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 0e55b6c1d2..99a268367b 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -903,6 +903,30 @@ supports changing the remote login shell @command{/bin/sh}.
Check the @samp{Share SSH connections if possible} control for that
session.
+@item @option{docker}
+@cindex method @option{docker}
+@cindex @option{docker} method
+
+Integration for Docker containers. The host name may be either a
+running container's name or ID, as returned by @samp{docker ps}.
+
+@item @option{podman}
+@cindex method @option{podman}
+@cindex @option{podman} method
+
+Podman is an alternative to @option{docker} which may be run rootless,
+if desired.
+
+@item @option{kubernetes}
+@cindex method @option{kubernetes}
+@cindex @option{kubernetes} method
+
+Integration for containers in Kubernetes pods. The host name is a pod
+name returned by @samp{kubectl get pods}. The first container in a
+pod is used.
+
+This method does not support user names.
+
@end table
@@ -1763,36 +1787,21 @@ They can be installed with Emacs's Package Manager.
This includes
@c @item ibuffer-tramp.el
@c Contact Svend Sorensen <svend@@ciffer.net>
-@item docker-tramp
-@cindex method @option{docker}
-@cindex @option{docker} method
-Integration for Docker containers. A container is accessed via
-@file{@trampfn{docker,user@@container,/path/to/file}}, where
-@samp{user} is the (optional) user that you want to use, and
-@samp{container} is the id or name of the container.
-
-@item kubernetes-tramp
-@cindex method @option{kubectl}
-@cindex @option{kubectl} method
-Integration for Docker containers deployed in a Kubernetes cluster.
-It is derived from @samp{docker-tramp}. A container is accessed via
-@file{@trampfn{kubectl,user@@container,/path/to/file}}, @samp{user}
-and @samp{container} have the same meaning as in @samp{docker-tramp}.
-
@item lxc-tramp
@cindex method @option{lxc}
@cindex @option{lxc} method
Integration for LXC containers. A container is accessed via
@file{@trampfn{lxc,container,/path/to/file}}, @samp{container} has the
-same meaning as in @samp{docker-tramp}. A @samp{user} specification
-is ignored.
+same meaning as with the @option{docker} method. A @samp{user}
+specification is ignored.
@item lxd-tramp
@cindex method @option{lxd}
@cindex @option{lxd} method
Integration for LXD containers. A container is accessed via
@file{@trampfn{lxd,user@@container,/path/to/file}}, @samp{user} and
-@samp{container} have the same meaning as in @samp{docker-tramp}.
+@samp{container} have the same meaning as with the @option{docker}
+method.
@item magit-tramp
@cindex method @option{git}
@@ -1997,10 +2006,10 @@ password of the target user. If these connections
happen on the local
host, an entry with the local user and local host is used:
@example
-machine @var{HOST} port sudo login @var{USER} password secret
+machine @var{host} port sudo login @var{user} password secret
@end example
-@var{USER} and @var{HOST} are the strings returned by
+@var{user} and @var{host} are the strings returned by
@code{(user-login-name)} and @code{(system-name)}. If one of these
methods is connected via a multi hop (@pxref{Multi-hops}), the
credentials of the previous hop are used.
@@ -3523,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
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index 24c3090ef7..a6745131d8 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
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 5644027f95..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
@@ -380,7 +380,7 @@ for specific schemes.
* info:: Emacs "Info" pages.
* mailto:: Sending email.
* news/nntp/snews:: Usenet news.
-* rlogin/telnet/tn3270:: Remote host connectivity.
+* telnet/tn3270:: Remote host connectivity.
* irc:: Internet Relay Chat.
* data:: Embedded data URLs.
* nfs:: Networked File System.
@@ -675,9 +675,8 @@ environment variable @samp{NNTPSERVER}, or @samp{news} if
that
environment variable is unset.
@end defopt
-@node rlogin/telnet/tn3270
-@section rlogin, telnet and tn3270
-@cindex rlogin
+@node telnet/tn3270
+@section telnet and tn3270
@cindex telnet
@cindex tn3270
@cindex terminal emulation
@@ -694,10 +693,10 @@ telnet://@var{user}:@var{password}@@@var{host}:@var{port}
but the @var{password} component is ignored. By default, the
@code{telnet} scheme is handled via Tramp (@pxref{Tramp}).
-To handle rlogin, telnet and tn3270 URLs, a @code{rlogin},
-@code{telnet} or @code{tn3270} (the program names and arguments are
-hardcoded) session is run in a @code{terminal-emulator} buffer.
-Well-known ports are used if the URL does not specify a port.
+To handle telnet and tn3270 URLs, a @code{telnet} or @code{tn3270}
+(the program names and arguments are hardcoded) session is run in a
+@code{terminal-emulator} buffer. Well-known ports are used if the URL
+does not specify a port.
@node irc
@section irc
@@ -1039,12 +1038,6 @@ a list of symbols. Possible values are:
Use this method if you must first telnet and log into a gateway host,
and then run telnet from that host to connect to outside machines.
-@item rlogin
-@cindex @command{rlogin}
-This method is identical to @code{telnet}, but uses @command{rlogin}
-to log into the remote machine without having to send the username and
-password over the wire every time.
-
@item socks
@cindex @sc{socks}
Use if the firewall has a @sc{socks} gateway running on it. The
@@ -1087,19 +1080,6 @@ The password to send when logging in.
This is a regular expression that matches the shell prompt.
@end defopt
-@defopt url-gateway-rlogin-host
-Host to @samp{rlogin} to before telnetting out.
-@end defopt
-@defopt url-gateway-rlogin-parameters
-Parameters to pass to @samp{rsh}.
-@end defopt
-@defopt url-gateway-rlogin-user-name
-User name to use when logging in to the gateway.
-@end defopt
-@defopt url-gateway-prompt-pattern
-This is a regular expression that matches the shell prompt.
-@end defopt
-
@defopt socks-server
This specifies the default server, it takes the form
@w{@code{("Default server" @var{server} @var{port} @var{version})}}
@@ -1327,8 +1307,6 @@ from the local machine. The supported methods are:
@table @code
@item telnet
Run telnet in a subprocess to connect;
-@item rlogin
-Rlogin to another machine to connect;
@item socks
Connect through a socks server;
@item ssl
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/viper.texi b/doc/misc/viper.texi
index 0703667ecc..d36019f06a 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -34,7 +34,7 @@ modify this GNU manual.''
@titlepage
@title Viper Is a Package for Emacs Rebels
@subtitle a Vi emulator for Emacs
-@subtitle November 2008, Viper Version 3.11.2
+@subtitle July 2013, Viper Version 3.14.2
@author Michael Kifer (Viper)
@author Aamod Sane (VIP 4.4)
@@ -325,9 +325,9 @@ lines (in the given order!):
@noindent
in your @file{~/.emacs} file. The @file{.emacs} file is placed in your
home directory and it is be executed every time you invoke Emacs. This is
-the place where all general Emacs customization takes place. Beginning with
-version 20.0, Emacsen have an interactive interface, which simplifies the
-job of customization significantly.
+the place where all general Emacs customization takes place. Emacs
+has an interactive interface (@kbd{M-x customize}), which simplifies
+the job of customization significantly.
Viper also uses the file @file{~/.emacs.d/viper} for Viper-specific
customization.
The location of Viper customization file can be changed by setting the
diff --git a/etc/AUTHORS b/etc/AUTHORS
index f6349df5bc..2659395898 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -103,8 +103,8 @@ Alakazam Petrofsky: changed hanoi.el
Alan Mackenzie: wrote cc-awk.el
and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-fonts.el
cc-langs.el cc-mode.el cc-styles.el cc-vars.el
-and changed cc-mode.texi minibuf.c bytecomp.el edebug.el follow.el
- window.c display.texi subr.el syntax.texi progmodes/compile.el
+and changed cc-mode.texi minibuf.c bytecomp.el window.c edebug.el
+ follow.el display.texi subr.el syntax.texi progmodes/compile.el
programs.texi eval.c keyboard.c lisp.h modes.texi window.el
windows.texi cus-start.el font-lock.el frame.c isearch.el
and 167 other files
@@ -994,7 +994,8 @@ and changed calc.el replace.el update-game-score.c
calc-ext.el
Colin Williams: changed calc.texi
-Colin Woodbury: changed files.el files.texi macros.texi shortdoc.el
+Colin Woodbury: changed files.el cl-seq.el files.texi macros.texi
+ shortdoc.el
Constantin Kulikov: changed server.el startup.el
@@ -2056,10 +2057,10 @@ Gregor Schmid: changed intervals.c intervals.h
tcl-mode.el textprop.c
Gregory Chernov: changed nnslashdot.el
-Gregory Heytings: changed isearch.el minibuffer.el mini.texi quail.el
- search.texi simple.el HELLO buffers.texi diff-mode.el emake facemenu.el
- files.el fringe.c help-macro.el icomplete.el keyboard.c misc-lang.el
- modula2.el pcmpl-gnu.el print.c pulse.el and 4 other files
+Gregory Heytings: changed isearch.el minibuffer.el efaq.texi mini.texi
+ quail.el search.texi simple.el HELLO buffers.texi diff-mode.el emake
+ facemenu.el fbterm.el files.el fringe.c help-macro.el icomplete.el
+ keyboard.c misc-lang.el modula2.el pcmpl-gnu.el and 6 other files
Grégory Mounié: changed display.texi hi-lock.el man.el xfns.c
@@ -4518,7 +4519,7 @@ Philipp Stephani: wrote callint-tests.el checkdoc-tests.el
and changed emacs-module.c emacs-module-tests.el configure.ac json.c
process.c eval.c internals.texi json-tests.el process-tests.el alloc.c
emacs-module.h.in emacs.c lread.c nsterm.m lisp.h pdumper.c bytecomp.el
- callproc.c seccomp-filter.c gtkutil.c files.el and 184 other files
+ callproc.c seccomp-filter.c gtkutil.c files.el and 185 other files
Phillip Lord: wrote ps-print-tests.el w32-feature.el
and changed build-zips.sh build-dep-zips.py lisp/Makefile.in undo.c
@@ -4787,7 +4788,7 @@ Robert Pluim: wrote nsm-tests.el
and changed configure.ac process.c blocks.awk network-stream-tests.el
font.c processes.texi ftfont.c gtkutil.c vc-git.el process-tests.el
emoji-zwj.awk gnutls.el network-stream.el nsm.el tramp.texi mml-sec.el
- nsterm.m unicode xfns.c auth.texi composite.c and 138 other files
+ nsterm.m unicode xfns.c auth.texi composite.c and 139 other files
Robert Thorpe: changed cus-start.el indent.el rmail.texi
@@ -5180,8 +5181,8 @@ Stefan Kangas: wrote bookmark-tests.el cal-julian-tests.el
and co-wrote help-tests.el keymap-tests.el
and changed efaq.texi checkdoc.el package.el cperl-mode.el bookmark.el
help.el keymap.c subr.el simple.el erc.el ediff-util.el idlwave.el
- time.el bytecomp-tests.el comp.el speedbar.el bytecomp.el edebug.el
- emacs-lisp-intro.texi flyspell.el ibuffer.el and 1344 other files
+ time.el bytecomp-tests.el comp.el emacs-lisp-intro.texi speedbar.el
+ bytecomp.el edebug.el flyspell.el ibuffer.el and 1348 other files
Stefan Merten: co-wrote rst.el
diff --git a/etc/DEBUG b/etc/DEBUG
index df289310f9..ef9160a209 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -661,10 +661,10 @@ Setting a breakpoint in the function 'x_error_quitter'
and looking at
the backtrace when Emacs stops inside that function will show what
code causes the X protocol errors.
-Note that the -xrm option may have no effect when you make an Emacs
-process invoked with the -nw option a server and want to trace X
-protocol errors from subsequent invocations of emacsclient in a GUI
-frame. In that case calling the initial Emacs via
+Note that the -xrm option may have no effect when you start a server
+in an Emacs session invoked with the -nw command-line option, and want
+to trace X protocol errors from GUI frames created by subsequent
+invocations of emacsclient. In that case starting Emacs via
emacs -nw --eval '(setq x-command-line-resources "emacs.synchronous: true")'
@@ -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 7f95cdd39a..988eb1e09c 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -59,9 +59,17 @@ which, when present, becomes the first argument passed to
the "USER"
IRC command. The traditional way of setting this globally, via
'erc-email-userid', is still honored.
-** Additional display options for updated buffers.
-Additional flexibility is now available for controlling the behavior
-of newly created target buffers, especially during reconnection.
+** Changes to display options for new ERC buffers.
+The default value for the option 'erc-join-buffer', which determines
+how new buffers are displayed, has been changed to 'bury' for security
+reasons. Although the old value of 'buffer' is still accessible,
+along with its original behavior, users wanting a safer alternative
+can now opt for an improved 'window-noselect' instead. It still
+offers the same pronounced visual cue when connecting and joining but
+now avoids any hijacking of the active window as well.
+
+Beyond this, additional flexibility is now available for controlling
+the behavior of newly created target buffers during reconnection.
** Improved handling of multiline prompt input.
This means better detection and handling of intervening and trailing
@@ -77,6 +85,12 @@ now collapse into an alternate form designated by the option
but can be fine-tuned via the repurposed, formerly abandoned option
'erc-hide-prompt'.
+Certain commands provided by the 'erc-match' module, such as
+'erc-add-keyword', 'erc-add-pal', and others, now optionally ask
+whether to 'regexp-quote' the current input. A new option,
+'erc-match-quote-when-adding', has been added to allow for retaining
+the old behavior, if desired.
+
A bug has been fixed affecting users of the Soju bouncer: outgoing
messages during periods of heavy traffic no longer disappear.
diff --git a/etc/HELLO b/etc/HELLO
index d73465318c..7bc12063f8 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -24,6 +24,7 @@ Non-ASCII examples:
LANGUAGE (NATIVE NAME) HELLO
---------------------- -----
+Adlam (𞤀𞤣𞤤𞤢𞤥) 𞤅𞤢𞤤𞤢𞥄𞤥
Amharic (አማርኛ) ሠላም
Arabic (العربيّة) السّلام عليكم
Armenian (հայերեն) Բարև ձեզ
@@ -40,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
@@ -56,6 +58,7 @@ Finnish (suomi) Hei / Hyvää päivää
French (français) Bonjour / Salut
Georgian (ქართული) გამარჯობა
German (Deutsch) Guten Tag / Grüß Gott
+Gothic (𐌲𐌿𐍄𐌹𐍃𐌺𐌰) 𐌷𐌰𐌹𐌻𐍃 / 𐌷𐌰𐌹𐌻𐌰
Grantha (𑌗𑍍𑌰𑌨𑍍𑌥) 𑌨𑌮𑌸𑍍𑌤𑍇 / 𑌨𑌮𑌸𑍍𑌕𑌾𑌰𑌃
Greek (ελληνικά) Γειά σας
Greek, ancient (ἑλληνική) Οὖλέ τε καὶ μέγα χαῖρε
@@ -84,6 +87,7 @@ Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނ
Maltese (il-Malti) Bonġu / Saħħa
Mathematics ∀ p ∈ world • hello p □
Meetei Mayek (ꯃꯤꯇꯩ ꯃꯌꯦꯛ) ꯈꯨꯔꯨꯝꯖꯔꯤ
+Mende Kikakui (𞠀𞠁𞠂) 𞠛𞠉
Modi (𑘦𑘻𑘚𑘲) 𑘡𑘦𑘭𑘿𑘎𑘰𑘨
Mongolian (монгол хэл) Сайн байна уу?
Northern Thai (ᨣᩣᩴᨾᩮᩬᩥᨦ / ᨽᩣᩈᩣᩃ᩶ᩣ᩠ᨶᨶᩣ) ᩈ᩠ᩅᩢᩔ᩠ᨯᩦᨣᩕᩢ᩠ᨸ
@@ -111,9 +115,9 @@ Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེག
Tigrigna (ትግርኛ) ሰላማት
Tirhuta (𑒞𑒱𑒩𑒯𑒳𑒞𑒰) 𑒣𑓂𑒩𑒢𑒰𑒧 / 𑒮𑒲𑒞𑒰𑒩𑒰𑒧
Turkish (Türkçe) Merhaba
-Ukrainian (українська) Вітаю
+Ukrainian (українська) Вітаю / Добрий день! / Привіт
Vietnamese (tiếng Việt) Chào bạn
-
+Wancho (𞋒𞋀𞋉𞋃𞋕) 𞋂𞋈𞋛
<x-charset><param>japanese-jisx0208</param>Japanese (日本語)
こんにちは</x-charset> <x-charset><param>katakana-jisx0201</param>/ ｺﾝﾆﾁﾊ
diff --git a/etc/HISTORY b/etc/HISTORY
index bb4e3e38e1..9e4becc946 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -226,6 +226,8 @@ GNU Emacs 27.2 (2021-03-25) emacs-27.2
GNU Emacs 28.1 (2022-04-04) emacs-28.1
+GNU Emacs 28.2 (2022-09-12) emacs-28.2
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index a5b5e9053d..a185967483 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,11 +24,24 @@ applies, and please also update docstrings as needed.
* Installation Changes in Emacs 29.1
+---
+** Ahead-of-time native compilation can now be specified via configure.
+Use '--with-native-compilation=aot' to specify that all the Lisp files
+in the Emacs tree should be natively compiled ahead of time. (This is
+slow on most machines.)
+
+++
** Emacs can be built with built-in support for accessing SQLite databases.
This uses the popular sqlite3 library, and can be disabled by using
the '--without-sqlite3' option to the 'configure' script.
++++
+** Support for the WebP image format.
+This support is built by default when the libwebp library is
+available, and includes support for animated WebP images. To disable
+WebP support, use the '--without-webp' configure flag. Image
+specifiers can now use ':type webp'.
+
+++
** Emacs has been ported to the Haiku operating system.
The configuration process should automatically detect and build for
@@ -92,23 +105,20 @@ 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.
+
---
** 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 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.
-
* Startup Changes in Emacs 29.1
@@ -131,6 +141,11 @@ and then execute the rest of the script file as Emacs
Lisp. When it
reaches the end of the script, Emacs will exit with an exit code from
the value of the final form.
++++
+** New function 'substitute-quotes'.
+This function works like 'substitute-command-keys' but only
+substitutes quote characters.
+
+++
** Emacs now supports setting 'user-emacs-directory' via '--init-directory'.
@@ -146,9 +161,16 @@ time.
** Native Compilation
++++
+*** 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
+from the 'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION' environment
+variable on Emacs startup.
+
---
*** New command 'native-compile-prune-cache'.
-This command deletes older ".eln" cache entries (but not the ones for
+This command deletes older eln cache entries (but not the ones for
the current Emacs version).
---
@@ -156,14 +178,64 @@ the current Emacs version).
This function can be called in your init files to change the
user-specific directory where Emacs stores the "*.eln" files produced
by native compilation of Lisp packages Emacs loads. The default
-eln-cache directory is unchanged: it is the "eln-cache" subdirectory
+eln cache directory is unchanged: it is the "eln-cache" subdirectory
of 'user-emacs-directory'.
* Incompatible changes in Emacs 29.1
++++
+** The image commands have changed key bindings.
+In previous Emacs versions, images have had the '+', '-' and 'r' keys
+bound when point is over an image. In Emacs 29.1, additional commands
+were added, and this made it more likely that users would trigger the
+image commands by mistake. To avoid this, all image commands have
+moved to the 'i' keymap, so '+' is now 'i +', '-' is now 'i -', and
+'r' is now 'i r'. In addition, these commands are now repeating, so
+you can rotate an image twice by saying 'i r r', for instance.
+
++++
+** Emacs now picks the correct coding system for X input methods.
+Previously, Emacs would use the locale coding system for input
+methods, which could in some circumstances be incorrect, especially
+when the input method chose to fall back to some other coding system.
+
+Now, Emacs automatically detects the coding system used by input
+methods, and uses that to decode input in preference to the value of
+'locale-coding-system'. This unfortunately means that users who have
+changed the coding system used to decode X keyboard input must adjust
+their customizations to 'locale-coding-system' to the variable
+'x-input-coding-system' instead.
+
++++
+** Bookmarks no longer include context for encrypted files.
+If you're visiting an encrypted file, setting a bookmark no longer
+includes excerpts from that buffer in the bookmarks file. This is
+implemented by the new hook 'bookmark-inhibit-context-functions',
+where packages can register a function which returns non-nil for file
+names to be excluded from adding such excerpts.
+
---
-*** The Gtk selection face is no longer used for the region.
+** 'show-paren-mode' is now disabled in 'special-mode' buffers.
+In Emacs versions previous to Emacs 28.1, 'show-paren-mode' defaulted
+off. In Emacs 28.1, the mode was switched on in all buffers. In
+Emacs 29.1, this was changed to be switched on in all editing-related
+buffers, but not in buffers that inherit from 'special-mode'. To get
+back to how things worked in Emacs 28.1, put the following in your
+init file:
+
+ (setopt show-paren-predicate t)
+
++++
+** Explicitly-set read-only state is preserved when reverting a buffer.
+If you use the 'C-x C-q' command to change the read-only state of the
+buffer and then revert it, Emacs would previously use the file
+permission bits to determine whether the buffer should be read-only
+after reverting the buffer. Emacs now remembers the decision made in
+'C-x C-q'.
+
+---
+** The Gtk selection face is no longer used for the region.
The combination of a Gtk-controlled background and a foreground color
controlled by the internal Emacs machinery led to low-contrast faces
in common default setups. Emacs now uses the same 'region' face on
@@ -275,6 +347,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,
@@ -289,6 +366,10 @@ been restricted to "...", '...', /.../, |...|, (...),
[...], <...>,
and {...}. See the "(eshell) Argument Predication and Modification"
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 '|'.
+
---
** The 'delete-forward-char' command now deletes by grapheme clusters.
This command is by default bound to the <Delete> function key
@@ -331,6 +412,56 @@ the major mode according to 'initial-major-mode', like at
Emacs
startup. Previously, these functions ignored
'initial-scratch-message' and left "*scratch*" in 'fundamental-mode'.
+---
+** Naming of Image-Dired thumbnail files has changed.
+Names of thumbnail files generated when 'image-dired-thumbnail-storage'
+is 'image-dired' now always end in ".jpg". This fixes various issues
+on different platforms, but means that thumbnails generated in Emacs 28
+will not be used in Emacs 29, and vice-versa. If disk space is an
+issue, consider deleting the 'image-dired-dir' directory after
+upgrading (usually "~/.emacs.d/image-dired/").
+
+---
+** The 'rlogin' method in the URL library is now obsolete.
+Emacs will now display a warning if you request a URL like
+"rlogin://foo@example.org".
+
+---
+** Setting 'url-gateway-method' to 'rlogin' is now obsolete.
+Emacs will now display a warning when setting it to that value.
+The user options 'url-gateway-rlogin-host',
+'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name'
+are also obsolete.
+
+---
+** The linum.el library is now obsolete.
+We recommend using either the built-in 'display-line-numbers-mode', or
+the 'nlinum' package from GNU ELPA instead. The former has better
+performance, but the latter is closer to a drop-in replacement.
+
+1. To use 'display-line-numbers-mode', add something like this to your
+ Init file:
+
+ (global-display-line-numbers-mode 1)
+ ;; Alternatively, to use it only in programming modes:
+ (add-hook 'prog-mode-hook #'display-line-numbers-mode)
+
+2. To use 'nlinum', add this to your Init file:
+
+ (package-install 'nlinum)
+ (global-nlinum-mode 1)
+ ;; Alternatively, to use it only in programming modes:
+ (add-hook 'prog-mode-hook #'nlinum-mode)
+
+3. To continue using the obsolete package 'linum', add this line to
+ your Init file, in addition to any existing customizations:
+
+ (require 'linum)
+
+---
+** The thumbs.el library is now obsolete.
+We recommend using 'M-x image-dired' instead.
+
---
** The autoarg.el library is now marked obsolete.
This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor
@@ -371,6 +502,18 @@ option) and can be set to nil to disable Just-in-time Lock
mode.
* Changes in Emacs 29.1
++++
+** New user option 'major-mode-remap-alist' to specify favorite major modes.
+This user option lets you remap the default modes (e.g. 'perl-mode' or
+'latex-mode') to your favorite ones (e.g. 'cperl-mode' or
+'LaTeX-mode') without having to use 'defalias', which can have
+undesirable side effects.
+This applies to all modes specified via 'auto-mode-alist', file-local
+variables, etc.
+
+---
+** Emacs now supports Unicode Standard version 15.0.
+
---
** New user option 'electric-quote-replace-consecutive'.
@@ -411,10 +554,6 @@ increase and decrease the font size globally.
Additionally, the
user option 'global-text-scale-adjust-resizes-frames' controls whether
the frames are resized when the font size is changed.
-+++
-** New function 'file-parent-directory'.
-Get the parent directory of a file.
-
** New config variable 'syntax-wholeline-max' to reduce the cost of long lines.
This variable is used by some operations (mostly syntax-propertization
and font-locking) to treat lines longer than this variable as if they
@@ -525,8 +664,9 @@ If non-nil, this option allows scrolling a window while
dragging text
around without a scroll wheel.
+++
-*** 'mouse-drag-copy-region' can now be 'non-empty'.
-This inhibits putting empty strings onto the kill ring.
+*** The value of 'mouse-drag-copy-region' can now be the symbol 'non-empty'.
+This prevents mouse drag gestures from putting empty strings onto the
+kill ring.
+++
** New user options 'dnd-indicate-insertion-point' and 'dnd-scroll-margin'.
@@ -559,7 +699,9 @@ yes/no question before executing. The new function
'command-query' is
a convenient method of making commands disabled in this way.
---
-** 'count-lines' will now report buffer totals if given a prefix.
+** 'count-words' will now report buffer totals if given a prefix.
+Without a prefix, it will only report the word count for the narrowed
+part of the buffer.
+++
** 'count-words' will now report sentence count when used interactively.
@@ -604,11 +746,6 @@ This value stands for the value of the corresponding
attribute of the
'default' face. It can be used to reset attribute values produced by
inheriting from other faces.
-+++
-** New function 'buffer-text-pixel-size'.
-This is similar to 'window-text-pixel-size', but can be used when the
-buffer isn't displayed.
-
+++
** New X resource: "borderThickness".
This controls the thickness of the external borders of the menu bars
@@ -674,22 +811,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
@@ -712,6 +833,25 @@ saved to the X primary selection, following the
'select-active-regions' variable. This support is enabled when
'tty-select-active-regions' is non-nil.
+---
+*** New command to set up display of unsupported characters.
+The new command 'standard-display-by-replacement-char' produces Lisp
+code that sets up the 'standard-display-table' to use a replacement
+character for display of characters that the text-mode terminal
+doesn't support. It is most useful with the Linux console and similar
+terminals, where Emacs has a reliable way of determining which
+characters have glyphs in the font loaded into the terminal's memory.
+
+---
+*** New functions to set terminal output buffer size.
+The new functions 'tty--set-output-buffer-size' and
+'tty--output-buffer-size' allow setting and retrieving the output
+buffer size of a terminal device. The default buffer size is and has
+always been BUFSIZ, which is defined in your system's stdio.h. When
+you set a buffer size with 'tty--set-output-buffer-size', this also
+prevents Emacs from explicitly flushing the tty output stream, except
+at the end of display update.
+
** ERT
+++
@@ -864,6 +1004,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
+++
@@ -881,18 +1027,20 @@ 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 'special-mode' and its derivatives.
-
-+++
-** Support for the WebP image format.
-This support is built by default when the libwebp library is
-available, and includes support for animated WebP images. To disable
-WebP support, use the '--without-webp' configure flag. Image
-specifiers can now use ':type webp'.
+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
++++
+*** New commands 'split-root-window-below' and 'split-root-window-right'.
+These commands split the root window in two, and are bound to 'C-x w 2'
+and 'C-x w 3', respectively. A number of other useful window-related
+commands are now available on the 'C-x w' prefix.
+
+++
*** New user option 'display-buffer-avoid-small-windows'.
If non-nil, this should be a window height, a number. Windows smaller
@@ -948,10 +1096,15 @@ suspicious and could be malicious.
** Emacs server and client changes
+++
-*** New command-line option '-r' for emacsclient.
+*** New command-line option '-r'/'--reuse-frame' for emacsclient.
With this command-line option, Emacs reuses an existing graphical client
frame if one exists; otherwise it creates a new frame.
++++
+*** New command-line option '-w N'/'--timeout=N' for emacsclient.
+With this command-line option, emacsclient will exit if Emacs does not
+respond within N seconds. The default is to wait forever.
+
+++
*** 'server-stop-automatically' can be used to automatically stop the server.
The Emacs server will be automatically stopped when certain conditions
@@ -969,6 +1122,30 @@ Rcirc will use the default 'completion-at-point'
mechanism. The
conventional IRC behavior of completing by cycling through the
available options can be restored by enabling this option.
++++
+*** New user option 'rcirc-bridge-bot-alist'.
+If you are in a channel where a bot is responsible for bridging
+between networks, you can use this variable to make these messages
+appear more native. For example you might set the option to:
+
+ (setq rcirc-bridge-bot-alist '(("bridge" . "{\\(.+?\\)}[[:space:]]+")))
+
+for messages like
+
+ 09:47 <bridge> {john} I am not on IRC
+
+to be reformatted into
+
+ 09:47 <john> I am not on IRC
+
+---
+*** New formatting commands.
+Most IRC clients (including rcirc) support basic formatting using
+control codes. Under the 'C-c C-f' prefix a few commands have been
+added to insert these automatically. For example, if a region is
+active and 'C-c C-f C-b' is invoked, markup is inserted for the region
+to be highlighted bold.
+
** Imenu
+++
@@ -1076,6 +1253,14 @@ When nil, this prevents comint from deleting the current
input when
inserting previous input using '<mouse-2>'. The default is t, to
preserve past behavior.
+---
+*** New minor mode 'comint-fontify-input-mode'.
+This minor mode is enabled by default in "*shell*" and "*ielm*"
+buffers. It fontifies input text according to 'shell-mode' or
+'emacs-lisp-mode' font-lock rules. Customize the user options
+'shell-fontify-input-enable' and 'ielm-fontify-input-enable' to nil if
+you don't want to enable input fontification by default.
+
** Mwheel
---
@@ -1100,10 +1285,10 @@ to edit such sequences by allowing point to "enter" the
sequence.
*** Support for many old scripts and writing systems.
Emacs now supports and has language-environments and input methods for
several dozens of old scripts that were used in the past for various
-languages in South and South-East Asia. For each such script Emacs
-now has font-selection and character composition rules, a language
-environment, and an input method. The newly-added scripts and the
-corresponding language environments are:
+languages. For each such script Emacs now has font-selection and
+character composition rules, a language environment, and an input
+method. The newly-added scripts and the corresponding language
+environments are:
Tai Tham script and the Northern Thai language environment
Brahmi script and language environment
@@ -1130,6 +1315,12 @@ Grantha script and language environment
Kharoshthi script and language environment
Lepcha script and language environment
Meetei Mayek script and language environment
+Adlam script and language environment
+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".
@@ -1143,6 +1334,9 @@ supported.
Type 'C-u C-h t' to select it in case your language setup does not do
so automatically.
+---
+*** New Ukrainian translation of the Emacs Tutorial.
+
---
*** New default phonetic input method for the Tamil language environment.
The default input method for the Tamil language environment is now
@@ -1150,9 +1344,35 @@ 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
+** ecomplete
+
+---
+*** New commands 'ecomplete-edit' and 'ecomplete-remove'.
+These allow you to (respectively) edit and bulk-remove entries from
+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.
+
** Dired
+++
@@ -1245,6 +1465,10 @@ This controls how statements like the following are
indented:
foo &&
bar
+*** New Flymake backend using the ShellCheck program.
+It is enabled by default, but requires that the external "shellcheck"
+command is installed.
+
** Cperl Mode
---
@@ -1280,6 +1504,11 @@ Sets the value of the buffer-local variable
'whitespace-style' in
'diff-mode' buffers. By default, this variable is '(face trailing)',
which preserves behavior from previous Emacs versions.
++++
+*** New user option 'diff-add-log-use-relative-names'.
+If non-nil insert file names in ChangeLog skeletons relative to the
+VC root directory.
+
** Ispell
---
@@ -1319,6 +1548,18 @@ 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.
+** 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
+++
@@ -1394,8 +1635,8 @@ characters instead of just 'SPC' and 'TAB'.
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') on heading lines. To
-disable these icons, customize 'outline-minor-mode-use-buttons' to a
+customizable icons (see 'icon-preference') in the margins. To
+disable these icons, set 'outline-minor-mode-use-buttons' to a
nil value.
---
@@ -1405,7 +1646,7 @@ uses the 'key-parse' syntax. It replaces the old
'kmacro-lambda-form'
(which is now declared obsolete).
---
-** 'savehist.el' can now truncate variables that are too long.
+** savehist.el can now truncate variables that are too long.
An element of 'savehist-additional-variables' can now be of the form
'(VARIABLE . MAX-ELTS)', which means to truncate the VARIABLE's value to
at most MAX-ELTS elements (if the value is a list) before saving the
@@ -1457,6 +1698,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
@@ -1510,6 +1755,9 @@ with 'C-s C-s', but also after typing a character.
Non-nil means that the default definitions of equivalent characters
are overridden.
+*** New command 'describe-char-fold-equivalences'.
+It displays character equivalences used by 'char-fold-to-regexp'.
+
+++
*** New command 'isearch-emoji-by-name'.
It is bound to 'C-x 8 e RET' during an incremental search. The
@@ -1517,11 +1765,26 @@ command accepts the Unicode name of an Emoji (for
example, "smiling
face" or "heart with arrow"), like 'C-x 8 e e', with minibuffer
completion, and adds the Emoji into the search string.
+** Glyphless characters
+
+++
-** New minor mode 'glyphless-display-mode'.
+*** New minor mode 'glyphless-display-mode'.
This allows an easy way to toggle seeing all glyphless characters in
the current buffer.
+---
+*** The extra slot of 'glyphless-char-display' can now have cons values.
+The extra slot of the 'glyphless-char-display' char-table can now have
+values that are cons cells, specifying separate values for text-mode
+and GUI terminals.
+
++++
+*** "Replacement character" feature for undisplayable characters on TTYs.
+The 'acronym' method of displaying glyphless characters on text-mode
+frames treats single-character acronyms specially: they are displayed
+without the surrounding [..] "box", thus in effect treating such
+"acronyms" as replacement characters.
+
** Registers
+++
@@ -1550,13 +1813,53 @@ This fills the region to be no wider than a specified
pixel width.
This will take you to the gnu.org web server's version of the current
info node. This command only works for the Emacs and Emacs Lisp manuals.
+** Shortdoc
+
+---
+*** New command 'shortdoc-copy-function-as-kill' bound to 'w'.
+It copies the name of the function near point into the kill ring.
+
+---
+*** 'N' and 'P' are now bound to 'shortdoc-{next,previous}-section'.
+This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'.
+
** VC
+---
+*** New command 'vc-pull-and-push'.
+This commands first does a "pull" command, and if that is successful,
+do a "push" command afterwards.
+
++++
+*** 'C-x v b' prefix key is used now for branch commands.
+'vc-print-branch-log' is bound to 'C-x v b l', and new commands are
+'vc-create-branch' ('C-x v b c') and 'vc-switch-branch' ('C-x v b s').
+The VC Directory buffer now uses the prefix 'b' for these branch-related
+commands.
+
+++
*** New command '%' ('vc-dir-mark-by-regexp').
This command marks files based on a regexp. If given a prefix
argument, unmark instead.
++++
+*** New command 'C-x v !' ('vc-edit-next-command').
+This prefix command requests editing of the next VC shell command
+before execution. For example, in a Git repository, you can produce a
+log of more than one branch by typing 'C-x v ! C-x v b l' and then
+appending additional branch names to the 'git log' command.
+
+---
+*** 'C-x v v' in a diffs buffer allows to commit only some of the changes.
+This command is intended to allow you to commit only some of the
+changes you have in your working tree. Begin by creating a buffer
+with the changes against the last commit, e.g. with 'C-x v D'
+('vc-root-diff'). Then edit the diffs to remove the hunks you don't
+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
@@ -1565,6 +1868,35 @@ directory in "~/foo/bar", using 'C-x v v' on a new,
unregistered file
in the Git repository in "~/foo/bar". This makes this command
consistent with 'vc-responsible-backend'.
+---
+*** Log Edit now font locks long Git commit summary lines.
+Writing shorter summary lines avoids truncation in contexts in which
+Git commands display summary lines. See the two new user options
+'vc-git-log-edit-summary-target-len' and 'vc-git-log-edit-summary-max-len'.
+
+---
+*** New 'log-edit-headers-separator' face.
+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
---
@@ -1726,6 +2058,18 @@ 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 filtering of messages by the 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-apply-filters-consecutively' controls
+whether the stacking of the filters is in effect.
+
** EIEIO
+++
@@ -1832,11 +2176,16 @@ as opposed to via the command-line.
*** New command 'image-transform-fit-to-window'.
This command fits the image to the current window by scaling down or
up as necessary. Unlike 'image-transform-fit-both', this does not
-only scale the image down, but up as well. It is bound to "s w" in
+only scale the image down, but up as well. It is bound to 's w' in
Image Mode by default.
+---
+*** New command 'image-mode-wallpaper-set'.
+This command sets the desktop background to the current image. It is
+bound to 'W' by default.
+
+++
-*** 'image-transform-fit-to-(height|width)' are now obsolete.
+*** 'image-transform-fit-to-{height,width}' are now obsolete.
Use the new command 'image-transform-fit-to-window' instead.
The keybinding for 'image-transform-fit-to-width' is now 's i'.
@@ -1857,12 +2206,21 @@ this message for SVG and XPM.
+++
*** New commands: 'image-flip-horizontally' and 'image-flip-vertically'.
-These commands horizontally and vertically flip the image under point.
+These commands horizontally and vertically flip the image under point,
+and are bound to 'i h' and 'i v', respectively.
+++
*** New command 'image-transform-set-percent'.
It allows setting the image size to a percentage of its original size,
-and is bound to "s p" in Image mode.
+and is bound to 's p' in Image mode.
+
++++
+*** 'image-transform-original' renamed to 'image-transform-reset-to-original'.
+The old name was confusing, and is now an obsolete function alias.
+
++++
+*** 'image-transform-reset' renamed to 'image-transform-reset-to-initial'.
+The old name was confusing, and is now an obsolete function alias.
** Images
@@ -1873,53 +2231,54 @@ This is done via 'image-converter-add-handler'.
** Image-Dired
+++
-*** 'image-dired-display-image-mode' is now based on 'image-mode'.
+*** 'image-dired-image-mode' is now based on 'image-mode'.
This avoids converting images in the background, and makes Image-Dired
noticeably faster. New keybindings from 'image-mode' are now
available in the "*image-dired-display-image*" buffer; press '?' or
-'h' in that buffer to see the full list. Finally, some commands and
-user options that are no longer needed are now obsolete:
-'image-dired-cmd-create-temp-image-options',
-'image-dired-cmd-create-temp-image-program',
-'image-dired-display-current-image-full',
-'image-dired-display-current-image-sized',
-'image-dired-display-window-height-correction',
-'image-dired-display-window-width-correction',
-'image-dired-temp-image-file'.
+'h' in that buffer to see the full list.
---
*** Navigation and marking commands now work in image display buffer.
The following new bindings have been added:
+- 'n', 'SPC' => 'image-dired-display-next'
+- 'p', 'DEL' => 'image-dired-display-previous'
+- 'm' => 'image-dired-mark-thumb-original-file'
+- 'd' => 'image-dired-flag-thumb-original-file'
+- 'u' => 'image-dired-unmark-thumb-original-file'
- n or SPC image-dired-display-next-thumbnail-original
- p or DEL image-dired-display-previous-thumbnail-original
- m image-dired-mark-thumb-original-file
- d image-dired-flag-thumb-original-file
- u image-dired-unmark-thumb-original-file
+---
+*** New command 'image-dired-unmark-all-marks'.
+It removes all marks from all files in the thumbnail and the
+associated Dired buffer, and is bound to 'U' in the thumbnail and
+display buffer.
---
-*** Reduce dependency on external "exiftool" command.
-The 'image-dired-copy-with-exif-file-name' no longer requires an
-external "exiftool" command to be available. The user options
-'image-dired-cmd-read-exif-data-program' and
-'image-dired-cmd-read-exif-data-options' are now obsolete.
+*** New command 'image-dired-do-flagged-delete'.
+It deletes all flagged files, and is bound to 'x' in the thumbnail
+buffer. It replaces the command 'image-dired-delete-marked', which is
+now an obsolete alias.
---
-*** New command for the thumbnail buffer.
-The new command 'image-dired-unmark-all-marks' has been added. It is
-bound to 'U' in the thumbnail and display buffer.
+*** New command 'image-dired-copy-filename-as-kill'.
+It copies the name of the marked or current image to the kill ring,
+and is bound to 'w' in the thumbnail buffer.
---
-*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020).
-This standard allows sharing generated thumbnails across different
-programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and
-1024x1024 pixels. See the user option 'image-dired-thumbnail-storage'
-to use it; it is not enabled by default.
+*** New command 'image-dired-wallpaper-set'.
+This command sets the desktop background to the image at point in the
+thumbnail buffer. It is bound to 'W' by default.
---
-*** Support GraphicsMagick command line tools.
-Support for the GraphicsMagick command line tool ("gm") has been
-added, and is used instead of ImageMagick when it is available.
+*** 'image-dired-slideshow-start' is now bound to 'S'.
+It is bound in both the thumbnail and display buffer, and no longer
+prompts for a timeout; use a numerical prefix (e.g. 'C-u 8 S') to set
+the timeout.
+
+---
+*** New user option 'image-dired-marking-shows-next'.
+If this option is non-nil (the default), marking, unmarking or
+flagging an image in either the thumbnail or display buffer shows the
+next image.
---
*** New face 'image-dired-thumb-flagged'.
@@ -1928,8 +2287,59 @@ used for images that are flagged for deletion in the
Dired buffer
associated with Image-Dired.
---
-*** 'image-dired-slideshow-start' is now bound to 'S'.
-It is bound in both the thumbnail and display buffer.
+*** Image information is now shown in the header line of the thumbnail buffer.
+This replaces the message that most navigation commands in the
+thumbnail buffer used to show at the bottom of the screen.
+
+---
+*** New specifiers for 'image-dired-display-properties-format'.
+This is used to format the new header line. The new specifiers are:
+"%d" for the name of the directory that the file is in, "%n" for
+file's number in the thumbnail buffer, and "%s" for the file size.
+
+The default format has been updated to use this. If you prefer the
+old format, add this to your Init file:
+
+ (setopt image-dired-display-properties-format "%b: %f (%t): %c")
+
+---
+*** New faces for the header line of the thumbnail buffer.
+These faces correspond to different parts of the header line, as
+specified in 'image-dired-display-properties-format':
+- 'image-dired-thumb-header-directory-name'
+- 'image-dired-thumb-header-file-name'
+- 'image-dired-thumb-header-file-size'
+- 'image-dired-thumb-header-image-count'
+
+---
+*** PDF support.
+Image-Dired now displays thumbnails for PDF files. Type 'RET' on a
+PDF file in the thumbnail buffer to visit the corresponding PDF.
+
+---
+*** Support GraphicsMagick command line tools.
+Support for the GraphicsMagick command line tool ("gm") has been
+added, and is used instead of ImageMagick when it is available.
+
+---
+*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020).
+This standard allows sharing generated thumbnails across different
+programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and
+1024x1024 pixels. See the user option 'image-dired-thumbnail-storage'
+to use it; it is not enabled by default.
+
+---
+*** Reduce dependency on external "exiftool" command.
+The 'image-dired-copy-with-exif-file-name' no longer requires an
+external "exiftool" command to be available. The user options
+'image-dired-cmd-read-exif-data-program' and
+'image-dired-cmd-read-exif-data-options' are now obsolete.
+
+---
+*** Support for bookmark.el.
+The command 'bookmark-set' (bound to 'C-x r m') is now supported in
+the thumbnail view, and will create a bookmark that opens the current
+directory in Image-Dired.
---
*** The 'image-dired-slideshow-start' command no longer prompts.
@@ -1939,38 +2349,64 @@ You can set the delay with a prefix argument, or a
negative prefix
argument to prompt for a delay. Customize the user option
'image-dired-slideshow-delay' to change the default from 5 seconds.
----
-*** Support for bookmark.el.
-The command 'bookmark-set' (bound to 'C-x r m') is now supported in
-the thumbnail view, and will create a bookmark that opens the current
-directory in Image-Dired.
++++
+*** 'image-dired-show-all-from-dir-max-files' increased to 1000.
+This user option controls asking for confirmation when starting
+Image-Dired in a directory with many files. Since Image-Dired creates
+thumbnails in the background in recent versions, this is not as
+important as it used to be. You can now also customize this option to
+nil to disable this confirmation completely.
---
-*** New user option 'image-dired-marking-shows-next'.
-If this option is non-nil (the default), marking, unmarking or
-flagging an image in either the thumbnail or display buffer shows the
-next image.
+*** 'image-dired-thumb-size' increased to 128.
+
++++
+*** 'image-dired-db-file' renamed to 'image-dired-tags-db-file'.
---
-*** Image information is now shown in the header line.
-This replaces the message most navigation commands in the thumbnail
-buffer used to show at the bottom of the screen.
+*** 'image-dired-display-image-mode' renamed to 'image-dired-image-mode'.
+The corresponding keymap is now named 'image-dired-image-mode-map'.
+++
-*** 'image-dired-show-all-from-dir-max-files' has been increased to 500.
-This option controls asking for confirmation when starting Image-Dired
-in a directory with many files. However, Image-Dired creates
-thumbnails in the background these days, so this is not as important
-as it used to be, back when entering a large directory could lock up
-Emacs for tens of seconds. In addition, you can now customize this
-option to nil to disable this confirmation completely.
+*** Some commands have been renamed to be shorter.
+- 'image-dired-display-thumbnail-original-image' has been renamed to
+ 'image-dired-display-this'.
+- 'image-dired-display-next-thumbnail-original' has been renamed to
+ 'image-dired-display-next'.
+- 'image-dired-display-previous-thumbnail-original' has been renamed
+ to 'image-dired-display-previous'.
+The old names are now obsolete aliases.
---
-*** 'image-dired-rotate-thumbnail-(left|right)' is now obsolete.
+*** 'image-dired-thumb-{height,width}' are now obsolete.
+Customize 'image-dired-thumb-size' instead, which will set both the
+height and width.
+
+---
+*** HTML image gallery generation is now obsolete.
+The 'image-dired-gallery-generate' command and these user options are
+now obsolete: 'image-dired-gallery-thumb-image-root-url',
+'image-dired-gallery-hidden-tags', 'image-dired-gallery-dir',
+'image-dired-gallery-image-root-url'.
+
+---
+*** 'image-dired-rotate-thumbnail-{left,right}' are now obsolete.
Instead, use commands 'image-dired-refresh-thumb' to generate a new
thumbnail, or 'image-rotate' to rotate the thumbnail without updating
the thumbnail file.
++++
+*** Some commands and user options are now obsolete.
+Since 'image-dired-display-image-mode' is now based on 'image-mode',
+some commands and user options are no longer needed and are now obsolete:
+'image-dired-cmd-create-temp-image-options',
+'image-dired-cmd-create-temp-image-program',
+'image-dired-display-current-image-full',
+'image-dired-display-current-image-sized',
+'image-dired-display-window-height-correction',
+'image-dired-display-window-width-correction',
+'image-dired-temp-image-file'.
+
** Dired
---
@@ -2002,7 +2438,10 @@ the buffer will take you to that directory.
*** Search and replace in Dired/Wdired supports more regexps.
For example, the regexp ".*" will match only characters that are part
of the file name. Also "^.*$" can be used to match at the beginning
-of the file name and at the end of the file name.
+of the file name and at the end of the file name. This is used only
+when searching on file names. In Wdired this can be used when the new
+user option 'wdired-search-replace-filenames' is non-nil (which is the
+default).
** Bookmarks
@@ -2021,9 +2460,9 @@ recently set.
It is bound to the new command 'bookmark-edit-annotation-cancel'.
---
-*** New option 'bookmark-fringe-mark'.
+*** New user option 'bookmark-fringe-mark'.
This option controls the bitmap used to indicate bookmarks in the
-fringe (or 'nil' to disable showing this marker).
+fringe (or nil to disable showing this marker).
** Exif
@@ -2073,6 +2512,11 @@ and friends.
** Tramp
++++
+*** New connection methods "docker", "podman" and "kubernetes".
+They allow accessing environments provided by Docker and similar
+programs.
+
---
*** Tramp supports abbreviating remote home directories now.
When calling 'abbreviate-file-name' on a Tramp file name, the result
@@ -2092,6 +2536,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
---
@@ -2115,6 +2565,18 @@ the Galeon web browser was released in September, 2008.
Note that this historical web browser is different from Mozilla
Firefox; it is its predecessor.
+** Python Mode
+
++++
+*** Project shells and a new user option 'python-shell-dedicated'.
+When called with a prefix argument, 'run-python' now offers the choice
+of creating a shell dedicated to the current project. This shell runs
+in the project root directory and is shared among all project buffers.
+
+Without a prefix argument, the kind of shell (buffer-dedicated,
+project-dedicated or global) is specified by the new
+'python-shell-dedicated' user option.
+
** Ruby Mode
---
@@ -2139,7 +2601,15 @@ automatically insert the Tramp prefix. The automatic
insertion
applies only when 'default-directory' is remote and the command is a
Lisp function. This frees you from having to keep track of whether
commands are Lisp function or external when supplying absolute file
-name arguments. See "Electric forward slash" in the Eshell manual.
+name arguments. See the "(eshell) Electric forward slash" node in the
+Eshell manual for details.
+
++++
+*** Improved support for redirection operators in Eshell.
+Eshell now supports a wider variety of redirection operators. For
+example, you can now redirect both stdout and stderr via '&>' or
+duplicate one output handle to another via 'NEW-FD>&OLD-FD'. For more
+information, see the "(eshell) Redirection" node in the Eshell manual.
+++
*** Double-quoting an Eshell expansion now treats the result as a single
string.
@@ -2151,7 +2621,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.
+++
@@ -2189,12 +2659,26 @@ behavior, customize the new
'eshell-lisp-form-nil-is-failure' option.
Enabling this will automatically kill a "*shell*" buffer as soon as
the shell session terminates.
+---
+*** New minor mode 'shell-highlight-undef-mode'.
+Customize 'shell-highlight-undef-enable' to t if you want to enable
+this minor mode in "*shell*" buffers. It will highlight undefined
+commands with a warning face as you type.
+
** Calc
+++
*** 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
---
@@ -2232,6 +2716,19 @@ Enabling this minor mode turns on hiding header
material, like
'elide-head' does; disabling it shows the header. The commands
'elide-head' and 'elide-head-show' are now obsolete.
+*** New package ansi-osc.el.
+Support for OSC ("Operating System Command") escape sequences has been
+extracted from comint.el in order to provide interpretation of OSC
+sequences in compilation buffers.
+
+Adding the new function 'ansi-osc-compilation-filter' to
+'compilation-filter-hook' enables interpretation of OSC escape
+sequences in compilation buffers. By default, all sequences are
+filtered out.
+
+The list of handlers (already covering OSC 7 and 8) has been extended
+with a handler for OSC 2, the command to set a window title.
+
+++
*** New user option 'project-vc-include-untracked'.
If non-nil, files untracked by a VCS are considered to be part of
@@ -2258,7 +2755,7 @@ instead of also trying to ping it. Customize the user
option
*** The 'run-dig' command is now obsolete; use 'dig' instead.
---
-*** Some `bib-mode' commands and variables have been renamed.
+*** Some 'bib-mode' commands and variables have been renamed.
To respect Emacs naming conventions, the variable 'unread-bib-file'
has been renamed to 'bib-unread-file'. The following commands have
also been renamed:
@@ -2279,9 +2776,43 @@ 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.
+---
+*** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'.
+It copies the current line into the kill ring.
+
+---
+*** 'edit-abbrevs' now uses font-locking.
+The new face 'abbrev-table-name' is used to display the abbrev table
+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
+point. The commands are bound to keys 'i c' and 'i x' (respectively)
+in the local keymap over images. They rely on external programs, by
+default "convert" from ImageMagick, to do the actual cropping/eliding
+of the image file.
+
+---
+** New package 'wallpaper'.
+This package provides the command 'wallpaper-set', which sets the
+desktop background image. Depending on the system and the desktop,
+this may require an external program (such as "swaybg", "gm",
+"display" or "xloadimage"). If so, a suitable command should be
+detected automatically in most cases. It can also be customized
+manually if needed, using the new user options 'wallpaper-command' and
+'wallpaper-command-args'.
+
+++
** New package 'oclosure'.
Allows the creation of "functions with slots" or "function objects"
@@ -2311,6 +2842,11 @@ when visiting JSON files.
* Incompatible Lisp Changes in Emacs 29.1
++++
+** 'format-prompt' now uses 'substitute-command-keys'.
+This means that both the prompt and 'minibuffer-default-prompt-format'
+will have key definitions and single quotes handled specially.
+
---
** 'find-image' now uses 'create-image'.
This means that images found through 'find-image' also have
@@ -2333,18 +2869,23 @@ in-memory format is now by using ':data-width' and
':data-height'.
** "loaddefs.el" generation has been reimplemented.
The various "loaddefs.el" files in the Emacs tree (which contain
information about autoloads, built-in packages and package prefixes)
-used to be generated by functions in "autoloads.el". These are now
-generated by "loaddefs-gen.el" instead. This leads to functionally
-equivalent loaddef files, but they do not use exactly the same syntax,
-so using 'M-x update-file-autoloads' no longer works. (This didn't
-work well in most files in the past, either, but it will now signal an
-error in any file.)
+used to be generated by functions in autoloads.el. These are now
+generated by loaddefs-gen.el instead. This leads to functionally
+equivalent "loaddef.el" files, but they do not use exactly the same
+syntax, so using 'M-x update-file-autoloads' no longer works. (This
+didn't work well in most files in the past, either, but it will now
+signal an error in any file.)
In addition, files are scanned in a slightly different way.
-Previously ';;;###' specs inside a top-level form (i.e., something
+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 build-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
@@ -2483,59 +3024,106 @@ It's been obsolete since Emacs-22.1, actually.
negative arguments, and is generally slower than 'ash', which should be
used instead. This warning can be suppressed by surrounding calls to
'lsh' with the construct '(with-suppressed-warnings ((suspicious lsh)) ...)',
-but switching to `ash` is generally much preferable.
+but switching to 'ash' is generally much preferable.
---
** Some functions and variables obsolete since Emacs 24 have been removed:
+'Buffer-menu-buffer+size-width', 'Electric-buffer-menu-mode',
'Info-edit-map', 'allout-abbreviate-flattened-numbering',
-'allout-mode-deactivate-hook', 'ansi-color-unfontify-region',
-'auth-source-forget-user-or-password', 'auth-source-hide-passwords',
-'auth-source-user-or-password', 'bibtex-complete',
-'bibtex-entry-field-alist', 'buffer-substring-filters',
-'byte-compile-disable-print-circle', 'cfengine-mode-abbrevs',
-'chart-map', 'comint-dynamic-complete',
-'comint-dynamic-complete-as-filename',
-'comint-dynamic-simple-complete', 'command-history-map',
-'compilation-parse-errors-function', 'completion-annotate-function',
-'condition-case-no-debug', 'count-lines-region', 'data-debug-map',
-'deferred-action-list', 'deferred-action-function',
-'dired-x-submit-report', 'eieio-defgeneric', 'eieio-defmethod',
-'emacs-lock-from-exiting', 'erc-complete-word',
-'eshell-cmpl-suffix-list', 'eshell-for', 'font-lock-maximum-size',
+'allout-exposure-change-hook', 'allout-mode-deactivate-hook',
+'allout-structure-added-hook', 'allout-structure-deleted-hook',
+'allout-structure-shifted-hook', 'ansi-color-unfontify-region',
+'archive-extract-hooks', 'auth-source-forget-user-or-password',
+'auth-source-hide-passwords', 'auth-source-user-or-password',
+'automatic-hscrolling', 'automount-dir-prefix', 'bibtex-complete',
+'bibtex-entry-field-alist', 'buffer-has-markers-at',
+'buffer-substring-filters', 'byte-compile-disable-print-circle',
+'c-prepare-bug-report-hooks', 'cfengine-mode-abbrevs',
+'change-log-acknowledgement', 'chart-map',
+'checkdoc-comment-style-hooks', 'comint--unquote&expand-filename',
+'comint-dynamic-complete', 'comint-dynamic-complete-as-filename',
+'comint-dynamic-simple-complete', 'comint-unquote-filename',
+'command-history-map', 'compilation-parse-errors-function',
+'completion-annotate-function', 'condition-case-no-debug',
+'count-lines-region', 'crisp-mode-modeline-string',
+'custom-print-functions', 'custom-print-functions',
+'cvs-string-prefix-p', 'data-debug-map', 'deferred-action-function',
+'deferred-action-list', 'dired-pop-to-buffer', 'dired-shrink-to-fit',
+'dired-sort-set-modeline', 'dired-x-submit-report',
+'display-buffer-function',
+'ediff-choose-window-setup-function-automatically',
+'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting',
+'erc-complete-word', 'erc-dcc-chat-filter-hook',
+'eshell-add-to-window-buffer-names', 'eshell-cmpl-suffix-list',
+'eshell-for', 'eshell-remove-from-window-buffer-names',
+'eshell-status-in-modeline', 'filesets-cache-fill-content-hooks',
+'font-list-limit', 'font-lock-maximum-size',
'font-lock-reference-face', 'gnus-carpal',
'gnus-debug-exclude-variables', 'gnus-debug-files',
'gnus-local-domain', 'gnus-outgoing-message-group',
-'gnus-secondary-servers', 'gnus-registry-user-format-function-M',
+'gnus-registry-user-format-function-M', 'gnus-secondary-servers',
+'gnus-subscribe-newsgroup-hooks', 'gud-inhibit-global-bindings',
+'hangul-input-method-inactivate', 'hfy-post-html-hooks',
'image-extension-data', 'image-library-alist',
+'inactivate-current-input-method-function', 'inactivate-input-method',
'inhibit-first-line-modes-regexps',
-'inhibit-first-line-modes-suffixes', 'intdos',
-'mail-complete-function', 'mail-completion-at-point-function',
+'inhibit-first-line-modes-suffixes', 'input-method-inactivate-hook',
+'intdos', 'javascript-generic-mode', 'javascript-generic-mode-hook',
+'latex-string-prefix-p', 'macro-declaration-function' (function),
+'macro-declaration-function' (variable), 'mail-complete-function',
+'mail-completion-at-point-function',
'mail-mailer-swallows-blank-line', 'mail-sent-via', 'make-register',
'makefile-complete', 'menu-bar-kill-ring-save',
'meta-complete-symbol', 'meta-mode-map',
+'mh-kill-folder-suppress-prompt-hooks',
'minibuffer-completing-symbol',
'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350',
-'msb-after-load-hooks', 'nnimap-split-rule', 'nntp-authinfo-file',
-'ns-alternatives-map', 'ns-store-cut-buffer-internal',
-'package-menu-view-commentary', 'pascal-last-completions',
-'pascal-show-completions', 'pascal-toggle-completions',
-'prolog-char-quote-workaround', 'read-filename-at-point',
+'mpc-string-prefix-p', 'msb-after-load-hooks',
+'nndiary-request-accept-article-hooks',
+'nndiary-request-create-group-hooks',
+'nndiary-request-update-info-hooks', 'nnimap-split-rule',
+'nntp-authinfo-file', 'ns-alternatives-map',
+'ns-store-cut-buffer-internal', 'package-menu-view-commentary',
+'pascal-last-completions', 'pascal-show-completions',
+'pascal-toggle-completions', 'pcomplete-arg-quote-list',
+'pcomplete-quote-argument', 'prolog-char-quote-workaround',
+'python-buffer', 'python-guess-indent', 'python-indent',
+'python-info-ppss-comment-or-string-p', 'python-info-ppss-context',
+'python-info-ppss-context-type', 'python-preoutput-result',
+'python-proc', 'python-send-receive', 'python-send-string',
+'python-use-skeletons', 'quail-inactivate', 'quail-inactivate-hook',
+'query-replace-interactive', 'rcirc-activity-hooks',
+'rcirc-print-hooks', 'rcirc-receive-message-hooks',
+'rcirc-sentinel-hooks', 'read-filename-at-point', 'redraw-modeline',
'reftex-index-map', 'reftex-index-phrases-map',
'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map',
-'register-name-alist', 'register-value',
+'register-name-alist', 'register-value', 'report-emacs-bug-info',
'report-emacs-bug-pretest-address',
'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to',
-'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face',
+'rmail-dont-reply-to-names', 'robin-inactivate',
+'robin-inactivate-hook', 'rst-block-face', 'rst-comment-face',
'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face',
'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face',
-'rst-reference-face', 'semantic-grammar-map',
-'semantic-grammar-syntax-table', 'set-register-value',
-'speedbar-key-map', 'speedbar-syntax-table',
-'starttls-any-program-available', 'strokes-report-bug',
+'rst-reference-face', 'semantic-change-hooks',
+'semantic-edits-delete-change-hooks',
+'semantic-edits-new-change-hooks',
+'semantic-edits-reparse-change-hooks', 'semantic-grammar-map',
+'semantic-grammar-syntax-table', 'semantic-lex-reset-hooks',
+'semanticdb-elisp-sym-function-arglist',
+'semanticdb-save-database-hooks', 'set-face-underline-p',
+'set-register-value', 'sh-maybe-here-document', 'speedbar-key-map',
+'speedbar-syntax-table', 'starttls-any-program-available',
+'strokes-modeline-string', 'strokes-report-bug',
+'term-default-bg-color', 'term-default-fg-color',
+'tex-string-prefix-p', 'timeclock-modeline-display',
+'timeclock-modeline-display', 'timeclock-update-modeline',
'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode',
-'turn-on-iimage-mode', 'vc-toggle-read-only', 'view-return-to-alist',
+'turn-on-iimage-mode', 'ucs-input-inactivate', 'ucs-insert',
+'url-recreate-url-attributes', 'user-variable-p',
+'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist',
'view-return-to-alist-update', 'w32-default-color-map' (function),
-'which-func-mode' (function), 'x-cut-buffer-or-selection-value'.
+'which-func-mode' (function), 'window-system-version',
+'winner-mode-leave-hook', 'x-cut-buffer-or-selection-value'.
---
** Some functions and variables obsolete since Emacs 23 have been removed:
@@ -2573,7 +3161,7 @@ functions.
---
** '?\' at the end of a line now signals an error.
-Previously it produced a nonsense value, -1, that was never intended.
+Previously, it produced a nonsense value, -1, that was never intended.
---
** Some libraries obsolete since Emacs 24.1 and 24.3 have been removed:
@@ -2581,35 +3169,55 @@ abbrevlist.el, assoc.el, complete.el, cust-print.el,
erc-hecomplete.el, mailpost.el, mouse-sel.el, old-emacs-lock.el,
patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el.
----
++++
** Many seldom-used generalized variables have been made obsolete.
Emacs has a number of rather obscure generalized variables defined,
that, for instance, allowed you to say things like:
- (setf (point-min) 4)
+ (setf (point-min) 4)
These never caught on and have been made obsolete. The form above,
for instance, is the same as saying
- (narrow-to-region 4 (point-max))
+ (narrow-to-region 4 (point-max))
The following generalized variables have been made obsolete:
-'buffer-local-value', 'visited-file-name', 'buffer-modified-p',
+'buffer-file-name', 'buffer-local-value', 'buffer-modified-p',
'buffer-name', 'buffer-string', 'buffer-substring', 'current-buffer',
'current-column', 'current-global-map', 'current-input-mode',
'current-local-map', 'current-window-configuration',
-'default-file-modes', 'documentation-property', 'frame-height',
-'frame-visible-p', 'global-key-binding', 'local-key-binding', 'mark',
-'mark-marker', 'marker-position', 'mouse-position', 'point',
-'point-marker', 'point-max', 'point-min', 'read-mouse-position',
-'screen-height', 'screen-width', 'selected-window', 'selected-screen',
-'selected-frame', 'standard-case-table', 'syntax-table',
-'visited-file-modtime', 'window-height', 'window-width' and
-'x-get-secondary-selection'.
+'default-file-modes', 'documentation-property', 'eq', 'frame-height',
+'frame-width', 'frame-visible-p', 'global-key-binding',
+'local-key-binding', 'mark', 'mark-marker', 'marker-position',
+'mouse-position', 'point', 'point-marker', 'point-max', 'point-min',
+'read-mouse-position', 'screen-height', 'screen-width',
+'selected-frame', 'selected-screen', 'selected-window',
+'standard-case-table', 'syntax-table', 'visited-file-modtime',
+'window-height', 'window-width', and 'x-get-secondary-selection'.
* 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.
+
+++
** New function 'make-obsolete-generalized-variable'.
This can be used to mark setters used by 'setf' as obsolete, and the
@@ -2655,9 +3263,32 @@ 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
+
+++
-** New function 'seq-split'.
-This returns a list of sub-sequences of the specified sequence.
+*** 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'.
@@ -2714,6 +3345,33 @@ request the name of the ".eln" file which defined a
given symbol.
+++
** New macro 'with-memoization' provides a very primitive form of memoization.
++++
+** 'max-char' can now report the maximum codepoint according to Unicode.
+When called with a new optional argument UNICODE non-nil, 'max-char'
+will now report the maximum valid codepoint defined by the Unicode
+Standard.
+
+** seq
+
++++
+** New function 'seq-split'.
+This returns a list of sub-sequences of the specified sequence.
+
++++
+** New function 'seq-remove-at-position'.
+This function returns a copy of the specified sequence where the
+element at a given (zero-based) index got removed.
+
++++
+** New function 'seq-positions'.
+This returns a list of the (zero-based) indices of elements matching a
+given predicate in the specified sequence.
+
++++
+** New function 'seq-keep'.
+This is like 'seq-map', but removes all nil results from the returned
+list.
+
** Themes
---
@@ -3108,6 +3766,10 @@ a valid key sequence according to 'key-valid-p'.
** New function 'file-name-split'.
This returns a list of all the components of a file name.
++++
+** New function 'file-name-parent-directory'.
+This returns the parent directory of a file name.
+
+++
** New macro 'with-undo-amalgamate'.
It records a particular sequence of operations as a single undo step.
@@ -3217,11 +3879,27 @@ This means the vscroll will not be reset when set on a
window that is
** XDG support
---
-*** New function 'xdg-state-home' returns 'XDG_STATE_HOME' environment
variable.
-This new location, introduced in the XDG Base Directory Specification
-version 0.8 (8th May 2021), "contains state data that should persist
+*** New function 'xdg-state-home'.
+It returns the new 'XDG_STATE_HOME' environment variable. It should
+point to a file name that "contains state data that should persist
between (application) restarts, but that is not important or portable
enough to the user that it should be stored in $XDG_DATA_HOME".
+(This variable was introduced in the XDG Base Directory Specification
+version 0.8 released on May 8, 2021.)
+
+---
+*** New function 'xdg-current-desktop'.
+It returns a list of strings, corresponding to the colon-separated
+list of names in the 'XDG_CURRENT_DESKTOP' environment variable, which
+identify the current desktop environment.
+(This variable was introduced in XDG Desktop Entry Specification
+version 1.2.)
+
+---
+*** New function 'xdg-session-type'.
+It returns the 'XDG_SESSION_TYPE' environment variable. (This is not
+part of any official standard; see the man page pam_systemd(8) for
+more information.)
+++
** New macro 'with-delayed-message'.
@@ -3294,6 +3972,11 @@ It no longer depends on edmacro.el and cl-lib.el.
This function returns t if point is on a valid image, and nil
otherwise.
++++
+** New function 'buffer-text-pixel-size'.
+This is similar to 'window-text-pixel-size', but can be used when the
+buffer isn't displayed.
+
+++
** New function 'string-pixel-width'.
This returns the width of a string in pixels. This can be useful when
@@ -3482,6 +4165,20 @@ to preserve the old behavior, apply
'(take N LIST)' returns the first N elements of LIST; 'ntake' does
the same but works by modifying LIST destructively.
+---
+** 'string-split' is now an alias for 'split-string'.
+
++++
+** 'format-spec' now accepts functions in the replacement.
+The function is called only when used in the format string. This is
+useful to avoid side-effects such as prompting, when the value is not
+actually being used for anything.
+
++++
+** The variable 'max-specpdl-size' has been made obsolete.
+Now 'max-lisp-eval-depth' alone is used for limiting Lisp recursion
+and stack usage. 'max-specpdl-size' is still present as a plain
+variable for compatibility but its limiting powers have been taken away.
* Changes in Emacs 29.1 on Non-Free Operating Systems
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 926b9f489e..b4ecbe7039 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -1413,7 +1413,8 @@ with different file attributes in two dired buffers.
*** New Dired command 'dired-do-touch' (bound to T) changes timestamps
of marked files with the value entered in the minibuffer.
-*** In Dired, the w command now stores the current line's file name
+*** New Dired command 'dired-copy-filename-as-kill' copies file name.
+In Dired, the w command now stores the current line's file name
into the kill ring. With a zero prefix arg, it stores the absolute file name.
*** In Dired-x, Omitting files is now a minor mode, dired-omit-mode.
@@ -3539,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.23 b/etc/NEWS.23
index ef87db79d9..5f13845dcb 100644
--- a/etc/NEWS.23
+++ b/etc/NEWS.23
@@ -2543,6 +2543,8 @@ a list of buffers/files to search for a string/regexp.
** The new major mode 'special-mode' is intended as a parent for
major modes such as those that set the "'mode-class 'special" property.
+** New package format-spec.el provides 'format-spec'.
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
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.28 b/etc/NEWS.28
index 01e8ac112f..1edf4e85b0 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -16,6 +16,41 @@ You can narrow news to a specific version by calling
'view-emacs-news'
with a prefix argument or by typing 'C-u C-h C-n'.
+* Installation Changes in Emacs 28.3
+
+
+* Startup Changes in Emacs 28.3
+
+
+* Changes in Emacs 28.3
+
+
+* Editing Changes in Emacs 28.3
+
+
+* Changes in Specialized Modes and Packages in Emacs 28.3
+
+** 'native-comp-driver-options' on macOS.
+The value of 'native-comp-driver-options' has been changed to contain
+"-Wl,-w" to suppress warnings of the form
+
+ ld: warning: -undefined dynamic_lookup may not work with chained fixups
+
+emitted during native compilation on macOS 12.6 with Xcode 14.
+
+
+* New Modes and Packages in Emacs 28.3
+
+
+* Incompatible Lisp Changes in Emacs 28.3
+
+
+* Lisp Changes in Emacs 28.3
+
+
+* Changes in Emacs 28.3 on Non-Free Operating Systems
+
+
* Installation Changes in Emacs 28.2
** To install the Emacs binary in a non-standard directory, use '--bindir='.
@@ -37,17 +72,11 @@ preloaded Lisp packages, and the relative name of that
directory needs
therefore to be recorded in the executable as part of the build.
-* Startup Changes in Emacs 28.2
-
-
* Changes in Emacs 28.2
This is a bug-fix release with no new features.
-* Editing Changes in Emacs 28.2
-
-
* Changes in Specialized Modes and Packages in Emacs 28.2
** The command 'kdb-macro-redisplay' was renamed to 'kmacro-redisplay'.
@@ -66,18 +95,6 @@ terminate Emacs with 'save-buffers-kill-emacs', not with
'kill-emacs'.
back then.)
-* New Modes and Packages in Emacs 28.2
-
-
-* Incompatible Lisp Changes in Emacs 28.2
-
-
-* Lisp Changes in Emacs 28.2
-
-
-* Changes in Emacs 28.2 on Non-Free Operating Systems
-
-
* Installation Changes in Emacs 28.1
** Emacs now optionally supports native compilation of Lisp files.
@@ -377,7 +394,7 @@ the current buffer and the text "GNU Emacs" instead of the
value of
your init file:
(setq frame-title-format '(multiple-frames "%b"
- ("" invocation-name "@" system-name)))
+ ("" invocation-name "@" system-name)))
*** New frame parameter 'drag-with-tab-line'.
This parameter, similar to 'drag-with-header-line', allows moving frames
@@ -1310,18 +1327,18 @@ comma-separated list.
*** New commands to filter the package list.
The filter commands are bound to the following keys:
-key binding
---- -------
-/ a package-menu-filter-by-archive
-/ d package-menu-filter-by-description
-/ k package-menu-filter-by-keyword
-/ N package-menu-filter-by-name-or-description
-/ n package-menu-filter-by-name
-/ s package-menu-filter-by-status
-/ v package-menu-filter-by-version
-/ m package-menu-filter-marked
-/ u package-menu-filter-upgradable
-/ / package-menu-clear-filter
+ key binding
+ --- -------
+ / a package-menu-filter-by-archive
+ / d package-menu-filter-by-description
+ / k package-menu-filter-by-keyword
+ / N package-menu-filter-by-name-or-description
+ / n package-menu-filter-by-name
+ / s package-menu-filter-by-status
+ / v package-menu-filter-by-version
+ / m package-menu-filter-marked
+ / u package-menu-filter-upgradable
+ / / package-menu-clear-filter
*** Option to automatically native-compile packages upon installation.
Customize the user option 'package-native-compile' to enable automatic
@@ -2614,7 +2631,7 @@ non-nil.
** ERC
-*** Starting with Emacs 28.1 and ERC 5.4, see the ERC-NEWS file for
+Starting with Emacs 28.1 and ERC 5.4, see the ERC-NEWS file for
user-visible changes in ERC.
** Xwidget Webkit mode
@@ -3275,12 +3292,13 @@ completing on commands from buffers in major modes
derived from
MODE..., or, if it's a minor mode, when that minor mode is enabled in
the current buffer.
-Note that these forms will only have their effect if the
+Note that these forms will only have their effect for 'M-x' if the
'read-extended-command-predicate' user option is customized to call
'command-completion-default-include-p' or a similar function. The
default value of 'read-extended-command-predicate' is nil, which means
no commands that match what you have typed are excluded from being
-completion candidates.
+completion candidates. The forms will, however, be used by 'M-S-x' by
+default.
** 'define-minor-mode' now takes an ':interactive' argument.
This can be used for specifying which modes this minor mode is meant
@@ -3605,6 +3623,13 @@ pairs.
** New function 'mail-header-parse-address-lax'.
Parse a string as a mail address-like string.
+** New function 'make-closure'.
+This function is used internally by the byte-compiler: calls to it are
+inserted into the generated bytecode to handle closures more
+efficiently than the old code which relied on
+'make-byte-code' instead.
+It also makes the disassembly more readable.
+
** New function 'make-separator-line'.
Make a string appropriate for usage as a visual separator line.
@@ -3941,7 +3966,6 @@ and enable the MS-Windows native Input Method Editor
(IME) at run
time. A companion function 'w32-get-ime-open-status' returns the
current IME activation status.
---
** On macOS, 's-<left>' and 's-<right>' are now bound to
'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
to select previous/next frame are still bound to 's-~' and 's-`'.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 6624f747c8..aaecc41f6e 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
@@ -2267,6 +2278,13 @@ term/xterm.el) for more details.
*** Linux console problems with double-width characters
+If possible, we recommend running Emacs inside fbterm, when in a Linux
+console (see the node "Emacs in a Linux console" in the Emacs FAQ).
+Most Unicode characters should then be displayed correctly.
+
+If that is not possible, the following may be useful to alleviate the
+problem of displaying Unicode characters in a raw console.
+
The Linux console declares UTF-8 encoding, but supports only a limited
number of Unicode characters, and can cause Emacs produce corrupted or
garbled display with some unusual characters and sequences. Emacs 28
diff --git a/etc/TODO b/etc/TODO
index 772fbf7191..cd02cf7023 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -359,6 +359,17 @@ should invoke the 'shape' method. 'hbfont_shape' should
be extended
to pass to 'hb_shape_full' the required array of features, as
mentioned in the above HarfBuzz discussion.
+Alternatively, stylistic sets could be a font property, or a face
+property. See this discussion:
+
+ https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01597.html
+
+For some relevant use cases, see
+
+ https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01652.html
+ https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01701.html
+ https://lists.gnu.org/archive/html/emacs-devel/2022-09/msg01772.html
+
** Concurrency
Stefan Monnier writes: "Including it as an 'experimental' compile-time
option sounds good. Of course there might still be big questions
@@ -498,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
@@ -875,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."
@@ -1481,8 +1491,8 @@ Markers are implemented as a non-sorted singly linked
list of markers.
This makes them scale badly when thousands of markers are created in a
buffer for some purpose, because some low-level primitives in Emacs
traverse the markers' list (e.g., when converting between character
-and byte positions), and also because searching for a marker (e.g.,
-with 'buffer-has-markers-at') becomes very slow.
+and byte positions), and also because searching for a marker becomes
+very slow.
**** Explore whether overlay-recenter can cure overlays performance problems
@@ -1686,12 +1696,6 @@ and the one to use when terminating the selection.
More specifically do what's needed to make ibuffer.el the default, or
just an extension of buff-menu.el.
-** Replace linum.el with nlinum.el
-https://lists.gnu.org/r/emacs-devel/2013-08/msg00379.html
-
-(Since Emacs 26 introduced native line numbers, this item is
-probably obsolete.)
-
** Merge sendmail.el and messages.el
Probably not a complete merge, but at least arrange for messages.el to
be a derived mode of sendmail.el. Or arrange for messages.el to be
@@ -1733,6 +1737,17 @@ https://lists.gnu.org/r/emacs-devel/2012-06/msg00354.html
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
@@ -1754,6 +1769,26 @@ enough environment under which the fix can be tested.
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.
+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
+by causing redisplay to delay until the next time the monitor can
+refresh; this works, but can cause substandard frame rate when
+redisplay happens less often than the monitor refreshing, as redisplay
+will have to continually wait for missed monitor refresh.
+
+The right remedy for this problem is to define a function that returns
+the amount of time remaining before the next vertical blanking period,
+and to schedule animation redisplay within that period, using the
+information provided by the _NET_WM_FRAME_DRAWN and
+_NET_WM_FRAME_TIMINGS compositor messages on X and the
+BScreen::GetMonitorInfo function on Haiku. Ideally, all features
+performing animations should be modified to use that method of
+scheduling redisplay. Examples include xref-pulse-momentarily and
+pixel-scroll-precision-start-momentum.
+
This file is part of GNU Emacs.
diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm
index aefa9dd5da..4dbcb9e6fd 100644
--- a/etc/images/checked.xpm
+++ b/etc/images/checked.xpm
@@ -1,23 +1,4 @@
/* XPM */
-/* Copyright (C) 2010-2022 Free Software Foundation, Inc.
- *
- * Author: Chong Yidong <cyd@stupidchicken.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/>.
- */
static char * checked_xpm[] = {
"12 12 5 1",
" c None",
diff --git a/etc/images/gnus/gnus-pointer.xpm b/etc/images/gnus/gnus-pointer.xpm
index c47443dbb7..5328b15bed 100644
--- a/etc/images/gnus/gnus-pointer.xpm
+++ b/etc/images/gnus/gnus-pointer.xpm
@@ -1,7 +1,7 @@
/* XPM */
-static char *gnus-pointer[] = {
+static char *gnus_pointer_xpm[] = {
/* width height num_colors chars_per_pixel */
-" 18 13 2 1",
+"18 13 2 1",
/* colors */
". c #0000ff",
"# c None s None",
@@ -19,4 +19,4 @@ static char *gnus-pointer[] = {
"###....####.######",
"###..######.######",
"###########.######"
-};
\ No newline at end of file
+};
diff --git a/etc/images/gnus/gnus.xpm b/etc/images/gnus/gnus.xpm
index b6ee4d0d73..4f46eca4fa 100644
--- a/etc/images/gnus/gnus.xpm
+++ b/etc/images/gnus/gnus.xpm
@@ -1,7 +1,7 @@
/* XPM */
-static char *gnus[] = {
+static char *gnus_xpm[] = {
/* width height num_colors chars_per_pixel */
-" 271 273 3 1",
+"271 273 3 1",
/* colors */
". s thing c #bf9900",
"# s shadow c #ffcc00",
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/images/mh-logo.xpm b/etc/images/mh-logo.xpm
index 846859e058..637c456964 100644
--- a/etc/images/mh-logo.xpm
+++ b/etc/images/mh-logo.xpm
@@ -1,32 +1,8 @@
/* XPM */
-/* MH-E Logo
- *
- * Copyright (C) 2003-2022 Free Software Foundation, Inc.
- *
- * Author: Satyaki Das
- *
- * 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/>.
- */
-static char *mh-e[] = {
-/* width height num_colors chars_per_pixel */
-" 18 13 2 1",
-/* colors */
+static char *mh_logo_xpm[] = {
+"18 13 2 1",
"# c #666699",
". c None s None",
-/* pixels */
"........##........",
".......####.......",
"......######......",
diff --git a/etc/images/outline-close.pbm b/etc/images/outline-close.pbm
new file mode 100644
index 0000000000..b37b640b55
Binary files /dev/null and b/etc/images/outline-close.pbm differ
diff --git a/etc/images/outline-close.svg b/etc/images/outline-close.svg
new file mode 100644
index 0000000000..ea9157a5fb
--- /dev/null
+++ b/etc/images/outline-close.svg
@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg"; width="20" height="20" viewBox="0 0 20
20">
+<title>outline-close</title>
+<g transform="rotate(-90, 10, 10)">
+<path d="m17.5 4.75-7.5 7.5-7.5-7.5L1 6.25l9 9 9-9z"/>
+</g>
+</svg>
diff --git a/etc/images/outline-open.pbm b/etc/images/outline-open.pbm
new file mode 100644
index 0000000000..06b520f14c
Binary files /dev/null and b/etc/images/outline-open.pbm differ
diff --git a/etc/images/outline-open.svg b/etc/images/outline-open.svg
new file mode 100644
index 0000000000..75cf6aff9f
--- /dev/null
+++ b/etc/images/outline-open.svg
@@ -0,0 +1,4 @@
+<svg xmlns="http://www.w3.org/2000/svg"; width="20" height="20" viewBox="0 0 20
20">
+<title>outline-open</title>
+<path d="m17.5 4.75-7.5 7.5-7.5-7.5L1 6.25l9 9 9-9z"/>
+</svg>
diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm
index b758346b96..85eec75230 100644
--- a/etc/images/unchecked.xpm
+++ b/etc/images/unchecked.xpm
@@ -1,23 +1,4 @@
/* XPM */
-/* Copyright (C) 2010-2022 Free Software Foundation, Inc.
- *
- * Author: Chong Yidong <cyd@stupidchicken.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/>.
- */
static char * unchecked_xpm[] = {
"12 12 5 1",
" c None",
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index b5a89c65cc..5676a31c3a 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -1315,7 +1315,9 @@ web.id
ie
gov.ie
-// il : http://www.isoc.org.il/domains/
+// il : http://www.isoc.org.il/domains/
+// see also: https://en.isoc.org.il/il-cctld/registration-rules
+// ISOC-IL (operated by .il Registry)
il
ac.il
co.il
@@ -1325,6 +1327,16 @@ k12.il
muni.il
net.il
org.il
+// xn--4dbrk0ce ("Israel", Hebrew) : IL
+ישראל
+// xn--4dbgdty6c.xn--4dbrk0ce.
+אקדמיה.ישראל
+// xn--5dbhl8d.xn--4dbrk0ce.
+ישוב.ישראל
+// xn--8dbq2a.xn--4dbrk0ce.
+צהל.ישראל
+// xn--hebda8b.xn--4dbrk0ce.
+ממשל.ישראל
// im : https://www.nic.im/
// Submitted by registry <info@nic.im>
@@ -1344,18 +1356,47 @@ tv.im
// Please note, that nic.in is not an official eTLD, but used by most
// government institutions.
in
+5g.in
+6g.in
+ac.in
+ai.in
+am.in
+bihar.in
+biz.in
+business.in
+ca.in
+cn.in
co.in
+com.in
+coop.in
+cs.in
+delhi.in
+dr.in
+edu.in
+er.in
firm.in
-net.in
-org.in
gen.in
+gov.in
+gujarat.in
ind.in
+info.in
+int.in
+internet.in
+io.in
+me.in
+mil.in
+net.in
nic.in
-ac.in
-edu.in
+org.in
+pg.in
+post.in
+pro.in
res.in
-gov.in
-mil.in
+travel.in
+tv.in
+uk.in
+up.in
+us.in
// info : https://en.wikipedia.org/wiki/.info
info
@@ -7130,7 +7171,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-07-28T15:14:54Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-09-15T15:17:34Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7639,7 +7680,7 @@ cars
// casa : 2013-11-21 Registry Services, LLC
casa
-// case : 2015-09-03 Helium TLDs Ltd
+// case : 2015-09-03 Digity, LLC
case
// cash : 2014-03-06 Binky Moon, LLC
@@ -7825,7 +7866,7 @@ cool
// corsica : 2014-09-25 Collectivité de Corse
corsica
-// country : 2013-12-19 DotCountry LLC
+// country : 2013-12-19 Internet Naming Company LLC
country
// coupon : 2015-02-26 Amazon Registry Services, Inc.
@@ -8329,7 +8370,7 @@ gifts
// gives : 2014-03-06 Public Interest Registry
gives
-// giving : 2014-11-13 Giving Limited
+// giving : 2014-11-13 Public Interest Registry
giving
// glass : 2013-11-07 Binky Moon, LLC
@@ -10763,6 +10804,52 @@ s3-website.eu-west-2.amazonaws.com
s3-website.eu-west-3.amazonaws.com
s3-website.us-east-2.amazonaws.com
+// AWS Cloud9 : https://aws.amazon.com/cloud9/
+// Submitted by: AWS Security <psl-maintainers@amazon.com>
+// Reference: 2b6dfa9a-3a7f-4367-b2e7-0321e77c0d59
+vfs.cloud9.af-south-1.amazonaws.com
+webview-assets.cloud9.af-south-1.amazonaws.com
+vfs.cloud9.ap-east-1.amazonaws.com
+webview-assets.cloud9.ap-east-1.amazonaws.com
+vfs.cloud9.ap-northeast-1.amazonaws.com
+webview-assets.cloud9.ap-northeast-1.amazonaws.com
+vfs.cloud9.ap-northeast-2.amazonaws.com
+webview-assets.cloud9.ap-northeast-2.amazonaws.com
+vfs.cloud9.ap-northeast-3.amazonaws.com
+webview-assets.cloud9.ap-northeast-3.amazonaws.com
+vfs.cloud9.ap-south-1.amazonaws.com
+webview-assets.cloud9.ap-south-1.amazonaws.com
+vfs.cloud9.ap-southeast-1.amazonaws.com
+webview-assets.cloud9.ap-southeast-1.amazonaws.com
+vfs.cloud9.ap-southeast-2.amazonaws.com
+webview-assets.cloud9.ap-southeast-2.amazonaws.com
+vfs.cloud9.ca-central-1.amazonaws.com
+webview-assets.cloud9.ca-central-1.amazonaws.com
+vfs.cloud9.eu-central-1.amazonaws.com
+webview-assets.cloud9.eu-central-1.amazonaws.com
+vfs.cloud9.eu-north-1.amazonaws.com
+webview-assets.cloud9.eu-north-1.amazonaws.com
+vfs.cloud9.eu-south-1.amazonaws.com
+webview-assets.cloud9.eu-south-1.amazonaws.com
+vfs.cloud9.eu-west-1.amazonaws.com
+webview-assets.cloud9.eu-west-1.amazonaws.com
+vfs.cloud9.eu-west-2.amazonaws.com
+webview-assets.cloud9.eu-west-2.amazonaws.com
+vfs.cloud9.eu-west-3.amazonaws.com
+webview-assets.cloud9.eu-west-3.amazonaws.com
+vfs.cloud9.me-south-1.amazonaws.com
+webview-assets.cloud9.me-south-1.amazonaws.com
+vfs.cloud9.sa-east-1.amazonaws.com
+webview-assets.cloud9.sa-east-1.amazonaws.com
+vfs.cloud9.us-east-1.amazonaws.com
+webview-assets.cloud9.us-east-1.amazonaws.com
+vfs.cloud9.us-east-2.amazonaws.com
+webview-assets.cloud9.us-east-2.amazonaws.com
+vfs.cloud9.us-west-1.amazonaws.com
+webview-assets.cloud9.us-west-1.amazonaws.com
+vfs.cloud9.us-west-2.amazonaws.com
+webview-assets.cloud9.us-west-2.amazonaws.com
+
// Amune : https://amune.org/
// Submitted by Team Amune <cert@amune.org>
t3l3p0rt.net
@@ -10871,6 +10958,10 @@ theshop.jp
shopselect.net
base.shop
+// BeagleBoard.org Foundation : https://beagleboard.org
+// Submitted by Jason Kridner <jkridner@beagleboard.org>
+beagleboard.io
+
// Beget Ltd
// Submitted by Lev Nekrasov <lnekrasov@beget.com>
*.beget.app
@@ -11649,6 +11740,11 @@ dynv6.net
// Submitted by Vladimir Dudr <info@e4you.cz>
e4.cz
+// Easypanel : https://easypanel.io
+// Submitted by Andrei Canta <andrei@easypanel.io>
+easypanel.app
+easypanel.host
+
// eero : https://eero.com/
// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
eero.online
@@ -11943,6 +12039,10 @@ id.forgerock.io
// Submitted by Koen Rouwhorst <koenrh@framer.com>
framer.app
framercanvas.com
+framer.media
+framer.photos
+framer.website
+framer.wiki
// Frusky MEDIA&PR : https://www.frusky.de
// Submitted by Victor Pupynin <hallo@frusky.de>
@@ -12820,6 +12920,7 @@ azure-mobile.net
cloudapp.net
azurestaticapps.net
1.azurestaticapps.net
+2.azurestaticapps.net
centralus.azurestaticapps.net
eastasia.azurestaticapps.net
eastus2.azurestaticapps.net
@@ -13554,6 +13655,10 @@ small-web.org
// Submitted by Dan Kozak <dan@smoove.io>
vp4.me
+// Snowflake Inc : https://www.snowflake.com/
+// Submitted by Faith Olapade <faith.olapade@snowflake.com>
+streamlitapp.com
+
// Snowplow Analytics : https://snowplowanalytics.com/
// Submitted by Ian Streeter <ian@snowplowanalytics.com>
try-snowplow.com
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index bb4bc5b25d..9462df8574 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,5 +1,5 @@
% Reference Card for Org Mode
-\def\orgversionnumber{9.5.4}
+\def\orgversionnumber{9.5.5}
\def\versionyear{2021} % latest update
\input emacsver.tex
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..fe44d520cc 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")
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 fd7ffff98f..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.6.0
+;; 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 c4edb1efcb..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.6.0
+;; 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.6.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 ()
@@ -634,7 +631,7 @@ symbol and the latter as a string.")
(bg-diff-focus-added . "#1d3c25") (fg-diff-focus-added . "#b4ddb4")
(bg-diff-focus-added-deuteran . "#003959") (fg-diff-focus-added-deuteran .
"#bfe4ff")
(bg-diff-focus-changed . "#424200") (fg-diff-focus-changed . "#d0daaf")
- (bg-diff-focus-removed . "#500f29") (fg-diff-focus-removed . "#eebdba")
+ (bg-diff-focus-removed . "#601f29") (fg-diff-focus-removed . "#eebdba")
(bg-mark-sel . "#002f2f") (fg-mark-sel . "#60cfa2")
(bg-mark-del . "#5a0000") (fg-mark-del . "#ff99aa")
@@ -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'."
@@ -1435,7 +1412,7 @@ By default, customizing a theme-related user option
through the
Custom interfaces or with `customize-set-variable' will not
reload the currently active Modus theme.
-Enable this behaviour by setting this variable to nil."
+Enable this behavior by setting this variable to nil."
:group 'modus-themes
:package-version '(modus-themes . "1.5.0")
:version "28.1"
@@ -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,9 +2251,13 @@ 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 specfying each key separately, a fallback list is
+Apart from specifying each key separately, a fallback list is
accepted. This is only useful when the desired aesthetic is the
same across all keys that are not explicitly referenced. For
example, this:
@@ -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
@@ -4387,6 +4357,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(help-key-binding ((,class :inherit modus-themes-key-binding)))
`(homoglyph ((,class :foreground ,red-alt-faint)))
`(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other-faint)))
+ `(icon-button ((,class :inherit modus-themes-box-button)))
`(italic ((,class :slant italic)))
`(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct)))
`(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline
t)))
@@ -4396,6 +4367,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(mm-uu-extract ((,class :background ,bg-dim :foreground
,fg-special-mild)))
`(next-error ((,class :inherit modus-themes-subtle-red :extend t)))
`(pgtk-im-0 ((,class :inherit modus-themes-refine-cyan)))
+ `(read-multiple-choice-face ((,class :inherit (bold
modus-themes-mark-alt))))
`(rectangle-preview ((,class :inherit modus-themes-special-warm)))
`(region ((,class ,@(modus-themes--region bg-region fg-main
bg-hl-alt-intense
bg-region-accent
@@ -4532,9 +4504,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(font-latex-string-face ((,class :inherit font-lock-string-face)))
`(font-latex-subscript-face ((,class :height 0.95)))
`(font-latex-superscript-face ((,class :height 0.95)))
+ `(font-latex-underline-face ((,class :inherit underline)))
`(font-latex-verbatim-face ((,class :inherit
modus-themes-markup-verbatim)))
`(font-latex-warning-face ((,class :inherit font-lock-warning-face)))
- `(tex-match ((,class :foreground ,blue-alt-other)))
`(tex-verbatim ((,class :inherit modus-themes-markup-verbatim)))
`(texinfo-heading ((,class :foreground ,magenta)))
`(TeX-error-description-error ((,class :inherit error)))
@@ -4657,6 +4629,18 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(calibredb-mark-face ((,class :inherit modus-themes-mark-sel)))
`(calibredb-size-face (( )))
`(calibredb-tag-face ((,class :foreground ,magenta-alt-faint)))
+;;;;; centaur-tabs
+ `(centaur-tabs-active-bar-face ((,class :background ,blue-active)))
+ `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground
,red-active :underline t)))
+ `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected)))
+ `(centaur-tabs-close-unselected ((,class :inherit
centaur-tabs-unselected)))
+ `(centaur-tabs-modified-marker-selected ((,class :inherit
centaur-tabs-selected)))
+ `(centaur-tabs-modified-marker-unselected ((,class :inherit
centaur-tabs-unselected)))
+ `(centaur-tabs-default ((,class :background ,bg-main)))
+ `(centaur-tabs-selected ((,class :inherit modus-themes-tab-active)))
+ `(centaur-tabs-selected-modified ((,class :inherit (italic
centaur-tabs-selected))))
+ `(centaur-tabs-unselected ((,class :inherit modus-themes-tab-inactive)))
+ `(centaur-tabs-unselected-modified ((,class :inherit (italic
centaur-tabs-unselected))))
;;;;; cfrs
`(cfrs-border-color ((,class :background ,fg-window-divider-inner)))
;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
@@ -4669,6 +4653,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(change-log-list ((,class :foreground ,magenta-alt)))
`(change-log-name ((,class :foreground ,magenta-alt-other)))
`(log-edit-header ((,class :foreground ,fg-special-warm)))
+ `(log-edit-headers-separator ((,class :height 1 :background
,fg-window-divider-inner :extend t)))
`(log-edit-summary ((,class :inherit bold :foreground ,blue)))
`(log-edit-unknown-header ((,class :inherit shadow)))
`(log-view-commit-body ((,class :foreground ,blue-nuanced-fg)))
@@ -4743,6 +4728,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(company-preview-common ((,class :inherit company-echo-common)))
`(company-preview-search ((,class :inherit modus-themes-special-calm)))
`(company-template-field ((,class :inherit modus-themes-intense-magenta)))
+ `(company-scrollbar-bg ((,class :background ,bg-active)))
+ `(company-scrollbar-fg ((,class :background ,fg-active)))
`(company-tooltip ((,class :background ,bg-alt)))
`(company-tooltip-annotation ((,class :inherit completions-annotations)))
`(company-tooltip-common ((,class :inherit company-echo-common)))
@@ -4781,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)))
@@ -4824,6 +4809,13 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(cperl-nonoverridable-face ((,class :foreground unspecified)))
`(cperl-array-face ((,class :inherit font-lock-keyword-face)))
`(cperl-hash-face ((,class :inherit font-lock-variable-name-face)))
+;;;;; crontab-mode
+ `(crontab-minute ((,class :foreground ,blue-alt)))
+ `(crontab-hour ((,class :foreground ,magenta-alt-other)))
+ `(crontab-month-day ((,class :foreground ,magenta-alt)))
+ `(crontab-month ((,class :foreground ,blue)))
+ `(crontab-week-day ((,class :foreground ,cyan)))
+ `(crontab-predefined ((,class :foreground ,blue-alt)))
;;;;; css-mode
`(css-property ((,class :inherit font-lock-type-face)))
`(css-selector ((,class :inherit font-lock-keyword-face)))
@@ -4904,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))))
@@ -5041,7 +5029,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(diredp-tagged-autofile-name ((,class :inherit
modus-themes-refine-magenta)))
`(diredp-write-priv ((,class :foreground ,cyan)))
;;;;; display-fill-column-indicator-mode
- `(fill-column-indicator ((,class :height 1 :background ,bg-inactive
:foreground ,bg-inactive)))
+ `(fill-column-indicator ((,class :height 1 :background ,bg-region
:foreground ,bg-region)))
;;;;; doom-modeline
`(doom-modeline-bar ((,class :inherit modus-themes-active-blue)))
`(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground
,bg-main)))
@@ -5608,7 +5596,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(gnus-summary-low-read ((,class :inherit italic :foreground ,fg-alt)))
`(gnus-summary-low-ticked ((,class :inherit italic :foreground
,red-refine-fg)))
`(gnus-summary-low-undownloaded ((,class :inherit italic :foreground
,yellow-refine-fg)))
- `(gnus-summary-low-unread ((,class :inherit bold :foreground
,fg-special-cold)))
+ `(gnus-summary-low-unread ((,class :inherit italic :foreground
,fg-special-cold)))
`(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm)))
`(gnus-summary-normal-read ((,class :inherit shadow)))
`(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other)))
@@ -5717,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)))))
@@ -5776,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)))
@@ -6461,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)))
@@ -6723,6 +6741,9 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(powerline-evil-operator-face ((,class :inherit
modus-themes-active-yellow)))
`(powerline-evil-replace-face ((,class :inherit modus-themes-active-red)))
`(powerline-evil-visual-face ((,class :inherit modus-themes-active-cyan)))
+;;;;; prescient
+ `(prescient-primary-highlight ((,class :inherit
modus-themes-completion-match-0)))
+ `(prescient-secondary-highlight ((,class :inherit
modus-themes-completion-match-1)))
;;;;; proced
`(proced-mark ((,class :inherit modus-themes-mark-symbol)))
`(proced-marked ((,class :inherit modus-themes-mark-alt)))
@@ -6841,9 +6862,6 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(selectrum-mouse-highlight ((,class :inherit highlight)))
`(selectrum-quick-keys-highlight ((,class :inherit bold :background
,bg-char-0)))
`(selectrum-quick-keys-match ((,class :inherit bold :background
,bg-char-1)))
-;;;;; selectrum-prescient
- `(selectrum-prescient-primary-highlight ((,class :inherit
modus-themes-completion-match-0)))
- `(selectrum-prescient-secondary-highlight ((,class :inherit
modus-themes-completion-match-1)))
;;;;; semantic
`(semantic-complete-inline-face ((,class :foreground ,fg-special-warm
:underline t)))
`(semantic-decoration-on-fileless-includes ((,class :inherit
modus-themes-refine-green)))
@@ -6988,6 +7006,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(speedbar-selected-face ((,class :inherit bold :foreground ,cyan)))
`(speedbar-separator-face ((,class :inherit modus-themes-intense-neutral)))
`(speedbar-tag-face ((,class :foreground ,yellow-alt-other)))
+;;;;; spell-fu
+ `(spell-fu-incorrect-face ((,class :inherit modus-themes-lang-error)))
;;;;; stripes
`(stripes ((,class :background ,bg-alt)))
;;;;; suggest
@@ -7083,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)))
@@ -7142,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)))
@@ -7526,7 +7542,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(xterm-color-names-bright ["gray35" ,red-alt ,green-alt ,yellow-alt
,blue-alt ,magenta-alt ,cyan-alt "white"])
(if (or (eq modus-themes-org-blocks 'tinted-background)
(eq modus-themes-org-blocks 'rainbow))
- `(org-src-block-faces ; TODO this list should be expanded
+ `(org-src-block-faces
`(("emacs-lisp" modus-themes-nuanced-magenta)
("elisp" modus-themes-nuanced-magenta)
("clojure" modus-themes-nuanced-magenta)
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index ba75a2527d..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.6.0
+;; 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/etc/tutorials/TUTORIAL.translators
b/etc/tutorials/TUTORIAL.translators
index 891b6a1682..64d71b61e8 100644
--- a/etc/tutorials/TUTORIAL.translators
+++ b/etc/tutorials/TUTORIAL.translators
@@ -90,6 +90,10 @@ Maintainer: Mats Lidell <matsl@contactor.se>
Author: Virach Sornlertlamvanich <virach@nectec.or.th>
Maintainer: Virach Sornlertlamvanich <virach@nectec.or.th>
+* TUTORIAL.uk:
+Author: Denys Nykula <vegan@libre.net.ua>
+Maintainer: Denys Nykula <vegan@libre.net.ua>
+
* TUTORIAL.zh:
Author: Chao-Hong Liu <chliu@gnu.org>
Maintainer: Chao-Hong Liu <chliu@gnu.org>
diff --git a/etc/tutorials/TUTORIAL.uk b/etc/tutorials/TUTORIAL.uk
new file mode 100644
index 0000000000..16190afe3a
--- /dev/null
+++ b/etc/tutorials/TUTORIAL.uk
@@ -0,0 +1,1150 @@
+Посібник Emacs. Умови копіювання в кінці.
+
+Команди Emacs передбачають використання клавіші CONTROL (часто
+підписаної CTRL чи CTL) або клавіші META (зазвичай підписаної ALT).
+Щоб не писати цього щоразу повністю, використовуємо такі скорочення:
+
+ C-<симв> означає затиснути клавішу CONTROL і натиснути клавішу
+ <симв>. Тобто C-f — це затиснути CONTROL і натиснути f.
+
+ M-<симв> означає затиснути клавішу META чи ALT і натиснути <симв>.
+ Якщо не маєте клавіші META чи ALT, натисніть по черзі
+ клавіші ESC та <симв>. Клавішу ESC ми позначаємо <ESC>.
+
+Щоб редагувати український текст в Emacs, перемкніться на англійську
+розкладку й наберіть C-\ — це активує український режим введення
+Emacs, у якому працюватимуть як слід усі описані в посібнику команди.
+Щоб знову вводити англійські символи, повторіть C-\.
+
+Зауважте: щоб завершити сеанс Emacs, наберіть C-x C-c. (Два символи.)
+Щоб скасувати частково введену команду, наберіть C-g. Щоб закрити
+посібник, наберіть C-x k, а тоді при запиті натисніть <Return> (цю
+клавішу може бути підписано Enter). Абзаци, що містять „»»“ на
+початку, — це вказівки, які вам слід виконати, щоб спробувати
+використати ту чи іншу команду. Наприклад:
+<<Програма help-with-tutorial огортає наступний рядок відступами>>
+[Кілька навмисне порожніх рядків. Скоро зрозумієте, навіщо.]
+»» Прямо зараз наберіть C-v (view — переглянути), щоб прогорнути
+ посібник униз. (Затисніть клавішу CONTROL і наберіть v.)
+ Робіть так щоразу, коли дочитуєте до кінця екрана.
+
+Як бачите, гортається не цілий екран, а на два рядки менше; це
+допомагає не губитись, коли читаєте довгі тексти.
+
+Це одноразова, трошки адаптована спеціально для вас копія тексту
+посібника Emacs. Будемо пропонувати вам випробовувати прямо на цьому
+тексті різні команди, які його змінюватимуть. Якщо зміните цей текст
+самостійно навіть без наших вказівок — чудово, це називається
+«редагування» й саме для цього створено Emacs.
+
+Перш за все навчимось пересуватися текстом. Ви вже знаєте, як
+прогорнути один екран уперед: C-v. Прогорнути один екран назад — це
+M-v (затисніть клавішу META й наберіть v — або наберіть <ESC>v, якщо
+не маєте ні клавіші META, ні клавіші ALT).
+
+»» Спробуйте набрати M-v й тоді C-v кілька разів по черзі.
+
+Якщо знаєте інші способи гортати текст, то можете, звісно,
+застосовувати і їх.
+
+* ПІДСУМОК
+----------
+
+Наступні команди допомагають гортати екрани тексту:
+
+ C-v (View — переглянути.)
+ Перейти на наступний екран.
+
+ M-v Перейти на попередній екран.
+
+ C-l (Clear — очистити.)
+ Очистити екран і вивести текст заново, центруючи екран
+ на тексті біля курсора. (Це CONTROL-L, не CONTROL-1.)
+
+»» Знайдіть курсор і зверніть увагу, який біля нього текст. Наберіть
+ C-l. Знайдіть, куди змістився курсор, і зауважте, що біля курсора
+ досі той самий текст, просто він тепер у центрі екрана. Якщо знов
+ натиснете C-l, цей самий текст посунеться догори екрана. Натисніть
+ C-l іще раз, і він посунеться донизу.
+
+Можете також гортати екрани клавішами PageUp і PageDn, якщо ваш
+термінал їх має. Але з C-v та M-v ви редагуватимете спритніше.
+
+* ОСНОВИ КЕРУВАННЯ КУРСОРОМ
+---------------------------
+
+Гортати екран за екраном — це вже непогано, але як перейти до
+конкретного місця в тексті на екрані?
+
+Є кілька способів. Можна рухатись клавішами стрілок, але зручніше
+тримати руки в стандартному положенні й використовувати команди C-p
+(previous — попередній), C-b (backward — назад), C-f (forward —
+уперед) і C-n (next — наступний). Ці символи рівнозначні
+чотирьом клавішам стрілок:
+
+ Попередній рядок, C-p
+ :
+ :
+ Назад, C-b .... Де курсор зараз .... Уперед, C-f
+ :
+ :
+ Наступний рядок, C-n
+
+»» Посуньте курсор до рядка посередині рисунка вгорі за допомогою C-n
+ та C-p. Тоді наберіть C-l, щоб центрувати екран на рисунку.
+
+Літери в скороченнях Emacs легко запам'ятати за відповідними їм
+англійськими словами, як зазначено вгорі. Ці основні команди руху
+курсора ви будете використовувати весь час.
+
+»» Наберіть C-n кілька разів, щоб посунути курсор до цього рядка.
+
+»» Посуньте курсор до якого-небудь слова в рядку, набравши C-f
+ декілька разів, а тоді поверніться вгору кількома натисками C-p.
+ Зауважте, як C-p поводиться, коли курсор не на початку рядка.
+
+Кожен рядок тексту закінчується символом нового рядка: цей символ
+технічно відділяє рядок від наступного. (Зазвичай останній рядок у
+файлі теж закінчується символом нового рядка, проте Emacs цього не
+вимагає.)
+
+»» Спробуйте C-b на початку рядка. Курсор має зміститись у кінець
+ попереднього рядка, бо рух назад (backward) «проїде» по символу
+ нового рядка.
+
+C-f — рух уперед (forward) — уміє «їздити» по символах нового рядка
+так само, як і C-b.
+
+»» Наберіть C-b іще кілька разів, щоб відчути, яким чином рухається
+ курсор. Тоді поверніться в кінець того рядка, з якого почали рух:
+ кілька разів наберіть C-f. Тоді перейдіть іще одним C-f до
+ наступного рядка.
+
+Коли ваш рух перетинає верх чи низ екрана, текст із-за краю
+посувається на екран. Це називається «гортання», або scrolling.
+Таким чином курсор, куди б у тексті ви його не спрямували, залишається
+в межах екрана Emacs.
+
+»» Спробуйте посунути курсор за нижню межу екрана кількома натисками
+ C-n — і зверніть увагу на поведінку.
+
+Коли рухатися символами надто повільно, рухайтеся словами. M-f
+(META-f) посуває курсор через ціле слово вперед (forward), а M-b —
+через слово назад (backward).
+
+»» Наберіть M-f і M-b по кілька разів.
+
+Коли ви посеред слова, M-f посуває курсор до кінця слова. Коли ви на
+пробілі, M-f посуває курсор у кінець наступного слова. M-b працює
+аналогічно в зворотному напрямі.
+
+»» Наберіть іще кілька M-f і M-b, розділяючи їх натисками C-f і C-b,
+ щоб поспостерігати за поведінкою M-f і M-b залежно від перебування
+ курсора в різних місцях усередині слів і між словами.
+
+Простежте паралелі між C-f і C-b з одного боку та M-f і M-b з іншого.
+Часто Meta-символи використовуються для роботи з одиницями,
+визначеними мовою: зі словами, реченнями, абзацами. Тоді як
+Control-символи працюють із низькорівневими одиницями, без огляду на
+редаговане середовище: з символами, рядками тощо.
+
+Ця паралель стосується також рядків і речень: C-a та C-e посувають до
+початку чи кінця рядка, тоді як M-a та M-e посувають до початку чи
+кінця речення.
+
+»» Наберіть C-a кілька разів, тоді наберіть C-e кілька разів.
+ Наберіть M-a кілька разів, тоді наберіть M-e кілька разів.
+
+Зверніть увагу на те, як повторні натиски C-a не викликають нових
+рухів, а от повтори M-a щоразу рухають вас на одне речення назад.
+Поведінка дещо різна, втім природна для кожного контексту.
+
+Координати курсора в тексті називаються «точкою». Іншими словами,
+курсор позначає на екрані поточну точку в тексті.
+
+Ось підсумок простих операцій посування курсора, зокрема команд руху
+словами й реченнями:
+
+ C-f (Forward — уперед.) Перейти на символ уперед
+ C-b (Backward — назад.) Перейти на символ назад
+
+ M-f Перейти на слово вперед
+ M-b Перейти на слово назад
+
+ C-n (Next — наступний.) До наступного рядка
+ C-p (Previous — попередній.) До попереднього рядка
+
+ C-a (Alpha — початок.) Перейти на початок рядка
+ C-e (End — кінець.) Перейти в кінець рядка
+
+ M-a Перейти назад на початок речення
+ M-e Перейти вперед у кінець речення
+
+»» Випробуйте всі ці команди по кілька разів для практики.
+ Ними ви користуватиметесь частіше за всі інші.
+
+Дві інші важливі команди руху курсора — це M-< (META-менше), яка веде
+на початок усього тексту, й M-> (META-більше), яка веде в кінець
+усього тексту.
+
+На більшості терміналів знак „<“ — над латинською комою, тобто ви
+затискаєте SHIFT, щоб його набрати. Відповідно M-< означає затиск не
+лише клавіші META, а ще й клавіші SHIFT. Без SHIFT вийде M-кома.
+
+»» Спробуйте М-< зараз, щоб перейти на початок посібника.
+ Тоді кілька разів наберіть C-v, щоб повернутись сюди.
+
+»» Спробуйте М-> зараз, щоб перейти в кінець посібника.
+ Тоді кілька разів наберіть M-v, щоб повернутись сюди.
+
+Можете також рухати курсор клавішами стрілок, якщо ваш термінал має
+такі клавіші. Втім, радимо опанувати C-b, C-f, C-n і C-p з трьох
+причин. По-перше, вони працюють на будь-яких терміналах. По-друге,
+практикуючи використання Emacs, ви невдовзі виявите, що набирати ці
+Control-символи швидше, ніж набирати стрілки (бо вам не доводиться
+зсувати руки з набірного положення). По-третє, щойно ви звикнете до
+використання цих команд із Control-символами, вам стане легко
+опанувати й інші розширені команди посування курсора.
+
+Більшість команд Emacs приймають числовий аргумент; для більшості
+команд він означає кількість повторів. Щоб передати команді кількість
+повторів, набирайте C-u і цифри, перш ніж набрати команду. Якщо маєте
+клавішу META (чи ALT), то маєте й інший, альтернативний шлях увести
+числовий аргумент: наберіть цифри, затиснувши клавішу META. Радимо
+опанувати шлях C-u, бо він працює на будь-яких терміналах. Числовий
+аргумент також називається «префіксним аргументом», бо ви набираєте
+його перед відповідною йому командою.
+
+Наприклад, C-u 8 C-f посуває курсор на вісім символів уперед.
+
+»» Спробуйте використати C-n чи C-p з числовим аргументом, щоб
+ посунути курсор до рядка поруч із цим рядком єдиною командою.
+
+Числовий аргумент означає для більшості команд кількість повторів, але
+деякі команди використовують його інакше. Декілька команд (але не ті,
+які вам уже відомі) використовують його як прапор: коли передаєте їм
+префіксний аргумент, це незалежно від значення змушує команду робити
+щось нетипове.
+
+C-v та M-v також є винятком. За наявності аргументу вони гортають
+текст угору чи вниз на означену ним кількість рядків, а не на цілий
+екран. Наприклад, C-u 8 C-v прокручує 8 рядків.
+
+»» Спробуйте набрати C-u 8 C-v прямо зараз.
+
+Це мало прогорнути текст на 8 рядків угору. Якщо бажаєте прогорнути
+його знов донизу, передайте аргумент команді M-v.
+
+Якщо ви користуєтесь графічним середовищем, наприклад X чи MS-Windows,
+то з одного боку вікна Emacs має бути висока прямокутна область, яка
+називається панеллю гортання. Можете гортати текст, натискаючи панель
+гортання кнопкою миші.
+
+Якщо у вашої миші є колесо гортання, можете гортати й ним.
+
+
+* ЯКЩО EMACS НЕ ВІДПОВІДАЄ
+--------------------------
+
+Якщо Emacs перестає відповідати на ваші команди, можете дати йому
+копняка, набравши C-g. Використовуйте C-g, щоб припинити команду, яка
+виконується надто довго.
+
+Також використовуйте C-g, щоб відхилити числовий аргумент або початок
+команди, яку передумали дописувати.
+
+»» Наберіть C-u 100, щоб зазначити числовий аргумент «100». Наберіть
+ C-g. Тепер наберіть C-f. Курсор має посунутись лише на один
+ символ, бо ви скасували аргумент набранням C-g.
+
+Ненароком набравши <ESC>, можете позбутись і його за допомогою C-g.
+
+
+* ВИМКНЕНІ КОМАНДИ
+------------------
+
+Деякі команди Emacs усталено «вимкнені», щоб не плутати користувачок і
+користувачів, які лише починають його вивчати.
+
+Коли ви набираєте ту чи іншу вимкнену команду, Emacs показує її назву
+й запитує, чи точно ви бажаєте виконати цю команду.
+
+Якщо ви справді бажаєте спробувати команду, наберіть <SPC> (пробіл) у
+відповідь на запитання. Зазвичай, не бажаючи виконувати вимкнену
+команду, відповідайте на це питання «n».
+
+»» Наберіть C-x C-l (цю команду вимкнено), а тоді наберіть n у
+ відповідь на запитання.
+
+
+* WINDOWS
+---------
+
+Emacs може мати кілька «вікон» — кожне зі своїм текстом. Згодом
+пояснимо, як використовувати декілька вікон одразу. Поки що слід
+розібратись, як позбутись зайвих вікон і повернутись до простого
+редагування в одному вікні. Це просто:
+
+ C-x 1 Одне вікно (тобто припинити всі інші вікна).
+
+Це означає набір CONTROL-x і цифри 1. C-x 1 розширює вікно, яке
+містить курсор, на весь екран, і видаляє всі інші вікна.
+
+»» Посуньте курсор до цього рядка й наберіть C-u 0 C-l. Тоді наберіть
+ C-h k C-f. Це вікно звузиться, й з'явиться нове вікно, в якому
+ буде показано документацію про команду C-f.
+
+»» Наберіть C-x 1 — вікно документації зникне.
+
+Є цілі набори команд, які починаються з CONTROL-x; більшість із них
+стосуються вікон, файлів, буферів тощо. Ці команди містять два, три
+або чотири символи.
+
+
+* ВВЕДЕННЯ Й ВИДАЛЕННЯ
+----------------------
+
+Якщо бажаєте ввести текст, просто наберіть цей текст. Звичайні
+символи, такі як A, 7, * тощо, вводяться прямо при набранні. Аби
+ввести символ нового рядка, натисніть <Return> (ця клавіша на
+клавіатурі часом підписана «Enter»).
+
+Щоб видалити символ перед курсором, наберіть <DEL>. Ця клавіша на
+клавіатурі зазвичай підписана «Backspace» — та сама, якою за межами
+Emacs ви зазвичай видаляєте останній набраний символ.
+
+На клавіатурі зазвичай є ще одна клавіша з підписом <Delete>, але в
+Emacs ми позначаємо <DEL> не її.
+
+»» Прямо зараз наберіть кілька символів, а тоді видаліть їх, набравши
+ <DEL> кілька разів. Сміливо змінюйте цей файл; оригінал посібника
+ залишиться недоторканим. Це ваша особиста одноразова копія.
+
+Коли рядок тексту завеликий для одного рядка на екрані, цей рядок
+тексту «продовжується» на ще один екранний рядок. Якщо ви
+користуєтесь графічним середовищем, на кожному боці текстової області
+(на лівому й правому «полях») з'являються маленькі вигнуті стрілки —
+позначки, де було продовжено той чи інший рядок. Якщо ви користуєтесь
+текстовим терміналом, продовжений рядок позначається оберненою скісною
+рискою («\») в крайній правій колонці екрана.
+
+»» Вводьте текст, доки не сягнете правого поля, а тоді вводьте ще.
+ Побачите, як з'явиться рядок продовження.
+
+»» Натискайте <DEL> раз за разом, щоб видаляти символи, доки рядок
+ тексту не вміститься знову в один екранний рядок. Рядок
+ продовження зникне.
+
+Символ нового рядка можете видалити так само, як будь-який інший.
+Видалення символу нового рядка між двома рядками зливає їх в один
+рядок. Якщо в результаті сполучений рядок ширший, ніж екран, то його
+буде показано з рядком продовження.
+
+»» Посуньте курсор на початок рядка й наберіть <DEL>. Це
+ зіллє той рядок із попереднім.
+
+»» Наберіть <Return>, щоб відновити символ нового рядка на місці щойно
+ видаленого.
+
+Клавіша <Return> особлива тим, що її натиск може не лише вводити
+символ нового рядка. Залежно від навколишнього тексту, її натиск може
+ввести пробіли після символу нового рядка таким чином, щоб текст у
+новоствореному рядку одразу вирівнювався відносно тексту попереднього
+рядка. Ми називаємо цю поведінку (складнішу дію клавіші, ніж просто
+введення відповідного символу) «електричною».
+
+»» Щоб побачити електричну поведінку <Return>,
+ наберіть <Return> у кінці цього рядка.
+
+Простежте, як при введенні символу нового рядка Emacs вводить пробіли
+таким чином, що курсор опиняється під «н» слова «наберіть».
+
+Пам'ятайте, більшості команд Emacs можливо передати кількість
+повторень; це стосується й текстових символів. Повторення текстового
+символу вводить цей символ декілька разів.
+
+»» Спробуйте зараз набрати C-u 8 *, аби ввести ********.
+
+Ви опанували основний спосіб набрати щось в Emacs і виправити помилки.
+Також можна видаляти цілі слова й рядки. Ось підсумок операцій
+видалення:
+
+ <DEL> Видалити символ перед курсором
+ C-d (Delete — видалити.) Видалити символ після курсора
+
+ M-<DEL> Вирізати слово перед курсором
+ M-d Вирізати слово після курсора
+
+ C-k (Kill — вирізати.) Вирізати з рядка все після курсора
+ M-k Вирізати з речення все після курсора
+
+Зважте на те, як <DEL> і C-d продовжують щодо M-<DEL> і M-d паралелі,
+розпочаті C-f і M-f (технічно <DEL> не є керівним символом, але зараз
+це несуттєво). C-k та M-k подібні до C-e та M-e тим, як вони працюють
+із рядками й реченнями відповідно.
+
+Є також спосіб вирізати одразу багато тексту. Перейдіть на початок чи
+в кінець потрібної частини тексту й натисніть C-<SPC>. (<SPC> —
+пробіл.) Тоді посуньте курсор на інший край частини тексту, яку
+бажаєте вирізати. Коли ви це робитимете, Emacs підсвітить текст між
+курсором і тим місцем, де ви набрали C-<SPC>. Нарешті наберіть C-w
+(whole — повністю). Це повністю виріже позначений текст.
+
+»» Посуньте курсор до «Є» на початку попереднього абзацу.
+»» Введіть C-<SPC>. Emacs має показати повідомлення «Mark set»
+ («Позначку встановлено») внизу екрана.
+»» Посуньте курсор до «п» в слові «потрібної» другого рядка абзацу.
+»» Наберіть C-w. Це виріже текст від «Є» включно до «п» не включно.
+ Якби ви набрали M-w, це його лише скопіювало б.
+
+Вирізання й видалення відрізняються тим, що вирізаний текст можливо
+вставити (будь-куди), тоді як видалене вставити неможливо (втім,
+можливо скасувати видалення — про це згодом). Вставка, так би мовити,
+виймає (yank) раніше вилучений текст. Зазвичай усі команди, які
+вилучають багато тексту, вирізають його (їх налаштовано таким чином,
+щоб ви могли потім вставити цей текст); а от команди, які вилучають
+лише один символ або порожні рядки чи пробіли, просто їх видаляють
+(без можливості вставлення). <DEL> і C-d без аргументу здійснюють
+видалення. За наявності аргументу вони вирізають.
+
+»» Посуньте курсор на початок рядка, в якому є символи.
+ Тоді наберіть C-k, щоб вирізати текст у цьому рядку.
+»» Наберіть C-k іще раз. Це виріже той символ нового рядка,
+ що завершує цей рядок.
+
+Зауважте, перший C-k вирізає вміст рядка, а другий C-k вирізає сам
+рядок і зсуває догори всі наступні рядки. C-k із числовим аргументом
+працює інакше: вирізає водночас вміст і самі рядки. Це не просто
+повторення. C-u 2 C-k вирізає два рядки разом із їхніми символами
+нового рядка; набравши C-k двічі, ви отримаєте інший результат.
+
+Можете вставити вирізаний текст туди ж, звідки його вирізали, або до
+певного іншого місця в редагованому тексті — навіть в інший файл.
+Можете вставляти один і той самий текст кілька разів; це створить
+кілька його копій. Англійською вирізання називають «kill» або «cut»,
+виймання (вставку) — «yank» або «paste»; перегляньте згодом глосарій у
+підручнику Emacs.
+
+Команда C-y вставляє останній вирізаний текст туди, де зараз курсор.
+
+»» Спробуйте набрати C-y, щоб вставити текст назад.
+
+Якщо наберете C-k декілька разів поспіль, увесь вирізаний текст
+збережеться разом, щоб одною командою C-y ви могли вставити водночас
+усі рядки.
+
+»» Спробуйте зараз набрати C-k декілька разів.
+
+Тепер отримаймо вирізаний текст:
+
+»» Наберіть C-y. Посуньте курсор на кілька рядків униз і наберіть C-y
+ знову. Тепер ви знаєте, як копіювати текст.
+
+Що робити, коли вже вирізали певний текст для вставки, але після цього
+вирізали ще щось? C-y вставляє найновіше вирізане. Проте минулого
+вирізаного не втрачено. Можете повернутись до нього командою M-y.
+Набравши C-y та вийнявши цим найновіше вирізане, наберіть M-y іще раз,
+щоб замінити вставлений текст на попереднє вирізане. Набирайте M-y
+знову й знову, щоб виймати минулі вирізання. Досягнувши шуканого
+тексту, ви не маєте більше нічого робити, щоб його зафіксувати.
+Просто продовжуйте редагувати, залишивши вставлений текст на місці.
+
+Набравши M-y достатньо разів, виймете найновіше вирізане знову.
+
+»» Виріжте рядок, посуньте курсор і виріжте ще один рядок.
+
+»» Тоді наберіть C-y, щоб отримати другий вирізаний рядок. Тоді
+ наберіть M-y, і той рядок заміниться на перший вирізаний рядок.
+
+»» Наберіть M-y іще кілька разів і простежте, що вийматиметься.
+ Продовжуйте набирати M-y, доки не виймете знову другий вирізаний
+ рядок, і тоді наберіть ще декілька M-y. За бажання спробуйте
+ передати M-y додатні чи від'ємні аргументи.
+
+
+* СКАСУВАННЯ
+------------
+
+Помилково змінивши текст, можете скасувати цю зміну командою
+скасування C-_, тобто затисніть Control та Shift і натисніть дефіс.
+
+Зазвичай C-_ скасовує зміни, внесені одною командою; якщо ви наберете
+кілька C-_ поспіль, кожне повторення скасує ще по одній команді.
+
+Але є два винятки. Команди, які не змінюють тексту, не враховуються
+(зокрема це команди руху курсора й команди гортання). Й текстові
+символи зазвичай обробляються по 20 водночас. (Це щоб зменшити
+кількість C-_, потрібних для скасування вставки тексту.)
+
+»» Виріжте цей рядок за допомогою C-k. Тоді наберіть C-_, щоб він
+ з'явився знову.
+
+C-/ — альтернативна команда скасування; вона працює так само, як C-_.
+Деякі термінали дають змогу набирати C-_ без клавіші Shift. Деякі
+термінали насправді передають Emacs саме C-_, коли ви набираєте C-/.
+Ще є команда C-x u, котра працює так само, як C-_, але менш зручна для
+набрання. Посібники для латинських розкладок описують команду C-/ як
+основну, проте українською C-_ набирати легше.
+
+Числовий аргумент для C-_, C-/ чи C-x u працює як кількість повторень.
+
+Можете скасувати видалення тексту так само, як скасовуєте вирізання.
+Відмінність між вирізанням і видаленням полягає в тому, чи можете ви
+вставити текст за допомогою C-y; для скасування нема жодної різниці.
+
+
+* ФАЙЛИ
+-------
+
+Щоб зробити зміни до тексту постійними, їх треба зберегти до файлу.
+Інакше ці зміни зникнуть при виході з Emacs. Аби зберегти текст до
+файлу, вам потрібно «знайти» файл, перш ніж ввести текст. (Це також
+називають «відкриттям» файлу.)
+
+Знаходження файлу показує його вміст усередині Emacs. Це виглядає,
+ніби ви редагуєте файл безпосередньо. Проте зміни, які ви вносите за
+допомогою Emacs, не стають постійними, доки ви не «збережете» файл.
+Це щоб не залишати лише частково зміненого файлу в системі, коли ви
+цього не бажаєте. Навіть після збереження Emacs залишає початковий
+файл під іншою назвою, щоб ви змогли згодом скасувати зміни, якщо вони
+виявляться помилковими.
+
+Якщо ви роздивитесь низ екрану, то помітите рядок, який містить дефіси
+й починається з чогось на кшталт « -:--- TUTORIAL». Ця частина екрану
+зазвичай показує назву файлу, який ви редагуєте. Зараз ви
+переглядаєте свою особисту копію посібника Emacs, названу «TUTORIAL».
+Коли ви знаходите файл за допомогою Emacs, назва цього файлу
+показується саме в тому місці.
+
+Команда знаходження файлу особлива тим, що запитує вас, який файл вам
+треба. Іншими словами, команда «зчитує аргумент» (у цьому випадку
+аргумент — назва файлу). Після набрання команди:
+
+ C-x C-f (Find — знайти.) Знайти файл
+
+Emacs попрохає вас набрати назву файлу. При введенні назву файлу
+показано в нижньому рядку екрана. Нижній рядок називають мінібуфером,
+коли він використовується для таких запитів. Можете використовувати
+звичні команди редагування Emacs, щоб редагувати назву файлу.
+
+Коли ви вводите назву файлу (чи заповнюєте інший мінібуфер), можете
+скасувати команду за допомогою C-g.
+
+»» Наберіть C-x C-f, а тоді наберіть C-g. Це скасує мінібуфер, а
+ також команду C-x C-f, яка використовувала мінібуфер. Тому ви не
+ знайдете жодного файлу.
+
+Коли ви введете назву файлу до кінця, наберіть <Return>, щоб завершити
+введення. Мінібуфер зникне, й команда C-x C-f спробує знайти обраний
+вами файл.
+
+Вміст файлу з'явиться на екрані, й ви зможете редагувати цей вміст.
+Коли вирішите зберегти зміни на постійно, наберіть команду:
+
+ C-x C-s (Save — зберегти.) Зберегти
+
+Це скопіює текст із Emacs до файлу. Коли ви робите це вперше, Emacs
+перейменовує початковий файл, щоб його не було втрачено. Нова назва
+формується доданням «~» у кінець назви початкового файлу. Завершивши
+збереження, Emacs показує назву записаного файлу.
+
+»» Наберіть C-x C-s TUTORIAL <Return>.
+ Це має зберегти посібник у файл із назвою «TUTORIAL» і показати
+ «Wrote ...TUTORIAL» унизу екрана.
+
+Можете знайти вже наявний файл, щоб переглянути чи відредагувати його.
+Або можете «знайти» файл, якого ще не існує. Так в Emacs створюють
+файли: відкривають порожній файл і починають вводити текст у цей файл.
+Коли ви попросите «зберегти» файл, Emacs насправді створить файл зі
+введеним вами текстом. Відтоді можете вважати, що редагуєте вже
+наявний файл.
+
+
+* БУФЕРИ
+--------
+
+Коли знаходите ще один файл за допомогою C-x C-f, перший файл
+залишається в Emacs. Можете перемкнутись на нього, знайшовши його
+знову за допомогою C-x C-f. Таким чином в Emacs можливо відкрити
+чимало файлів.
+
+Emacs зберігає текст кожного файлу всередині об'єкта — так званого
+«буфера». Знаходження файлу створює буфер усередині Emacs. Щоб
+переглянути перелік уже наявних буферів, наберіть
+
+ C-x C-b (Buffer — буфер.) Перелічити буфери
+
+»» Спробуйте C-x C-b прямо зараз.
+
+Зауважте, що кожен буфер має власну назву, а ще біля нього може бути
+назва того файлу, вміст якого він утримує. Будь-який текст, який ви
+бачите у вікні Emacs, завжди є частиною певного буфера.
+
+»» Наберіть C-x 1, щоб позбутись переліку буферів.
+
+Коли буферів декілька, лише один із них може бути «поточним». Це той
+буфер, який ви редагуєте. Якщо бажаєте редагувати інший буфер, на
+нього слід «перемкнутись». Якщо бажаєте перемкнутись на буфер, що
+відповідає певному файлу, відкрийте файл знову за допомогою C-x C-f.
+Але простіше використати команду C-x b. Цій команді достатньо
+передати назву буфера.
+
+»» Відкрийте файл «foo», набравши C-x C-f foo <Return>. Тоді наберіть
+ C-x b TUTORIAL <Return>, щоб повернутись до цього посібника.
+
+Зазвичай назва буфера збігається з назвою файлу (без шляху). Втім, це
+не завжди так. Перелік буферів, відкритий за допомогою C-x C-b,
+показує як назву буфера, так і назву файлу кожного буфера.
+
+Деякі буфери не відповідають файлам. Буфер *Buffer List* («Перелік
+буферів»), який показує створені за допомогою C-x C-b буфери, не має
+жодного файлу. Цей буфер TUTORIAL спершу не мав файлу, але тепер має,
+бо в попередньому розділі ви набрали C-x C-s і зберегли його до файлу.
+
+Буфер *Messages* також не відповідає жодному файлу. Цей буфер містить
+повідомлення, які з'являлись у нижньому рядку вашого сеансу Emacs.
+
+»» Наберіть C-x b *Messages* <Return>, щоб переглянути буфер
+ повідомлень. Тоді наберіть C-x b TUTORIAL <Return>, щоб
+ повернутись до цього посібника.
+
+Якщо змінити текст одного файлу й знайти інший файл, то перший файл не
+буде збережено. Зміни залишаться всередині Emacs у буфері цього
+файлу. Створення чи редагування буфера другого файлу не впливає на
+буфер першого файлу. Це дуже корисно, але буфер першого файлу теж
+треба якось зберігати. Перемикатись на цей буфер, щоб зберегти його
+за допомогою C-x C-s, було б незручно. Тож маємо
+
+ C-x s (Save — зберегти.)
+ Зберегти певні буфери до їхніх файлів
+
+C-x s запитує вас про кожен буфер, який ви змінили й не зберегли, чи
+бажаєте ви його зберегти.
+
+»» Введіть рядок тексту й наберіть C-x s.
+ Маєте отримати запитання, чи бажаєте ви зберегти буфер TUTORIAL.
+ Погодьтесь, набравши у відповідь «y».
+
+
+* РОЗШИРЕННЯ НАБОРУ КОМАНД
+--------------------------
+
+Команд Emacs значно більше, ніж можливо розкласти по всіх Control- і
+Meta-символах. Emacs обходить це за допомогою команди x (extend —
+розширити). Вона має два різновиди:
+
+ C-x Запитує один символ.
+ M-x Запитує англійську назву команди.
+
+Ці команди дуже корисні, проте використовуються менш часто, ніж ті
+команди, які ви вже опанували. Деякі з цих команд ви вже бачили,
+наприклад файлові команди C-x C-f для знаходження й C-x C-s для
+збереження. Ще один приклад — команда завершення сеансу Emacs: C-x
+C-c пропонує зберегти кожен змінений файл, перш ніж зупинити Emacs.
+
+Якщо ви користуєтесь графічним середовищем, вам не потрібні жодні
+додаткові команди для переходу від Emacs до іншого застосунку. Можете
+переходити мишею чи командами менеджера вікон. Але якщо ви
+користуєтесь текстовим терміналом, який може показувати лише один
+повноекранний застосунок, то вам потрібно «призупинити» Emacs, щоб
+перейти до іншого застосунку.
+
+Команда C-z виходить з Emacs *тимчасово* — тобто ви можете повернутись
+до цього ж сеансу Emacs згодом. Коли Emacs запущено в текстовому
+терміналі, C-z «призупиняє» Emacs, тобто повертає вас до оболонки, але
+не припиняє завдання Emacs. У найпоширеніших оболонках ви можете
+відновити Emacs командою «fg» або «%emacs».
+
+Використовувати C-x C-c слід перед виходом із системи. Ще цією
+командою слід закривати той Emacs, який ви запустили для швидкого
+редагування, наприклад за допомогою знаряддя обробки пошти.
+
+Команд C-x чимало. Ось перелік тих, які ви вже опанували:
+
+ C-x C-f (Find — знайти.) Знайти файл.
+ C-x C-s (Save — зберегти.) Зберегти буфер до файлу.
+ C-x s Зберегти певні буфери до їхніх файлів.
+ C-x C-b (Buffer — буфер.) Перелічити буфери.
+ C-x b Перемкнути буфер.
+ C-x C-c (Close — закрити.) Вийти з Emacs.
+ C-x 1 Видалити всі вікна, крім одного.
+ C-x u (Undo — скасувати.) Скасувати останню дію.
+
+Розширені команди, які використовуються менш часто чи лише в певних
+режимах, мають довші англійські назви. Наприклад, команда
+replace-string («замінити рядок») змінює в буфері один рядок на інший.
+Коли ви набираєте M-x, Emacs показує внизу екрана запит M-x, у
+відповідь на який вам слід набрати назву команди — «replace-string» у
+цьому випадку. Просто наберіть «repl s<TAB>» — і Emacs допише назву
+команди. (<TAB> — це клавіша Tab, яку зазвичай розміщено над клавішею
+Caps Lock чи Shift ліворуч на клавіатурі.) Підтвердьте назву команди
+клавішею <Return>.
+
+Команда replace-string потребує двох аргументів: рядка, який слід
+замінити, й рядка, яким ви його замінюєте. Введення кожного аргументу
+потрібно завершити клавішею <Return>.
+
+»» Посуньте курсор до порожнього рядка двома рядки нижче, ніж цей.
+ Тоді наберіть M-x repl s<Return>змінено<Return>перетворено<Return>.
+
+ Зверніть увагу на те, як зміниться цей рядок: ви заміните слово
+ «змінено» на слово «перетворено» в усіх місцях після курсора, де
+ воно зустрічається.
+
+
+* САМОЗБЕРЕЖЕННЯ
+----------------
+
+Коли ви змінюєте файл, але не зберігаєте змін, то ці зміни може бути
+втрачено, якщо комп'ютер зазнає збою. Emacs захищає вас від цього
+періодичним записом файлів «самозбереження» для кожного редагованого
+файлу. Назва файлу самозбереження починається й закінчується символом
+#, тобто якщо ваш файл називається «hello.c», його файл самозбереження
+називатиметься «#hello.c#». Коли ви зберігаєте файл звичним шляхом,
+Emacs видаляє відповідний файл самозбереження.
+
+Після збою комп'ютера ви можете відновити самозбережені правки,
+знайшовши файл як зазвичай (редагований файл, не файл самозбереження)
+й набравши M-x recover-this-file <Return>. (Команда перекладається як
+«відновити цей файл».) У відповідь на запит підтвердження, наберіть
+yes<Return>, щоб погодитись і відновити дані самозбереження.
+
+
+* ВІДЛУННЯ
+----------
+
+Коли Emacs помічає, що ви поволі набираєте багатосимвольну команду,
+він показує вам набрану частину команди внизу екрана в області, яку
+називають echo — відлунням. Ця область покриває нижній рядок екрана.
+
+
+* РЯДОК РЕЖИМУ
+--------------
+
+Рядок прямо над областю відлуння називають «рядком режиму». В рядку
+режиму має виводитись щось таке:
+
+ -:**- TUTORIAL 63% L749 (Fundamental)
+
+Цей рядок надає корисні дані про стан Emacs і редагованого тексту.
+
+Ви вже знаєте, що значить TUTORIAL: це назва того файлу, який ви
+знайшли раніше. ЧЧ% повідомляє, в якій частині буфера тексту ви
+перебуваєте; це означає, що ЧЧ відсотків буфера зараз над екраном.
+Якщо верх буфера видно на екрані, то замість «0%» буде «Top» — «Верх».
+Якщо низ буфера видно на екрані, то буде показано «Bot» — «Низ».
+Якщо ви читаєте такий маленький буфер, що весь його вміст видно на
+одному екрані, то в рядку режиму буде «All» — «Усе».
+
+Літера L (line — рядок) і цифри показують інший аспект вашого
+місцеперебування — номер рядка поточної точки.
+
+Зірки спереду вказують, що ви змінили текст. Коли файл тільки
+відкрито чи збережено, ця частина рядка режиму показує лише дефіси,
+без зірок.
+
+Частина рядка режиму всередині дужок вказує, які режими редагування
+наразі чинні. Типовий режим — це Fundamental («основний»); саме ним
+ви зараз користуєтесь. Це один із «вищих» режимів.
+
+Emacs має чимало різних вищих режимів. Деякі з них призначені для
+редагування різних мов і/або видів тексту, зокрема режим Lisp (для
+мови програмування Лісп), режим Text (для тексту) тощо. В певну мить
+активним може бути один і тільки один вищий режим, і його назву завжди
+можна знайти в рядку режиму — там, де зараз ви бачите Fundamental.
+
+Кожен вищий режим змінює поведінку декількох команд. Наприклад, є
+команди для створення коментарів у програмі, й оскільки кожна мова
+програмування по-своєму визначає вигляд коментарів, то й кожен вищий
+режим має вставляти коментарі по-своєму. Кожен вищий режим є назвою
+тої команди розширення, якою ви його вмикаєте. Наприклад, командою
+M-x fundamental-mode ви вмикаєте основний режим.
+
+Для редагування тексту мовами людського спілкування, такими як цей
+файл, ви зазвичай використовуватимете режим Text.
+
+»» Наберіть M-x text-mode <Return>.
+
+Не переймайтесь, жодні з уже відомих вам команд Emacs не стануть
+поводитись геть інакше. Проте ви можете помітити, що M-f і M-b тепер
+обробляють апострофи як частини слів. Досі, в режимі Fundamental, M-f
+і M-b обробляли апострофи як пунктуацію.
+
+Вищі режими зазвичай вносять саме такі невеличкі зміни: більшість
+команд продовжують виконувати звичні завдання — з деякими
+відмінностями в деталях.
+
+Щоб переглянути документацію про поточний вищий режим, наберіть C-h m.
+
+»» Посуньте курсор до рядка, наступного після цього.
+»» Наберіть C-l C-l, щоб посунути цей рядок угору екрана.
+»» Наберіть C-h m, щоб побачити різницю режимів Text і Fundamental.
+»» Наберіть C-x 1, щоб вилучити документацію з екрана.
+
+Вищі режими називаються вищими, тому що бувають і нижчі режими. Нижчі
+режими не заміщають вищих режимів, а трошки їх змінюють. Кожен нижчий
+режим можна ввімкнути чи вимкнути окремо, незалежно від усіх інших
+нижчих режимів — і незалежно від вашого вищого режиму. Тож ви можете
+не використовувати нижчих режимів зовсім, або використовувати єдиний
+нижчий режим, або поєднувати декілька нижчих режимів.
+
+Один із дуже корисних нижчих режимів, особливо для редагування тексту
+мовами людського спілкування, — це режим Auto Fill (самозаповнення).
+Коли цей режим увімкнено, Emacs автоматично вставляє символ нового
+рядка між словами, коли при введенні тексту певний рядок виявляється
+занадто широким.
+
+Режим самозаповнення вмикається командою M-x auto-fill-mode <Return>.
+Коли режим увімкнено, можете вимкнути його знову тою ж командою. Якщо
+режим вимкнено, команда його вмикає; а коли режим увімкнено, команда
+його вимикає. Можна сказати, що команда «перемикає режим».
+
+»» Наберіть M-x auto-fill-mode <Return>. Тоді набирайте «йцук » знов
+ і знов, доки рядок не поділиться на два. Пробіли слід набирати,
+ оскільки самозаповнення розбиває рядки тільки на пробілах.
+
+Поле зазвичай починається після 70 символів, але можете змінити це
+командою C-x f. Передайте бажане значення поля числовим аргументом
+цій команді.
+
+»» Наберіть C-x f із аргументом 20. (C-u 2 0 C-x f).
+ Тоді наберіть будь-який текст і зверніть увагу, яким чином Emacs
+ поділить його на 20-символьні рядки. Тоді поверніть полю значення
+ 70 за допомогою ще одної команди C-x f.
+
+Якщо ви зміните щось посеред абзацу, режим самозаповнення не ділитиме
+абзацу на рядки заново без вашого дозволу.
+Щоб поділити абзац заново (замінюючи наявні символи нового рядка),
+посуньте курсор до цього абзацу й наберіть M-q (META-q).
+
+»» Посуньте курсор до попереднього абзацу й наберіть M-q.
+
+
+* ПОШУК
+-------
+
+Emacs уміє шукати рядки (групи послідовних символів) в тексті як після
+курсора, так і перед ним. Пошук рядка є командою руху курсора, тобто
+посуває курсор до наступного місця, де з'являється цей рядок.
+
+Команда пошуку Emacs є покроковою. Тобто пошук відбувається прямо при
+набранні рядка, який ви бажаєте шукати.
+
+Пошук уперед розпочинає команда C-s (search — пошук), а пошук назад —
+команда C-r (reverse — навпаки). АЛЕ ЗАЧЕКАЙТЕ! Не поспішайте
+випробовувати ці команди.
+
+Набравши C-s, ви помітите, що область відлуння покаже рядок
+«I-search». Це означатиме, що Emacs перейшов до режиму incremental
+search — покрокового пошуку — й очікує, поки ви наберете, що бажаєте
+шукати. <Return> завершує пошук.
+
+»» Тепер наберіть C-s, щоб розпочати пошук. ПОВОЛІ, літера за
+ літерою, наберіть слово «курсор», зупиняючись після кожного символу
+ й звертаючи увагу на те, що відбувається з курсором. Отже, ви
+ щойно пошукали «курсор» один раз.
+»» Наберіть C-s іще раз — знайдіть наступну послідовність «курсор».
+»» Тепер наберіть <DEL> чотири рази й зауважте, куди зсунеться курсор.
+»» Наберіть <Return>, щоб завершити пошук.
+
+Щойно ви спостерігали, як покроковий пошук Emacs намагається перейти
+до послідовності, збіжної з набраним вами рядком. Щоб перейти до
+наступної послідовності «курсор», наберіть C-s іще раз. Якщо такої
+послідовності не існує, Emacs сигналить і повідомляє, що пошук наразі
+«failing» — неуспішний. C-g завершує пошук у будь-якому разі.
+
+Якщо під час покрокового пошуку набрати <DEL», пошук «повертається» до
+попередньої точки. Якщо набрати <DEL> одразу після C-s — переходу до
+наступного збігу з шуканим рядком — то <DEL> поверне курсор до
+попереднього збігу. Якщо збігів перед курсором нема, <DEL> зітре
+останній символ рядка пошуку. Наприклад, наберіть «к», щоб пошукати
+перший збіг із «к». Тоді наберіть «у» — це посуне курсор до першого
+збігу з «ку». Нарешті наберіть <DEL> — це зітре «у» з рядка пошуку,
+тож курсор повернеться до першого збігу з «к».
+
+Якщо посеред пошуку ви набираєте Control- чи Meta-символ (за винятком
+символів власне пошуку, як-от C-s чи C-r), пошук припиняється.
+
+C-s розпочинає пошук будь-якого збігу з шуканим рядком ПІСЛЯ того
+місця, де курсор зараз. Якщо бажаєте пошукати щось у більш ранньому
+тексті, наберіть натомість C-r. Усе, що ми зазначили про C-s,
+стосується й C-r, — крім напряму пошуку, який стає зворотним.
+
+
+* ДЕКІЛЬКА ВІКОН
+----------------
+
+Emacs має ту файну властивість, що ви можете переглядати водночас
+декілька вікон на одному екрані. (Зауважте, що Emacs використовує
+роз'яснений у наступному розділі термін «рамка», або frame, замість
+вжитого в деяких інших застосунках терміна «вікно».) Підручник Emacs
+містить глосарій термінів Emacs.
+
+»» Посуньте курсор до цього рядка й наберіть C-l C-l.
+
+»» Наберіть C-x 2 — розділіть екран на два вікна. Обидва вікна
+ показуватимуть цей посібник. Курсор редагування залишатиметься в
+ горішньому вікні.
+
+»» Наберіть C-M-v — перегорніть нижнє вікно.
+ (Якщо не маєте клавіші META, наберіть <ESC> C-v.)
+
+»» Наберіть C-x o (other — інше), щоб посунути курсор до нижнього
+ вікна. Погортайте нижнє вікно за допомогою C-v та M-v. Читайте ці
+ вказівки далі в горішньому вікні.
+
+»» Наберіть C-x o ще раз, щоб посунути курсор назад до горішнього
+ вікна. Курсор у горішньому вікні опиниться там же, де був досі.
+
+Можете й надалі перемикатись між вікнами за допомогою C-x o. «Обране»
+вікно, в якому переважно відбувається редагування, — це те вікно, в
+якому ви бачите помітний курсор, який блимає, коли ви нічого не
+набираєте. Кожне вікно має власну точку, на яку вказує його курсор;
+якщо ви запускаєте Emacs у графічному середовищі, ці курсори не
+блимають і мають вигляд порожніх коробок.
+
+Команда C-M-v дуже корисна, коли ви редагуєте текст в одному вікні й
+використовуєте інше вікно лише як довідку. Не виходячи з обраного
+вікна, ви можете гортати текст в іншому вікні за допомогою C-M-v.
+
+C-M-v — це один із CONTROL-META-символів. Якщо ви маєте клавішу META
+(чи Alt), то можете набрати C-M-v, затиснувши водночас клавіші CONTROL
+та META й натиснувши v. Неважливо, яку з клавіш CONTROL і META ви
+затиснете першою, бо ці клавіші не діють самостійно, а змінюють
+символи, які ви набираєте.
+
+Якщо у вас нема клавіші META, можете використати натомість <ESC>, але
+тоді порядок таки важливий: наберіть спершу <ESC>, а тоді CONTROL-v.
+CONTROL-<ESC> v не спрацює, бо <ESC> не змінює інші символи, а є
+повноцінною клавішею.
+
+»» Наберіть C-x 1 (у горішньому вікні), щоб позбутись нижнього вікна.
+
+(Якби ви набрали C-x 1 у нижньому вікні, то позбулися б горішнього
+вікна. Уявляйте цю команду як «Залишити лише одне вікно — те, в якому
+я зараз».)
+
+Показувати один і той самий буфер в обох вікнах необов'язково. Якщо в
+одному вікні ви наберете C-x C-f і знайдете файл, то на інше вікно це
+не вплине. Можете знаходити файли в обох вікнах незалежно.
+
+Ось ще один шлях застосування двох вікон для показу двох різних речей:
+
+»» Наберіть C-x 4 C-f та назву одного зі своїх файлів. Завершіть за
+ допомогою <Return>. Зазначений файл з'явиться в нижньому вікні.
+ Курсор також туди посунеться.
+
+»» Наберіть C-x o, щоб перейти до горішнього вікна,
+ й C-x 1, щоб видалити нижнє вікно.
+
+
+* ДЕКІЛЬКА РАМОК
+----------------
+
+Emacs також дає змогу створити декілька «рамок» (frames). Рамкою
+називають будь-яку добірку вікон разом із її меню, панелями гортання,
+областю відлуння тощо. У графічних середовищах Emacs називає рамкою
+те, що багато інших застосунків називають «вікном». Екран може
+показувати декілька графічних рамок водночас. На текстовому терміналі
+може бути видно лише одну рамку.
+
+»» Наберіть C-x 5 2.
+ На вашому екрані з'явиться нова рамка.
+
+У новій рамці ви можете робити все те, що й у початковій рамці.
+Початкова рамка не є чимось особливим.
+
+»» Наберіть C-x 5 0.
+ Це вилучить обрану рамку.
+
+Вилучити рамку можна й тим звичним шляхом, який передбачає графічне
+середовище (зазвичай це кнопка «X» в одному з горішніх кутів рамки).
+Якщо вилучити таким чином останню рамку сеансу Emacs, увесь Emacs буде
+припинено.
+
+
+* РІВНІ РЕКУРСІЇ РЕДАГУВАННЯ
+----------------------------
+
+Інколи ви потраплятимете в так званий «рівень рекурсії редагування».
+Його позначають квадратні дужки в рядку режиму навколо круглих дужок
+назви вищого режиму. Наприклад, ви можете бачити [(Fundamental)]
+замість (Fundamental).
+
+Щоб вийти з рівня рекурсії редагування, наберіть <ESC> <ESC> <ESC>.
+Це всеохопна команда виходу. Можете використовувати її й для закриття
+зайвих вікон чи виходу з мінібуфера.
+
+»» Наберіть M-x, щоб потрапити до мінібуфера.
+ Тоді наберіть <ESC> <ESC> <ESC>, щоб із нього вийти.
+
+Вийти з рівня рекурсії редагування за допомогою C-g неможливо, бо C-g
+використовується для скасування команд і аргументів УСЕРЕДИНІ рівня
+рекурсії редагування.
+
+
+* ОТРИМАТИ БІЛЬШЕ ДОВІДКИ
+-------------------------
+
+Цей посібник намагається надати необхідний для початку роботи з Emacs
+мінімум даних. Emacs уміє стільки всього, що одним посібником описати
+всі його функції було б неможливо. Проте вам буде цікаво дізнатись
+більше про Emacs та його корисні функції. Emacs надає команди для
+читання документації про команди Emacs. Усі команди довідки (help)
+починаються з CONTROL-h — символу довідки.
+
+Для отримання довідки наберіть символ C-h, а тоді той символ, довідку
+якого бажаєте прочитати. Якщо ви СПРАВДІ загубились, C-h ? попрохає
+Emacs перелічити розділи довідки. Якщо ви набрали C-h і передумали
+читати довідку, натисніть C-g для скасування.
+
+(Якщо C-h не показує довідкового повідомлення внизу екрана, спробуйте
+набрати клавішу F1 чи M-x help <Return> натомість.)
+
+Основна функція довідки — це C-h c. Наберіть C-h, символ c, а також
+символ чи послідовність команди; тоді Emacs покаже коротенький
+англійський опис цієї команди.
+
+»» Наберіть C-h c C-p.
+
+Має з'явитись повідомлення на кшталт:
+
+ C-p runs the command previous-line
+
+Тобто «C-p виконує команду previous-line (попередній рядок)». Це
+повідомляє вам назву функції. Оскільки назви функцій добираються
+таким чином, щоб зображати дії, виконувані відповідною командою,
+вони можуть слугувати коротенькою документацією — достатньою, щоб
+нагадати вам команди, які ви вже опанували.
+
+Багатосимвольні команди, такі як C-x C-s чи <ESC>v (замість M-v, якщо
+не маєте клавіш META й ALT), також можна зазначати після C-h c.
+
+Щоб дізнатися більше про команду, зокрема про клавіші, які можна
+набирати після неї, використайте C-h k (keys — клавіші) замість C-h c
+(command — команда).
+
+»» Наберіть C-h k C-p.
+
+Це покаже у вікні Emacs документацію функції та її назву. Дочитавши
+показане, наберіть C-x 1, щоб позбутись того вікна. Робити це одразу
+необов'язково. Можете продовжити редагування, звіряючись із текстом
+довідки, й набрати C-x 1 лише згодом.
+
+Ось кілька інших корисних варіантів C-h:
+
+ C-h x Описати команду. Вам буде треба набрати назву команди.
+
+»» Спробуйте набрати C-h x previous-line <Return>.
+ Це покаже всі наявні в Emacs дані про ту функцію,
+ яка втілює команду C-p.
+
+Схожа команда C-h v показує документацію змінних — зокрема тих,
+значення яких ви можете змінити для налаштування поведінки Emacs.
+Наберіть назву змінної, коли Emacs її у вас запитає.
+
+ C-h a (Apropos — пов'язане.) Наберіть ключове слово — й
+ Emacs покаже всі команди, назви яких містять це слово.
+ Всі ці команди можна викликати за допомогою META-x.
+ Для деяких команд Apropos наводить також символи чи
+ послідовності, які виконують цю ж команду.
+
+»» Наберіть C-h a file <Return>.
+
+Це покаже в ще одному вікні перелік усіх команд M-x, назви яких
+містять «file» — файл. Поруч із назвами команд ви побачите відповідні
+їм символи (як-от C-x C-f поруч із find-file — знайти файл).
+
+»» Наберіть C-M-v, щоб прогорнути вікно довідки.
+ Повторіть це декілька разів.
+
+»» Наберіть C-x 1, щоб видалити вікно довідки.
+
+ C-h i (Info — дані.) Читати вкладені підручники. Ця команда
+ веде вас до особливого буфера *info*, в якому ви можете
+ читати підручники про встановлені у вашій системі пакунки.
+ Наберіть m emacs <Return>, щоб почитати підручник Emacs.
+ Якщо ви досі не користувались Info, наберіть h — і Emacs
+ запустить для вас путівник можливостями режиму Info.
+ Опрацювавши цей посібник, звертайтесь до Info-підручника
+ Emacs як до основної документації.
+
+
+* БІЛЬШЕ ФУНКЦІЙ
+----------------
+
+Щоб дізнатись більше про Emacs, почитайте його підручник усередині
+Emacs, скориставшись меню Help (Довідка) чи набравши C-h r. Дві
+функції, які можуть вас особливо зацікавити, це Completion —
+доповнення, яке заощаджує натиски клавіш; і Dired — редагування
+каталогів, яке спрощує керування файлами.
+
+Доповнення дає змогу набирати менше тексту. Наприклад, щоб
+перемкнутись на буфер *Messages*, можете набрати C-x b *M<Tab> — і
+Emacs заповнить решту назви буфера настільки, наскільки зможе вивести
+з уже набраного вами тексту. Доповнення також працює з назвами команд
+і файлів. Підручник Emacs описує доповнення в розділі «Completion».
+
+Dired дає змогу перелічувати файли в каталозі (а на вимогу ще й у
+підкаталогах), рухатися цим переліком, відкривати, перейменовувати й
+видаляти файли тощо. Підручник Emacs описує керування файлами в
+розділі «Dired».
+
+Підручник також описує безліч інших функцій Emacs.
+
+
+* ВСТАНОВЛЕННЯ ПАКУНКІВ
+-----------------------
+
+Спільнотою Emacs розроблено величезну добірку пакунків, які роблять
+Emacs потужнішим. Ці пакунки містять підтримку нових мов, теми
+оформлення, додатки для взаємодії з іншими застосунками — й ще
+багато-багато всього.
+
+Щоб переглянути перелік усіх доступних пакунків, наберіть M-x
+list-packages. З'явиться екран, за допомогою якого ви можете
+встановлювати й видаляти пакунки, а також читати описи пакунків.
+Підручник Emacs розповідає про керування пакунками докладніше.
+
+
+* ОТОЖ
+------
+
+Щоб вийти з Emacs, наберіть C-x C-c.
+
+Посібник має на меті бути зрозумілим усім новим користувачкам і
+користувачам, тож якщо будь-що роз'яснено нечітко чи помилково —
+скаржтесь! Український переклад: Денис Никула <vegan@libre.net.ua>.
+
+
+* КОПІЮВАННЯ
+------------
+
+Цей посібник — нащадок цілого родоводу посібників Emacs, починаючи з
+первісного посібника Emacs, який написав Стюарт Кракрафт.
+
+Ця версія посібника — складник GNU Emacs. Її захищено авторським
+правом. Розповсюджувати копії дозволено за певних умов:
+
+ Copyright (C) 1985, 1996, 1998, 2001-2022 Free Software Foundation,
+ Inc. (Фонд вільного програмного забезпечення, Inc.)
+
+ Цей файл — складник GNU Emacs.
+
+ GNU Emacs — вільне програмне забезпечення: можете розповсюджувати
+ й/або змінювати його згідно з умовами Загальної громадської ліцензії
+ GNU в тому вигляді, в якому її публікує Фонд вільного програмного
+ забезпечення, — версії 3 чи (на ваш розсуд) будь-якої новішої.
+
+ GNU Emacs поширюється зі сподіванням, що він стане в нагоді, але БЕЗ
+ ЖОДНИХ ГАРАНТІЙ; без навіть уявної гарантії КОМЕРЦІЙНОЇ ПРИДАТНОСТІ
+ чи ВІДПОВІДНОСТІ БУДЬ-ЯКОМУ ПЕВНОМУ ЗАСТОСУВАННЮ. Докладніше про це
+ йдеться в Загальній громадській ліцензії GNU.
+
+ Ви мали отримати копію Загальної громадської ліцензії GNU разом із
+ GNU Emacs. Якщо ні, перегляньте <https://www.gnu.org/licenses/>.
+
+Будь ласка, прочитайте файл COPYING і поширте після цього копії
+GNU Emacs вашим подругам і друзям. Зупинімо гальмування розвитку
+програмного забезпечення (так звану «власність» над ним),
+використовуючи, пишучи й поширюючи вільні програми!
diff --git a/leim/Makefile.in b/leim/Makefile.in
index 29b9f3b2f8..fbd733b7f6 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -128,7 +128,6 @@ leim-list.el: ${leimdir}/leim-list.el
${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC}
$(AM_V_GEN)rm -f $@
$(AM_V_at)${RUN_EMACS} -l international/quail \
- --eval "(setq max-specpdl-size 5000)" \
--eval "(update-leim-list-file (unmsys--file-name \"${leimdir}\"))"
$(AM_V_at)sed -n -e '/^[^;]/p' -e 's/^;\(;*\)inc /;\1 /p' < $< >> $@
@@ -139,7 +138,6 @@ ${leimdir}/ja-dic/ja-dic.el: | $(leimdir)/ja-dic
generate-ja-dic: ${leimdir}/ja-dic/ja-dic.el
${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L
$(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \
- --eval "(setq max-specpdl-size 5000)" \
-f batch-skkdic-convert -dir "$(leimdir)/ja-dic"
$(JA_DIC_NO_REDUCTION_OPTION) "$<"
${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index cf4659fc2c..cfad3fc394 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -306,8 +306,8 @@ $(DESTDIR)${archlibdir}: all
$(info $ )
$(info Installing utilities run internally by Emacs.)
umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}"
- exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && /bin/pwd` && \
- if [ "$$exp_archlibdir" != "`/bin/pwd`" ]; then \
+ exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \
+ if [ "$$exp_archlibdir" != "`pwd -P`" ]; then \
for file in ${UTILITIES}; do \
$(INSTALL_PROGRAM) $(INSTALL_STRIP) $$file \
"$(DESTDIR)${archlibdir}/$$file" || exit; \
@@ -333,8 +333,8 @@ $(DESTDIR)${archlibdir}: all
chmod u=rwx,g=rwx,o=rx "$(DESTDIR)${gamedir}"
endif
endif
- exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && /bin/pwd` && \
- if [ "$$exp_archlibdir" != "`cd ${srcdir} && /bin/pwd`" ]; then \
+ exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \
+ if [ "$$exp_archlibdir" != "`cd ${srcdir} && pwd -P`" ]; then \
for file in ${SCRIPTS}; do \
$(INSTALL_SCRIPT) ${srcdir}/$$file \
"$(DESTDIR)${archlibdir}/$$file" || exit; \
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 73c8e45a86..425db8cfac 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1,6 +1,6 @@
/* Client process that communicates with GNU Emacs acting as server.
-Copyright (C) 1986-1987, 1994, 1999-2022 Free Software Foundation, Inc.
+Copyright (C) 1986-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -66,6 +66,8 @@ char *w32_getenv (const char *);
#endif /* !WINDOWSNT */
+#define DEFAULT_TIMEOUT (30)
+
#include <ctype.h>
#include <errno.h>
#include <getopt.h>
@@ -144,6 +146,9 @@ static char const *socket_name;
/* If non-NULL, the filename of the authentication file. */
static char const *server_file;
+/* Seconds to wait before timing out (0 means wait forever). */
+static uintmax_t timeout;
+
/* If non-NULL, the tramp prefix emacs must use to find the files. */
static char const *tramp_prefix;
@@ -178,6 +183,7 @@ static struct option const longopts[] =
{ "server-file", required_argument, NULL, 'f' },
{ "display", required_argument, NULL, 'd' },
{ "parent-id", required_argument, NULL, 'p' },
+ { "timeout", required_argument, NULL, 'w' },
{ "tramp", required_argument, NULL, 'T' },
{ 0, 0, 0, 0 }
};
@@ -185,7 +191,7 @@ static struct option const longopts[] =
/* Short options, in the same order as the corresponding long options.
There is no '-p' short option. */
static char const shortopts[] =
- "nqueHVtca:F:"
+ "nqueHVtca:F:w:"
#ifdef SOCKETS_IN_FILE_SYSTEM
"s:"
#endif
@@ -497,6 +503,7 @@ decode_options (int argc, char **argv)
if (opt < 0)
break;
+ char* endptr;
switch (opt)
{
case 0:
@@ -530,6 +537,17 @@ decode_options (int argc, char **argv)
nowait = true;
break;
+ case 'w':
+ timeout = strtoumax (optarg, &endptr, 10);
+ if (timeout <= 0 ||
+ ((timeout == INTMAX_MAX || timeout == INTMAX_MIN)
+ && errno == ERANGE))
+ {
+ fprintf (stderr, "Invalid timeout: \"%s\"\n", optarg);
+ exit (EXIT_FAILURE);
+ }
+ break;
+
case 'e':
eval = true;
break;
@@ -671,6 +689,7 @@ The following OPTIONS are accepted:\n\
Set the parameters of a new frame\n\
-e, --eval Evaluate the FILE arguments as ELisp expressions\n\
-n, --no-wait Don't wait for the server to return\n\
+-w, --timeout Seconds to wait before timing out\n\
-q, --quiet Don't display messages on success\n\
-u, --suppress-output Don't display return values from the server\n\
-d DISPLAY, --display=DISPLAY\n\
@@ -1059,7 +1078,9 @@ set_tcp_socket (const char *local_server_file)
/* The cast to 'const char *' is to avoid a compiler warning when
compiling for MS-Windows sockets. */
- setsockopt (s, SOL_SOCKET, SO_LINGER, (const char *) &l_arg, sizeof l_arg);
+ int ret = setsockopt (s, SOL_SOCKET, SO_LINGER, (const char *) &l_arg,
sizeof l_arg);
+ if (ret < 0)
+ sock_err_message ("setsockopt");
/* Send the authentication. */
auth_string[AUTH_KEY_LENGTH] = '\0';
@@ -1870,6 +1891,43 @@ start_daemon_and_retry_set_socket (void)
return emacs_socket;
}
+static void
+set_socket_timeout (HSOCKET socket, int seconds)
+{
+ int ret;
+
+#ifndef WINDOWSNT
+ struct timeval timeout;
+ timeout.tv_sec = seconds;
+ timeout.tv_usec = 0;
+ ret = setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, &timeout, sizeof timeout);
+#else
+ DWORD timeout;
+
+ if (seconds > INT_MAX / 1000)
+ timeout = INT_MAX;
+ else
+ timeout = seconds * 1000;
+ ret = setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, (char *) &timeout, sizeof
timeout);
+#endif
+
+ if (ret < 0)
+ sock_err_message ("setsockopt");
+}
+
+static bool
+check_socket_timeout (int rl)
+{
+#ifndef WINDOWSNT
+ return (rl == -1)
+ && (errno == EAGAIN)
+ && (errno == EWOULDBLOCK);
+#else
+ return (rl == SOCKET_ERROR)
+ && (WSAGetLastError() == WSAETIMEDOUT);
+#endif
+}
+
int
main (int argc, char **argv)
{
@@ -2086,19 +2144,40 @@ main (int argc, char **argv)
}
fflush (stdout);
+ set_socket_timeout (emacs_socket, timeout > 0 ? timeout : DEFAULT_TIMEOUT);
+ bool saw_response = false;
/* Now, wait for an answer and print any messages. */
while (exit_status == EXIT_SUCCESS)
{
+ bool retry = true;
+ bool msg_showed = quiet;
do
{
act_on_signals (emacs_socket);
rl = recv (emacs_socket, string, BUFSIZ, 0);
+ retry = check_socket_timeout (rl);
+ if (retry && !saw_response)
+ {
+ if (timeout > 0)
+ {
+ /* Don't retry if we were given a --timeout flag. */
+ fprintf (stderr, "\nServer not responding; timed out after
%ju seconds",
+ timeout);
+ retry = false;
+ }
+ else if (!msg_showed)
+ {
+ msg_showed = true;
+ fprintf (stderr, "\nServer not responding; use Ctrl+C to
break");
+ }
+ }
}
- while (rl < 0 && errno == EINTR);
+ while ((rl < 0 && errno == EINTR) || retry);
if (rl <= 0)
break;
+ saw_response = true;
string[rl] = '\0';
/* Loop over all NL-terminated messages. */
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 9f0de7d64f..7e54b878a2 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -39,7 +39,6 @@ variants of those files that can be used to sandbox Emacs
before
#include <errno.h>
#include <limits.h>
#include <stdarg.h>
-#include <stdbool.h>
#include <stdlib.h>
#include <stdint.h>
#include <stdio.h>
@@ -60,7 +59,6 @@ variants of those files that can be used to sandbox Emacs
before
#include <unistd.h>
#include <attribute.h>
-#include <verify.h>
#ifndef ARCH_CET_STATUS
#define ARCH_CET_STATUS 0x3001
@@ -71,19 +69,16 @@ fail (int error, const char *format, ...)
{
va_list ap;
va_start (ap, format);
+ vfprintf (stderr, format, ap);
+ va_end (ap);
if (error == 0)
- {
- vfprintf (stderr, format, ap);
- fputc ('\n', stderr);
- }
+ fputc ('\n', stderr);
else
{
- char buffer[1000];
- vsnprintf (buffer, sizeof buffer, format, ap);
+ fputs (": ", stderr);
errno = error;
- perror (buffer);
+ perror (NULL);
}
- va_end (ap);
fflush (NULL);
exit (EXIT_FAILURE);
}
@@ -168,12 +163,12 @@ main (int argc, char **argv)
set_attribute (SCMP_FLTATR_CTL_NNP, 1);
set_attribute (SCMP_FLTATR_CTL_TSYNC, 1);
- verify (CHAR_BIT == 8);
- verify (sizeof (int) == 4 && INT_MIN == INT32_MIN
- && INT_MAX == INT32_MAX);
- verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN
- && LONG_MAX == INT64_MAX);
- verify (sizeof (void *) == 8);
+ static_assert (CHAR_BIT == 8);
+ static_assert (sizeof (int) == 4 && INT_MIN == INT32_MIN
+ && INT_MAX == INT32_MAX);
+ static_assert (sizeof (long) == 8 && LONG_MIN == INT64_MIN
+ && LONG_MAX == INT64_MAX);
+ static_assert (sizeof (void *) == 8);
assert ((uintptr_t) NULL == 0);
/* Allow a clean exit. */
@@ -183,8 +178,8 @@ main (int argc, char **argv)
/* Allow `mmap' and friends. This is necessary for dynamic loading,
reading the portable dump file, and thread creation. We don't
allow pages to be both writable and executable. */
- verify (MAP_PRIVATE != 0);
- verify (MAP_SHARED != 0);
+ static_assert (MAP_PRIVATE != 0);
+ static_assert (MAP_SHARED != 0);
RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_WRITE)),
@@ -211,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));
@@ -223,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
@@ -256,9 +255,9 @@ main (int argc, char **argv)
/* Allow opening files, assuming they are only opened for
reading. */
- verify (O_WRONLY != 0);
- verify (O_RDWR != 0);
- verify (O_CREAT != 0);
+ static_assert (O_WRONLY != 0);
+ static_assert (O_RDWR != 0);
+ static_assert (O_CREAT != 0);
RULE (SCMP_ACT_ALLOW, SCMP_SYS (open),
SCMP_A1_32 (SCMP_CMP_MASKED_EQ,
~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
@@ -329,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/lib/acl-internal.h b/lib/acl-internal.h
index 93533762dd..94553fab25 100644
--- a/lib/acl-internal.h
+++ b/lib/acl-internal.h
@@ -19,7 +19,6 @@
#include "acl.h"
-#include <stdbool.h>
#include <stdlib.h>
/* All systems define the ACL related API in <sys/acl.h>. */
diff --git a/lib/acl.h b/lib/acl.h
index f4d0df8061..0be6ef1cea 100644
--- a/lib/acl.h
+++ b/lib/acl.h
@@ -20,7 +20,6 @@
#ifndef _GL_ACL_H
#define _GL_ACL_H 1
-#include <stdbool.h>
#include <sys/types.h>
#include <sys/stat.h>
diff --git a/lib/assert.in.h b/lib/assert.in.h
new file mode 100644
index 0000000000..2c358ba62e
--- /dev/null
+++ b/lib/assert.in.h
@@ -0,0 +1,27 @@
+/* Substitute for and wrapper around <assert.h>
+ Copyright (C) 2011-2022 Free Software Foundation, Inc.
+
+ This file is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Lesser General Public License as
+ published by the Free Software Foundation; either version 2.1 of the
+ License, or (at your option) any later version.
+
+ This file 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 Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Do not guard the include, since <assert.h> is supposed to define
+ the assert macro each time it is included. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#@INCLUDE_NEXT@ @NEXT_ASSERT_H@
+
+/* The definition of static_assert is copied here. */
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index 1a4f603898..1202ff8a36 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -23,8 +23,6 @@
#ifndef C_CTYPE_H
#define C_CTYPE_H
-#include <stdbool.h>
-
#ifndef _GL_INLINE_HEADER_BEGIN
#error "Please include config.h first."
#endif
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index a7fa7feb62..8c3d7f7cf8 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -30,7 +30,6 @@
#include <errno.h>
#include <fcntl.h>
#include <limits.h>
-#include <stdbool.h>
#include <string.h>
#include <sys/stat.h>
#include <unistd.h>
diff --git a/lib/cloexec.h b/lib/cloexec.h
index 7a22d77532..15d2d5efe2 100644
--- a/lib/cloexec.h
+++ b/lib/cloexec.h
@@ -15,8 +15,6 @@
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
-#include <stdbool.h>
-
/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true,
or clear the flag if VALUE is false.
Return 0 on success, or -1 on error with 'errno' set.
diff --git a/lib/close-stream.c b/lib/close-stream.c
index 9b0e97b271..0fdca79bf8 100644
--- a/lib/close-stream.c
+++ b/lib/close-stream.c
@@ -20,7 +20,6 @@
#include "close-stream.h"
#include <errno.h>
-#include <stdbool.h>
#include "fpending.h"
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
index 354641af0a..4b4f5d4f9a 100644
--- a/lib/count-leading-zeros.h
+++ b/lib/count-leading-zeros.h
@@ -43,13 +43,17 @@ extern "C" {
# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER
-# pragma intrinsic _BitScanReverse
-# pragma intrinsic _BitScanReverse64
+# pragma intrinsic (_BitScanReverse)
+# if defined _M_X64
+# pragma intrinsic (_BitScanReverse64)
+# endif
# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
do \
{ \
unsigned long result; \
- return MSC_BUILTIN (&result, x) ? result : CHAR_BIT * sizeof x; \
+ if (MSC_BUILTIN (&result, x)) \
+ return CHAR_BIT * sizeof x - 1 - result; \
+ return CHAR_BIT * sizeof x; \
} \
while (0)
#else
@@ -109,8 +113,18 @@ count_leading_zeros_l (unsigned long int x)
COUNT_LEADING_ZEROS_INLINE int
count_leading_zeros_ll (unsigned long long int x)
{
+#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64
+ /* 32-bit MSVC does not have _BitScanReverse64, only _BitScanReverse. */
+ unsigned long result;
+ if (_BitScanReverse (&result, (unsigned long) (x >> 32)))
+ return CHAR_BIT * sizeof x - 1 - 32 - result;
+ if (_BitScanReverse (&result, (unsigned long) x))
+ return CHAR_BIT * sizeof x - 1 - result;
+ return CHAR_BIT * sizeof x;
+#else
COUNT_LEADING_ZEROS (__builtin_clzll, _BitScanReverse64,
unsigned long long int);
+#endif
}
#ifdef __cplusplus
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
index 9a989a4324..61fbdf2980 100644
--- a/lib/count-trailing-zeros.h
+++ b/lib/count-trailing-zeros.h
@@ -43,8 +43,10 @@ extern "C" {
# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER
-# pragma intrinsic _BitScanForward
-# pragma intrinsic _BitScanForward64
+# pragma intrinsic (_BitScanForward)
+# if defined _M_X64
+# pragma intrinsic (_BitScanForward64)
+# endif
# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
do \
{ \
@@ -101,8 +103,18 @@ count_trailing_zeros_l (unsigned long int x)
COUNT_TRAILING_ZEROS_INLINE int
count_trailing_zeros_ll (unsigned long long int x)
{
+#if (defined _MSC_VER && !defined __clang__) && !defined _M_X64
+ /* 32-bit MSVC does not have _BitScanForward64, only _BitScanForward. */
+ unsigned long result;
+ if (_BitScanForward (&result, (unsigned long) x))
+ return result;
+ if (_BitScanForward (&result, (unsigned long) (x >> 32)))
+ return result + 32;
+ return CHAR_BIT * sizeof x;
+#else
COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64,
unsigned long long int);
+#endif
}
#ifdef __cplusplus
diff --git a/lib/diffseq.h b/lib/diffseq.h
index 0f76ea1d5a..a8b0e7bd40 100644
--- a/lib/diffseq.h
+++ b/lib/diffseq.h
@@ -70,7 +70,6 @@
Before including this file, you also need to include:
#include <limits.h>
- #include <stdbool.h>
#include "minmax.h"
*/
diff --git a/lib/filevercmp.c b/lib/filevercmp.c
index 7e54793e61..844505a6bf 100644
--- a/lib/filevercmp.c
+++ b/lib/filevercmp.c
@@ -20,11 +20,9 @@
#include <config.h>
#include "filevercmp.h"
-#include <stdbool.h>
#include <c-ctype.h>
#include <limits.h>
#include <idx.h>
-#include <verify.h>
/* Return the length of a prefix of S that corresponds to the suffix
defined by this extended regular expression in the C locale:
@@ -75,7 +73,7 @@ order (char const *s, idx_t pos, idx_t len)
return -2;
else
{
- verify (UCHAR_MAX <= (INT_MAX - 1 - 2) / 2);
+ static_assert (UCHAR_MAX <= (INT_MAX - 1 - 2) / 2);
return c + UCHAR_MAX + 1;
}
}
diff --git a/lib/fsusage.h b/lib/fsusage.h
index 0443d19f92..27085b7b41 100644
--- a/lib/fsusage.h
+++ b/lib/fsusage.h
@@ -22,7 +22,6 @@
# define FSUSAGE_H_
# include <stdint.h>
-# include <stdbool.h>
struct fs_usage
{
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index 37e8280867..1fddee97af 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -82,7 +82,6 @@
#include <stdlib.h>
#include <errno.h>
-#include <stdbool.h>
#include <stdio.h>
# include <sys/types.h>
diff --git a/lib/getrandom.c b/lib/getrandom.c
index e146873093..c05a48167e 100644
--- a/lib/getrandom.c
+++ b/lib/getrandom.c
@@ -23,7 +23,6 @@
#include <errno.h>
#include <fcntl.h>
-#include <stdbool.h>
#include <unistd.h>
#if defined _WIN32 && ! defined __CYGWIN__
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 5bb78740d6..04644bdabe 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -60,7 +60,6 @@
# --avoid=sigprocmask \
# --avoid=stat \
# --avoid=stdarg \
-# --avoid=stdbool \
# --avoid=threadlib \
# --avoid=tzset \
# --avoid=unsetenv \
@@ -147,6 +146,7 @@
# stat-time \
# std-gnu11 \
# stdalign \
+# stdbool \
# stddef \
# stdio \
# stpcpy \
@@ -180,6 +180,7 @@ AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
APPLE_UNIVERSAL_BUILD = @APPLE_UNIVERSAL_BUILD@
AR = @AR@
ARFLAGS = @ARFLAGS@
+ASSERT_H = @ASSERT_H@
AUTO_DEPEND = @AUTO_DEPEND@
AWK = @AWK@
BITSIZEOF_PTRDIFF_T = @BITSIZEOF_PTRDIFF_T@
@@ -307,6 +308,7 @@ GL_COND_OBJ_TIME_RZ_CONDITION =
@GL_COND_OBJ_TIME_RZ_CONDITION@
GL_COND_OBJ_TIME_R_CONDITION = @GL_COND_OBJ_TIME_R_CONDITION@
GL_COND_OBJ_UTIMENSAT_CONDITION = @GL_COND_OBJ_UTIMENSAT_CONDITION@
GL_GENERATE_ALLOCA_H_CONDITION = @GL_GENERATE_ALLOCA_H_CONDITION@
+GL_GENERATE_ASSERT_H_CONDITION = @GL_GENERATE_ASSERT_H_CONDITION@
GL_GENERATE_BYTESWAP_H_CONDITION = @GL_GENERATE_BYTESWAP_H_CONDITION@
GL_GENERATE_ERRNO_H_CONDITION = @GL_GENERATE_ERRNO_H_CONDITION@
GL_GENERATE_EXECINFO_H_CONDITION = @GL_GENERATE_EXECINFO_H_CONDITION@
@@ -951,6 +953,8 @@ MKDIR_P = @MKDIR_P@
MODULES_OBJ = @MODULES_OBJ@
MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@
MODULES_SUFFIX = @MODULES_SUFFIX@
+NEXT_ASSERT_H = @NEXT_ASSERT_H@
+NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@
NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@
NEXT_AS_FIRST_DIRECTIVE_ERRNO_H = @NEXT_AS_FIRST_DIRECTIVE_ERRNO_H@
NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@
@@ -1440,6 +1444,39 @@ EXTRA_DIST += allocator.h
endif
## end gnulib module allocator
+## begin gnulib module assert-h
+ifeq (,$(OMIT_GNULIB_MODULE_assert-h))
+
+BUILT_SOURCES += $(ASSERT_H)
+
+# We need the following in order to create <assert.h> when the system
+# doesn't have one that works with the given compiler.
+ifneq (,$(GL_GENERATE_ASSERT_H_CONDITION))
+assert.h: assert.in.h verify.h $(top_builddir)/config.status
+ $(gl_V_at){ $(SED_HEADER_STDOUT) \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_ASSERT_H''@|$(NEXT_ASSERT_H)|g' \
+ < $(srcdir)/assert.in.h && \
+ sed -e '/@assert.h omit start@/,/@assert.h omit end@/d' \
+ -e 's|_gl_verify|_gl_static_assert|g' \
+ -e 's|_GL_VERIFY|_GL_STATIC_ASSERT|g' \
+ -e 's|_GL\(_STATIC_ASSERT_H\)|_GL\1|g' \
+ < $(srcdir)/verify.h; \
+ } > $@-t
+ $(AM_V_at)mv $@-t $@
+else
+assert.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += assert.h assert.h-t
+
+EXTRA_DIST += assert.in.h verify.h
+
+endif
+## end gnulib module assert-h
+
## begin gnulib module at-internal
ifeq (,$(OMIT_GNULIB_MODULE_at-internal))
diff --git a/lib/malloc/dynarray.h b/lib/malloc/dynarray.h
index f16fd950df..df1aa4167d 100644
--- a/lib/malloc/dynarray.h
+++ b/lib/malloc/dynarray.h
@@ -94,7 +94,6 @@
#ifndef _DYNARRAY_H
#define _DYNARRAY_H
-#include <stdbool.h>
#include <stddef.h>
#include <string.h>
diff --git a/lib/md5.c b/lib/md5.c
index 57489ed74c..c16ac4a93a 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -27,7 +27,6 @@
#endif
#include "md5.h"
-#include <stdalign.h>
#include <stdint.h>
#include <string.h>
#include <sys/types.h>
diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c
index 95f067f82d..ea037b801d 100644
--- a/lib/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -1,8 +1,9 @@
/* mini-gmp, a minimalistic implementation of a GNU GMP subset.
Contributed to the GNU project by Niels Möller
+ Additional functionalities and improvements by Marco Bodrato.
-Copyright 1991-1997, 1999-2021 Free Software Foundation, Inc.
+Copyright 1991-1997, 1999-2022 Free Software Foundation, Inc.
This file is part of the GNU MP Library.
@@ -3098,7 +3099,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const
mpz_t m)
if (en == 0)
{
- mpz_set_ui (r, 1);
+ mpz_set_ui (r, mpz_cmpabs_ui (m, 1));
return;
}
diff --git a/lib/nanosleep.c b/lib/nanosleep.c
index 446794edc0..55d6fa650e 100644
--- a/lib/nanosleep.c
+++ b/lib/nanosleep.c
@@ -23,9 +23,7 @@
#include <time.h>
#include "intprops.h"
-#include "verify.h"
-#include <stdbool.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/select.h>
@@ -59,7 +57,7 @@ nanosleep (const struct timespec *requested_delay,
{
/* Verify that time_t is large enough. */
- verify (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60);
+ static_assert (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60);
const time_t limit = 24 * 24 * 60 * 60;
time_t seconds = requested_delay->tv_sec;
struct timespec intermediate;
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index c1dd554247..37034eb9fb 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -65,7 +65,6 @@ extern char *tzname[];
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
-#include <stdbool.h>
#include "attribute.h"
#include <intprops.h>
diff --git a/lib/openat.h b/lib/openat.h
index 56919ef8dc..c2f64ff50e 100644
--- a/lib/openat.h
+++ b/lib/openat.h
@@ -24,7 +24,6 @@
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
-#include <stdbool.h>
#ifndef _GL_INLINE_HEADER_BEGIN
#error "Please include config.h first."
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 400aff001a..a3cbb7f261 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -23,7 +23,6 @@
#include <fcntl.h>
#include "binary-io.h"
-#include "verify.h"
#if GNULIB_defined_O_NONBLOCK
# include "nonblocking.h"
@@ -95,7 +94,7 @@ pipe2 (int fd[2], int flags)
}
# else
{
- verify (O_NONBLOCK == 0);
+ static_assert (O_NONBLOCK == 0);
}
# endif
diff --git a/lib/rawmemchr.c b/lib/rawmemchr.c
index ea68c1bfc6..bdd7307de4 100644
--- a/lib/rawmemchr.c
+++ b/lib/rawmemchr.c
@@ -23,10 +23,8 @@
#if !HAVE_RAWMEMCHR
# include <limits.h>
-# include <stdalign.h>
# include <stdint.h>
-# include "verify.h"
/* Find the first occurrence of C in S. */
void *
@@ -36,7 +34,7 @@ rawmemchr (const void *s, int c_in)
typedef uintptr_t longword;
/* If you change the "uintptr_t", you should change UINTPTR_WIDTH to match.
This verifies that the type does not have padding bits. */
- verify (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword));
+ static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword));
const unsigned char *char_ptr;
unsigned char c = c_in;
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index 57a455b1f4..784d2d4586 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -29,7 +29,6 @@
#include <locale.h>
#include <wchar.h>
#include <wctype.h>
-#include <stdbool.h>
#include <stdint.h>
#ifndef _LIBC
diff --git a/lib/sha1.c b/lib/sha1.c
index 79e50ba0b0..5a18213edc 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -29,7 +29,6 @@
#endif
#include "sha1.h"
-#include <stdalign.h>
#include <stdint.h>
#include <string.h>
diff --git a/lib/sha256.c b/lib/sha256.c
index c9ca618c67..60cd763612 100644
--- a/lib/sha256.c
+++ b/lib/sha256.c
@@ -28,7 +28,6 @@
#endif
#include "sha256.h"
-#include <stdalign.h>
#include <stdint.h>
#include <string.h>
diff --git a/lib/sha512.c b/lib/sha512.c
index 6776bb464d..fd17a7dc76 100644
--- a/lib/sha512.c
+++ b/lib/sha512.c
@@ -28,7 +28,6 @@
#endif
#include "sha512.h"
-#include <stdalign.h>
#include <stdint.h>
#include <string.h>
diff --git a/lib/signal.in.h b/lib/signal.in.h
index 640b5022f5..c0d4848db0 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -55,13 +55,21 @@
#ifndef _@GUARD_PREFIX@_SIGNAL_H
#define _@GUARD_PREFIX@_SIGNAL_H
-/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6, Android,
+/* For testing the OpenBSD version. */
+#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
+ && defined __OpenBSD__
+# include <sys/param.h>
+#endif
+
+/* Mac OS X 10.3, FreeBSD < 8.0, OpenBSD < 5.1, OSF/1 4.0, Solaris 2.6,
Android,
OS/2 kLIBC declare pthread_sigmask in <pthread.h>, not in <signal.h>.
But avoid namespace pollution on glibc systems.*/
#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
&& ((defined __APPLE__ && defined __MACH__) \
- || defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ \
- || defined __sun || defined __ANDROID__ || defined __KLIBC__) \
+ || (defined __FreeBSD__ && __FreeBSD__ < 8) \
+ || (defined __OpenBSD__ && OpenBSD < 201205) \
+ || defined __osf__ || defined __sun || defined __ANDROID__ \
+ || defined __KLIBC__) \
&& ! defined __GLIBC__
# include <pthread.h>
#endif
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index 3b117df11f..58fd245c62 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -42,10 +42,7 @@
'-malign-double' is used.
The result cannot be used as a value for an 'enum' constant, if you
- want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc.
-
- Include <stddef.h> for offsetof. */
-#include <stddef.h>
+ want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */
/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other
standard headers, defines conflicting implementations of _Alignas
@@ -61,17 +58,19 @@
&& !defined __clang__) \
|| (defined __clang__ && __clang_major__ < 8))
# ifdef __cplusplus
-# if 201103 <= __cplusplus
+# if (201103 <= __cplusplus || defined _MSC_VER)
# define _Alignof(type) alignof (type)
# else
template <class __t> struct __alignof_helper { char __a; __t __b; };
# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+# define _GL_STDALIGN_NEEDS_STDDEF 1
# endif
# else
# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+# define _GL_STDALIGN_NEEDS_STDDEF 1
# endif
#endif
-#if ! (defined __cplusplus && 201103 <= __cplusplus)
+#if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))
# define alignof _Alignof
#endif
#define __alignof_is_defined 1
@@ -102,7 +101,7 @@
*/
#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112
-# if defined __cplusplus && 201103 <= __cplusplus
+# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)
# define _Alignas(a) alignas (a)
# elif (!defined __attribute__ \
&& ((defined __APPLE__ && defined __MACH__ \
@@ -116,12 +115,19 @@
# define _Alignas(a) __declspec (align (a))
# endif
#endif
-#if ((defined _Alignas && ! (defined __cplusplus && 201103 <= __cplusplus)) \
+#if ((defined _Alignas \
+ && !(defined __cplusplus && (201103 <= __cplusplus || defined
_MSC_VER))) \
|| (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
# define alignas _Alignas
#endif
-#if defined alignas || (defined __cplusplus && 201103 <= __cplusplus)
+#if (defined alignas \
+ || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)))
# define __alignas_is_defined 1
#endif
+/* Include <stddef.h> if needed for offsetof. */
+#if _GL_STDALIGN_NEEDS_STDDEF
+# include <stddef.h>
+#endif
+
#endif /* _GL_STDALIGN_H */
diff --git a/lib/stdckdint.in.h b/lib/stdckdint.in.h
index 90fa62e596..762d3fdb79 100644
--- a/lib/stdckdint.in.h
+++ b/lib/stdckdint.in.h
@@ -20,8 +20,6 @@
#include "intprops-internal.h"
-#include <stdbool.h>
-
/* Store into *R the low-order bits of A + B, A - B, A * B, respectively.
Return 1 if the result overflows, 0 otherwise.
A, B, and *R can have any integer type other than char, bool, a
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index a86643c3ca..8e0a609f1f 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -226,7 +226,7 @@ _GL_FUNCDECL_SYS (aligned_alloc, void *,
_GL_CXXALIAS_SYS (aligned_alloc, void *, (size_t alignment, size_t size));
# endif
# endif
-# if @HAVE_ALIGNED_ALLOC@
+# if (__GLIBC__ >= 2) && @HAVE_ALIGNED_ALLOC@
_GL_CXXALIASWARN (aligned_alloc);
# endif
#else
@@ -1363,7 +1363,9 @@ _GL_CXXALIAS_SYS (strtol, long,
(const char *restrict string, char **restrict endptr,
int base));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (strtol);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef strtol
# if HAVE_RAW_DECL_STRTOL
@@ -1444,7 +1446,9 @@ _GL_CXXALIAS_SYS (strtoul, unsigned long,
(const char *restrict string, char **restrict endptr,
int base));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (strtoul);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef strtoul
# if HAVE_RAW_DECL_STRTOUL
diff --git a/lib/string.in.h b/lib/string.in.h
index 3996da9fcb..e56f6db0c9 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -943,7 +943,9 @@ _GL_FUNCDECL_SYS (mbslen, size_t, (const char *string)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_SYS (mbslen, size_t, (const char *string));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (mbslen);
+# endif
#endif
#if @GNULIB_MBSNLEN@
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index cad12d0d9b..29d16d29ce 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -25,8 +25,6 @@
#include <stdlib.h>
-#include "verify.h"
-
#ifdef UNSIGNED
# ifndef HAVE_DECL_STRTOULL
"this configure-time declaration test was not run"
@@ -62,8 +60,8 @@ long long int strtoll (char const *, char **, int);
Int
Strtoimax (char const *ptr, char **endptr, int base)
{
- verify (sizeof (Int) == sizeof (Unsigned long int)
- || sizeof (Int) == sizeof (Unsigned long long int));
+ static_assert (sizeof (Int) == sizeof (Unsigned long int)
+ || sizeof (Int) == sizeof (Unsigned long long int));
if (sizeof (Int) != sizeof (Unsigned long int))
return Strtoll (ptr, endptr, base);
diff --git a/lib/sys_random.in.h b/lib/sys_random.in.h
index e730e6139f..c91bcd2cd0 100644
--- a/lib/sys_random.in.h
+++ b/lib/sys_random.in.h
@@ -84,7 +84,9 @@ _GL_FUNCDECL_SYS (getrandom, ssize_t,
_GL_CXXALIAS_SYS (getrandom, ssize_t,
(void *buffer, size_t length, unsigned int flags));
# endif
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 25) > 2
_GL_CXXALIASWARN (getrandom);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef getrandom
# if HAVE_RAW_DECL_GETRANDOM
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index 2bd0e0f79a..860e957fe0 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -82,9 +82,10 @@
of 'struct timeval', and no definition of this type.
Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select()
in <sys/time.h>.
- But avoid namespace pollution on glibc systems and "unknown type
- name" problems on Cygwin. */
-# if !(defined __GLIBC__ || defined __CYGWIN__)
+ But avoid namespace pollution on glibc systems, a circular include
+ <sys/select.h> -> <sys/time.h> -> <sys/select.h> on FreeBSD 13.1, and
+ "unknown type name" problems on Cygwin. */
+# if !(defined __GLIBC__ || defined __FreeBSD__ || defined __CYGWIN__)
# include <sys/time.h>
# endif
@@ -287,7 +288,9 @@ _GL_CXXALIAS_SYS_CAST (pselect, int,
struct timespec const *restrict,
const sigset_t *restrict));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (pselect);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef pselect
# if HAVE_RAW_DECL_PSELECT
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 714c3cb189..0ec320f58c 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -596,44 +596,6 @@ _GL_WARN_ON_USE (lchmod, "lchmod is unportable - "
#endif
-#if @GNULIB_LSTAT@
-# if ! @HAVE_LSTAT@
-/* mingw does not support symlinks, therefore it does not have lstat. But
- without links, stat does just fine. */
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# define lstat stat
-# endif
-_GL_CXXALIAS_RPL_1 (lstat, stat, int,
- (const char *restrict name, struct stat *restrict buf));
-# elif @REPLACE_LSTAT@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef lstat
-# define lstat rpl_lstat
-# endif
-_GL_FUNCDECL_RPL (lstat, int,
- (const char *restrict name, struct stat *restrict buf)
- _GL_ARG_NONNULL ((1, 2)));
-_GL_CXXALIAS_RPL (lstat, int,
- (const char *restrict name, struct stat *restrict buf));
-# else
-_GL_CXXALIAS_SYS (lstat, int,
- (const char *restrict name, struct stat *restrict buf));
-# endif
-# if @HAVE_LSTAT@
-_GL_CXXALIASWARN (lstat);
-# endif
-#elif @GNULIB_OVERRIDES_STRUCT_STAT@
-# undef lstat
-# define lstat lstat_used_without_requesting_gnulib_module_lstat
-#elif defined GNULIB_POSIXCHECK
-# undef lstat
-# if HAVE_RAW_DECL_LSTAT
-_GL_WARN_ON_USE (lstat, "lstat is unportable - "
- "use gnulib module lstat for portability");
-# endif
-#endif
-
-
#if @GNULIB_MKDIR@
# if @REPLACE_MKDIR@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -895,6 +857,44 @@ _GL_WARN_ON_USE (stat, "stat is unportable - "
#endif
+#if @GNULIB_LSTAT@
+# if ! @HAVE_LSTAT@
+/* mingw does not support symlinks, therefore it does not have lstat. But
+ without links, stat does just fine. */
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define lstat stat
+# endif
+_GL_CXXALIAS_RPL_1 (lstat, stat, int,
+ (const char *restrict name, struct stat *restrict buf));
+# elif @REPLACE_LSTAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef lstat
+# define lstat rpl_lstat
+# endif
+_GL_FUNCDECL_RPL (lstat, int,
+ (const char *restrict name, struct stat *restrict buf)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (lstat, int,
+ (const char *restrict name, struct stat *restrict buf));
+# else
+_GL_CXXALIAS_SYS (lstat, int,
+ (const char *restrict name, struct stat *restrict buf));
+# endif
+# if @HAVE_LSTAT@
+_GL_CXXALIASWARN (lstat);
+# endif
+#elif @GNULIB_OVERRIDES_STRUCT_STAT@
+# undef lstat
+# define lstat lstat_used_without_requesting_gnulib_module_lstat
+#elif defined GNULIB_POSIXCHECK
+# undef lstat
+# if HAVE_RAW_DECL_LSTAT
+_GL_WARN_ON_USE (lstat, "lstat is unportable - "
+ "use gnulib module lstat for portability");
+# endif
+#endif
+
+
#if @GNULIB_MDA_UMASK@
/* On native Windows, map 'umask' to '_umask', so that -loldnames is not
required. In C++ with GNULIB_NAMESPACE, avoid differences between
diff --git a/lib/tempname.c b/lib/tempname.c
index 5adfe629a8..dbff638f70 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -20,16 +20,9 @@
# include "tempname.h"
#endif
-#include <sys/types.h>
-#include <assert.h>
-#include <stdbool.h>
-
#include <errno.h>
#include <stdio.h>
-#ifndef P_tmpdir
-# define P_tmpdir "/tmp"
-#endif
#ifndef TMP_MAX
# define TMP_MAX 238328
#endif
@@ -43,27 +36,23 @@
# error report this to bug-gnulib@gnu.org
#endif
-#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
-#include <stdalign.h>
#include <stdint.h>
#include <sys/random.h>
#include <sys/stat.h>
#include <time.h>
#if _LIBC
-# define struct_stat64 struct stat64
-# define __secure_getenv __libc_secure_getenv
+# define struct_stat64 struct __stat64_t64
#else
# define struct_stat64 struct stat
# define __gen_tempname gen_tempname
# define __mkdir mkdir
# define __open open
-# define __lstat64(file, buf) lstat (file, buf)
-# define __stat64(file, buf) stat (file, buf)
+# define __lstat64_time64(file, buf) lstat (file, buf)
# define __getrandom getrandom
# define __clock_gettime64 clock_gettime
# define __timespec64 timespec
@@ -77,100 +66,56 @@ typedef uint_fast64_t random_value;
#define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */
#define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
-#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME)
-# define HAS_CLOCK_ENTROPY true
-#else
-# define HAS_CLOCK_ENTROPY false
-#endif
+/* Return the result of mixing the entropy from R and S.
+ Assume that R and S are not particularly random,
+ and that the result should look randomish to an untrained eye. */
static random_value
-random_bits (random_value var, bool use_getrandom)
+mix_random_values (random_value r, random_value s)
{
- random_value r;
- /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */
- if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r)
- return r;
-#if HAS_CLOCK_ENTROPY
- /* Add entropy if getrandom did not work. */
- struct __timespec64 tv;
- __clock_gettime64 (CLOCK_MONOTONIC, &tv);
- var ^= tv.tv_nsec;
-#endif
- return 2862933555777941757 * var + 3037000493;
+ /* As this code is used only when high-quality randomness is neither
+ available nor necessary, there is no need for fancier polynomials
+ such as those in the Linux kernel's 'random' driver. */
+ return (2862933555777941757 * r + 3037000493) ^ s;
}
-#if _LIBC
-/* Return nonzero if DIR is an existent directory. */
-static int
-direxists (const char *dir)
-{
- struct_stat64 buf;
- return __stat64 (dir, &buf) == 0 && S_ISDIR (buf.st_mode);
-}
+/* Set *R to a random value.
+ Return true if *R is set to high-quality value taken from getrandom.
+ Otherwise return false, falling back to a low-quality *R that might
+ depend on S.
-/* Path search algorithm, for tmpnam, tmpfile, etc. If DIR is
- non-null and exists, uses it; otherwise uses the first of $TMPDIR,
- P_tmpdir, /tmp that exists. Copies into TMPL a template suitable
- for use with mk[s]temp. Will fail (-1) if DIR is non-null and
- doesn't exist, none of the searched dirs exists, or there's not
- enough space in TMPL. */
-int
-__path_search (char *tmpl, size_t tmpl_len, const char *dir, const char *pfx,
- int try_tmpdir)
+ This function returns false only when getrandom fails.
+ On GNU systems this should happen only early in the boot process,
+ when the fallback should be good enough for programs using tempname
+ because any attacker likely has root privileges already. */
+
+static bool
+random_bits (random_value *r, random_value s)
{
- const char *d;
- size_t dlen, plen;
+ /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */
+ if (__getrandom (r, sizeof *r, GRND_NONBLOCK) == sizeof *r)
+ return true;
- if (!pfx || !pfx[0])
- {
- pfx = "file";
- plen = 4;
- }
- else
- {
- plen = strlen (pfx);
- if (plen > 5)
- plen = 5;
- }
+ /* If getrandom did not work, use ersatz entropy based on low-order
+ clock bits. On GNU systems getrandom should fail only
+ early in booting, when ersatz should be good enough.
+ Do not use ASLR-based entropy, as that would leak ASLR info into
+ the resulting file name which is typically public.
- if (try_tmpdir)
- {
- d = __secure_getenv ("TMPDIR");
- if (d != NULL && direxists (d))
- dir = d;
- else if (dir != NULL && direxists (dir))
- /* nothing */ ;
- else
- dir = NULL;
- }
- if (dir == NULL)
- {
- if (direxists (P_tmpdir))
- dir = P_tmpdir;
- else if (strcmp (P_tmpdir, "/tmp") != 0 && direxists ("/tmp"))
- dir = "/tmp";
- else
- {
- __set_errno (ENOENT);
- return -1;
- }
- }
+ Of course we are in a state of sin here. */
- dlen = strlen (dir);
- while (dlen > 1 && dir[dlen - 1] == '/')
- dlen--; /* remove trailing slashes */
+ random_value v = s;
- /* check we have room for "${dir}/${pfx}XXXXXX\0" */
- if (tmpl_len < dlen + 1 + plen + 6 + 1)
- {
- __set_errno (EINVAL);
- return -1;
- }
+#if _LIBC || (defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME)
+ struct __timespec64 tv;
+ __clock_gettime64 (CLOCK_REALTIME, &tv);
+ v = mix_random_values (v, tv.tv_sec);
+ v = mix_random_values (v, tv.tv_nsec);
+#endif
- sprintf (tmpl, "%.*s/%.*sXXXXXX", (int) dlen, dir, (int) plen, pfx);
- return 0;
+ *r = mix_random_values (v, clock ());
+ return false;
}
-#endif /* _LIBC */
#if _LIBC
static int try_tempname_len (char *, int, void *, int (*) (char *, void *),
@@ -197,7 +142,7 @@ try_nocreate (char *tmpl, _GL_UNUSED void *flags)
{
struct_stat64 st;
- if (__lstat64 (tmpl, &st) == 0 || errno == EOVERFLOW)
+ if (__lstat64_time64 (tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}
@@ -267,32 +212,17 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
unsigned int attempts = ATTEMPTS_MIN;
#endif
- /* A random variable. The initial value is used only the for fallback path
- on 'random_bits' on 'getrandom' failure. Its initial value tries to use
- some entropy from the ASLR and ignore possible bits from the stack
- alignment. */
- random_value v = ((uintptr_t) &v) / alignof (max_align_t);
-
-#if !HAS_CLOCK_ENTROPY
- /* Arrange gen_tempname to return less predictable file names on
- systems lacking clock entropy <https://bugs.gnu.org/57129>. */
- static random_value prev_v;
- v ^= prev_v;
-#endif
+ /* A random variable. */
+ random_value v = 0;
- /* How many random base-62 digits can currently be extracted from V. */
+ /* A value derived from the random variable, and how many random
+ base-62 digits can currently be extracted from VDIGBUF. */
+ random_value vdigbuf;
int vdigits = 0;
- /* Whether to consume entropy when acquiring random bits. On the
- first try it's worth the entropy cost with __GT_NOCREATE, which
- is inherently insecure and can use the entropy to make it a bit
- more secure. On the (rare) second and later attempts it might
- help against DoS attacks. */
- bool use_getrandom = tryfunc == try_nocreate;
-
- /* Least unfair value for V. If V is less than this, V can generate
- BASE_62_DIGITS digits fairly. Otherwise it might be biased. */
- random_value const unfair_min
+ /* Least biased value for V. If V is less than this, V can generate
+ BASE_62_DIGITS unbiased digits. Otherwise the digits are biased. */
+ random_value const biased_min
= RANDOM_VALUE_MAX - RANDOM_VALUE_MAX % BASE_62_POWER;
len = strlen (tmpl);
@@ -312,18 +242,16 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
{
if (vdigits == 0)
{
- do
- {
- v = random_bits (v, use_getrandom);
- use_getrandom = true;
- }
- while (unfair_min <= v);
+ /* Worry about bias only if the bits are high quality. */
+ while (random_bits (&v, v) && biased_min <= v)
+ continue;
+ vdigbuf = v;
vdigits = BASE_62_DIGITS;
}
- XXXXXX[i] = letters[v % 62];
- v /= 62;
+ XXXXXX[i] = letters[vdigbuf % 62];
+ vdigbuf /= 62;
vdigits--;
}
@@ -331,9 +259,6 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
if (fd >= 0)
{
__set_errno (save_errno);
-#if !HAS_CLOCK_ENTROPY
- prev_v = v;
-#endif
return fd;
}
else if (errno != EEXIST)
diff --git a/lib/time.in.h b/lib/time.in.h
index 6d4c771963..6aa67498f5 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -435,8 +435,10 @@ _GL_WARN_ON_USE (asctime, "asctime can overrun buffers in
some cases - "
# endif
# if defined GNULIB_POSIXCHECK
# undef asctime_r
+# if HAVE_RAW_DECL_ASCTIME_R
_GL_WARN_ON_USE (asctime_r, "asctime_r can overrun buffers in some cases - "
"better use strftime (or even sprintf) instead");
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef ctime
@@ -445,8 +447,10 @@ _GL_WARN_ON_USE (ctime, "ctime can overrun buffers in some
cases - "
# endif
# if defined GNULIB_POSIXCHECK
# undef ctime_r
+# if HAVE_RAW_DECL_CTIME_R
_GL_WARN_ON_USE (ctime_r, "ctime_r can overrun buffers in some cases - "
"better use strftime (or even sprintf) instead");
+# endif
# endif
#endif
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 1a91d3778e..601ce5950e 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -27,7 +27,6 @@
#include <time.h>
#include <errno.h>
-#include <stdbool.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 57df09ecdf..50f6e56550 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -1143,7 +1143,9 @@ _GL_FUNCDECL_SYS (getdomainname, int, (char *name, size_t
len)
# endif
_GL_CXXALIAS_SYS (getdomainname, int, (char *name, size_t len));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (getdomainname);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef getdomainname
# if HAVE_RAW_DECL_GETDOMAINNAME
@@ -2055,7 +2057,7 @@ _GL_CXXALIAS_MDA_CAST (swab, void, (char *from, char *to,
int n));
# else
# if defined __hpux /* HP-UX */
_GL_CXXALIAS_SYS (swab, void, (const char *from, char *to, int n));
-# elif defined __sun && !defined _XPG4 /* Solaris */
+# elif defined __sun && (defined __SunOS_5_10 || defined __XOPEN_OR_POSIX) &&
!defined _XPG4 /* Solaris */
_GL_CXXALIAS_SYS (swab, void, (const char *from, char *to, ssize_t n));
# else
_GL_CXXALIAS_SYS (swab, void, (const void *from, void *to, ssize_t n));
diff --git a/lib/utimens.c b/lib/utimens.c
index 2fa1251850..23b9180935 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -26,7 +26,6 @@
#include <errno.h>
#include <fcntl.h>
-#include <stdbool.h>
#include <string.h>
#include <sys/stat.h>
#include <sys/time.h>
diff --git a/lib/verify.h b/lib/verify.h
index 47b6ee661b..99af802993 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -25,19 +25,19 @@
works as per C11. This is supported by GCC 4.6.0+ and by clang 4+.
Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as
- per C2x. This is supported by GCC 9.1+.
+ per C23. This is supported by GCC 9.1+.
Support compilers claiming conformance to the relevant standard,
and also support GCC when not pedantic. If we were willing to slow
'configure' down we could also use it with other compilers, but
since this affects only the quality of diagnostics, why bother? */
#ifndef __cplusplus
-# if (201112L <= __STDC_VERSION__ \
+# if (201112 <= __STDC_VERSION__ \
|| (!defined __STRICT_ANSI__ \
&& (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 5 <= __clang_major__)))
# define _GL_HAVE__STATIC_ASSERT 1
# endif
-# if (202000L <= __STDC_VERSION__ \
+# if (202000 <= __STDC_VERSION__ \
|| (!defined __STRICT_ANSI__ && 9 <= __GNUC__))
# define _GL_HAVE__STATIC_ASSERT1 1
# endif
@@ -202,12 +202,12 @@ template <int w>
This macro requires three or more arguments but uses at most the first
two, so that the _Static_assert macro optionally defined below supports
- both the C11 two-argument syntax and the C2x one-argument syntax.
+ both the C11 two-argument syntax and the C23 one-argument syntax.
Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
-#if 200410 <= __cpp_static_assert
+#if 202311 <= __STDC_VERSION__ || 200410 <= __cpp_static_assert
# define _GL_VERIFY(R, DIAGNOSTIC, ...) static_assert (R, DIAGNOSTIC)
#elif defined _GL_HAVE__STATIC_ASSERT
# define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
@@ -223,11 +223,30 @@ template <int w>
/* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */
#ifdef _GL_STATIC_ASSERT_H
# if !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert
-# define _Static_assert(...) \
- _GL_VERIFY (__VA_ARGS__, "static assertion failed", -)
+# define _Static_assert(R, ...) \
+ _GL_VERIFY ((R), "static assertion failed", -)
# endif
-# if __cpp_static_assert < 201411 && !defined static_assert
-# define static_assert _Static_assert /* C11 requires this #define. */
+# if (!defined static_assert \
+ && __STDC_VERSION__ < 202311 \
+ && (!defined __cplusplus \
+ || (__cpp_static_assert < 201411 \
+ && __GNUG__ < 6 && __clang_major__ < 6)))
+# if defined __cplusplus && _MSC_VER >= 1900 && !defined __clang__
+/* MSVC 14 in C++ mode supports the two-arguments static_assert but not
+ the one-argument static_assert, and it does not support _Static_assert.
+ We have to play preprocessor tricks to distinguish the two cases.
+ Since the MSVC preprocessor is not ISO C compliant (cf.
+ <https://stackoverflow.com/questions/5134523/>), the solution is specific
+ to MSVC. */
+# define _GL_EXPAND(x) x
+# define _GL_SA1(a1) static_assert ((a1), "static assertion failed")
+# define _GL_SA2 static_assert
+# define _GL_SA3 static_assert
+# define _GL_SA_PICK(x1,x2,x3,x4,...) x4
+# define static_assert(...)
_GL_EXPAND(_GL_SA_PICK(__VA_ARGS__,_GL_SA3,_GL_SA2,_GL_SA1)) (__VA_ARGS__)
+# else
+# define static_assert _Static_assert /* C11 requires this #define. */
+# endif
# endif
#endif
@@ -303,7 +322,7 @@ template <int w>
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
#elif 1200 <= _MSC_VER
# define assume(R) __assume (R)
-#elif 202311L <= __STDC_VERSION__
+#elif 202311 <= __STDC_VERSION__
# include <stddef.h>
# define assume(R) ((R) ? (void) 0 : unreachable ())
#elif (defined GCC_LINT || defined lint) && _GL_HAS_BUILTIN_TRAP
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 0b97a64109..6053ffa65a 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -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.14 b/lisp/ChangeLog.14
index c84e44536d..686746abe0 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)
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 53caf69e1c..23e61ff787 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -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.17 b/lisp/ChangeLog.17
index cebafe18aa..df731fe9ed 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -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/Makefile.in b/lisp/Makefile.in
index c73a623cce..338814fdda 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -31,10 +31,16 @@ EXEEXT = @EXEEXT@
XARGS_LIMIT = @XARGS_LIMIT@
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+NATIVE_COMPILATION_AOT = @NATIVE_COMPILATION_AOT@
ifeq ($(HAVE_NATIVE_COMP),yes)
+# Environment variable to enable Ahead-Of-Time compilation.
ifndef NATIVE_FULL_AOT
NATIVE_SKIP_NONDUMP = 1
endif
+# Configured for Ahead-Of-Time compilation.
+ifeq ($(NATIVE_COMPILATION_AOT),yes)
+NATIVE_SKIP_NONDUMP = ""
+endif
endif
-include ${top_builddir}/src/verbose.mk
@@ -70,9 +76,7 @@ BYTE_COMPILE_FLAGS = \
--eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \
$(BYTE_COMPILE_EXTRA_FLAGS)
# ... but we must prefer .elc files for those in the early bootstrap.
-# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el.
-compile-first: BYTE_COMPILE_FLAGS = \
- --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS)
+compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
@@ -306,16 +310,18 @@ endif
ifeq ($(HAVE_NATIVE_COMP),yes)
ifeq ($(ANCIENT),yes)
# The first compilation of compile-first, using an interpreted compiler:
-# The resulting .elc files get given a date of 1971-01-01 so that their
-# date stamp is earlier than the source files, causing these to be compiled
-# into native code at the second recursive invocation of this $(MAKE),
-# using these .elc's. This is faster than just compiling the native code
-# directly using the interpreted compile-first files. (Note: 1970-01-01
-# fails on some systems.)
+# The resulting .elc files get given a timestamp of the Unix epoch,
+# 1970-01-01, so that their timestamps are earlier than the source files,
+# causing these to be compiled into native code at the second recursive
+# invocation of this $(MAKE), using these .elc's. This is faster than just
+# compiling the native code directly using the interpreted compile-first
+# files. Note that the epoch date is hard-coded into Fload in src/lread.c
+# which uses it to avoid displaying certain messages which might be
+# irritating/misleading during a bootstrap.
.el.elc:
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
-l comp -f batch-byte-compile $<
- touch -t 197101010000 $@
+ TZ=UTC0 touch -t 197001010000 $@
else
.el.elc:
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
@@ -342,8 +348,8 @@ compile-first: $(COMPILE_FIRST)
.PHONY: compile-targets
# TARGETS is set dynamically in the recursive call from 'compile-main'.
-# Do not build comp.el unless necessary not to exceed max-specpdl-size and
-# max-lisp-eval-depth in normal builds.
+# Do not build comp.el unless necessary not to exceed max-lisp-eval-depth
+# in normal builds.
ifneq ($(HAVE_NATIVE_COMP),yes)
compile-targets: $(filter-out ./emacs-lisp/comp-cstr.elc,$(filter-out
./emacs-lisp/comp.elc,$(TARGETS)))
else
@@ -424,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 718938df0c..2ca8e25dac 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1,7 +1,6 @@
;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
@@ -1220,13 +1219,28 @@ SORTFUN is passed to `sort' to change the default
ordering."
(sort entries (lambda (x y)
(funcall sortfun (nth 2 x) (nth 2 y)))))))
+(defface abbrev-table-name
+ '((t :inherit font-lock-function-name-face))
+ "Face used for displaying the abbrev table name in `edit-abbrevs-mode'."
+ :version "29.1")
+
+(defvar edit-abbrevs-mode-font-lock-keywords
+ `((,(rx bol "("
+ ;; lisp-mode-symbol-regexp
+ (regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\)+")
+ ")" eol)
+ 0 'abbrev-table-name)))
+
;; Keep it after define-abbrev-table, since define-derived-mode uses
;; define-abbrev-table.
(define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
"Major mode for editing the list of abbrev definitions.
This mode is for editing abbrevs in a buffer prepared by `edit-abbrevs',
which see."
- :interactive nil)
+ :interactive nil
+ (setq-local font-lock-defaults
+ '(edit-abbrevs-mode-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq font-lock-multiline nil))
(defun abbrev--possibly-save (query &optional arg)
;; Query mode.
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 736fb7d99d..4eab2c11c6 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -312,7 +312,7 @@ enhancements, directly.")
(defvar-local allout-inhibit-body-modification-hook nil
"Override de-escaping of text-prefixes in item bodies during specific
changes.
-This is used by `allout-buffer-modification-handler' to signal such changes
+This is used by `allout-body-modification-handler' to signal such changes
to `allout-body-modification-handler', and is always reset by
`allout-post-command-business'.")
;;;_ = allout-widgets-icons-cache
@@ -2177,10 +2177,10 @@ 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-workhash' during
+;; Adds the overlay to the `allout-unresolved-body-mod-workroster' during
;; before-change operation, and removes from that list during after-change
;; operation.
(cond (allout-inhibit-body-modification-hook nil)))
diff --git a/lisp/allout.el b/lisp/allout.el
index fb922608b0..5f7087829e 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1352,8 +1352,6 @@ their settings before `allout-mode' was started."
"Symbol for use as allout invisible-text overlay category.")
;;;_ = allout-exposure-change-functions
-(define-obsolete-variable-alias 'allout-exposure-change-hook
- 'allout-exposure-change-functions "24.3")
(defcustom allout-exposure-change-functions nil
"Abnormal hook run after allout outline subtree exposure changes.
It is run at the conclusion of `allout-flag-region'.
@@ -1370,8 +1368,6 @@ This hook might be invoked multiple times by a single
command."
:version "24.3")
;;;_ = allout-structure-added-functions
-(define-obsolete-variable-alias 'allout-structure-added-hook
- 'allout-structure-added-functions "24.3")
(defcustom allout-structure-added-functions nil
"Abnormal hook run after adding items to an Allout outline.
Functions on the hook should take two arguments:
@@ -1385,8 +1381,6 @@ This hook might be invoked multiple times by a single
command."
:version "24.3")
;;;_ = allout-structure-deleted-functions
-(define-obsolete-variable-alias 'allout-structure-deleted-hook
- 'allout-structure-deleted-functions "24.3")
(defcustom allout-structure-deleted-functions nil
"Abnormal hook run after deleting subtrees from an Allout outline.
Functions on the hook must take two arguments:
@@ -1403,8 +1397,6 @@ This hook might be invoked multiple times by a single
command."
:version "24.3")
;;;_ = allout-structure-shifted-functions
-(define-obsolete-variable-alias 'allout-structure-shifted-hook
- 'allout-structure-shifted-functions "24.3")
(defcustom allout-structure-shifted-functions nil
"Abnormal hook run after shifting items in an Allout outline.
Functions on the hook should take two arguments:
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
new file mode 100644
index 0000000000..499c9dce73
--- /dev/null
+++ b/lisp/ansi-osc.el
@@ -0,0 +1,201 @@
+;;; ansi-osc.el --- Support for OSC escape sequences -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Augusto Stoffel <arstoffel@gmail.com>
+;; Matthias Meulien <orontee@gmail.com>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: processes, terminals, services
+
+;; 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:
+
+;; Interpretation of OSC (Operating System Commands) escape sequences.
+;; Handlers for OSC 2, 7 and 8 (for window title, current directory
+;; and hyperlinks respectively) are provided.
+
+;; The function `ansi-osc-compilation-filter' can be added to
+;; `compilation-filter-hook' to collect OSC sequences in compilation
+;; buffers. The variable `ansi-osc-for-compilation-buffer' tells what
+;; to do with collected sequences.
+
+;;; Code:
+
+(defconst ansi-osc-control-seq-regexp
+ ;; See ECMA 48, section 8.3.89 "OSC - OPERATING SYSTEM COMMAND".
+ "\e\\][\x08-\x0D]*[\x20-\x7E]*\\(\a\\|\e\\\\\\)"
+ "Regexp matching an OSC control sequence.")
+
+(defun ansi-osc-filter-region (begin end)
+ "Filter out all OSC control sequences from region between BEGIN and END."
+ (save-excursion
+ (goto-char begin)
+ ;; Delete escape sequences.
+ (while (re-search-forward ansi-osc-control-seq-regexp end t)
+ (delete-region (match-beginning 0) (match-end 0)))))
+
+(defvar-local ansi-osc-handlers '(("2" . ansi-osc-window-title-handler)
+ ("7" . ansi-osc-directory-tracker)
+ ("8" . ansi-osc-hyperlink-handler))
+ "Alist of handlers for OSC escape sequences.
+See `ansi-osc-apply-on-region' for details.")
+
+(defvar-local ansi-osc--marker nil)
+;; The function `ansi-osc-apply-on-region' can set `ansi-osc--marker'
+;; to the start position of an escape sequence without termination.
+
+(defun ansi-osc-apply-on-region (begin end)
+ "Interpret OSC escape sequences in region between BEGIN and END.
+This function searches for escape sequences of the forms
+
+ ESC ] command ; text BEL
+ ESC ] command ; text ESC \\
+
+Every occurrence of such escape sequences is removed from the
+buffer. Then, if `command' is a key in the alist that is the
+value of the local variable `ansi-osc-handlers', that key's
+value, which should be a function, is called with `command' and
+`text' as arguments, with point where the escape sequence was
+located."
+ (save-excursion
+ (goto-char (or ansi-osc--marker begin))
+ (when (eq (char-before) ?\e) (backward-char))
+ (while (re-search-forward "\e]" end t)
+ (let ((pos0 (match-beginning 0))
+ (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" end t)
+ (match-string 1)))
+ (pos1 (point)))
+ (if (re-search-forward "\a\\|\e\\\\" end t)
+ (let ((text (buffer-substring-no-properties
+ pos1 (match-beginning 0))))
+ (setq ansi-osc--marker nil)
+ (delete-region pos0 (point))
+ (when-let ((fun (cdr (assoc-string code ansi-osc-handlers))))
+ (funcall fun code text)))
+ (put-text-property pos0 end 'invisible t)
+ (setq ansi-osc--marker (copy-marker pos0)))))))
+
+;; Window title handling (OSC 2)
+
+(defvar-local ansi-osc-window-title nil)
+(defun ansi-osc-window-title-handler (_ text)
+ "Set value of `ansi-osc-window-title' from an OSC 2 escape sequence.
+The variable `ansi-osc-window-title' can then be referenced in
+`frame-title-format' to dynamically set the frame title.
+
+This function is intended to be included as an element of the
+list that is the value of `ansi-osc-handlers'."
+ (setq ansi-osc-window-title text))
+
+;; Current directory tracking (OSC 7)
+
+(declare-function url-host "url/url-parse.el")
+(declare-function url-type "url/url-parse.el")
+(declare-function url-filename "url/url-parse.el")
+(defun ansi-osc-directory-tracker (_ text)
+ "Update `default-directory' from OSC 7 escape sequences.
+
+This function is intended to be included as an element of the
+the list that is the value of `ansi-osc-handlers'. You should arrange
+for your shell to print the appropriate escape sequence at each prompt,
+such as with the following command:
+
+ printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
+
+This functionality serves as an alternative to `dirtrack-mode'
+and `shell-dirtrack-mode'."
+ (let ((url (url-generic-parse-url text)))
+ (when (and (string= (url-type url) "file")
+ (or (null (url-host url))
+ (string= (url-host url) (system-name))))
+ (ignore-errors
+ (cd-absolute (url-unhex-string (url-filename url)))))))
+
+;; Hyperlink handling (OSC 8)
+
+(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
+ 'help-echo (lambda (_ buffer pos)
+ (when-let ((url (get-text-property pos 'browse-url-data
buffer)))
+ (format "mouse-2, C-c RET: Open %s" url))))
+
+(defvar-local ansi-osc-hyperlink--state nil)
+
+(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
+that is the value of `ansi-osc-handlers'."
+ (when ansi-osc-hyperlink--state
+ (let ((start (car ansi-osc-hyperlink--state))
+ (url (cdr ansi-osc-hyperlink--state)))
+ (make-text-button start (point)
+ 'type 'ansi-osc-hyperlink
+ 'browse-url-data url)))
+ (setq ansi-osc-hyperlink--state
+ (and (string-match ";\\(.+\\)" text)
+ (cons (point-marker) (match-string-no-properties 1 text)))))
+
+(defgroup ansi-osc nil
+ "Interpretation of OSC escape sequences.
+Handlers for OSC 2, 7 and 8 (for window title, current directory
+and hyperlinks respectively) are provided. OSC (Operating System
+Commands) control sequences are defined in section 8.3.89 of the
+ECMA-48 standard is freely available at
+<URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm>
+as a PDF file."
+ :version "29.1"
+ :group 'processes)
+
+(defcustom ansi-osc-for-compilation-buffer 'filter
+ "What to do with OSC escape sequences in compilation output.
+
+If nil, do nothing.
+
+If the symbol `filter', then filter out all OSC control sequences.
+
+If any other non-nil value, then collect OSC control sequences
+and call the appropriate handlers as described in `ansi-osc-handlers'.
+
+In order for this to have any effect, `ansi-osc-compilation-filter'
+must be in `compilation-filter-hook'."
+ :type '(choice (const :tag "Do nothing" nil)
+ (const :tag "Filter out OSC" filter)
+ (other :tag "Translate OSC" t))
+ :group 'ansi-osc
+ :version "29.1")
+
+(defvar compilation-filter-start)
+
+;;;###autoload
+(defun ansi-osc-compilation-filter ()
+ "Maybe collect OSC control sequences.
+This function depends on the variable `ansi-osc-for-compilation-buffer',
+and is meant to be used in `compilation-filter-hook'."
+ (let ((inhibit-read-only t))
+ (pcase ansi-osc-for-compilation-buffer
+ ('nil nil)
+ ('filter
+ (ansi-osc-filter-region compilation-filter-start (point)))
+ (_
+ (ansi-osc-apply-on-region compilation-filter-start (point))))))
+
+(provide 'ansi-osc)
+;;; ansi-osc.el ends here
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 632ae57852..b6f7794e33 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -125,8 +125,6 @@ A non-local file is one whose file name is not proper
outside Emacs.
A local copy of the archive will be used when updating."
:type 'regexp)
-(define-obsolete-variable-alias 'archive-extract-hooks
- 'archive-extract-hook "24.3")
(defcustom archive-extract-hook nil
"Hook run when an archive member has been extracted."
:type 'hook)
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 86e0b48a79..0955e2ed07 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -319,6 +319,16 @@ then NAME & USER, then NAME & PORT, then just NAME."
(list
(format "%s" name)))))
+(defun auth-source-pass-file-name-p (file)
+ "Say whether FILE is used by `auth-source-pass'."
+ (and (stringp file) (stringp auth-source-pass-filename)
+ (string-equal
+ (expand-file-name file) (expand-file-name auth-source-pass-filename))))
+
+(with-eval-after-load 'bookmark
+ (add-hook 'bookmark-inhibit-context-functions
+ #'auth-source-pass-file-name-p))
+
(provide 'auth-source-pass)
;;; auth-source-pass.el ends here
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index c79e5b81f7..feefd391a8 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -522,6 +522,21 @@ parameters."
;; (mapcar #'auth-source-backend-parse auth-sources)
+(defun auth-source-file-name-p (file)
+ "Say whether FILE is used by `auth-sources'."
+ (let* ((backends (mapcar #'auth-source-backend-parse auth-sources))
+ (files
+ (mapcar (lambda (x)
+ (when (member (slot-value x 'type) '(json netrc plstore))
+ (slot-value x 'source)))
+ backends)))
+ (member (expand-file-name file)
+ (mapcar #'expand-file-name (remq nil files)))))
+
+(with-eval-after-load 'bookmark
+ (add-hook 'bookmark-inhibit-context-functions
+ #'auth-source-file-name-p))
+
(cl-defun auth-source-search (&rest spec
&key max require create delete
&allow-other-keys)
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 29d10bc629..354b28da5a 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -1,7 +1,6 @@
;;; autoinsert.el --- automatic mode-dependent insertion of text into new
files -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: Charlie Martin <crm@cs.duke.edu>
;; Adapted-By: Daniel Pfeiffer <occitan@esperanto.org>
@@ -25,27 +24,27 @@
;;; Commentary:
-;; The following defines an association list for text to be
-;; automatically inserted when a new file is created, and a function
-;; which automatically inserts these files; the idea is to insert
-;; default text much as the mode is automatically set using
-;; auto-mode-alist.
+;; The following defines an association list for text to be
+;; automatically inserted when a new file is created, and a function
+;; which automatically inserts these files; the idea is to insert
+;; default text much as the mode is automatically set using
+;; auto-mode-alist.
+;;
+;; To use, add this to your Init file:
;;
-;; To use:
;; (auto-insert-mode t)
-;; setq auto-insert-directory to an appropriate slash-terminated value
+;; (setq auto-insert-directory "~/some-dir")
;;
-;; You can also customize the variable `auto-insert-mode' to load the
-;; package. Alternatively, add the following to your init file:
-;; (auto-insert-mode 1)
+;; You can also customize the variable `auto-insert-mode' to load the
+;; package.
;;
-;; Author: Charlie Martin
-;; Department of Computer Science and
-;; National Biomedical Simulation Resource
-;; Box 3709
-;; Duke University Medical Center
-;; Durham, NC 27710
-;; (crm@cs.duke.edu,mcnc!duke!crm)
+;; Author: Charlie Martin
+;; Department of Computer Science and
+;; National Biomedical Simulation Resource
+;; Box 3709
+;; Duke University Medical Center
+;; Durham, NC 27710
+;; (crm@cs.duke.edu,mcnc!duke!crm)
;;; Code:
@@ -136,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: "
@@ -169,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)
@@ -348,9 +347,7 @@ described above, e.g. [\"header.insert\"
date-and-author-update]."
;; Establish a default value for auto-insert-directory
(defcustom auto-insert-directory "~/insert/"
- "Directory from which auto-inserted files are taken.
-The value must be an absolute directory name;
-thus, on a GNU or Unix system, it must end in a slash."
+ "Directory from which auto-inserted files are taken."
:type 'directory)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 872a896689..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
@@ -677,7 +678,7 @@ will use an up-to-date value of `auto-revert-interval'."
;;
;; We do this by reverting immediately in response to the first in a
;; flurry of notifications. Any notifications during the following
-;; `auto-revert-lockout-interval' seconds are noted but not acted upon
+;; `auto-revert--lockout-interval' seconds are noted but not acted upon
;; until the end of that interval.
(defconst auto-revert--lockout-interval 2.5
diff --git a/lisp/battery.el b/lisp/battery.el
index 72b3dfdae7..8de80109c6 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -914,6 +914,15 @@ The following %-sequences are provided:
;;; `apm' interface for BSD.
+;; This function is a wrapper on `call-process' that return the
+;; standard output in a string. We are using it instead
+;; `shell-command-to-string' because this last one is trying to run
+;; PROGRAM on the remote host if the buffer is remote.
+(defun battery--call-process-to-string (program &rest args)
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (apply #'call-process program nil t nil args))))
+
(defun battery-bsd-apm ()
"Get APM status information from BSD apm binary.
The following %-sequences are provided:
@@ -929,13 +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'?
- (shell-command-to-string "/usr/bin/uname"))))
+ (battery--call-process-to-string "uname"))))
(apm-flag (pcase os-name
("OpenBSD" "mP")
("FreeBSD" "st")
(_ "ms")))
- (apm-cmd (concat "/usr/sbin/apm -abl" apm-flag))
- (apm-output (split-string (shell-command-to-string apm-cmd)))
+ (apm-args (concat "-abl" apm-flag))
+ (apm-output (split-string
+ (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 8dfc16bf9f..b57ad12986 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -592,9 +592,26 @@ NAME is a suggested name for the constructed bookmark. It
can be nil
in which case a default heuristic will be used. The function can also
equivalently just return ALIST without NAME.")
+(defcustom bookmark-inhibit-context-functions nil
+ "List of functions to call before making a bookmark record.
+The functions take `buffer-file-name' as argument. If any of
+these functions returns non-nil, the bookmark does not record
+context strings from the current buffer."
+ :type 'hook
+ :version "29.1")
+
(defun bookmark-make-record ()
"Return a new bookmark record (NAME . ALIST) for the current location."
- (let ((record (funcall bookmark-make-record-function)))
+ (let* ((bookmark-search-size
+ ;; If we're in a buffer that's visiting an encrypted file,
+ ;; don't include any context in the bookmark file, because
+ ;; that would leak (possibly secret) data.
+ (if (and buffer-file-name
+ (run-hook-with-args-until-success
+ 'bookmark-inhibit-context-functions buffer-file-name))
+ 0
+ bookmark-search-size))
+ (record (funcall bookmark-make-record-function)))
;; Set up default name if the function does not provide one.
(unless (stringp (car record))
(if (car record) (push nil record))
@@ -1441,7 +1458,7 @@ name."
(let ((final-new-name
(or new-name ; use second arg, if non-nil
(read-from-minibuffer
- "New name: "
+ (format-prompt "Rename \"%s\" to" nil old-name)
nil
(define-keymap
:parent minibuffer-local-map
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 539ef673f0..abf152f058 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -54,21 +54,6 @@
:group 'Buffer-menu)
(put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
-(defcustom Buffer-menu-buffer+size-width nil
- "Combined width of buffer name and size columns in Buffer Menu.
-If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'.
-
-If non-nil, the value of `Buffer-menu-name-width' is overridden;
-the name column is assigned width `Buffer-menu-buffer+size-width'
-minus `Buffer-menu-size-width'. This use is deprecated."
- :type '(choice (const nil) number)
- :group 'Buffer-menu
- :version "24.3")
-
-(make-obsolete-variable 'Buffer-menu-buffer+size-width
- "use `Buffer-menu-name-width' and
`Buffer-menu-size-width' instead."
- "24.3")
-
(defun Buffer-menu--dynamic-name-width (buffers)
"Return a name column width based on the current window width.
The width will never exceed the actual width of the buffer names,
@@ -679,9 +664,6 @@ means list those buffers and no others."
(setq name-width (if (functionp Buffer-menu-name-width)
(funcall Buffer-menu-name-width (mapcar #'car
entries))
Buffer-menu-name-width))
- ;; Handle obsolete variable:
- (if Buffer-menu-buffer+size-width
- (setq name-width (- Buffer-menu-buffer+size-width size-width)))
(setq tabulated-list-format
(vector '("C" 1 t :pad-right 0)
'("R" 1 t :pad-right 0)
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index bb427ef86e..4a9ff256f9 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -207,9 +207,8 @@
;; The following is to take care of any minor modes which override
;; a Calc command.
-(defvar calc-override-minor-modes-map
- (make-sparse-keymap)
- "A list of keybindings that might be overwritten by minor modes.")
+(defvar-keymap calc-override-minor-modes-map
+ :doc "A list of keybindings that might be overwritten by minor modes.")
;; Add any keys that might be overwritten here.
(define-key calc-override-minor-modes-map "`" 'calc-edit)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index f11d9741ec..127f6340a1 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1447,7 +1447,8 @@ Redefine the corresponding command."
(let ((calc-kbd-push-level 0))
(execute-kbd-macro (substring body 0 -2))))
(let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
- (message "%s" "Saving modes; type Z' to restore")
+ ;; Avoid substituting the "'" character:
+ (message "%s" "Saving modes; type Z' to restore")
(recursive-edit))))))
(defun calc-kbd-pop ()
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 0e8ea42bed..758b920184 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -52,18 +52,14 @@ With a prefix, push that prefix as a number onto the stack."
(calc-less-recursion-depth n)
(let ((n (if n (prefix-numeric-value n) 2)))
(if (> n 1)
- (setq max-specpdl-size (* max-specpdl-size n)
- max-lisp-eval-depth (* max-lisp-eval-depth n))))
+ (setq max-lisp-eval-depth (* max-lisp-eval-depth n))))
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))))
(defun calc-less-recursion-depth (n)
(interactive "P")
(let ((n (if n (prefix-numeric-value n) 2)))
(if (> n 1)
- (setq max-specpdl-size
- (max (/ max-specpdl-size n) 600)
- max-lisp-eval-depth
- (max (/ max-lisp-eval-depth n) 200))))
+ (setq max-lisp-eval-depth (max (/ max-lisp-eval-depth n) 200))))
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 504ba5b40d..35014e022b 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -668,13 +668,11 @@ Interactively, reads the register using
`register-read-with-preview'."
(backward-char 1)
(calc-set-command-flag 'do-edit))
-(defvar calc-edit-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\n" #'calc-edit-finish)
- (define-key map "\r" #'calc-edit-return)
- (define-key map "\C-c\C-c" #'calc-edit-finish)
- map)
- "Keymap for use by the `calc-edit' command.")
+(defvar-keymap calc-edit-mode-map
+ :doc "Keymap for use by the `calc-edit' command."
+ "C-j" #'calc-edit-finish
+ "RET" #'calc-edit-return
+ "C-c C-c" #'calc-edit-finish)
(defvar calc-original-buffer nil)
(defvar calc-return-buffer nil)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 6c21430b1b..6ea8a4202f 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1162,7 +1162,7 @@ Used by `calc-user-invocation'.")
;;;; (Autoloads here)
-(load "calc-loaddefs.el" nil t)
+(load "calc-loaddefs" nil t)
;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch)
@@ -1373,10 +1373,8 @@ Notations: 3.14e6 3.14 * 10^6
(calc-check-defines))
(setplist 'calc-define nil)))))
-(defvar calc-trail-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map calc-mode-map)
- map))
+(defvar-keymap calc-trail-mode-map
+ :parent calc-mode-map)
(defun calc--header-line (long short width &optional fudge)
"Return a Calc header line appropriate for the buffer WIDTH.
@@ -1627,8 +1625,7 @@ See calc-keypad for details."
(error
(if (and (eq (car err) 'error)
(stringp (nth 1 err))
- (string-match "max-specpdl-size\\|max-lisp-eval-depth"
- (nth 1 err)))
+ (string-search "max-lisp-eval-depth" (nth 1 err)))
(error (substitute-command-keys
"Computation got stuck or ran too long. Type \\`M' to
increase the limit"))
(setq calc-aborted-prefix nil)
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 4febad53fc..211e0f1e62 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -384,7 +384,8 @@ Moves forward if ARG is negative."
;;;###cal-autoload
(defun calendar-goto-day-of-year (year day &optional noecho)
"Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is non-nil.
-Negative DAY counts backward from end of year."
+Negative DAY counts backward from end of year.
+Interactively, prompt for YEAR and DAY number."
(interactive
(let* ((year (calendar-read-sexp
"Year (>0)"
@@ -394,7 +395,7 @@ Negative DAY counts backward from end of year."
(day (calendar-read-sexp
"Day number (+/- 1-%d)"
(lambda (x) (and (<= 1 (abs x)) (<= (abs x) last)))
- nil
+ (calendar-day-number (calendar-current-date))
last)))
(list year day)))
(calendar-goto-date
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 6b6cc517a2..e36119984b 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -137,9 +137,6 @@ This variable only has effect if set with \\[customize]."
(defvar timeclock-update-timer nil
"The timer used to update `timeclock-mode-string'.")
-(define-obsolete-variable-alias 'timeclock-modeline-display
- 'timeclock-mode-line-display "24.3")
-
;; For byte-compiler.
(defvar display-time-hook)
(defvar timeclock-mode-line-display)
@@ -259,9 +256,6 @@ The time is bracketed by <> if you are clocked in,
otherwise by [].")
;;; User Functions:
-(define-obsolete-function-alias 'timeclock-modeline-display
- 'timeclock-mode-line-display "24.3")
-
;;;###autoload
(define-minor-mode timeclock-mode-line-display
"Toggle display of the amount of time left today in the mode line.
@@ -612,9 +606,6 @@ arguments of `completing-read'."
"Ask the user for the reason they are clocking out."
(completing-read "Reason for clocking out: " timeclock-reason-list))
-(define-obsolete-function-alias 'timeclock-update-modeline
- 'timeclock-update-mode-line "24.3")
-
(defun timeclock-update-mode-line ()
"Update the `timeclock-mode-string' displayed in the mode line.
The value of `timeclock-relative' affects the display as described in
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index 78edea1da8..8458820bdd 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -34,8 +34,7 @@
"Initialize a new configure.ac in ROOTDIR for PROGRAM using TESTFILE.
ROOTDIR is the root directory of a given autoconf controlled project.
PROGRAM is the program to be configured.
-TESTFILE is the file used with AC_INIT.
-Configure the initial configure script using `autoconf-new-automake-string'."
+TESTFILE is the file used with AC_INIT."
(interactive "DRoot Dir: \nsProgram: \nsTest File: ")
(require 'ede/srecode)
(if (bufferp rootdir)
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/pulse.el b/lisp/cedet/pulse.el
index 9941f2a0cb..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)
@@ -202,12 +202,8 @@ If POINT is nil or missing, the current point is used
instead.
Optional argument FACE specifies the face to do the highlighting."
(save-excursion
(goto-char (or point (point)))
- (let ((start (line-beginning-position))
- (end (save-excursion
- (end-of-line)
- (when (not (eobp))
- (forward-char 1))
- (point))))
+ (let ((start (progn (vertical-motion 0) (point)))
+ (end (progn (vertical-motion 1) (point))))
(pulse-momentary-highlight-region start end face))))
;;;###autoload
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 02ebde4078..f72e206908 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -342,9 +342,6 @@ Return a list of tags."
)
taglst))))
-(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist
- #'help-function-arglist "24.3")
-
(provide 'semantic/db-el)
;;; semantic/db-el.el ends here
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index e2c9d618ba..0fc6806e40 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -70,8 +70,6 @@ passes a list of predicates in
`semanticdb-project-predicate-functions'."
:type '(repeat (choice (string :tag "Directory") (const never) (const always)
(const project))))
-(define-obsolete-variable-alias 'semanticdb-save-database-hooks
- 'semanticdb-save-database-functions "24.3")
(defcustom semanticdb-save-database-functions nil
"Abnormal hook run after a database is saved.
Each function is called with one argument, the object representing
diff --git a/lisp/cedet/semantic/ede-grammar.el
b/lisp/cedet/semantic/ede-grammar.el
index ff9f991ff4..40ff8fc86d 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -177,10 +177,9 @@ Lays claim to all -by.el, and -wy.el files."
(cl-defmethod ede-proj-makefile-insert-rules :after ((this
semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target.
-This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
-needed for the compilation of the resulting parsers."
- (insert (format "%s: EMACSFLAGS+= --eval '(setq max-specpdl-size 1500 \
-max-lisp-eval-depth 700)'\n"
+This raises `max-lisp-eval-depth', which can be needed for the compilation
+of the resulting parsers."
+ (insert (format "%s: EMACSFLAGS+= --eval '(setq max-lisp-eval-depth
700)'\n"
(oref this name))))
(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this
semantic-ede-proj-target-grammar))
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 4679500ed9..4efc283520 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -72,8 +72,6 @@ updated in the current buffer.
For language specific hooks, make sure you define this as a local hook.")
-(define-obsolete-variable-alias 'semantic-change-hooks
- 'semantic-change-functions "24.3")
(defvar semantic-change-functions
'(semantic-edits-change-function-handle-changes)
"Abnormal hook run when semantic detects a change in a buffer.
@@ -91,14 +89,10 @@ If the hook returns non-nil, then declare that a reparse is
needed.
For language specific hooks, make sure you define this as a local hook.
Not used yet; part of the next generation reparse mechanism.")
-(define-obsolete-variable-alias 'semantic-edits-new-change-hooks
- 'semantic-edits-new-change-functions "24.3")
(defvar semantic-edits-new-change-functions nil
"Abnormal hook run when a new change is found.
Functions must take one argument representing an overlay on that change.")
-(define-obsolete-variable-alias 'semantic-edits-delete-change-hooks
- 'semantic-edits-delete-change-functions "24.3")
(defvar semantic-edits-delete-change-functions nil
"Abnormal hook run before a change overlay is deleted.
Deleted changes occur when multiple changes are merged.
@@ -110,8 +104,6 @@ Changes move when a new change overlaps an old change. The
old change
will be moved.
Functions must take one argument representing an overlay being moved.")
-(define-obsolete-variable-alias 'semantic-edits-reparse-change-hooks
- 'semantic-edits-reparse-change-functions "24.3")
(defvar semantic-edits-reparse-change-functions nil
"Abnormal hook run after a change results in a reparse.
Functions are called before the overlay is deleted, and after the
@@ -136,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/fw.el b/lisp/cedet/semantic/fw.el
index 113323cb33..9917c4c5be 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -339,7 +339,7 @@ calling this one."
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.
FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'."
- (let* ((recentf-exclude #'always)
+ (let* ((recentf-exclude '(always))
;; This is a brave statement. Don't waste time loading in
;; lots of modes. Especially decoration mode can waste a lot
;; of time for a buffer we intend to kill.
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index d42022e042..8ba0e346ff 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1009,7 +1009,6 @@ Return non-nil if there were no errors, nil if errors."
packagename (byte-compile-dest-file packagename))
(let (;; Some complex grammar table expressions need a few
;; more resources than the default.
- (max-specpdl-size (max 3000 max-specpdl-size))
(max-lisp-eval-depth (max 1000 max-lisp-eval-depth))
)
;; byte compile the resultant file
@@ -1148,9 +1147,9 @@ END is the limit of the search."
(defvar semantic-grammar-mode-keywords-1
`(("\\(\\<%%\\>\\|\\<%[{}]\\)"
- 0 font-lock-reference-face)
+ 0 font-lock-constant-face)
("\\(%\\)\\(\\(\\sw\\|\\s_\\)+\\)"
- (1 font-lock-reference-face)
+ (1 font-lock-constant-face)
(2 font-lock-keyword-face))
("\\<error\\>"
0 (unless (semantic-grammar-in-lisp-p) 'bold))
@@ -1167,7 +1166,8 @@ END is the limit of the search."
(,semantic-grammar-lex-c-char-re
0 ,(if (boundp 'font-lock-constant-face)
'font-lock-constant-face
- 'font-lock-string-face) t)
+ 'font-lock-string-face)
+ t)
;; Must highlight :keyword here, because ':' is a punctuation in
;; grammar mode!
("[\r\n\t ]+:\\sw+\\>"
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 75c4ee328d..b3c9e96538 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -718,8 +718,6 @@ This is an alist of (ANCHOR . STREAM) elements where ANCHOR
is the
start position of the block, and STREAM is the list of tokens in that
block.")
-(define-obsolete-variable-alias 'semantic-lex-reset-hooks
- 'semantic-lex-reset-functions "24.3")
(defvar semantic-lex-reset-functions nil
"Abnormal hook used by major-modes to reset lexical analyzers.
Hook functions are called with START and END values for the
diff --git a/lisp/cedet/semantic/mru-bookmark.el
b/lisp/cedet/semantic/mru-bookmark.el
index 9dee0415a3..c3f59a3358 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -264,11 +264,9 @@ been edited, and you can re-visit them with
\\[semantic-mrub-switch-tags]."
:group 'semantic
:type 'hook)
-(defvar semantic-mru-bookmark-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km "\C-xB" #'semantic-mrub-switch-tags)
- km)
- "Keymap for mru-bookmark minor mode.")
+(defvar-keymap semantic-mru-bookmark-mode-map
+ :doc "Keymap for mru-bookmark minor mode."
+ "C-x B" #'semantic-mrub-switch-tags)
(define-minor-mode semantic-mru-bookmark-mode
"Minor mode for tracking tag-based bookmarks automatically.
diff --git a/lisp/cedet/semantic/util-modes.el
b/lisp/cedet/semantic/util-modes.el
index 33fed9191e..96d1de5a26 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -196,10 +196,8 @@ Argument OVERLAY is the overlay created to mark the change.
This function will set the face property on this overlay."
(overlay-put overlay 'face 'semantic-highlight-edits-face))
-(defvar semantic-highlight-edits-mode-map
- (let ((km (make-sparse-keymap)))
- km)
- "Keymap for highlight-edits minor mode.")
+(defvar-keymap semantic-highlight-edits-mode-map
+ :doc "Keymap for highlight-edits minor mode.")
;;;###autoload
(define-minor-mode semantic-highlight-edits-mode
@@ -343,11 +341,9 @@ Do not search past BOUND if non-nil."
(setq ol (cdr ol))))))
ol)))
-(defvar semantic-show-unmatched-syntax-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km "\C-c,`" #'semantic-show-unmatched-syntax-next)
- km)
- "Keymap for command `semantic-show-unmatched-syntax-mode'.")
+(defvar-keymap semantic-show-unmatched-syntax-mode-map
+ :doc "Keymap for command `semantic-show-unmatched-syntax-mode'."
+ "C-c , `" #'semantic-show-unmatched-syntax-next)
;;;###autoload
(define-minor-mode semantic-show-unmatched-syntax-mode
@@ -417,10 +413,8 @@ non-nil if the minor mode is enabled.
:group 'semantic
:type 'hook)
-(defvar semantic-show-parser-state-mode-map
- (let ((km (make-sparse-keymap)))
- km)
- "Keymap for show-parser-state minor mode.")
+(defvar-keymap semantic-show-parser-state-mode-map
+ :doc "Keymap for show-parser-state minor mode.")
;;;###autoload
(define-minor-mode semantic-show-parser-state-mode
@@ -553,11 +547,9 @@ to indicate a parse in progress."
:group 'semantic
:type 'hook)
-(defvar semantic-stickyfunc-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km [ header-line down-mouse-1 ] #'semantic-stickyfunc-menu)
- km)
- "Keymap for stickyfunc minor mode.")
+(defvar-keymap semantic-stickyfunc-mode-map
+ :doc "Keymap for stickyfunc minor mode."
+ "<header-line> <down-mouse-1>" #'semantic-stickyfunc-menu)
(defvar semantic-stickyfunc-popup-menu nil
"Menu used if the user clicks on the header line used by stickyfunc mode.")
@@ -824,11 +816,9 @@ Argument EVENT describes the event that caused this
function to be called."
:group 'semantic
:type 'hook)
-(defvar semantic-highlight-func-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km [mouse-3] #'semantic-highlight-func-menu)
- km)
- "Keymap for highlight-func minor mode.")
+(defvar-keymap semantic-highlight-func-mode-map
+ :doc "Keymap for highlight-func minor mode."
+ "<mouse-3>" #'semantic-highlight-func-menu)
(defvar semantic-highlight-func-popup-menu nil
"Menu used if the user clicks on the header line.
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/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/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 724a6e0a94..cc0983f9f9 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -179,13 +179,11 @@ Don't scan past LIMIT."
Once the escape_start, and escape_end sequences are known, then
we can tell font lock about them.")
-(defvar srecode-template-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km "\C-c\C-c" #'srecode-compile-templates)
- (define-key km "\C-c\C-m" #'srecode-macro-help)
- (define-key km "/" #'srecode-self-insert-complete-end-macro)
- km)
- "Keymap used in srecode mode.")
+(defvar-keymap srecode-template-mode-map
+ :doc "Keymap used in srecode mode."
+ "C-c C-c" #'srecode-compile-templates
+ "C-c C-m" #'srecode-macro-help
+ "/" #'srecode-self-insert-complete-end-macro)
;;;###autoload
(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
@@ -260,9 +258,9 @@ we can tell font lock about them.")
(when (class-abstract-p C)
(throw 'skip nil))
- (princ (substitute-command-keys "`"))
+ (princ (substitute-quotes "`"))
(princ name)
- (princ (substitute-command-keys "'"))
+ (princ (substitute-quotes "'"))
(when (slot-exists-p C 'key)
(when key
(princ " - Character Key: ")
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 05ae52cae0..43e3cd45ec 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -24,6 +24,8 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(eval-and-compile
(put 'char-fold-table 'char-table-extra-slots 1)
(defconst char-fold--default-override nil)
@@ -48,6 +50,7 @@
(eval-and-compile
+ (defvar char-fold--no-regexp nil)
(defun char-fold--make-table ()
(let* ((equiv (make-char-table 'char-fold-table))
(equiv-multi (make-char-table 'char-fold-table))
@@ -201,11 +204,14 @@
symmetric)))
;; Convert the lists of characters we compiled into regexps.
- (map-char-table
- (lambda (char decomp-list)
- (let ((re (regexp-opt (cons (char-to-string char) decomp-list))))
- (aset equiv char re)))
- equiv)
+ (unless char-fold--no-regexp
+ ;; Non-nil `char-fold--no-regexp' unoptimized for regexp
+ ;; is used by `describe-char-fold-equivalences'.
+ (map-char-table
+ (lambda (char decomp-list)
+ (let ((re (regexp-opt (cons (char-to-string char) decomp-list))))
+ (aset equiv char re)))
+ equiv))
equiv)))
(defconst char-fold-table
@@ -421,6 +427,68 @@ BOUND NOERROR COUNT are passed to `re-search-backward'."
(interactive "sSearch: ")
(re-search-backward (char-fold-to-regexp string) bound noerror count))
+
+;;;###autoload
+(defun describe-char-fold-equivalences (char &optional lax)
+ "Display characters equivalent to CHAR under character-folding.
+Prompt for CHAR (using `read-char-by-name', which see for how to
+specify the character). With no input, i.e. when CHAR is nil,
+describe all available character equivalences of `char-fold-to-regexp'.
+Optional argument LAX (interactively, the prefix argument), if
+non-nil, means also include partially matching ligatures and
+non-canonical equivalences."
+ (interactive (list (ignore-errors
+ (read-char-by-name
+ (format-prompt "Unicode name, single char, or hex"
+ "all")
+ t))
+ current-prefix-arg))
+ (require 'help-fns)
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-char-fold-equivalences)
+ (called-interactively-p 'interactive))
+ (let* ((equivalences nil)
+ (char-fold--no-regexp t)
+ (table (char-fold--make-table))
+ (extra (char-table-extra-slot table 0)))
+ (if (not char)
+ (map-char-table
+ (lambda (char list)
+ (when lax
+ (setq list (append list (mapcar (lambda (entry)
+ (cdr entry))
+ (aref extra char)))))
+ (setq equivalences (cons (cons char list)
+ equivalences)))
+ table)
+ (setq equivalences (aref table char))
+ (when lax
+ (setq equivalences (append equivalences
+ (mapcar (lambda (entry)
+ (cdr entry))
+ (aref extra char)))))
+ (setq equivalences (cons (char-to-string char) equivalences)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (if char
+ (insert
+ (mapconcat
+ (lambda (c)
+ (format "%s: %s\n"
+ c
+ (mapconcat
+ (lambda (ch)
+ (format "?\\N{%s}"
+ (or (get-char-code-property ch 'name)
+ (get-char-code-property ch
'old-name))))
+ c)))
+ equivalences))
+ (insert "A list of char-fold equivalences for
`char-fold-to-regexp':\n\n")
+ (setq-local bidi-paragraph-direction 'left-to-right)
+ (dolist (equiv (nreverse equivalences))
+ (insert (format "%c: %s\n" (car equiv)
+ (string-join (cdr equiv) " "))))))))))
+
(provide 'char-fold)
;;; char-fold.el ends here
diff --git a/lisp/comint.el b/lisp/comint.el
index 3ed04f098c..07ced8d321 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -103,6 +103,7 @@
(require 'ring)
(require 'ansi-color)
+(require 'ansi-osc)
(require 'regexp-opt) ;For regexp-opt-charset.
(eval-when-compile (require 'subr-x))
@@ -1944,6 +1945,7 @@ Similarly for Soar, Scheme, etc."
(when comint-highlight-input
(add-text-properties beg end
'( font-lock-face comint-highlight-input
+
comint--fontify-input-inhibit-fontification t
front-sticky t )))
(unless comint-use-prompt-regexp
;; Give old user input a field property of `input', to
@@ -2145,6 +2147,12 @@ 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.
@@ -3268,8 +3276,6 @@ See `comint-word'."
(defun comint--unquote-argument (str)
(car (comint--unquote&requote-argument str)))
-(define-obsolete-function-alias 'comint--unquote&expand-filename
- #'comint--unquote-argument "24.3")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
@@ -3290,14 +3296,6 @@ Magic characters are those in
`comint-file-name-quote-list'."
(setq i (1+ (match-end 0)))))
filename))))
-(defun comint-unquote-filename (filename)
- "Return FILENAME with quoted characters unquoted."
- (declare (obsolete nil "24.3"))
- (if (null comint-file-name-quote-list)
- filename
- (save-match-data
- (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
-
(defun comint--requote-argument (upos qstr)
;; See `completion-table-with-quoting'.
(let ((res (comint--unquote&requote-argument qstr upos)))
@@ -3923,12 +3921,12 @@ REGEXP-GROUP is the regular expression group in REGEXP
to use."
;; to `comint-osc-handlers' allows a customized treatment of further
;; sequences.
-(defvar-local comint-osc-handlers '(("7" . comint-osc-directory-tracker)
- ("8" . comint-osc-hyperlink-handler))
- "Alist of handlers for OSC escape sequences.
-See `comint-osc-process-output' for details.")
-
-(defvar-local comint-osc--marker nil)
+;; Aliases defined for reverse compatibility
+(defvaralias 'comint-osc-handlers 'ansi-osc-handlers)
+(defalias 'comint-osc-directory-tracker 'ansi-osc-directory-tracker)
+(defalias 'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler)
+(defalias 'comint-osc-hyperlink 'ansi-osc-hyperlink)
+(defvaralias 'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map)
(defun comint-osc-process-output (_)
"Interpret OSC escape sequences in comint output.
@@ -3944,83 +3942,321 @@ removed from the buffer. Then, if `command' is a key
of the
`comint-osc-handlers' alist, the corresponding value, which
should be a function, is called with `command' and `text' as
arguments, with point where the escape sequence was located."
- (let ((bound (process-mark (get-buffer-process (current-buffer)))))
- (save-excursion
- ;; Start one char before last output to catch a possibly stray ESC
- (goto-char (or comint-osc--marker (1- comint-last-output-start)))
- (when (eq (char-before) ?\e) (backward-char))
- (while (re-search-forward "\e]" bound t)
- (let ((pos0 (match-beginning 0))
- (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" bound t)
- (match-string 1)))
- (pos1 (point)))
- (if (re-search-forward "\a\\|\e\\\\" bound t)
- (let ((text (buffer-substring-no-properties
- pos1 (match-beginning 0))))
- (setq comint-osc--marker nil)
- (delete-region pos0 (point))
- (when-let ((fun (cdr (assoc-string code comint-osc-handlers))))
- (funcall fun code text)))
- (put-text-property pos0 bound 'invisible t)
- (setq comint-osc--marker (copy-marker pos0))))))))
-
-;; Current directory tracking (OSC 7)
-
-(declare-function url-host "url/url-parse.el")
-(declare-function url-type "url/url-parse.el")
-(declare-function url-filename "url/url-parse.el")
-(defun comint-osc-directory-tracker (_ text)
- "Update `default-directory' from OSC 7 escape sequences.
-
-This function is intended to be included as an entry of
-`comint-osc-handlers'. You should moreover arrange for your
-shell to print the appropriate escape sequence at each prompt,
-say with the following command:
-
- printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
-
-This functionality serves as an alternative to `dirtrack-mode'
-and `shell-dirtrack-mode'."
- (let ((url (url-generic-parse-url text)))
- (when (and (string= (url-type url) "file")
- (or (null (url-host url))
- (string= (url-host url) (system-name))))
- (ignore-errors
- (cd-absolute (url-unhex-string (url-filename url)))))))
-
-;; Hyperlink handling (OSC 8)
-
-(defvar comint-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.")
-
-(define-button-type 'comint-osc-hyperlink
- 'keymap comint-osc-hyperlink-map
- 'help-echo (lambda (_ buffer pos)
- (when-let ((url (get-text-property pos 'browse-url-data
buffer)))
- (format "mouse-2, C-c RET: Open %s" url))))
-
-(defvar-local comint-osc-hyperlink--state nil)
-
-(defun comint-osc-hyperlink-handler (_ text)
- "Create a hyperlink from an OSC 8 escape sequence.
-This function is intended to be included as an entry of
-`comint-osc-handlers'."
- (when comint-osc-hyperlink--state
- (let ((start (car comint-osc-hyperlink--state))
- (url (cdr comint-osc-hyperlink--state)))
- (make-text-button start (point)
- 'type 'comint-osc-hyperlink
- 'browse-url-data url)))
- (setq comint-osc-hyperlink--state
- (and (string-match ";\\(.+\\)" text)
- (cons (point-marker) (match-string-no-properties 1 text)))))
+ (let ((start (1- comint-last-output-start))
+ ;; Start one char before last output to catch a possibly stray ESC
+ (bound (process-mark (get-buffer-process (current-buffer)))))
+ (ansi-osc-apply-on-region start bound)))
+;;; Input fontification and indentation through an indirect buffer
+;;============================================================================
+;;
+;; Modes derived from `comint-mode' can set up fontification and
+;; indentation of input text with the help of an indirect buffer whose
+;; major mode and font-lock settings are set accordingly.
+
+(defvar-local comint-indirect-setup-function nil
+ "Function to set up an indirect comint fontification buffer.
+This function is called by `comint-indirect-buffer' with zero
+arguments after making an indirect buffer. It is usually set to
+a major-mode command whose font-locking and indentation are
+desired for input text. In order to prevent possible mode hooks
+from running, the variable `delay-mode-hooks' is set to t prior
+to calling this function and `change-major-mode-hook' along with
+`after-change-major-mode-hook' are bound to nil.")
+
+(defcustom comint-indirect-setup-hook nil
+ "Hook run in an indirect buffer for input fontification.
+Input fontification and indentation, if enabled, is performed in
+an indirect buffer, whose major mode and syntax highlighting are
+set up according to `comint-indirect-setup-function'. After this
+setup is done, run this hook with the indirect buffer as the
+current buffer. This can be used to further customize
+fontification and other behavior of the indirect buffer."
+ :group 'comint
+ :type 'hook
+ :version "29.1")
+
+(defvar-local comint--indirect-buffer nil
+ "Indirect buffer used for input fontification.")
+
+(defvar-local comint--fontify-input-saved-jit-lock-contextually nil)
+
+(define-minor-mode comint-fontify-input-mode
+ "Enable input fontification in the current comint buffer.
+This minor mode is useful if the current major mode derives from
+`comint-mode' and if `comint-indirect-setup-function' is set.
+Comint modes that support input fontification usually set this
+variable buffer-locally to a major-mode command whose
+font-locking is desired for input text.
+
+Input text is fontified through an indirect buffer created with
+`comint-indirect-buffer', which see.
+
+This function signals an error if `comint-use-prompt-regexp' is
+non-nil. Input fontification isn't compatible with this
+setting."
+ :lighter nil
+ (if comint-fontify-input-mode
+ (let ((success nil))
+ (unwind-protect
+ (progn
+ (comint--fontify-input-on)
+ (setq success t))
+ (unless success
+ (setq comint-fontify-input-mode nil)
+ (comint--fontify-input-off))))
+ (comint--fontify-input-off)))
+
+(defun comint--fontify-input-on ()
+ "Enable input fontification in the current comint buffer."
+ (comint--fontify-input-off)
+
+ (when comint-use-prompt-regexp
+ (error
+ "Input fontification is incompatible with `comint-use-prompt-regexp'"))
+
+ (add-function :around (local 'font-lock-fontify-region-function)
+ #'comint--fontify-input-fontify-region)
+ ;; `before-change-functions' are only run in the current buffer and
+ ;; not in its indirect buffers, which means that we must manually
+ ;; flush ppss cache
+ (add-hook 'before-change-functions
+ #'comint--fontify-input-ppss-flush-indirect 99 t)
+
+ ;; Set up contextual fontification
+ (unless (booleanp jit-lock-contextually)
+ (setq comint--fontify-input-saved-jit-lock-contextually
+ jit-lock-contextually)
+ (setq-local jit-lock-contextually t)
+ (when jit-lock-mode
+ (jit-lock-mode t))))
+
+(defun comint--fontify-input-off ()
+ "Disable input fontification in the current comint buffer."
+ (remove-function (local 'font-lock-fontify-region-function)
+ #'comint--fontify-input-fontify-region)
+ (remove-hook 'before-change-functions
+ #'comint--fontify-input-ppss-flush-indirect t)
+
+ ;; Reset contextual fontification
+ (when comint--fontify-input-saved-jit-lock-contextually
+ (setq-local jit-lock-contextually
+ comint--fontify-input-saved-jit-lock-contextually)
+ (setq comint--fontify-input-saved-jit-lock-contextually nil)
+ (when jit-lock-mode
+ (jit-lock-mode t)))
+
+ (font-lock-flush))
+
+(defun comint--fontify-input-ppss-flush-indirect (beg &rest rest)
+ (when-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (when (memq #'syntax-ppss-flush-cache before-change-functions)
+ (apply #'syntax-ppss-flush-cache beg rest)))))
+
+(defun comint--fontify-input-fontify-region (fun beg end verbose)
+ "Fontify process output and user input in the current comint buffer.
+First, fontify the region between BEG and END using FUN. Then
+fontify only the input text in the region with the help of an
+indirect buffer. VERBOSE is passed to the fontify-region
+functions. Skip fontification of input regions with non-nil
+`comint--fontify-input-inhibit-fontification' text property."
+ (pcase (funcall fun beg end verbose)
+ (`(jit-lock-bounds ,beg1 . ,end1)
+ (setq beg beg1 end end1)))
+ (pcase
+ (let ((min (point-min))
+ (max (point-max)))
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (comint--intersect-regions
+ nil (lambda (beg end)
+ (unless (get-text-property
+ beg 'comint--fontify-input-inhibit-fontification)
+ (font-lock-fontify-region beg end verbose)))
+ beg end)))
+ (`((jit-lock-bounds ,beg1 . ,_) . (jit-lock-bounds ,_ . ,end1))
+ (setq beg (min beg beg1))
+ (setq end (max end end1))))
+
+ `(jit-lock-bounds ,beg . ,end))
+
+(defun comint--intersect-regions (fun-output fun-input beg end)
+ "Iterate over comint output and input regions between BEG and END.
+Divide the region specified by BEG and END into smaller regions
+that cover either process output (its `field' property is `output')
+or input (all remaining text). Interchangeably call FUN-OUTPUT
+on each output region, and FUN-INPUT on each input region.
+
+FUN-OUTPUT and FUN-INPUT are passed two arguments, the beginning
+and end of the smaller region. Before calling each function,
+narrow the buffer to the surrounding process output or input. You
+can also pass nil as either function to skip its corresponding
+regions.
+
+Return a cons cell of return values of the first and last
+function called, or nil, if no function was called (if BEG = END)."
+ (let ((beg1 beg)
+ (end1 (copy-marker nil t))
+ (return-beg nil) (return-end nil)
+ (is-output (eq (get-text-property beg 'field) 'output)))
+ (setq end (copy-marker end t))
+
+ (while (< beg1 end)
+ (set-marker
+ end1 (or (if is-output
+ (text-property-not-all beg1 end 'field 'output)
+ (text-property-any beg1 end 'field 'output))
+ end))
+ (when-let ((fun (if is-output fun-output fun-input)))
+ (save-restriction
+ (let ((beg2 beg1)
+ (end2 end1))
+ (when (= beg2 beg)
+ (setq beg2 (field-beginning beg2)))
+ (when (= end2 end)
+ (setq end2 (field-end end2)))
+ ;; Narrow to the whole field surrounding the region
+ (narrow-to-region beg2 end2))
+ (setq return-end (list (funcall fun beg1
+ (marker-position end1)))))
+ (unless return-beg
+ (setq return-beg return-end)))
+ (setq beg1 (marker-position end1))
+ (setq is-output (not is-output)))
+
+ (set-marker end nil)
+ (set-marker end1 nil)
+ (when return-beg
+ (cons (car return-beg) (car return-end)))))
+
+(defun comint-indent-input-line (fun)
+ "Indent current line from comint process output or input.
+If point is on output, call FUN, otherwise indent the current
+line in the indirect buffer created by `comint-indirect-buffer',
+which see."
+ (if (or comint-use-prompt-regexp
+ (eq (get-text-property (point) 'field) 'output))
+ (funcall fun)
+ (let ((point (point))
+ (min (point-min))
+ (max (point-max)))
+ (unwind-protect
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (goto-char point)
+ (narrow-to-region (field-beginning) (field-end))
+ (unwind-protect (funcall indent-line-function)
+ (setq point (point))))
+ (goto-char point)))))
+
+(defun comint-indent-input-region (fun start end)
+ "Indent comint process output and input between START and END.
+Output text between START and END is indented with FUN and input
+text is indented in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (if comint-use-prompt-regexp
+ (funcall fun start end)
+ (let ((opoint (copy-marker (point)))
+ final-point)
+ (unwind-protect
+ (comint--intersect-regions
+ (lambda (start end)
+ (goto-char opoint)
+ (if (= opoint (point))
+ (unwind-protect (funcall fun start end)
+ (setq final-point (copy-marker (point))))
+ (funcall fun start end)))
+ (lambda (start end)
+ (let ((min (point-min))
+ (max (point-max))
+ (final-point1 nil))
+ (unwind-protect
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (goto-char opoint)
+ (if (= opoint (point))
+ (unwind-protect
+ (funcall indent-region-function start end)
+ (setq final-point1 (point)))
+ (funcall indent-region-function start end)))
+ (when final-point1
+ (setq final-point (copy-marker final-point1))))))
+ start end)
+ (if final-point
+ (progn
+ (goto-char final-point)
+ (set-marker final-point nil))
+ (goto-char opoint))
+ (set-marker opoint nil)))))
+
+(defun comint-indent-input-line-default ()
+ "Indent current line from comint process output or input.
+If point is on output, indent the current line according to the
+default value of `indent-line-function', otherwise indent the
+current line in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (comint-indent-input-line (default-value 'indent-line-function)))
+
+(defun comint-indent-input-region-default (start end)
+ "Indent comint process output and input between START and END.
+Output text between START and END is indented according to the
+default value of `indent-region-function' and input text is
+indented in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (comint-indent-input-region (default-value 'indent-line-function)
+ start end))
+
+(defun comint-indirect-buffer (&optional no-create)
+ "Return an indirect comint fontification buffer.
+If an indirect buffer for the current buffer already exists,
+return it, otherwise create it first and set it up by calling
+`comint-indirect-setup-function' with zero arguments, turning on
+font-lock, and running `comint-indirect-setup-hook'. This setup
+happens with `delay-mode-hooks' set to t in order to prevent
+possible SETUP-FUN's mode hooks from running.
+
+If an indirect buffer doesn't exist and NO-CREATE is non-nil,
+return nil."
+ (or
+ comint--indirect-buffer
+ (unless no-create
+ (let ((setup-hook
+ (if (local-variable-p 'comint-indirect-setup-hook)
+ (list comint-indirect-setup-hook)))
+ (setup-fun comint-indirect-setup-function))
+
+ (add-hook 'change-major-mode-hook #'comint--indirect-cleanup
+ nil t)
+
+ (with-current-buffer
+ (setq comint--indirect-buffer
+ (make-indirect-buffer
+ (current-buffer)
+ (generate-new-buffer-name
+ (concat " " (buffer-name) "-comint-indirect"))))
+ (setq-local delay-mode-hooks t)
+ (when setup-fun
+ (let ((change-major-mode-hook nil)
+ (after-change-major-mode-hook nil))
+ (funcall setup-fun)))
+ (setq-local font-lock-dont-widen t)
+ (setq-local font-lock-support-mode nil)
+ (font-lock-mode)
+ (when setup-hook
+ (setq-local comint-indirect-setup-hook
+ (car setup-hook)))
+ (run-hooks 'comint-indirect-setup-hook))
+ comint--indirect-buffer))))
+
+(defun comint--indirect-cleanup ()
+ (when comint--indirect-buffer
+ (kill-buffer comint--indirect-buffer)
+ (setq comint--indirect-buffer nil)))
+
+
+
;;; Converting process modes to use comint mode
;;============================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index bb07a0694a..3f18202aff 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -175,7 +175,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(prin1 (sort found #'string<))))
alist))))))
(dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
- (insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n")))
+ (insert "(custom--add-custom-loads '" (car e) " '" (cdr e) ")\n")))
(insert "\
;; The remainder of this file is for handling :version.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index d3768766be..e043d9bc17 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1546,7 +1546,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))
@@ -4298,7 +4298,12 @@ restoring it to the state of a face that has never been
customized."
"A Lisp fringe bitmap name."
:format "%v"
:tag "Fringe bitmap"
- :match (lambda (_widget value) (fringe-bitmap-p value))
+ :match (lambda (_widget value)
+ ;; In no-X builds (where `fringe-bitmaps' is undefined),
+ ;; allow anything. This ensures that customizations set on
+ ;; a with-X build aren't considered invalid under no-X.
+ (or (not (boundp 'fringe-bitmaps))
+ (fringe-bitmap-p value)))
:completions (apply-partially #'completion-table-with-predicate
obarray #'fringe-bitmap-p 'strict)
:prompt-match 'fringe-bitmap-p
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 0e1cb4589d..d7fb56c985 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -251,7 +251,6 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
;; emacs.c
(report-emacs-bug-address emacsbug string)
;; eval.c
- (max-specpdl-size limits integer)
(max-lisp-eval-depth limits integer)
(max-mini-window-height limits
(choice (const :tag "quarter screen" nil)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 69ec837db8..b891f24154 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -142,7 +142,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
@@ -496,7 +496,7 @@ It includes all faces in list FACES."
(princ (substitute-command-keys " in `"))
(help-insert-xref-button (file-name-nondirectory fn)
'help-theme-def fn)
- (princ (substitute-command-keys "'")))
+ (princ (substitute-quotes "'")))
(princ ".\n")
(if (custom-theme-p theme)
(progn
diff --git a/lisp/custom.el b/lisp/custom.el
index 96dfb37d86..0d3e2e5d0c 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -674,8 +674,6 @@ property, or (ii) an alias for another customizable
variable."
"Return the standard value of VARIABLE."
(eval (car (get variable 'standard-value)) t))
-(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
-
(defun custom-note-var-changed (variable)
"Inform Custom that VARIABLE has been set (changed).
VARIABLE is a symbol that names a user option.
@@ -1154,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."
@@ -1166,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\".
@@ -1374,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,
@@ -1709,6 +1768,13 @@ If a choice with the same tag already exists, no action
is taken."
(put variable 'custom-type
(append choices (list choice))))))
+(defun custom--add-custom-loads (symbol loads)
+ ;; Don't overwrite existing `custom-loads'.
+ (dolist (load (get symbol 'custom-loads))
+ (unless (memq load loads)
+ (push load loads)))
+ (put symbol 'custom-loads loads))
+
(provide 'custom)
;;; custom.el ends here
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 94b2baf72d..327a4f038b 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -987,7 +987,7 @@ Also see the `dired-confirm-shell-command' variable."
;; Add 'wait' to force those POSIX shells to wait until
;; all commands finish.
(or (and parallel-in-background (not w32-shell)
- "&wait")
+ " &wait")
"")))
(t
(let ((files (mapconcat #'shell-quote-argument
@@ -999,7 +999,7 @@ Also see the `dired-confirm-shell-command' variable."
;; Be consistent in how we treat inputs to commands -- do
;; the same here as in the `on-each' case.
(if (and in-background (not w32-shell))
- "&wait"
+ " &wait"
"")))))
(or (and in-background "&")
""))))
@@ -1169,6 +1169,10 @@ Return the result of `process-file' - zero for success."
;; Optional decompression.
"unxz")
+ ;; zstandard archives
+ `(,(rx (or ".tar.zst" ".tzst") eos) "unzstd -c %i | tar -xf -")
+ `(,(rx ".zst" eos) "unzstd --rm")
+
'("\\.shar\\.Z\\'" "zcat * | unshar")
'("\\.shar\\.g?z\\'" "gunzip -qc * | unshar")
@@ -2876,6 +2880,10 @@ of `dired-dwim-target', which see.
Also see `dired-do-revert-buffer'."
(interactive "P")
+ (when (seq-find (lambda (file)
+ (member (file-name-nondirectory file) '("." "..")))
+ (dired-get-marked-files nil arg))
+ (user-error "Can't rename \".\" or \"..\" files"))
(dired-do-create-files 'move #'dired-rename-file
"Move" arg dired-keep-marker-rename "Rename"))
@@ -3470,7 +3478,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."
@@ -3544,7 +3552,8 @@ Intended to be added to `isearch-mode-hook'."
The returned function narrows the search to match the search string
only as part of a file name enclosed by the text property `dired-filename'.
It's intended to override the default search function."
- (isearch-search-fun-in-text-property (funcall orig-fun) 'dired-filename))
+ (isearch-search-fun-in-text-property
+ (funcall orig-fun) '(dired-filename dired-symlink-filename)))
;;;###autoload
(defun dired-isearch-filenames ()
diff --git a/lisp/dired.el b/lisp/dired.el
index f45d215ed6..209e270942 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -508,15 +508,6 @@ This is what the do-commands look for, and what the
mark-commands store.")
(defvar dired-del-marker ?D
"Character used to flag files for deletion.")
-(defvar dired-shrink-to-fit t
- ;; I see no reason ever to make this nil -- rms.
- ;; (> baud-rate search-slow-speed)
- "Non-nil means Dired shrinks the display buffer to fit the marked files.")
-(make-obsolete-variable 'dired-shrink-to-fit
- "use the Customization interface to add a new rule
-to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
-action argument symbol is `window-height' and its value is nil." "24.3")
-
(defvar dired-file-version-alist)
;;;###autoload
@@ -786,7 +777,7 @@ Subexpression 2 must end right before the \\n.")
nil
'(1 'dired-broken-symlink)
'(2 dired-symlink-face)
- '(3 'dired-broken-symlink)))
+ '(3 '(face dired-broken-symlink dired-symlink-filename t))))
;;
;; Symbolic link to a directory.
(list dired-re-sym
@@ -798,7 +789,7 @@ Subexpression 2 must end right before the \\n.")
'(dired-move-to-filename)
nil
'(1 dired-symlink-face)
- '(2 dired-directory-face)))
+ '(2 '(face dired-directory-face dired-symlink-filename t))))
;;
;; Symbolic link to a non-directory.
(list dired-re-sym
@@ -812,7 +803,7 @@ Subexpression 2 must end right before the \\n.")
'(dired-move-to-filename)
nil
'(1 dired-symlink-face)
- '(2 'default)))
+ '(2 '(face default dired-symlink-filename t))))
;;
;; Sockets, pipes, block devices, char devices.
(list dired-re-special
@@ -1466,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)
@@ -1920,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
@@ -2259,8 +2254,6 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
"M-s f C-M-s" #'dired-isearch-filenames-regexp
;; misc
"<remap> <read-only-mode>" #'dired-toggle-read-only
- ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
- "<remap> <toggle-read-only>" #'dired-toggle-read-only
"?" #'dired-summary
"DEL" #'dired-unmark-backward
"<remap> <undo>" #'dired-undo
@@ -2967,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))
@@ -3675,16 +3668,16 @@ non-empty directories is allowed."
case-fold-search markers)
(if (save-excursion (goto-char (point-min))
(re-search-forward regexp nil t))
- (dired-internal-do-deletions
- (nreverse
- ;; this can't move point since ARG is nil
- (dired-map-over-marks (cons (dired-get-filename)
- (let ((m (point-marker)))
- (push m markers)
- m))
- nil))
- nil t)
- (dolist (m markers) (set-marker m nil))
+ (progn
+ (dired-internal-do-deletions
+ (nreverse
+ (dired-map-over-marks (cons (dired-get-filename)
+ (let ((m (point-marker)))
+ (push m markers)
+ m))
+ nil))
+ nil t)
+ (dolist (m markers) (set-marker m nil)))
(or nomessage
(message "(No deletions requested)")))))
@@ -3746,7 +3739,10 @@ non-empty directories is allowed."
(progress-reporter-update progress-reporter succ)
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
- #'dired-delete-entry fn))
+ #'dired-delete-entry fn)
+ ;; For when FN's directory name is different
+ ;; from the current buffer's dired-directory.
+ (dired-delete-entry fn))
(quit (throw '--delete-cancel (message "OK, canceled")))
(error ;; catch errors from failed deletions
(dired-log "%s: %s\n" (car err) (error-message-string err))
@@ -3876,28 +3872,6 @@ or \"* [3 files]\"."
(format "[next %d files]" arg)
(format "%c [%d files]" dired-marker-char count)))))
-(defun dired-pop-to-buffer (buf)
- "Pop up buffer BUF in a way suitable for Dired."
- (declare (obsolete pop-to-buffer "24.3"))
- (let ((split-window-preferred-function
- (lambda (window)
- (or (and (let ((split-height-threshold 0))
- (window-splittable-p (selected-window)))
- ;; Try to split the selected window vertically if
- ;; that's possible. (Bug#1806)
- (split-window-below))
- ;; Otherwise, try to split WINDOW sensibly.
- (split-window-sensibly window))))
- pop-up-frames)
- (pop-to-buffer (get-buffer-create buf)))
- ;; See Bug#12281.
- (set-window-start nil (point-min))
- ;; If dired-shrink-to-fit is t, make its window fit its contents.
- (when dired-shrink-to-fit
- ;; Try to not delete window when we want to display less than
- ;; `window-min-height' lines.
- (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t)))
-
(defcustom dired-no-confirm nil
"A list of symbols for commands Dired should not confirm, or t.
Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
@@ -4587,9 +4561,6 @@ Possible values:
(t (concat "Dired " dired-actual-switches))))))
(force-mode-line-update)))
-(define-obsolete-function-alias 'dired-sort-set-modeline
- #'dired-sort-set-mode-line "24.3")
-
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle sorting by date, and refresh the Dired buffer.
With a prefix argument, edit the current listing switches instead."
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 422728c61c..f0ee3d1d78 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -296,6 +296,78 @@ in `.emacs'."
(if (coding-system-p c) c 'latin-1))))
(standard-display-european-internal)))
+
+;;;###autoload
+(defun standard-display-by-replacement-char (&optional repl from to)
+ "Produce code to display characters between FROM and TO using REPL.
+This function produces a buffer with code to set up `standard-display-table'
+such that characters that cannot be displayed by the terminal, and
+don't already have their display set up in `standard-display-table', will
+be represented by a replacement character. You can evaluate the produced
+code to use the setup for the current Emacs session, or copy the code
+into your init file, to make Emacs use it for subsequent sessions.
+
+Interactively, the produced code arranges for any character in
+the range [#x100..#x10FFFF] that the terminal cannot display to
+be represented by the #xFFFD Unicode replacement character.
+
+When called from Lisp, FROM and TO define the range of characters for
+which to produce the setup code for `standard-display-table'. If they
+are omitted, they default to #x100 and #x10FFFF respectively, covering
+the entire non-ASCII range of Unicode characters.
+REPL is the replacement character to use. If it's omitted, it defaults
+to #xFFFD, the Unicode replacement character, usually displayed as a
+black diamond with a question mark inside.
+The produced code sets up `standard-display-table' to show REPL with
+the `homoglyph' face, making the replacements stand out on display.
+
+This command is most useful with text-mode terminals, such as the
+Linux console, for which Emacs has a reliable way of determining
+which characters can be displayed and which cannot."
+ (interactive)
+ (or repl
+ (setq repl #xfffd))
+ (or (and from to (<= from to))
+ (setq from #x100
+ to (max-char 'unicode)))
+ (let ((buf (get-buffer-create "*Display replacements*"))
+ (ch from)
+ (tbl standard-display-table)
+ first)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert "\
+;; This code was produced by `standard-display-by-replacement-char'.
+;; Evaluate the Lisp code below to make Emacs show the standard
+;; replacement character as a substitute for each undisplayable character.
+;; One way to do that is with \"C-x h M-x eval-region RET\".
+;; Normally you would put this code in your Emacs initialization file,
+;; perhaps conditionally based on the type of terminal, so that
+;; this setup happens automatically on each startup.
+(let ((tbl (or standard-display-table
+ (setq standard-display-table (make-display-table)))))\n")
+ (while (<= ch to)
+ (cond
+ ((or (char-displayable-p ch)
+ (aref tbl ch))
+ (setq ch (1+ ch)))
+ (t
+ (setq first ch)
+ (while (and (<= ch to)
+ (not (or (char-displayable-p ch)
+ (aref tbl ch))))
+ (setq ch (1+ ch)))
+ (insert
+ " (set-char-table-range tbl '("
+ (format "#x%x" first)
+ " . "
+ (format "#x%x" (1- ch))
+ ")\n\ (vconcat (list (make-glyph-code "
+ (format "#x%x" repl) " 'homoglyph))))\n"))))
+ (insert ")\n"))
+ (pop-to-buffer buf)))
+
+
(provide 'disp-table)
;;; disp-table.el ends here
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 70852885a8..b2e93a63de 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -370,8 +370,8 @@ currently being held down. It should only be called upon a
;; the standard (i.e. Qt programs).
"text/plain" "text/plain;charset=utf-8")
(cl-ecase action
- ('copy 'XdndActionCopy)
- ('move 'XdndActionMove))
+ (copy 'XdndActionCopy)
+ (move 'XdndActionMove))
frame nil allow-same-frame)))
(cond
((eq return-value 'XdndActionCopy) 'copy)
@@ -457,9 +457,9 @@ currently being held down. It should only be called upon a
;; programs.
"_DT_NETFILE")
(cl-ecase action
- ('copy 'XdndActionCopy)
- ('move 'XdndActionMove)
- ('link 'XdndActionLink))
+ (copy 'XdndActionCopy)
+ (move 'XdndActionMove)
+ (link 'XdndActionLink))
frame nil allow-same-frame)))
(cond
((eq return-value 'XdndActionCopy) 'copy)
@@ -527,9 +527,9 @@ FILES will be dragged."
;; and Haiku.
"FILE_NAME" "HOST_NAME")
(cl-ecase action
- ('copy 'XdndActionCopy)
- ('move 'XdndActionMove)
- ('link 'XdndActionLink))
+ (copy 'XdndActionCopy)
+ (move 'XdndActionMove)
+ (link 'XdndActionLink))
frame nil allow-same-frame)))
(cond
((eq return-value 'XdndActionCopy) 'copy)
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 29da3b4297..b1ea90c212 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -153,7 +153,7 @@
"In-buffer document viewer.
The viewer handles PDF, PostScript, DVI, DJVU, ODF, EPUB, CBZ,
FB2, XPS and OXPS files, if the appropriate converter programs
-are available (see Info node `(emacs)Document View')"
+are available (see Info node `(emacs)Document View')."
:link '(function-link doc-view)
:version "22.2"
:group 'applications
@@ -209,6 +209,45 @@ are available (see Info node `(emacs)Document View')"
function)
:version "24.4")
+(defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg)
+ "Whether to use svg images for PDF files."
+ :type 'boolean
+ :version "29.1")
+
+(defcustom doc-view-imenu-enabled (and (executable-find "mutool") t)
+ "Whether to generate an imenu outline when \"mutool\" is available."
+ :type 'boolean
+ :version "29.1")
+
+(defcustom doc-view-imenu-title-format "%t (%p)"
+ "Format spec for imenu's display of section titles from docview documents.
+
+The special markers '%t' and '%p' are replaced by the section
+title and page number in this format string, which uses
+`format-spec'.
+
+For instance, setting this variable to \"%t\" will produce items
+showing only titles and no page number."
+ :type 'string
+ :version "29.1")
+
+(defcustom doc-view-imenu-flatten nil
+ "Whether to flatten the list of sections in an imenu or show it nested."
+ :type 'boolean
+ :version "29.1")
+
+(defcustom doc-view-svg-background "white"
+ "Background color for svg images.
+See `doc-view-mupdf-use-svg'."
+ :type 'color
+ :version "29.1")
+
+(defcustom doc-view-svg-foreground "black"
+ "Foreground color for svg images.
+See `doc-view-mupdf-use-svg'."
+ :type 'color
+ :version "29.1")
+
(defcustom doc-view-ghostscript-options
'("-dSAFER" ;; Avoid security problems when rendering files from untrusted
;; sources.
@@ -1562,6 +1601,9 @@ ARGS is a list of image descriptors."
(setq args `(,@args :width ,doc-view-image-width)))
(unless (member :transform-smoothing args)
(setq args `(,@args :transform-smoothing t)))
+ (when (eq doc-view--image-type 'svg)
+ (setq args `(,@args :background
,doc-view-svg-background
+ :foreground
,doc-view-svg-foreground)))
(apply #'create-image file doc-view--image-type nil
args))))
(slice (doc-view-current-slice))
(img-width (and image (car (image-size image))))
@@ -1854,6 +1896,81 @@ If BACKWARD is non-nil, jump to the previous match."
(y-or-n-p "No more matches before current page. Wrap to last
match? "))
(doc-view-goto-page (caar (last doc-view--current-search-matches)))))))
+;;;; Imenu support
+(defconst doc-view--outline-rx
+ "[^\t]+\\(\t+\\)\"\\(.+\\)\"\t#\\(?:page=\\)?\\([0-9]+\\)")
+
+(defvar-local doc-view--outline nil
+ "Cached PDF outline, so that it is only computed once per document.")
+
+(defun doc-view--pdf-outline (&optional file-name)
+ "Return a list describing the outline of FILE-NAME.
+Return a list describing the current file if FILE-NAME is nil.
+
+Each element in the returned list contains information about a section's
+title, nesting level and page number. The list is flat: its tree
+structure is extracted by `doc-view--imenu-subtree'."
+ (let ((fn (or file-name (buffer-file-name))))
+ (when fn
+ (let ((outline nil)
+ (fn (shell-quote-argument (expand-file-name fn))))
+ (with-temp-buffer
+ (insert (shell-command-to-string (format "mutool show %s outline"
fn)))
+ (goto-char (point-min))
+ (while (re-search-forward doc-view--outline-rx nil t)
+ (push `((level . ,(length (match-string 1)))
+ (title . ,(replace-regexp-in-string "\\\\[rt]" " "
+ (match-string 2)))
+ (page . ,(string-to-number (match-string 3))))
+ outline)))
+ (nreverse outline)))))
+
+(defun doc-view--imenu-subtree (outline act)
+ "Construct a tree of imenu items for the given outline list and action.
+
+This auxliary function constructs recursively all the items for
+the first node in the outline and all its siblings at the same
+level. Returns that imenu alist together with any other pending outline
+entries at an upper level."
+ (let ((level (alist-get 'level (car outline)))
+ (nested (not doc-view-imenu-flatten))
+ (index nil))
+ (while (and (car outline)
+ (or (not nested)
+ (<= level (alist-get 'level (car outline)))))
+ (let-alist (car outline)
+ (let ((title (format-spec doc-view-imenu-title-format
+ `((?t . ,.title) (?p . ,.page)))))
+ (if (and nested (> .level level))
+ (let ((sub (doc-view--imenu-subtree outline act))
+ (fst (car index)))
+ (setq index (cdr index))
+ (push (cons (car fst) (cons fst (car sub))) index)
+ (setq outline (cdr sub)))
+ (push `(,title 0 ,act ,.page) index)
+ (setq outline (cdr outline))))))
+ (cons (nreverse index) outline)))
+
+(defun doc-view-imenu-index (&optional file-name goto-page-fn)
+ "Create an imenu index using \"mutool\" to extract its outline.
+
+For extensibility, callers can specify a FILE-NAME to indicate
+the buffer other than the current buffer, and a jumping function
+GOTO-PAGE-FN other than `doc-view-goto-page'."
+ (let* ((goto (or goto-page-fn 'doc-view-goto-page))
+ (act (lambda (_name _pos page) (funcall goto page)))
+ (outline (or doc-view--outline (doc-view--pdf-outline file-name))))
+ (car (doc-view--imenu-subtree outline act))))
+
+(defun doc-view-imenu-setup ()
+ "Set up local state in the current buffer for imenu, if needed."
+ (when (and doc-view-imenu-enabled (executable-find "mutool"))
+ (setq-local imenu-create-index-function #'doc-view-imenu-index
+ imenu-submenus-on-top nil
+ imenu-sort-function nil
+ doc-view--outline (doc-view--pdf-outline))
+ (when doc-view--outline (imenu-add-to-menubar "Outline"))))
+
;;;; User interface commands and the mode
(put 'doc-view-mode 'mode-class 'special)
@@ -1983,7 +2100,11 @@ If BACKWARD is non-nil, jump to the previous match."
(pcase-let ((`(,conv-function ,type ,extension)
(pcase doc-view-doc-type
('djvu (list #'doc-view-djvu->tiff-converter-ddjvu 'tiff
"tif"))
- (_ (list doc-view-pdf->png-converter-function 'png
"png")))))
+ (_ (if (and (eq doc-view-pdf->png-converter-function
+ #'doc-view-pdf->png-converter-mupdf)
+ doc-view-mupdf-use-svg)
+ (list doc-view-pdf->png-converter-function 'svg "svg")
+ (list doc-view-pdf->png-converter-function 'png
"png"))))))
(setq-local doc-view-single-page-converter-function conv-function)
(setq-local doc-view--image-type type)
(setq-local doc-view--image-file-pattern (concat "page-%s." extension))))
@@ -2023,7 +2144,7 @@ If BACKWARD is non-nil, jump to the previous match."
"Major mode in DocView buffers.
DocView Mode is an Emacs document viewer. It displays PDF, PS
-and DVI files (as PNG images) in Emacs buffers.
+and DVI files (as PNG or SVG images) in Emacs buffers.
You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to
toggle between displaying the document or editing it as text.
@@ -2118,6 +2239,7 @@ toggle between displaying the document or editing it as
text.
(setq mode-name "DocView"
buffer-read-only t
major-mode 'doc-view-mode)
+ (doc-view-imenu-setup)
(doc-view-initiate-display)
;; Switch off view-mode explicitly, because doc-view-mode is the
;; canonical view mode for PDF/PS/DVI files. This could be
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/ebuff-menu.el b/lisp/ebuff-menu.el
index 2b1fc916d9..809a31d457 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -203,9 +203,6 @@ See the documentation of `electric-buffer-list' for
details."
(setq mode-line-buffer-identification "Electric Buffer List")
(setq-local Helper-return-blurb "return to buffer editing"))
-(define-obsolete-function-alias 'Electric-buffer-menu-mode
- #'electric-buffer-menu-mode "24.3")
-
;; generally the same as Buffer-menu-mode-map
;; (except we don't indirect to global-map)
(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index aa415a3e9e..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."
@@ -81,6 +81,17 @@ string that was matched."
(function-item :tag "Sort by newness" ecomplete-newness)
(function :tag "Other")))
+(defcustom ecomplete-auto-select nil
+ "Whether `ecomplete-display-matches' should automatically select a sole
option."
+ :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)
@@ -94,21 +105,39 @@ string that was matched."
(insert-file-contents ecomplete-database-file)
(setq ecomplete-database (read (current-buffer)))))))
-(defun ecomplete-add-item (type key text)
- "Add item TEXT of TYPE to the database, using KEY as the identifier."
+(defun ecomplete-add-item (type key text &optional force)
+ "Add item TEXT of TYPE to the database, using KEY as the identifier.
+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 (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."
+ (unless ecomplete-database
+ (ecomplete-setup))
+ (let ((elems (assq type ecomplete-database)))
(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 (>= (length text) (length oldtext))
- text oldtext))))
- (nconc elems (list (list key 1 now text))))))
+ (user-error "No elements of type %s" type))
+ (let ((entry (assoc key elems)))
+ (unless entry
+ (user-error "No entry with key %s" key))
+ (setcdr elems (delq entry (cdr elems))))))
(defun ecomplete-get-item (type key)
"Return the text for the item identified by KEY of the required TYPE."
@@ -159,10 +188,14 @@ string that was matched."
(defun ecomplete-display-matches (type word &optional choose)
"Display the top-rated elements TYPE that match WORD.
If CHOOSE, allow the user to choose interactively between the
-matches."
+matches.
+
+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")))
+ (max-lines (and matches (- (length match-list) 2)))
(line 0)
- (max-lines (when matches (- (length (split-string matches "\n")) 2)))
(message-log-max nil)
command highlight)
(if (not matches)
@@ -173,25 +206,31 @@ matches."
(progn
(message "%s" matches)
nil)
- (setq highlight (ecomplete-highlight-match-line matches line))
- (let ((local-map (make-sparse-keymap))
- (prev-func (lambda () (setq line (max (1- line) 0))))
- (next-func (lambda () (setq line (min (1+ line) max-lines))))
- selected)
- (define-key local-map (kbd "RET")
- (lambda () (setq selected (nth line (split-string matches "\n")))))
- (define-key local-map (kbd "M-n") next-func)
- (define-key local-map (kbd "<down>") next-func)
- (define-key local-map (kbd "M-p") prev-func)
- (define-key local-map (kbd "<up>") prev-func)
- (let ((overriding-local-map local-map))
- (while (and (null selected)
- (setq command (read-key-sequence highlight))
- (lookup-key local-map command))
- (apply (key-binding command) nil)
- (setq highlight (ecomplete-highlight-match-line matches line))))
- (message (or selected "Abort"))
- selected)))))
+ (if (and ecomplete-auto-select
+ max-lines
+ (zerop max-lines))
+ ;; Auto-select when only one option is available.
+ (nth 0 match-list)
+ ;; Interactively choose from the filtered completions.
+ (let ((local-map (make-sparse-keymap))
+ (prev-func (lambda () (setq line (max (1- line) 0))))
+ (next-func (lambda () (setq line (min (1+ line) max-lines))))
+ selected)
+ (define-key local-map (kbd "RET")
+ (lambda () (setq selected (nth line match-list))))
+ (define-key local-map (kbd "M-n") next-func)
+ (define-key local-map (kbd "<down>") next-func)
+ (define-key local-map (kbd "M-p") prev-func)
+ (define-key local-map (kbd "<up>") prev-func)
+ (let ((overriding-local-map local-map))
+ (setq highlight (ecomplete-highlight-match-line matches line))
+ (while (and (null selected)
+ (setq command (read-key-sequence highlight))
+ (lookup-key local-map command))
+ (apply (key-binding command) nil)
+ (setq highlight (ecomplete-highlight-match-line matches line))))
+ (message (or selected "Abort"))
+ selected))))))
(defun ecomplete-highlight-match-line (matches line)
(with-temp-buffer
@@ -248,6 +287,54 @@ matches."
ecomplete-sort-predicate))))
(complete-with-action action candidates string pred))))))
+(defun ecomplete--prompt-type ()
+ (unless ecomplete-database
+ (ecomplete-setup))
+ (if (length= ecomplete-database 1)
+ (caar ecomplete-database)
+ (completing-read "Item type to edit: "
+ (mapcar #'car ecomplete-database)
+ nil t)))
+
+(defun ecomplete-edit ()
+ "Prompt for an ecomplete item and allow editing it."
+ (interactive)
+ (let* ((type (ecomplete--prompt-type))
+ (data (cdr (assq type ecomplete-database)))
+ (key (completing-read "Key to edit: " data nil t))
+ (new (read-string "New value (empty to remove): "
+ (nth 3 (assoc key data)))))
+ (if (zerop (length new))
+ (progn
+ (ecomplete--remove-item type key)
+ (message "Removed %s" key))
+ (ecomplete-add-item type key new t)
+ (message "Updated %s to %s" key new))
+ (ecomplete-save)))
+
+(defun ecomplete-remove ()
+ "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)))
+ (match (read-regexp (format "Remove %s keys matching (regexp): "
+ type)))
+ (elems (seq-filter (lambda (elem)
+ (string-match-p match (car elem)))
+ data)))
+ (if (length= elems 0)
+ (message "No matching entries for %s" match)
+ (when (yes-or-no-p (format "Delete %s matching ecomplete %s? "
+ (length elems)
+ (if (length= elems 1)
+ "entry"
+ "entries")))
+ (dolist (elem elems)
+ (ecomplete--remove-item type (car elem)))
+ (ecomplete-save)
+ (message "Deleted entries")))))
+
(provide 'ecomplete)
;;; ecomplete.el ends here
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 70473770d1..d461698c88 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -209,7 +209,6 @@ frames where the source code location is known.")
"v" #'backtrace-toggle-locals
"#" #'backtrace-toggle-print-circle
":" #'backtrace-toggle-print-gensym
- "s" #'backtrace-goto-source
"RET" #'backtrace-help-follow-symbol
"+" #'backtrace-multi-line
"-" #'backtrace-single-line
@@ -754,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 882b1d68c4..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)
@@ -70,7 +71,7 @@ number of repetitions actually used."
(defun benchmark--adaptive (func time)
"Measure the run time of FUNC, calling it enough times to last TIME seconds.
-Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'."
+Result is (REPETITIONS . DATA) where DATA is as returned by `benchmark-call'."
(named-let loop ((repetitions 1)
(data (let ((x (list 0))) (setcdr x x) x)))
;; (message "Running %d iteration" repetitions)
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 27b0d33d3e..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))
@@ -737,7 +737,7 @@ for speeding up processing.")
reverse nreverse sort))
(setq form (nth 1 form))
t)
- ((memq head '(mapc setq setcar setcdr puthash))
+ ((memq head '(mapc setq setcar setcdr puthash set))
(setq form (nth 2 form))
t)
((memq head '(aset put function-put))
@@ -793,6 +793,7 @@ for speeding up processing.")
sxhash sxhash-equal sxhash-eq sxhash-eql
sxhash-equal-including-properties
make-marker copy-marker point-marker mark-marker
+ set-marker
kbd key-description
always))
t)
@@ -811,7 +812,7 @@ for speeding up processing.")
(defun byte-compile-nilconstp (form)
"Return non-nil if FORM always evaluates to a nil value."
(setq form (byte-opt--bool-value-form form))
- (or (not form) ; assume (quote nil) always being normalised to nil
+ (or (not form) ; assume (quote nil) always being normalized to nil
(and (consp form)
(let ((head (car form)))
;; FIXME: There are many other expressions that are statically
nil.
@@ -1183,7 +1184,7 @@ See Info node `(elisp) Integer Basics'."
(if (equal new-args (cdr form))
;; Input is unchanged: keep original form, and don't represent
;; a nil result explicitly because that would lead to infinite
- ;; growth when the optimiser is iterated.
+ ;; growth when the optimizer is iterated.
(setq nil-result nil)
(setq form (cons (car form) new-args)))
@@ -1531,15 +1532,16 @@ See Info node `(elisp) Integer Basics'."
(put 'set 'byte-optimizer #'byte-optimize-set)
(defun byte-optimize-set (form)
- (let ((var (car-safe (cdr-safe form))))
- (cond
- ((and (eq (car-safe var) 'quote) (consp (cdr var)))
- `(setq ,(cadr var) ,@(cddr form)))
- ((and (eq (car-safe var) 'make-local-variable)
- (eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
- (consp (cdr var)))
- `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
- (t form))))
+ (pcase (cdr form)
+ ;; Make sure we only turn `set' into `setq' for dynamic variables.
+ (`((quote ,(and var (guard (and (symbolp var)
+ (not (macroexp--const-symbol-p var))
+ (not (assq var byte-optimize--lexvars))))))
+ ,newval)
+ `(setq ,var ,newval))
+ (`(,(and ml `(make-local-variable ,(and v `(quote ,_)))) ,newval)
+ `(progn ,ml (,(car form) ,v ,newval)))
+ (_ form)))
;; enumerating those functions which need not be called if the returned
;; value is not used. That is, something like
@@ -1999,20 +2001,20 @@ If FOR-EFFECT is non-nil, the return value is assumed
to be of no importance."
(setq keep-going t)
(setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
(setq rest (cdr rest))
- (cond ((= tmp 1)
+ (cond ((eql tmp 1)
(byte-compile-log-lap
" %s discard\t-->\t<deleted>" lap0)
(setq lap (delq lap0 (delq lap1 lap))))
- ((= tmp 0)
+ ((eql tmp 0)
(byte-compile-log-lap
" %s discard\t-->\t<deleted> discard" lap0)
(setq lap (delq lap0 lap)))
- ((= tmp -1)
+ ((eql tmp -1)
(byte-compile-log-lap
" %s discard\t-->\tdiscard discard" lap0)
(setcar lap0 'byte-discard)
(setcdr lap0 0))
- ((error "Optimizer error: too much on the stack"))))
+ (t (error "Optimizer error: too much on the stack"))))
;;
;; goto*-X X: --> X:
;;
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9a56ba0f7a..a33808ab92 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -112,44 +112,6 @@ So far, FUNCTION can only be a symbol, not a lambda
expression."
(function-put 'defmacro 'doc-string-elt 3)
(function-put 'defmacro 'lisp-indent-function 2)
-;; `macro-declaration-function' are both obsolete (as marked at the end of this
-;; file) but used in many .elc files.
-
-;; We don't use #' here, because it's an obsolete function, and we
-;; can't use `with-suppressed-warnings' here due to how this file is
-;; used in the bootstrapping process.
-(defvar macro-declaration-function 'macro-declaration-function
- "Function to process declarations in a macro definition.
-The function will be called with two args MACRO and DECL.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The value the function returns is not used.")
-
-(defalias 'macro-declaration-function
- #'(lambda (macro decl)
- "Process a declaration found in a macro definition.
-This is set as the value of the variable `macro-declaration-function'.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The return value of this function is not used."
- ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
- (let (d)
- ;; Ignore the first element of `decl' (it's always `declare').
- (while (setq decl (cdr decl))
- (setq d (car decl))
- (if (and (consp d)
- (listp (cdr d))
- (null (cdr (cdr d))))
- (cond ((eq (car d) 'indent)
- (put macro 'lisp-indent-function (car (cdr d))))
- ((eq (car d) 'debug)
- (put macro 'edebug-form-spec (car (cdr d))))
- ((eq (car d) 'doc-string)
- (put macro 'doc-string-elt (car (cdr d))))
- (t
- (message "Unknown declaration %s" d)))
- (message "Invalid declaration %s" d))))))
-
;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file
;; loaded by loadup.el that uses declarations in macros. We specify
@@ -519,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).
@@ -771,9 +738,4 @@ type is. This defaults to \"INFO\"."
;; (file-format emacs19))"
;; nil)
-(make-obsolete-variable 'macro-declaration-function
- 'macro-declarations-alist "24.3")
-(make-obsolete 'macro-declaration-function
- 'macro-declarations-alist "24.3")
-
;;; byte-run.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c25250533a..9f29ffbb8e 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."
@@ -1356,6 +1352,7 @@ FORMAT and ARGS are as in `byte-compile-warn'."
(let ((byte-compile-form-stack (cons arg byte-compile-form-stack)))
(apply #'byte-compile-warn format args)))
+;;;###autoload
(defun byte-compile-warn-obsolete (symbol type)
"Warn that SYMBOL (a variable, function or generalized variable) is obsolete.
TYPE is a string that say which one of these three types it is."
@@ -1404,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
@@ -1468,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)
@@ -1704,12 +1703,12 @@ URLs."
(+ " " (or
;; Arguments.
(+ (or (syntax symbol)
- (any word "-/:[]&=().?^\\#'")))
+ (any word "-/:[]&=()<>.,?^\\#*'\"")))
;; Argument that is a list.
(seq "(" (* (not ")")) ")")))
")")))
""
- ;; Heuristic: We can't reliably do `subsititute-command-keys'
+ ;; Heuristic: We can't reliably do `substitute-command-keys'
;; substitutions, since the value of a keymap in general can't be
;; known at compile time. So instead, we assume that these
;; substitutions are of some length N.
@@ -2320,9 +2319,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
@@ -2560,7 +2565,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)
@@ -3103,8 +3108,8 @@ lambda-expression."
;; Check that the bit after the `interactive' spec is
;; just a list of symbols (i.e., modes).
(unless (seq-every-p #'symbolp (cdr (cdr int)))
- (byte-compile-warn-x int "malformed interactive specc: %s"
- int))
+ (byte-compile-warn-x
+ int "malformed `interactive' specification: %s" int))
(setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
@@ -4658,13 +4663,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
@@ -4673,7 +4671,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 7f95fa94fa..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))
@@ -137,13 +105,24 @@ is less than this number.")
;; Alist associating to each function body the list of its free variables.
)
+(defvar cconv--interactive-form-funs
+ ;; Table used to hold the functions we create internally for
+ ;; 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 '())
@@ -151,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 '()))
@@ -257,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)
@@ -337,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))))
@@ -503,9 +478,23 @@ places where they originally did not directly appear."
cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
- (let ((docstring (if (eq :documentation (car-safe (car body)))
- (cconv-convert (cadr (pop body)) env extend))))
- (cconv--convert-function args body env form docstring)))
+ (let* ((docstring (if (eq :documentation (car-safe (car body)))
+ (cconv-convert (cadr (pop body)) env extend)))
+ (bf (if (stringp (car body)) (cdr body) body))
+ (if (when (eq 'interactive (car-safe (car bf)))
+ (gethash form cconv--interactive-form-funs)))
+ (cif (when if (cconv-convert if env extend)))
+ (_ (pcase cif
+ (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif
nil))
+ ('nil nil)
+ ;; The interactive form needs special treatment, so the form
+ ;; inside the `interactive' won't be used any further.
+ (_ (setf (cadr (car bf)) nil))))
+ (cf (cconv--convert-function args body env form docstring)))
+ (if (not cif)
+ ;; Normal case, the interactive form needs no special treatment.
+ cf
+ `(cconv--interactive-helper ,cf ,cif))))
(`(internal-make-closure . ,_)
(byte-compile-report-error
@@ -589,12 +578,12 @@ places where they originally did not directly appear."
(cconv-convert arg env extend))
(cons fun args)))))))
- (`(interactive . ,forms)
- `(,(car form) . ,(mapcar (lambda (form)
- (cconv-convert form nil nil))
- forms)))
+ ;; The form (if any) is converted beforehand as part of the `lambda' case.
+ (`(interactive . ,_) form)
- (`(declare . ,_) form) ;The args don't contain code.
+ ;; `declare' should now be macro-expanded away (and if they're not, we're
+ ;; in trouble because they *can* contain code nowadays).
+ ;; (`(declare . ,_) form) ;The args don't contain code.
(`(oclosure--fix-type (ignore . ,vars) ,exp)
(dolist (var vars)
@@ -615,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).
@@ -658,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.
@@ -666,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"
@@ -696,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.
@@ -711,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))
@@ -724,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)
@@ -739,6 +738,13 @@ This function does not return anything but instead fills
the
(`(function (lambda ,vrs . ,body-forms))
(when (eq :documentation (car-safe (car body-forms)))
(cconv-analyze-form (cadr (pop body-forms)) env))
+ (let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms)))
+ (when (eq 'interactive (car-safe (car bf)))
+ (let ((if (cadr (car bf))))
+ (unless (macroexp-const-p if) ;Optimize this common case.
+ (let ((f `#'(lambda () ,if)))
+ (setf (gethash form cconv--interactive-form-funs) f)
+ (cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))
(`(setq ,var ,expr)
@@ -771,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)))
@@ -787,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)
@@ -803,13 +810,8 @@ This function does not return anything but instead fills
the
(cconv-analyze-form fun env)))
(dolist (form args) (cconv-analyze-form form env)))
- (`(interactive . ,forms)
- ;; These appear within the function body but they don't have access
- ;; to the function's arguments.
- ;; We could extend this to allow interactive specs to refer to
- ;; variables in the function's enclosing environment, but it doesn't
- ;; seem worth the trouble.
- (dolist (form forms) (cconv-analyze-form form nil)))
+ ;; The form (if any) is converted beforehand as part of the `lambda' case.
+ (`(interactive . ,_) nil)
;; `declare' should now be macro-expanded away (and if they're not, we're
;; in trouble because they *can* contain code nowadays).
@@ -826,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 a5ab3a50ff..3f9bc28e0b 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -250,7 +250,7 @@ with these words enabled."
(defvar checkdoc-ispell-lisp-words
'("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp")
"List of words that are correct when spell-checking Lisp documentation.")
-;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable
#'checkdoc-list-of-strings-p)
+;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable
#'list-of-strings-p)
(defcustom checkdoc-max-keyref-before-warn nil
"If non-nil, number of \\\\=[command-to-keystroke] tokens allowed in a doc
string.
@@ -281,8 +281,6 @@ Currently, all recognized keywords must be on
`finder-known-keywords'."
:version "25.1"
:type 'boolean)
-(define-obsolete-variable-alias 'checkdoc-style-hooks
- 'checkdoc-style-functions "24.3")
(defvar checkdoc-style-functions nil
"Hook run after the standard style check is completed.
All functions must return nil or a string representing the error found.
@@ -292,8 +290,6 @@ Each hook is called with two parameters, (DEFUNINFO
ENDPOINT).
DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the
location of end of the documentation string.")
-(define-obsolete-variable-alias 'checkdoc-comment-style-hooks
- 'checkdoc-comment-style-functions "24.3")
(defvar checkdoc-comment-style-functions nil
"Hook run after the standard comment style check is completed.
Must return nil if no errors are found, or a string describing the
@@ -324,7 +320,7 @@ These words are ignored when unquoted symbols are searched
for.
This should be set in an Emacs Lisp file's local variables."
:type '(repeat (string :tag "Word"))
:version "28.1")
-;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable
#'checkdoc-list-of-strings-p)
+;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable
#'list-of-strings-p)
(defcustom checkdoc-column-zero-backslash-before-paren t
"Non-nil means to warn if there is no \"\\\" before \"(\" in column zero.
@@ -364,9 +360,9 @@ large number of libraries means it is impractical to fix all
of these warnings masse. In almost any other case, setting
this to anything but t is likely to be counter-productive.")
-;;;###autoload
(defun checkdoc-list-of-strings-p (obj)
"Return t when OBJ is a list of strings."
+ (declare (obsolete list-of-strings-p "29.1"))
;; this is a function so it might be shared by checkdoc-proper-noun-list
;; and/or checkdoc-ispell-lisp-words in the future
(and (listp obj)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 607810ee14..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))))
@@ -772,7 +772,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(help-insert-xref-button
(help-fns-short-filename location)
'cl-type-definition type location 'define-type)
- (insert (substitute-command-keys "'")))
+ (insert (substitute-quotes "'")))
(insert ".\n")
;; Parents.
@@ -782,7 +782,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(insert " Inherits from ")
(while (setq cur (pop pl))
(setq cur (cl--class-name cur))
- (insert (substitute-command-keys "`"))
+ (insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
'cl-help-type cur)
(insert (substitute-command-keys (if pl "', " "'"))))
@@ -796,7 +796,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(when ch
(insert " Children ")
(while (setq cur (pop ch))
- (insert (substitute-command-keys "`"))
+ (insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
'cl-help-type cur)
(insert (substitute-command-keys (if ch "', " "'"))))
@@ -815,10 +815,10 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(when generics
(insert (propertize "Specialized Methods:\n\n" 'face 'bold))
(dolist (generic generics)
- (insert (substitute-command-keys "`"))
+ (insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name generic)
'help-function generic)
- (insert (substitute-command-keys "'"))
+ (insert (substitute-quotes "'"))
(pcase-dolist (`(,qualifiers ,args ,doc)
(cl--generic-method-documentation generic type))
(insert (format " %s%S\n" qualifiers args)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 0560ddda26..7b6d43e572 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -94,11 +94,6 @@
;; This second one is closely related to what we do here (and that's
;; the name "generalizer" comes from).
-;; The autoloads.el mechanism which adds package--builtin-versions
-;; maintenance to loaddefs.el doesn't work for preloaded packages (such
-;; as this one), so we have to do it by hand!
-(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
-
;; Note: For generic functions that dispatch on several arguments (i.e. those
;; which use the multiple-dispatch feature), we always use the same "tagcodes"
;; and the same set of arguments on which to dispatch. This works, but is
@@ -425,11 +420,13 @@ the specializer used will be the one returned by BODY."
;; only called with explicit arguments.
(uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))
(λ-lift (mapcar #'car uses-cnm)))
- (if (not uses-cnm)
- (cons nil
- `#'(lambda (,@args)
- ,@(car parsed-body)
- ,nbody))
+ (cond
+ ((not uses-cnm)
+ (cons nil
+ `#'(lambda (,@args)
+ ,@(car parsed-body)
+ ,nbody)))
+ (lexical-binding
(cons 'curried
`#'(lambda (,nm) ;Called when constructing the effective
method.
(let ((,nmp (if (cl--generic-isnot-nnm-p ,nm)
@@ -465,7 +462,20 @@ the specializer used will be the one returned by BODY."
;; A destructuring-bind would do the trick
;; as well when/if it's more efficient.
(apply (lambda (,@λ-lift ,@args) ,nbody)
- ,@λ-lift ,arglist)))))))))
+ ,@λ-lift ,arglist)))))))
+ (t
+ (cons t
+ `#'(lambda (,cnm ,@args)
+ ,@(car parsed-body)
+ ,(macroexp-warn-and-return
+ "cl-defmethod used without lexical-binding"
+ (if (not (assq nmp uses-cnm))
+ nbody
+ `(let ((,nmp (lambda ()
+ (cl--generic-isnot-nnm-p ,cnm))))
+ ,nbody))
+ 'lexical t)))))
+ ))
(f (error "Unexpected macroexpansion result: %S" f))))))
(put 'cl-defmethod 'function-documentation
@@ -640,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-lib.el b/lisp/emacs-lisp/cl-lib.el
index a54fa21fa9..b83b44974d 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -89,12 +89,6 @@
(defvar cl--optimize-speed 1)
(defvar cl--optimize-safety 1)
-;;;###autoload
-(define-obsolete-variable-alias
- ;; This alias is needed for compatibility with .elc files that use defstruct
- ;; and were compiled with Emacs<24.3.
- 'custom-print-functions 'cl-custom-print-functions "24.3")
-
;;;###autoload
(defvar cl-custom-print-functions nil
"This is a list of functions that format user objects for printing.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 80ca43c902..beafee1d63 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -775,14 +775,34 @@ compared by `eql'.
\(fn EXPR (KEYLIST BODY...)...)"
(declare (indent 1) (debug (form &rest (sexp body))))
(macroexp-let2 macroexp-copyable-p temp expr
- (let* ((head-list nil))
+ (let* ((head-list nil)
+ (has-otherwise nil))
`(cond
,@(mapcar
(lambda (c)
- (cons (cond ((memq (car c) '(t otherwise)) t)
+ (cons (cond (has-otherwise
+ (error "Misplaced t or `otherwise' clause"))
+ ((memq (car c) '(t otherwise))
+ (setq has-otherwise t)
+ t)
((eq (car c) 'cl--ecase-error-flag)
`(error "cl-ecase failed: %s, %s"
,temp ',(reverse head-list)))
+ ((null (car c))
+ (macroexp-warn-and-return
+ "Case nil will never match"
+ nil 'suspicious))
+ ((and (consp (car c)) (cdar c) (not (cddar c))
+ (memq (caar c) '(quote function)))
+ (macroexp-warn-and-return
+ (format-message
+ (concat "Case %s will match `%s'. If "
+ "that's intended, write %s "
+ "instead. Otherwise, don't "
+ "quote `%s'.")
+ (car c) (caar c) (list (cadar c) (caar c))
+ (cadar c))
+ `(cl-member ,temp ',(car c)) 'suspicious))
((listp (car c))
(setq head-list (append (car c) head-list))
`(cl-member ,temp ',(car c)))
@@ -2261,139 +2281,131 @@ This is like `cl-flet', but for macros instead of
functions.
(eval `(function (lambda ,@res)) t))
macroexpand-all-environment))))))
-(defun cl--sm-macroexpand (orig-fun exp &optional env)
+(defun cl--sm-macroexpand (exp &optional env)
+ "Special macro expander used inside `cl-symbol-macrolet'."
+ ;; FIXME: Arguably, this should be the official definition of `macroexpand'.
+ (while (not (eq exp (setq exp (macroexpand-1 exp env)))))
+ exp)
+
+(defun cl--sm-macroexpand-1 (orig-fun exp &optional env)
"Special macro expander advice used inside `cl-symbol-macrolet'.
-This function extends `macroexpand' during macro expansion
+This function extends `macroexpand-1' during macro expansion
of `cl-symbol-macrolet' to additionally expand symbol macros."
- (let ((macroexpand-all-environment env)
+ (let ((exp (funcall orig-fun exp env))
(venv (alist-get :cl-symbol-macros env)))
- (while
- (progn
- (setq exp (funcall orig-fun exp env))
- (pcase exp
- ((pred symbolp)
- ;; Perform symbol-macro expansion.
- (let ((symval (assq exp venv)))
- (when symval
- (setq exp (cadr symval)))))
- (`(setq . ,args)
- ;; Convert setq to setf if required by symbol-macro expansion.
- (let ((convert nil)
- (rargs nil))
- (while args
- (let ((place (pop args)))
- ;; Here, we know `place' should be a symbol.
- (while
- (let ((symval (assq place venv)))
- (when symval
- (setq place (cadr symval))
- (if (symbolp place)
- t ;Repeat.
- (setq convert t)
- nil))))
- (push place rargs)
- (push (pop args) rargs)))
- (setq exp (cons (if convert 'setf 'setq)
- (nreverse rargs)))
- convert))
- ;; CL's symbol-macrolet used to treat re-bindings as candidates for
- ;; expansion (turning the let into a letf if needed), contrary to
- ;; Common-Lisp where such re-bindings hide the symbol-macro.
- ;; Not sure if there actually is code out there which depends
- ;; on this behavior (haven't found any yet).
- ;; Such code should explicitly use `cl-letf' instead, I think.
- ;;
- ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body)
pcase--dontcare))
- ;; (let ((letf nil) (found nil) (nbs ()))
- ;; (dolist (binding bindings)
- ;; (let* ((var (if (symbolp binding) binding (car binding)))
- ;; (sm (assq var venv)))
- ;; (push (if (not (cdr sm))
- ;; binding
- ;; (let ((nexp (cadr sm)))
- ;; (setq found t)
- ;; (unless (symbolp nexp) (setq letf t))
- ;; (cons nexp (cdr-safe binding))))
- ;; nbs)))
- ;; (when found
- ;; (setq exp `(,(if letf
- ;; (if (eq (car exp) 'let) 'cl-letf
'cl-letf*)
- ;; (car exp))
- ;; ,(nreverse nbs)
- ;; ,@body)))))
- ;;
- ;; We implement the Common-Lisp behavior, instead (see bug#26073):
- ;; The behavior of CL made sense in a dynamically scoped
- ;; language, but nowadays, lexical scoping semantics is more often
- ;; expected.
- (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare))
- (let ((nbs ()) (found nil))
- (dolist (binding bindings)
- (let* ((var (if (symbolp binding) binding (car binding)))
- (val (and found (consp binding) (eq 'let* (car exp))
- (list (macroexpand-all (cadr binding)
- env)))))
- (push (if (assq var venv)
- ;; This binding should hide "its" surrounding
- ;; symbol-macro, but given the way macroexpand-all
- ;; works (i.e. the `env' we receive as input will
- ;; be (re)applied to the code we return), we can't
- ;; prevent application of `env' to the
- ;; sub-expressions, so we need to α-rename this
- ;; variable instead.
- (let ((nvar (make-symbol (symbol-name var))))
- (setq found t)
- (push (list var nvar) venv)
- (push (cons :cl-symbol-macros venv) env)
- (cons nvar (or val (cdr-safe binding))))
- (if val (cons var val) binding))
- nbs)))
- (when found
- (setq exp `(,(car exp)
- ,(nreverse nbs)
- ,@(macroexp-unprogn
- (macroexpand-all (macroexp-progn body)
- env)))))
- nil))
- ;; Do the same as for `let' but for variables introduced
- ;; via other means, such as `lambda' and `condition-case'.
- (`(function (lambda ,args . ,body))
- (let ((nargs ()) (found nil))
- (dolist (var args)
- (push (cond
- ((memq var '(&optional &rest)) var)
- ((assq var venv)
- (let ((nvar (make-symbol (symbol-name var))))
- (setq found t)
- (push (list var nvar) venv)
- (push (cons :cl-symbol-macros venv) env)
- nvar))
- (t var))
- nargs))
- (when found
- (setq exp `(function
- (lambda ,(nreverse nargs)
- . ,(mapcar (lambda (exp)
- (macroexpand-all exp env))
- body)))))
- nil))
- ((and `(condition-case ,var ,exp . ,clauses)
- (guard (assq var venv)))
- (let ((nvar (make-symbol (symbol-name var))))
- (push (list var nvar) venv)
- (push (cons :cl-symbol-macros venv) env)
- (setq exp
- `(condition-case ,nvar ,(macroexpand-all exp env)
- . ,(mapcar
- (lambda (clause)
- `(,(car clause)
- . ,(mapcar (lambda (exp)
- (macroexpand-all exp env))
- (cdr clause))))
- clauses)))
- nil))
- )))
- exp))
+ (pcase exp
+ ((pred symbolp)
+ ;; Try symbol-macro expansion.
+ (let ((symval (assq exp venv)))
+ (if symval (cadr symval) exp)))
+ (`(setq . ,args)
+ ;; Convert setq to setf if required by symbol-macro expansion.
+ (let ((convert nil))
+ (while args
+ (let* ((place (pop args))
+ ;; Here, we know `place' should be a symbol.
+ (symval (assq place venv)))
+ (pop args)
+ (when symval
+ (setq convert t))))
+ (if convert
+ (cons 'setf (cdr exp))
+ exp)))
+ ;; CL's symbol-macrolet used to treat re-bindings as candidates for
+ ;; expansion (turning the let into a letf if needed), contrary to
+ ;; Common-Lisp where such re-bindings hide the symbol-macro.
+ ;; Not sure if there actually is code out there which depends
+ ;; on this behavior (haven't found any yet).
+ ;; Such code should explicitly use `cl-letf' instead, I think.
+ ;;
+ ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare))
+ ;; (let ((letf nil) (found nil) (nbs ()))
+ ;; (dolist (binding bindings)
+ ;; (let* ((var (if (symbolp binding) binding (car binding)))
+ ;; (sm (assq var venv)))
+ ;; (push (if (not (cdr sm))
+ ;; binding
+ ;; (let ((nexp (cadr sm)))
+ ;; (setq found t)
+ ;; (unless (symbolp nexp) (setq letf t))
+ ;; (cons nexp (cdr-safe binding))))
+ ;; nbs)))
+ ;; (when found
+ ;; (setq exp `(,(if letf
+ ;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+ ;; (car exp))
+ ;; ,(nreverse nbs)
+ ;; ,@body)))))
+ ;;
+ ;; We implement the Common-Lisp behavior, instead (see bug#26073):
+ ;; The behavior of CL made sense in a dynamically scoped
+ ;; language, but nowadays, lexical scoping semantics is more often
+ ;; expected.
+ (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare))
+ (let ((nbs ()) (found nil))
+ (dolist (binding bindings)
+ (let* ((var (if (symbolp binding) binding (car binding)))
+ (val (and found (consp binding) (eq 'let* (car exp))
+ (list (macroexpand-all (cadr binding)
+ env)))))
+ (push (if (assq var venv)
+ ;; This binding should hide "its" surrounding
+ ;; symbol-macro, but given the way macroexpand-all
+ ;; works (i.e. the `env' we receive as input will
+ ;; be (re)applied to the code we return), we can't
+ ;; prevent application of `env' to the
+ ;; sub-expressions, so we need to α-rename this
+ ;; variable instead.
+ (let ((nvar (make-symbol (symbol-name var))))
+ (setq found t)
+ (push (list var nvar) venv)
+ (push (cons :cl-symbol-macros venv) env)
+ (cons nvar (or val (cdr-safe binding))))
+ (if val (cons var val) binding))
+ nbs)))
+ (if found
+ `(,(car exp)
+ ,(nreverse nbs)
+ ,@(macroexp-unprogn
+ (macroexpand-all (macroexp-progn body)
+ env)))
+ exp)))
+ ;; Do the same as for `let' but for variables introduced
+ ;; via other means, such as `lambda' and `condition-case'.
+ (`(function (lambda ,args . ,body))
+ (let ((nargs ()) (found nil))
+ (dolist (var args)
+ (push (cond
+ ((memq var '(&optional &rest)) var)
+ ((assq var venv)
+ (let ((nvar (make-symbol (symbol-name var))))
+ (setq found t)
+ (push (list var nvar) venv)
+ (push (cons :cl-symbol-macros venv) env)
+ nvar))
+ (t var))
+ nargs))
+ (if found
+ `(function
+ (lambda ,(nreverse nargs)
+ . ,(mapcar (lambda (exp)
+ (macroexpand-all exp env))
+ body)))
+ exp)))
+ ((and `(condition-case ,var ,exp . ,clauses)
+ (guard (assq var venv)))
+ (let ((nvar (make-symbol (symbol-name var))))
+ (push (list var nvar) venv)
+ (push (cons :cl-symbol-macros venv) env)
+ `(condition-case ,nvar ,(macroexpand-all exp env)
+ . ,(mapcar
+ (lambda (clause)
+ `(,(car clause)
+ . ,(mapcar (lambda (exp)
+ (macroexpand-all exp env))
+ (cdr clause))))
+ clauses))))
+ (_ exp))))
;;;###autoload
(defmacro cl-symbol-macrolet (bindings &rest body)
@@ -2412,7 +2424,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf
EXPANSION ...).
(unwind-protect
(progn
(unless advised
- (advice-add 'macroexpand :around #'cl--sm-macroexpand))
+ (advice-add 'macroexpand :override #'cl--sm-macroexpand)
+ (advice-add 'macroexpand-1 :around #'cl--sm-macroexpand-1))
(let* ((venv (cdr (assq :cl-symbol-macros
macroexpand-all-environment)))
(expansion
@@ -2428,7 +2441,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf
EXPANSION ...).
expansion nil nil rev-malformed-bindings))
expansion)))
(unless advised
- (advice-remove 'macroexpand #'cl--sm-macroexpand)))))
+ (advice-remove 'macroexpand #'cl--sm-macroexpand)
+ (advice-remove 'macroexpand-1 #'cl--sm-macroexpand-1)))))
;;;###autoload
(defmacro cl-with-gensyms (names &rest body)
@@ -2762,11 +2776,17 @@ Each PLACE may be a symbol, or any generalized variable
allowed by `setf'.
(funcall setter vold)))
binds))))
(let* ((binding (car bindings))
- (place (macroexpand (car binding) macroexpand-all-environment)))
+ (place (car binding)))
(gv-letplace (getter setter) place
(macroexp-let2 nil vnew (cadr binding)
- (if (symbolp place)
+ (if (and (symbolp place)
+ ;; `place' could be some symbol-macro.
+ (eq place getter))
;; Special-case for simple variables.
+ ;; FIXME: We currently only use this special case when `place'
+ ;; is a simple var. Should we also use it when the
+ ;; macroexpansion of `place' is a simple var (i.e. when
+ ;; getter+setter is the same as that of a simple var)?
(cl--letf (cdr bindings)
(cons `(,getter ,(if (cdr binding) vnew getter))
simplebinds)
@@ -3105,7 +3125,7 @@ To see the documentation for a defined struct type, use
`(and ,pred-form t)))
forms)
(push `(eval-and-compile
- (put ',name 'cl-deftype-satisfies ',predicate))
+ (define-symbol-prop ',name 'cl-deftype-satisfies ',predicate))
forms))
(let ((pos 0) (descp descs))
(while descp
@@ -3570,7 +3590,7 @@ and then returning foo."
(cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
(cons '_cl-whole-arg args))
,@body)
- (put ',func 'compiler-macro #',fname))))
+ (define-symbol-prop ',func 'compiler-macro #',fname))))
;;;###autoload
(defun cl-compiler-macroexpand (form)
@@ -3679,8 +3699,8 @@ macro that returns its `&whole' argument."
The type name can then be used in `cl-typecase', `cl-check-type', etc."
(declare (debug cl-defmacro) (doc-string 3) (indent 2))
`(cl-eval-when (compile load eval)
- (put ',name 'cl-deftype-handler
- (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
+ (define-symbol-prop ',name 'cl-deftype-handler
+ (cl-function (lambda (&cl-defs ('*) ,@arglist)
,@body)))))
(cl-deftype extended-char () '(and character (not base-char)))
;; Define fixnum so `cl-typep' recognize it and the type check emitted
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 e10443588e..863e895efd 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.
@@ -178,14 +178,15 @@ and above."
:type '(repeat string)
:version "28.1")
-(defcustom native-comp-driver-options nil
+(defcustom native-comp-driver-options (when (eq system-type 'darwin)
+ '("-Wl,-w"))
"Options passed verbatim to the native compiler's back-end driver.
Note that not all options are meaningful; typically only the options
affecting the assembler and linker are likely to be useful.
Passing these options is only available in libgccjit version 9
and above."
- :type '(repeat string) ; FIXME is this right?
+ :type '(repeat string)
:version "28.1")
(defcustom comp-libgccjit-reproducer nil
@@ -462,7 +463,7 @@ Useful to hook into pass checkers.")
(marker-buffer (function (marker) (or buffer null)))
(markerp (function (t) boolean))
(max (function ((or number marker) &rest (or number marker)) number))
- (max-char (function () fixnum))
+ (max-char (function (&optional t) fixnum))
(member (function (t list) list))
(memory-limit (function () integer))
(memq (function (t list) list))
@@ -686,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
@@ -695,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))
@@ -2056,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."
@@ -3714,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)
@@ -3800,22 +3803,25 @@ Return the trampoline if found or nil otherwise."
(lexical-binding t))
(comp--native-compile
form nil
- (cl-loop
- for dir in (if native-compile-target-directory
- (list (expand-file-name comp-native-version-dir
- native-compile-target-directory))
- (comp-eln-load-path-eff))
- for f = (expand-file-name
- (comp-trampoline-filename subr-name)
- dir)
- unless (file-exists-p dir)
- do (ignore-errors
- (make-directory dir t)
- (cl-return f))
- when (file-writable-p f)
- do (cl-return f)
- finally (error "Cannot find suitable directory for output in \
-`native-comp-eln-load-path'")))))
+ ;; If we've disabled nativecomp, don't write the trampolines to
+ ;; the eln cache (but create them).
+ (and (not inhibit-automatic-native-compilation)
+ (cl-loop
+ for dir in (if native-compile-target-directory
+ (list (expand-file-name comp-native-version-dir
+
native-compile-target-directory))
+ (comp-eln-load-path-eff))
+ for f = (expand-file-name
+ (comp-trampoline-filename subr-name)
+ dir)
+ unless (file-exists-p dir)
+ do (ignore-errors
+ (make-directory dir t)
+ (cl-return f))
+ when (file-writable-p f)
+ do (cl-return f)
+ finally (error "Cannot find suitable directory for output in \
+`native-comp-eln-load-path'"))))))
;; Some entry point support code.
@@ -3923,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))
@@ -3935,11 +3942,14 @@ display a message."
when (or native-comp-always-compile
load ; Always compile when the compilation is
; commanded for late load.
- (file-newer-than-file-p
- source-file (comp-el-to-eln-filename source-file)))
+ ;; Skip compilation if `comp-el-to-eln-filename' fails
+ ;; to find a writable directory.
+ (with-demoted-errors "Async compilation :%S"
+ (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
@@ -3995,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
@@ -4039,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)
- (max-specpdl-size (max max-specpdl-size 5000))
- (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)))
- (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.
@@ -4112,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)))
@@ -4159,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
@@ -4187,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.
@@ -4216,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
@@ -4310,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\\)?\\'"))
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/debug.el b/lisp/emacs-lisp/debug.el
index 460057b3af..f78d44cf98 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -110,10 +110,6 @@ The value used here is passed to `quit-restore-window'."
(defvar debugger-previous-window-height nil
"The last recorded height of `debugger-previous-window'.")
-(defvar debugger-previous-backtrace nil
- "The contents of the previous backtrace (including text properties).
-This is to optimize `debugger-make-xrefs'.")
-
(defvar debugger-outer-match-data)
(defvar debugger-will-be-back nil
"Non-nil if we expect to get back in the debugger soon.")
@@ -836,6 +832,10 @@ To specify a nil argument interactively, exit with an
empty minibuffer."
;;;###autoload
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
+(make-obsolete-variable 'debugger-previous-backtrace
+ "no longer used." "29.1")
+(defvar debugger-previous-backtrace nil)
+
(provide 'debug)
;;; debug.el ends here
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index c3a4e9fc7a..7d54a84687 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -417,7 +417,12 @@ No problems result if this variable is not bound.
`(defvar ,keymap-sym
(let ((m ,keymap))
(cond ((keymapp m) m)
- ((listp m) (easy-mmode-define-keymap m))
+ ;; FIXME: `easy-mmode-define-keymap' is obsolete,
+ ;; so this form should also be obsolete somehow.
+ ((listp m)
+ (with-suppressed-warnings ((obsolete
+ easy-mmode-define-keymap))
+ (easy-mmode-define-keymap m)))
(t (error "Invalid keymap %S" m))))
,(format "Keymap for `%s'." mode-name)))
@@ -679,6 +684,7 @@ Valid keywords and arguments are:
:group Ignored.
:suppress Non-nil to call `suppress-keymap' on keymap,
`nodigits' to suppress digits as prefix arguments."
+ (declare (obsolete define-keymap "29.1"))
(let (inherit dense suppress)
(while args
(let ((key (pop args))
@@ -719,9 +725,7 @@ The M, BS, and ARGS arguments are as per that function.
DOC is
the constant's documentation.
This macro is deprecated; use `defvar-keymap' instead."
- ;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still
- ;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first.
- (declare (doc-string 3) (indent 1))
+ (declare (doc-string 3) (indent 1) (obsolete defvar-keymap "29.1"))
`(defconst ,m
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
,doc))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 9de8999fdf..67704bdb51 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -129,7 +129,7 @@ contains an infinite loop. When Edebug is instrumenting
code
containing very large quoted lists, it may reach this limit and give
the error message \"Too deep - perhaps infinite loop in spec?\".
Make this limit larger to countermand that, but you may also need to
-increase `max-lisp-eval-depth' and `max-specpdl-size'."
+increase `max-lisp-eval-depth'."
:type 'integer
:version "26.1")
@@ -1107,8 +1107,7 @@ purpose by adding an entry to this alist, and setting
edebug-best-error
edebug-error-point
;; Do this once here instead of several times.
- (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
- (max-specpdl-size (+ 2000 max-specpdl-size)))
+ (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)))
(let ((no-match
(catch 'no-match
(setq result (edebug-read-and-maybe-wrap-form1))
@@ -2317,7 +2316,6 @@ and run its entry function, and set up `edebug-before' and
;; but not inside an unwind-protect.
;; Doing it here also keeps it from growing too large.
(max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
- (max-specpdl-size (+ 200 max-specpdl-size))
(debugger edebug-debugger) ; only while edebug is active.
(edebug-outside-debug-on-error debug-on-error)
@@ -3791,9 +3789,6 @@ limited by `edebug-print-length' or `edebug-print-level'."
;;; Edebug Minor Mode
-(define-obsolete-variable-alias 'gud-inhibit-global-bindings
- 'edebug-inhibit-emacs-lisp-mode-bindings "24.3")
-
(defvar edebug-inhibit-emacs-lisp-mode-bindings nil
"If non-nil, inhibit Edebug bindings on the C-x C-a key.
By default, loading the `edebug' library causes these bindings to
@@ -4182,6 +4177,7 @@ from Edebug instrumentation found in the backtrace."
(backtrace-mode)
(add-hook 'backtrace-goto-source-functions
#'edebug--backtrace-goto-source nil t))
+ (edebug-backtrace-mode)
(setq edebug-instrumented-backtrace-frames
(backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame)
@@ -4258,6 +4254,14 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(setf (edebug--frame-before-index frame) before-index)
(setf (edebug--frame-after-index frame) after-index))
+(defvar-keymap edebug-backtrace-mode-map
+ "s" #'backtrace-goto-source)
+
+(define-minor-mode edebug-backtrace-mode
+ "Minor mode for showing backtraces from edebug."
+ :lighter nil
+ :interactive nil)
+
(defun edebug--backtrace-goto-source ()
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
@@ -4567,6 +4571,12 @@ With prefix argument, make it a temporary breakpoint."
(was-macro `(macro . ,unwrapped))
(t unwrapped))))))
+(defun edebug--strip-plist (symbol)
+ "Remove edebug related properties from plist for SYMBOL."
+ (dolist (prop '( edebug edebug-behavior edebug-coverage
+ edebug-freq-count ghost-edebug))
+ (cl-remprop symbol prop)))
+
(defun edebug-remove-instrumentation (functions)
"Remove Edebug instrumentation from FUNCTIONS.
Interactively, the user is prompted for the function to remove
@@ -4598,6 +4608,7 @@ instrumentation for, defaulting to all functions."
(dolist (symbol functions)
(when-let ((unwrapped
(edebug--unwrap*-symbol-function symbol)))
+ (edebug--strip-plist symbol)
(defalias symbol unwrapped)))
(message "Removed edebug instrumentation from %s"
(mapconcat #'symbol-name functions ", ")))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 5e7b5cbfb2..65aa6aa6df 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -249,16 +249,22 @@ use '%s or turn off `eieio-backward-compatibility'
instead" cname)
(defun eieio-make-class-predicate (class)
(lambda (obj)
(:documentation
- (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)"
- class))
+ (concat
+ (internal--format-docstring-line
+ "Return non-nil if OBJ is an object of type `%S'."
+ class)
+ "\n\n(fn OBJ)"))
(and (eieio-object-p obj)
(same-class-p obj class))))
(defun eieio-make-child-predicate (class)
(lambda (obj)
(:documentation
- (format "Return non-nil if OBJ is an object of type `%S' or a subclass.
-\n(fn OBJ)" class))
+ (concat
+ (internal--format-docstring-line
+ "Return non-nil if OBJ is an object of type `%S' or a subclass."
+ class)
+ "\n\n(fn OBJ)"))
(and (eieio-object-p obj)
(object-of-class-p obj class))))
@@ -353,8 +359,8 @@ See `defclass' for more information."
(defalias csym
(lambda (obj)
(:documentation
- (format
- "Test OBJ to see if it a list of objects which are a child of
type %s"
+ (internal--format-docstring-line
+ "Test OBJ to see if it a list of objects which are a child of
type `%s'."
cname))
(when (listp obj)
(let ((ans t)) ;; nil is valid
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 5f67263f17..b599aabb7f 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -153,7 +153,7 @@ are not abstract."
(help-insert-xref-button
(help-fns-short-filename location)
'cl-type-definition ctr location 'define-type)
- (insert (substitute-command-keys "'")))
+ (insert (substitute-quotes "'")))
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
(goto-char (point-max))
(if (autoloadp def)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 984166b593..8351d97b13 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -136,6 +136,7 @@ and reference them using the function `class-option'."
(accessors ()))
;; Collect the accessors we need to define.
+ (setq slots (mapcar (lambda (x) (if (consp x) x (list x))) slots))
(pcase-dolist (`(,sname . ,soptions) slots)
(let* ((acces (plist-get soptions :accessor))
(initarg (plist-get soptions :initarg))
@@ -217,10 +218,11 @@ and reference them using the function `class-option'."
(when (and eieio-backward-compatibility (eq alloc :class))
;; FIXME: How could I declare this *method* as obsolete.
(push `(cl-defmethod ,acces ((this (subclass ,name)))
- ,(format
- "Retrieve the class slot `%S' from a class `%S'.
-This method is obsolete."
- sname name)
+ ,(concat
+ (internal--format-docstring-line
+ "Retrieve the class slot `%S' from a class `%S'."
+ sname name)
+ "\nThis method is obsolete.")
(if (slot-boundp this ',sname)
(eieio-oref-default this ',sname)))
accessors)))
@@ -229,16 +231,18 @@ This method is obsolete."
;; name whose purpose is to set the value of the slot.
(if writer
(push `(cl-defmethod ,writer ((this ,name) value)
- ,(format "Set the slot `%S' of an object of class `%S'."
- sname name)
+ ,(internal--format-docstring-line
+ "Set the slot `%S' of an object of class `%S'."
+ sname name)
(setf (slot-value this ',sname) value))
accessors))
;; If a reader is defined, then create a generic method
;; of that name whose purpose is to access this slot value.
(if reader
(push `(cl-defmethod ,reader ((this ,name))
- ,(format "Access the slot `%S' from object of class `%S'."
- sname name)
+ ,(internal--format-docstring-line
+ "Access the slot `%S' from object of class `%S'."
+ sname name)
(slot-value this ',sname))
accessors))
))
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 4436d0a4b1..a891f068a7 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -102,6 +102,43 @@ the name of the test and the result of NAME-FORM."
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
+(cl-defmacro ert-with-test-buffer-selected ((&key name)
+ &body body)
+ "Create a test buffer, switch to it, and run BODY.
+
+This extends `ert-with-test-buffer' by displaying the test
+buffer (whose name is derived from NAME) in a temporary window.
+The temporary window becomes the `selected-window' before BODY is
+evaluated. The modification hooks `before-change-functions' and
+`after-change-functions' are not inhibited during the evaluation
+of BODY, which makes it easier to use `execute-kbd-macro' to
+simulate user interaction. The window configuration is restored
+before returning, even if BODY exits nonlocally. The return
+value is the last form in BODY."
+ (declare (debug ((":name" form) def-body))
+ (indent 1))
+ (let ((ret (make-symbol "ert--with-test-buffer-selected-ret")))
+ `(save-window-excursion
+ (let (,ret)
+ (ert-with-test-buffer (:name ,name)
+ (with-current-buffer-window (current-buffer)
+ `(display-buffer-below-selected
+ (body-function
+ . ,(lambda (window)
+ (select-window window t)
+ ;; body-function is intended to initialize the
+ ;; contents of a temporary read-only buffer, so
+ ;; it is executed with some convenience
+ ;; changes. Undo those changes so that the
+ ;; test buffer behaves more like an ordinary
+ ;; buffer while the body executes.
+ (let ((inhibit-modification-hooks nil)
+ (inhibit-read-only nil)
+ (buffer-read-only nil))
+ (setq ,ret (progn ,@body))))))
+ nil))
+ ,ret))))
+
;;;###autoload
(defun ert-kill-all-test-buffers ()
"Kill all test buffers that are still live."
@@ -422,6 +459,10 @@ The following keyword arguments are supported:
:text STRING If non-nil, pass STRING to `make-temp-file' as
the TEXT argument.
+:buffer SYMBOL Open the temporary file using `find-file-noselect'
+ and bind SYMBOL to the buffer. Kill the buffer
+ after BODY exits normally or non-locally.
+
:coding CODING If non-nil, bind `coding-system-for-write' to CODING
when executing BODY. This is handy when STRING includes
non-ASCII characters or the temporary file must have a
@@ -430,14 +471,17 @@ The following keyword arguments are supported:
See also `ert-with-temp-directory'."
(declare (indent 1) (debug (symbolp body)))
(cl-check-type name symbol)
- (let (keyw prefix suffix directory text extra-keywords coding)
+ (let (keyw prefix suffix directory text extra-keywords buffer coding)
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
(pcase keyw
(:prefix (setq prefix (pop body)))
(:suffix (setq suffix (pop body)))
+ ;; This is only for internal use by `ert-with-temp-directory'
+ ;; and is therefore not documented.
(:directory (setq directory (pop body)))
(:text (setq text (pop body)))
+ (:buffer (setq buffer (pop body)))
(:coding (setq coding (pop body)))
(_ (push keyw extra-keywords) (pop body))))
(when extra-keywords
@@ -452,9 +496,16 @@ See also `ert-with-temp-directory'."
(make-temp-file ,prefix ,directory ,suffix ,text)))
(,name ,(if directory
`(file-name-as-directory ,temp-file)
- temp-file)))
+ temp-file))
+ ,@(when buffer
+ (list `(,buffer (find-file-literally ,temp-file)))))
(unwind-protect
(progn ,@body)
+ (ignore-errors
+ ,@(when buffer
+ (list `(with-current-buffer buf
+ (set-buffer-modified-p nil))
+ `(kill-buffer ,buffer))))
(ignore-errors
,(if directory
`(delete-directory ,temp-file :recursive)
@@ -517,7 +568,7 @@ The same keyword arguments are supported as in
`("\\`mock\\'" nil ,(system-name)))
;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
;; in batch mode only, therefore.
- (unless (and (null noninteractive) (file-directory-p "~/"))
+ (when (and noninteractive (not (file-directory-p "~/")))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory))))
"Temporary directory for remote file tests.")
diff --git a/lisp/emacs-lisp/generate-lisp-file.el
b/lisp/emacs-lisp/generate-lisp-file.el
index 8896a3f701..7b087a4ecb 100644
--- a/lisp/emacs-lisp/generate-lisp-file.el
+++ b/lisp/emacs-lisp/generate-lisp-file.el
@@ -63,12 +63,12 @@ inserted."
(cl-defun generate-lisp-file-trailer (file &key version inhibit-provide
(coding 'utf-8-emacs-unix) autoloads
- compile provide)
+ compile provide inhibit-native-compile)
"Insert a standard trailer for FILE.
By default, this trailer inhibits version control, byte
compilation, updating autoloads, and uses a `utf-8-emacs-unix'
coding system. These can be inhibited by providing non-nil
-values to the VERSION, NO-PROVIDE, AUTOLOADS and COMPILE
+values to the VERSION, AUTOLOADS, COMPILE and NATIVE-COMPILE
keyword arguments.
CODING defaults to `utf-8-emacs-unix'. Use a nil value to
@@ -79,7 +79,11 @@ If PROVIDE is non-nil, use that in the `provide' statement
instead of using FILE as the basis.
If `standard-output' is bound to a buffer, insert in that buffer.
-If no, insert at point in the current buffer."
+If no, insert at point in the current buffer.
+
+If INHITBIT-NATIVE-COMPILE is non-nil, add a cookie to inhibit
+native compilation. (By default, a file will be native-compiled
+if it's also byte-compiled)."
(with-current-buffer (if (bufferp standard-output)
standard-output
(current-buffer))
@@ -96,9 +100,11 @@ If no, insert at point in the current buffer."
(unless version
(insert ";; version-control: never\n"))
(unless compile
- (insert ";; no-byte-" "compile: t\n")) ;; #$ is byte-compiled into nil.
+ (insert ";; no-byte-" "compile: t\n"))
(unless autoloads
(insert ";; no-update-autoloads: t\n"))
+ (when inhibit-native-compile
+ (insert ";; no-native-" "compile: t\n"))
(when coding
(insert (format ";; coding: %s\n"
(if (eq coding t)
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 770cdb3d4f..11251d7a96 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that
returns the value to
set it to.
DO must return an Elisp expression."
(cond
- ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
+ ((symbolp place)
+ (let ((me (macroexpand-1 place macroexpand-all-environment)))
+ (if (eq me place)
+ (funcall do place (lambda (v) `(setq ,place ,v)))
+ (gv-get me do))))
((not (consp place)) (signal 'gv-invalid-place (list place)))
(t
(let* ((head (car place))
@@ -441,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.
@@ -532,13 +537,15 @@ The return value is the last VAL in the list.
(funcall do `(error . ,args)
(lambda (v) `(progn ,v (error . ,args))))))
-(defmacro gv-synthetic-place (getter setter)
+(defun gv-synthetic-place (getter setter)
"Special place described by its setter and getter.
GETTER and SETTER (typically obtained via `gv-letplace') get and
-set that place. I.e. This macro allows you to do the \"reverse\" of what
-`gv-letplace' does.
-This macro only makes sense when used in a place."
- (declare (gv-expander funcall))
+set that place. I.e. this function allows you to do the
+\"reverse\" of what `gv-letplace' does.
+
+This function is only useful when used in conjunction with
+generalized variables in place forms."
+ (declare (gv-expander funcall) (compiler-macro (lambda (_) getter)))
(ignore setter)
getter)
@@ -706,6 +713,8 @@ REF must have been previously obtained with `gv-ref'."
(gv-define-setter frame-width (x &optional frame)
`(set-frame-width (or ,frame (selected-frame)) ,x))
+(make-obsolete-generalized-variable 'frame-width 'set-frame-width "29.1")
+
(gv-define-simple-setter getenv setenv t)
(gv-define-simple-setter get-register set-register)
@@ -804,6 +813,7 @@ REF must have been previously obtained with `gv-ref'."
`(cond
(,v ,(funcall setter val))
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+(make-obsolete-generalized-variable 'eq nil "29.1")
(gv-define-expander substring
(lambda (do place from &optional to)
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 6c95d86b47..fb5d518b22 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,27 +153,39 @@ 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)
@@ -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 93749a3451..86c4483030 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -196,14 +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)
- (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/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c906ee6e31..7e39a77aed 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -325,6 +325,20 @@ This will generate compile-time constants from BINDINGS."
(throw 'matched t)))
(throw 'matched nil)))))
+(defun lisp-mode--search-key (char bound)
+ (catch 'found
+ (while (re-search-forward
+ (concat "\\_<" char (rx lisp-mode-symbol) "\\_>")
+ bound t)
+ (when (or (< (match-beginning 0) (+ (point-min) 2))
+ ;; A quoted white space before the &/: means that this
+ ;; is not the start of a :keyword or an &option.
+ (not (eql (char-after (- (match-beginning 0) 2))
+ ?\\))
+ (not (memq (char-after (- (match-beginning 0) 1))
+ '(?\s ?\n ?\t))))
+ (throw 'found t)))))
+
(let-when-compile
((lisp-fdefs '("defmacro" "defun"))
(lisp-vdefs '("defvar"))
@@ -496,11 +510,11 @@ This will generate compile-time constants from BINDINGS."
(,(rx "\\\\=")
(0 font-lock-builtin-face prepend))
;; Constant values.
- (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
+ (,(lambda (bound) (lisp-mode--search-key ":" bound))
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
- . font-lock-type-face)
+ (,(lambda (bound) (lisp-mode--search-key "&" bound))
+ (0 font-lock-builtin-face))
;; ELisp regexp grouping constructs
(,(lambda (bound)
(catch 'found
@@ -549,11 +563,12 @@ This will generate compile-time constants from BINDINGS."
;; must come before keywords below to have effect
(,(concat "#:" (rx lisp-mode-symbol) "") 0 font-lock-builtin-face)
;; Constant values.
- (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
+ (,(lambda (bound) (lisp-mode--search-key ":" bound))
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
- . font-lock-type-face)
+ (,(lambda (bound) (lisp-mode--search-key "&" bound))
+ (0 font-lock-builtin-face))
+ ;; ELisp regexp grouping constructs
;; This is too general -- rms.
;; A user complained that he has functions whose names start with `do'
;; and that they get the wrong color.
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index e13b92bab8..ecc5f7e47b 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -283,14 +283,24 @@ 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
;; a group.
- (let ((groupname (nth 1 form)))
+ (let ((groupname (nth 1 form))
+ (parent (eval (plist-get form :group) t)))
`(let ((loads (get ',groupname 'custom-loads)))
(if (member ',file loads) nil
- (put ',groupname 'custom-loads (cons ',file loads))))))
+ (put ',groupname 'custom-loads (cons ',file loads))
+ ,@(when parent
+ `((put ',parent 'custom-loads
+ (cons ',groupname (get ',parent 'custom-loads)))))))))
;; When processing a macro expansion, any expression
;; before a :autoload-end should be included. These are typically (put
@@ -504,6 +514,7 @@ If COMPILE, don't include a \"don't compile\" cookie."
(generate-lisp-file-trailer
file :provide (and (stringp feature) feature)
:compile compile
+ :inhibit-native-compile t
:inhibit-provide (not feature))
(buffer-string))))
@@ -511,7 +522,7 @@ If COMPILE, don't include a \"don't compile\" cookie."
(defun loaddefs-generate (dir output-file &optional excluded-files
extra-data include-package-version
generate-full)
- "Generate loaddefs files for Lisp files in the directories DIRS.
+ "Generate loaddefs files for Lisp files in one or more directories given by
DIR.
DIR can be either a single directory or a list of directories.
The autoloads will be written to OUTPUT-FILE. If any Lisp file
@@ -519,7 +530,7 @@ binds `generated-autoload-file' as a file-local variable,
write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
-directory or directories specified by DIRS.
+directories specified by DIR.
Optional argument EXCLUDED-FILES, if non-nil, should be a list of
files, such as preloaded files, whose autoloads should not be written
@@ -627,7 +638,7 @@ instead of just updating them with the new/changed
autoloads."
;; It's a new file; put the data at the end.
(progn
(goto-char (point-max))
- (search-backward "\f\n"))
+ (search-backward "\f\n" nil t))
;; Delete the old version of the section.
(delete-region (match-beginning 0)
(and (search-forward "\n\f\n;;;")
@@ -725,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/macroexp.el b/lisp/emacs-lisp/macroexp.el
index c3ba1b36d4..f4df40249d 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -110,7 +110,8 @@ each clause."
(let ((symbols-with-pos-enabled t))
(apply handler form (cdr form)))
(error
- (message "Compiler-macro error for %S: Handler: %S\n%S" (car form)
handler err)
+ (message "Warning: Optimization failure for %S: Handler: %S\n%S"
+ (car form) handler err)
form)))
(defun macroexp--funcall-if-compiled (_form)
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/nadvice.el b/lisp/emacs-lisp/nadvice.el
index a9a20ab5ab..429052bfdf 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -4,6 +4,7 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
+;; Version: 1.0
;; This file is part of GNU Emacs.
@@ -37,11 +38,6 @@
;;; Code:
-;; The autoloads.el mechanism which adds package--builtin-versions
-;; maintenance to loaddefs.el doesn't work for preloaded packages (such
-;; as this one), so we have to do it by hand!
-(push (purecopy '(nadvice 1 0)) package--builtin-versions)
-
(oclosure-define (advice
(:predicate advice--p)
(:copier advice--cons (cdr))
@@ -108,19 +104,26 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
(format "%s\n%s" name doc)
(format "%s" name))
(or doc "No documentation")))))
- "\n")))
+ "\n"
+ (and
+ (eq how :override)
+ (concat
+ (format-message
+ "\nThis is an :override advice, which means that `%s' isn't\n"
function)
+ "run at all, and the documentation below may be irrelevant.\n")))))
(defun advice--make-docstring (function)
"Build the raw docstring for FUNCTION, presumably advised."
(let* ((flist (indirect-function function))
(docfun nil)
(macrop (eq 'macro (car-safe flist)))
- (docstring nil))
+ (before nil)
+ (after nil))
(when macrop
(setq flist (cdr flist)))
(if (and (autoloadp flist)
(get function 'advice--pending))
- (setq docstring
+ (setq after
(advice--make-single-doc (get function 'advice--pending)
function macrop))
(while (advice--p flist)
@@ -130,9 +133,13 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
;; object instead! So here we try to undo the damage.
(when (integerp (aref flist 4))
(setq docfun flist))
- (setq docstring (concat docstring (advice--make-single-doc
- flist function macrop))
- flist (advice--cdr flist))))
+ (let ((doc-bit (advice--make-single-doc flist function macrop)))
+ ;; We want :overrides to go to the front, because they mean
+ ;; that the doc string may be irrelevant.
+ (if (eq (advice--how flist) :override)
+ (setq before (concat before doc-bit))
+ (setq after (concat after doc-bit))))
+ (setq flist (advice--cdr flist))))
(unless docfun
(setq docfun flist))
(let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops.
@@ -145,12 +152,18 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
(if (stringp arglist) t
(help--make-usage-docstring function arglist)))
(setq origdoc (cdr usage)) (car usage)))
- (help-add-fundoc-usage (concat origdoc
- (if (string-suffix-p "\n" origdoc)
- "\n"
- "\n\n")
- docstring)
- usage))))
+ (help-add-fundoc-usage
+ (with-temp-buffer
+ (when before
+ (insert before)
+ (ensure-empty-lines 1))
+ (when origdoc
+ (insert origdoc))
+ (when after
+ (ensure-empty-lines 1)
+ (insert after))
+ (buffer-string))
+ usage))))
(defun advice-eval-interactive-spec (spec)
"Evaluate the interactive spec SPEC."
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 9775e8cc65..c77ac151d7 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -557,6 +557,21 @@ This has 2 uses:
(oclosure-define (save-some-buffers-function
(:predicate save-some-buffers-function--p)))
+;; This OClosure type is used internally by `cconv.el' to handle
+;; the case where we need to build a closure whose `interactive' spec
+;; captures variables from the context.
+;; It arguably belongs with `cconv.el' but is needed at runtime,
+;; so we placed it here.
+(oclosure-define (cconv--interactive-helper) fun if)
+(defun cconv--interactive-helper (fun if)
+ "Add interactive \"form\" IF to FUN.
+Returns a new command that otherwise behaves like FUN.
+IF should actually not be a form but a function of no arguments."
+ (oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
+ (&rest args)
+ (apply (if (called-interactively-p 'any)
+ #'funcall-interactively #'funcall)
+ fun args)))
(provide 'oclosure)
;;; oclosure.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ed23ee5f22..f3077cbbdb 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -346,21 +346,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")
@@ -828,8 +835,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
@@ -923,7 +929,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))
@@ -1185,8 +1191,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
@@ -2189,8 +2199,8 @@ to install it but still mark it as selected."
(assq (car elt) package-archive-contents)))
(and available
(version-list-<
- (package-desc-priority-version (cadr elt))
- (package-desc-priority-version (cadr available))))))
+ (package-desc-version (cadr elt))
+ (package-desc-version (cadr available))))))
package-alist)))
;;;###autoload
@@ -2436,10 +2446,14 @@ If NOSAVE is non-nil, the package is not removed from
"Reinstall package PKG.
PKG should be either a symbol, the package name, or a `package-desc'
object."
- (interactive (list (intern (completing-read
- "Reinstall package: "
- (mapcar #'symbol-name
- (mapcar #'car package-alist))))))
+ (interactive
+ (progn
+ (package--archives-initialize)
+ (list (intern (completing-read
+ "Reinstall package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist)))))))
+ (package--archives-initialize)
(package-delete
(if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
'force 'nosave)
@@ -2648,7 +2662,7 @@ Helper function for `describe-package'."
"',\n shadowing a ")
(propertize "built-in package"
'font-lock-face 'package-status-built-in))
- (insert (substitute-command-keys "'")))
+ (insert (substitute-quotes "'")))
(if signed
(insert ".")
(insert " (unsigned)."))
@@ -3700,30 +3714,34 @@ objects removed."
`((delete . ,del) (install . ,ins) (upgrade . ,upg))))
(defun package-menu--perform-transaction (install-list delete-list)
- "Install packages in INSTALL-LIST and delete DELETE-LIST."
- (if install-list
- (let ((status-format (format ":Installing %%d/%d"
- (length install-list)))
- (i 0)
- (package-menu--transaction-status))
- (dolist (pkg install-list)
- (setq package-menu--transaction-status
- (format status-format (cl-incf i)))
- (force-mode-line-update)
- (redisplay 'force)
- ;; Don't mark as selected, `package-menu-execute' already
- ;; does that.
- (package-install pkg 'dont-select))))
- (let ((package-menu--transaction-status ":Deleting"))
- (force-mode-line-update)
- (redisplay 'force)
- (dolist (elt (package--sort-by-dependence delete-list))
- (condition-case-unless-debug err
- (let ((inhibit-message (or inhibit-message package-menu-async)))
- (package-delete elt nil 'nosave))
- (error (message "Error trying to delete `%s': %S"
- (package-desc-full-name elt)
- err))))))
+ "Install packages in INSTALL-LIST and delete DELETE-LIST.
+Return nil if there were no errors; non-nil otherwise."
+ (let ((errors nil))
+ (if install-list
+ (let ((status-format (format ":Installing %%d/%d"
+ (length install-list)))
+ (i 0)
+ (package-menu--transaction-status))
+ (dolist (pkg install-list)
+ (setq package-menu--transaction-status
+ (format status-format (cl-incf i)))
+ (force-mode-line-update)
+ (redisplay 'force)
+ ;; Don't mark as selected, `package-menu-execute' already
+ ;; does that.
+ (package-install pkg 'dont-select))))
+ (let ((package-menu--transaction-status ":Deleting"))
+ (force-mode-line-update)
+ (redisplay 'force)
+ (dolist (elt (package--sort-by-dependence delete-list))
+ (condition-case-unless-debug err
+ (let ((inhibit-message (or inhibit-message package-menu-async)))
+ (package-delete elt nil 'nosave))
+ (error
+ (push (package-desc-full-name elt) errors)
+ (message "Error trying to delete `%s': %S"
+ (package-desc-full-name elt) err)))))
+ errors))
(defun package--update-selected-packages (add remove)
"Update the `package-selected-packages' list according to ADD and REMOVE.
@@ -3796,8 +3814,8 @@ Optional argument NOQUERY non-nil means do not ask the
user to confirm."
(message "Operation %s started" message-template)
;; Packages being upgraded are not marked as selected.
(package--update-selected-packages .install .delete)
- (package-menu--perform-transaction install-list delete-list)
- (when package-selected-packages
+ (unless (package-menu--perform-transaction install-list delete-list)
+ ;; If there weren't errors, output data.
(if-let* ((removable (package--removable-packages)))
(message "Operation finished. Packages that are no longer
needed: %d. Type `%s' to remove them"
(length removable)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index e6e8bb202d..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."
@@ -369,7 +370,8 @@ provided in the Commentary section of this library."
(get-buffer-create reb-buffer)
`((display-buffer-in-direction)
(direction . ,dir)
- (dedicated . t))))))
+ (dedicated . t)
+ (window-height . fit-window-to-buffer))))))
(font-lock-mode 1)
(reb-initialize-buffer)))
@@ -439,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)
@@ -517,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)
@@ -553,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))
@@ -599,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)))
@@ -607,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)
@@ -626,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
@@ -643,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/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index cae5dd00d1..4d5a39458d 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -133,7 +133,6 @@ usually more efficient than that of a simplified version:
(save-match-data
;; Recurse on the sorted list.
(let* ((max-lisp-eval-depth 10000)
- (max-specpdl-size 10000)
(completion-ignore-case nil)
(completion-regexp-list nil)
(open (cond ((stringp paren) paren) (paren "\\(")))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index b6f0f66e5b..82ade0ac0c 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -346,6 +346,20 @@ list."
(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.
+
+N is the (zero-based) index of the element that should not be in
+the result.
+
+The result is a sequence of the same type as SEQUENCE."
+ (seq-concatenate
+ (let ((type (type-of sequence)))
+ (if (eq type 'cons) 'list type))
+ (seq-subseq sequence 0 n)
+ (seq-subseq sequence (1+ n))))
+
;;;###autoload
(cl-defgeneric seq-reduce (function sequence initial-value)
"Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
@@ -409,7 +423,7 @@ found or not."
(cl-defgeneric seq-contains (sequence elt &optional testfn)
"Return the first element in SEQUENCE that is equal to ELT.
-Equality is defined by TESTFN if non-nil or by `equal' if nil."
+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)
@@ -418,7 +432,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil."
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
"Return non-nil if SEQUENCE contains an element equal to ELT.
-Equality is defined by TESTFN if non-nil or by `equal' if nil."
+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)))
@@ -429,14 +443,14 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil."
(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 TESTFN if non-nil or by `equal' if nil."
+Equality 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 index of the first element in SEQUENCE that is equal to ELT.
-Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ "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)
@@ -445,6 +459,23 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil."
(setq index (1+ index)))
nil)))
+;;;###autoload
+(cl-defgeneric seq-positions (sequence elt &optional testfn)
+ "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is 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'.
+
+The result is a list of (zero-based) indices."
+ (let ((result '()))
+ (seq-do-indexed
+ (lambda (e index)
+ (when (funcall (or testfn #'equal) e elt)
+ (push index result)))
+ sequence)
+ (nreverse result)))
+
;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
@@ -502,7 +533,7 @@ 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 TESTFN if non-nil or by `equal' if nil."
+Equality is defined by the function TESTFN, which defaults to `equal'."
(let* ((accum (lambda (acc elt)
(if (seq-contains-p acc elt testfn)
acc
@@ -514,7 +545,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil."
;;;###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 TESTFN if non-nil or by `equal' if nil."
+Equality 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)
@@ -524,7 +555,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil."
(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 TESTFN if non-nil or by `equal' if nil."
+Equality is defined by the function TESTFN, which defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
acc
@@ -618,13 +649,7 @@ Signal an error if SEQUENCE is empty."
(cl-defmethod seq-take ((list list) n)
"Optimized implementation of `seq-take' for lists."
- (if (eval-when-compile (fboundp 'take))
- (take n list)
- (let ((result '()))
- (while (and list (> n 0))
- (setq n (1- n))
- (push (pop list) result))
- (nreverse result))))
+ (take n list))
(cl-defmethod seq-drop-while (pred (list list))
"Optimized implementation of `seq-drop-while' for lists."
@@ -655,16 +680,6 @@ Signal an error if SEQUENCE is empty."
sequence
(concat sequence)))
-(defun seq--activate-font-lock-keywords ()
- "Activate font-lock keywords for some symbols defined in seq."
- (font-lock-add-keywords 'emacs-lisp-mode
- '("\\<seq-doseq\\>" "\\<seq-let\\>")))
-
-(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
- ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
- ;; we automatically highlight macros.
- (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
-
(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,
@@ -680,5 +695,9 @@ which may be shorter."
result))
(nreverse result)))
+(defun seq-keep (function sequence)
+ "Apply FUNCTION to SEQUENCE and return all non-nil results."
+ (delq nil (seq-map function sequence)))
+
(provide 'seq)
;;; seq.el ends here
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 990dabe351..dbac03432c 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -22,6 +22,15 @@
;;; Commentary:
+;; This package lists functions based on various groupings.
+;;
+;; For instance, `string-trim' and `mapconcat' are `string' functions,
+;; so `M-x shortdoc RET string RET' will give an overview of functions
+;; that operate on strings.
+;;
+;; The documentation groups are created with the
+;; `define-short-documentation-group' macro.
+
;;; Code:
(require 'seq)
@@ -355,13 +364,11 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(abbreviate-file-name
:no-eval (abbreviate-file-name "/home/some-user")
:eg-result "~some-user")
- (file-parent-directory
- :eval (file-parent-directory "/foo/bar")
- :eval (file-parent-directory "~")
- :eval (file-parent-directory "/tmp/")
- :eval (file-parent-directory "foo/bar")
- :eval (file-parent-directory "foo")
- :eval (file-parent-directory "/"))
+ (file-name-parent-directory
+ :eval (file-name-parent-directory "/foo/bar")
+ :eval (file-name-parent-directory "/foo/")
+ :eval (file-name-parent-directory "foo/bar")
+ :eval (file-name-parent-directory "foo"))
"Quoted File Names"
(file-name-quote
:args (name)
@@ -846,6 +853,10 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (seq-find #'numberp '(a b 3 4 f 6)))
(seq-position
:eval (seq-position '(a b c) 'c))
+ (seq-positions
+ :eval (seq-positions '(a b c a d) 'a)
+ :eval (seq-positions '(a b c a d) 'z)
+ :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=))
(seq-length
:eval (seq-length "abcde"))
(seq-max
@@ -886,8 +897,13 @@ 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 #'cl-digit-char-p '(?6 ?a ?7)))
(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)))
(seq-union
@@ -1507,8 +1523,11 @@ Example:
:doc "Keymap for `shortdoc-mode'."
"n" #'shortdoc-next
"p" #'shortdoc-previous
+ "N" #'shortdoc-next-section
+ "P" #'shortdoc-previous-section
"C-c C-n" #'shortdoc-next-section
- "C-c C-p" #'shortdoc-previous-section)
+ "C-c C-p" #'shortdoc-previous-section
+ "w" #'shortdoc-copy-function-as-kill)
(define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc."
@@ -1521,35 +1540,49 @@ Example:
(funcall
(if reverse 'text-property-search-backward
'text-property-search-forward)
- sym nil t t)
+ sym nil t)
(setq arg (1- arg))))
(defun shortdoc-next (&optional arg)
- "Move cursor to the next function.
-With ARG, do it that many times."
+ "Move point to the next function.
+With prefix numeric argument ARG, do it that many times."
(interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function))
(defun shortdoc-previous (&optional arg)
- "Move cursor to the previous function.
-With ARG, do it that many times."
+ "Move point to the previous function.
+With prefix numeric argument ARG, do it that many times."
(interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function t)
(backward-char 1))
(defun shortdoc-next-section (&optional arg)
- "Move cursor to the next section.
-With ARG, do it that many times."
+ "Move point to the next section.
+With prefix numeric argument ARG, do it that many times."
(interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section))
(defun shortdoc-previous-section (&optional arg)
- "Move cursor to the previous section.
-With ARG, do it that many times."
+ "Move point to the previous section.
+With prefix numeric argument ARG, do it that many times."
(interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section t)
(forward-line -2))
+(defun shortdoc-copy-function-as-kill ()
+ "Copy name of the function near point into the kill ring."
+ (interactive)
+ (save-excursion
+ (goto-char (pos-bol))
+ (when-let* ((re (rx bol "(" (group (+ (not (in " "))))))
+ (string
+ (and (or (looking-at re)
+ (re-search-backward re nil t))
+ (match-string 1))))
+ (set-text-properties 0 (length string) nil string)
+ (kill-new string)
+ (message string))))
+
(provide 'shortdoc)
;;; shortdoc.el ends here
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index bd7c3c82f9..6e4d88b4df 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -97,6 +97,7 @@ threading."
(maphash (lambda (_ v) (push v values)) hash-table)
values))
+;;;###autoload
(defsubst string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
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/testcover.el b/lisp/emacs-lisp/testcover.el
index cd2e388ce4..760063d1f9 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -637,8 +637,7 @@ argument is maybe, return maybe. Return 1value only if
both arguments
are 1value."
(cl-case val
(testcover-1value result)
- (maybe (and result 'maybe))
- (nil nil)))
+ (maybe (and result 'maybe))))
(defun testcover-analyze-coverage-compose (forms func)
"Analyze a list of FORMS for code coverage using FUNC.
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 61265c97c2..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))
@@ -770,7 +778,8 @@ If NEXT, do the next column."
((string-match "\\([0-9.]+\\)px" spec)
(string-to-number (match-string 1 spec)))
((string-match "\\([0-9.]+\\)%" spec)
- (* (string-to-number (match-string 1 spec)) (window-width nil t)))
+ (/ (* (string-to-number (match-string 1 spec)) (window-width nil t))
+ 100))
(t
(error "Invalid spec: %s" spec))))
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index 06130afa7d..9c2aae1fe9 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -66,9 +66,8 @@
The previous command is accessible, as usual, via `.'. The command before this
can be invoked as `<this key> 1', and the command before that, and the command
before that one is accessible as `<this key> 2'.
-The notation for these keys is borrowed from XEmacs. Basically,
-a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
-`(meta control f1)'."
+Basically, a key is a symbol, e.g., `a', `\\1', `f2', etc., or a
+list, e.g., `(meta control f1)'."
:type 'sexp
:group 'viper)
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index 18e47c682e..386bd73964 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -88,6 +88,14 @@ interface, update `file-name-handler-alist'."
epa-file-inhibit-auto-save)
(auto-save-mode 0)))
+(defun epa-file-name-p (file)
+ "Say whether FILE is handled by `epa-file'."
+ (and auto-encryption-mode (string-match-p epa-file-name-regexp file)))
+
+(with-eval-after-load 'bookmark
+ (add-hook 'bookmark-inhibit-context-functions
+ #'epa-file-name-p))
+
(define-minor-mode auto-encryption-mode
"Toggle automatic file encryption/decryption (Auto Encryption mode)."
:global t :init-value t :group 'epa-file :version "23.1"
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index 7c60b659f0..4c539b56a3 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -41,7 +41,7 @@
(defcustom epa-keyserver "pgp.mit.edu"
"Domain of keyserver.
-This is used by `epa-ks-lookup-key', for looking up public keys."
+This is used by `epa-search-keys', for looking up public keys."
:type '(choice :tag "Keyserver"
(repeat :tag "Random pool"
(string :tag "Keyserver address"))
@@ -66,14 +66,12 @@ This is used by `epa-ks-lookup-key', for looking up public
keys."
"List of arguments to pass to `epa-search-keys'.
This is used when reverting a buffer to restart search.")
-(defvar epa-ks-search-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map (kbd "f") #'epa-ks-mark-key-to-fetch)
- (define-key map (kbd "i") #'epa-ks-inspect-key-to-fetch)
- (define-key map (kbd "u") #'epa-ks-unmark-key-to-fetch)
- (define-key map (kbd "x") #'epa-ks-do-key-to-fetch)
- map))
+(defvar-keymap epa-ks-search-mode-map
+ :suppress t
+ "f" #'epa-ks-mark-key-to-fetch
+ "i" #'epa-ks-inspect-key-to-fetch
+ "u" #'epa-ks-unmark-key-to-fetch
+ "x" #'epa-ks-do-key-to-fetch)
(define-derived-mode epa-ks-search-mode tabulated-list-mode "Keyserver"
"Major mode for listing public key search results."
@@ -182,7 +180,7 @@ If EXACT is non-nil, don't accept approximate matches."
"Prepare KEYS for `tabulated-list-mode', for buffer BUF.
KEYS is a list of `epa-ks-key' structures, as parsed by
-`epa-ks-parse-result'."
+`epa-ks--parse-buffer'."
(when (buffer-live-p buf)
(let (entries)
(dolist (key keys)
diff --git a/lisp/epa.el b/lisp/epa.el
index 63bc0941d6..cb87d80885 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -183,28 +183,26 @@ You should bind this variable with `let', but do not set
it globally.")
(defvar epa-suppress-error-buffer nil)
(defvar epa-last-coding-system-specified nil)
-(defvar epa-key-list-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "\C-m" 'epa-show-key)
- (define-key keymap [?\t] 'forward-button)
- (define-key keymap [backtab] 'backward-button)
- (define-key keymap "m" 'epa-mark-key)
- (define-key keymap "u" 'epa-unmark-key)
- (define-key keymap "d" 'epa-decrypt-file)
- (define-key keymap "v" 'epa-verify-file)
- (define-key keymap "s" 'epa-sign-file)
- (define-key keymap "e" 'epa-encrypt-file)
- (define-key keymap "r" 'epa-delete-keys)
- (define-key keymap "i" 'epa-import-keys)
- (define-key keymap "o" 'epa-export-keys)
- (define-key keymap "g" 'revert-buffer)
- (define-key keymap "n" 'next-line)
- (define-key keymap "p" 'previous-line)
- (define-key keymap " " 'scroll-up-command)
- (define-key keymap [?\S-\ ] 'scroll-down-command)
- (define-key keymap [delete] 'scroll-down-command)
- (define-key keymap "q" 'epa-exit-buffer)
- keymap))
+(defvar-keymap epa-key-list-mode-map
+ "RET" #'epa-show-key
+ "TAB" #'forward-button
+ "<backtab>" #'backward-button
+ "m" #'epa-mark-key
+ "u" #'epa-unmark-key
+ "d" #'epa-decrypt-file
+ "v" #'epa-verify-file
+ "s" #'epa-sign-file
+ "e" #'epa-encrypt-file
+ "r" #'epa-delete-keys
+ "i" #'epa-import-keys
+ "o" #'epa-export-keys
+ "g" #'revert-buffer
+ "n" #'next-line
+ "p" #'previous-line
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "<delete>" #'scroll-down-command
+ "q" #'epa-exit-buffer)
(easy-menu-define epa-key-list-mode-menu epa-key-list-mode-map
"Menu for `epa-key-list-mode'."
@@ -230,10 +228,8 @@ You should bind this variable with `let', but do not set
it globally.")
["Unmark Key" epa-unmark-key
:help "Unmark a key"]))
-(defvar epa-key-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "q" 'epa-exit-buffer)
- keymap))
+(defvar-keymap epa-key-mode-map
+ "q" #'epa-exit-buffer)
(defvar epa-exit-buffer-function #'quit-window)
diff --git a/lisp/epg.el b/lisp/epg.el
index c3c26badbb..ceeb269b07 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1519,12 +1519,8 @@ If you are unsure, use synchronous version of this
function
(process-send-eof (epg-context-process context))))
;; Normal (or cleartext) signature.
(if (epg-data-file signature)
- (epg--start context (if (eq (epg-context-protocol context) 'CMS)
- (list "--verify" "--" (epg-data-file signature))
- (list "--" (epg-data-file signature))))
- (epg--start context (if (eq (epg-context-protocol context) 'CMS)
- '("--verify" "-")
- '("-")))
+ (epg--start context (list "--verify" "--" (epg-data-file signature)))
+ (epg--start context '("--verify" "-"))
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
(epg-data-string signature)))
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index 0ea7ef09aa..8fc9785430 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>
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-dcc.el b/lisp/erc/erc-dcc.el
index dd70bfb7b7..90a10766c4 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1108,9 +1108,6 @@ Possible values are: ask, auto, ignore."
(pcomplete-here '("auto" "ask" "ignore")))
(defalias 'pcomplete/erc-mode/SREQ #'pcomplete/erc-mode/CREQ)
-(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook
- 'erc-dcc-chat-filter-functions "24.3")
-
(defvar erc-dcc-chat-filter-functions '(erc-dcc-chat-parse-output)
"Abnormal hook run after parsing (and maybe inserting) a DCC message.
Each function is called with two arguments: the ERC process and
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 7c9174ff66..6b9aa47d86 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -240,6 +240,15 @@ server and other miscellaneous functions."
:version "24.3"
:type 'boolean)
+(defcustom erc-match-quote-when-adding 'ask
+ "Whether to `regexp-quote' when adding to a match list interactively.
+When the value is a boolean, the opposite behavior will be made
+available via universal argument."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const ask)
+ (const t)
+ (const nil)))
+
;; Internal variables:
;; This is exactly the same as erc-button-syntax-table. Should we
@@ -290,7 +299,7 @@ Note that this is the default face to use if
;; Functions:
-(defun erc-add-entry-to-list (list prompt &optional completions)
+(defun erc-add-entry-to-list (list prompt &optional completions alt)
"Add an entry interactively to a list.
LIST must be passed as a symbol
The query happens using PROMPT.
@@ -299,7 +308,16 @@ Completion is performed on the optional alist COMPLETIONS."
prompt
completions
(lambda (x)
- (not (erc-member-ignore-case (car x) (symbol-value list)))))))
+ (not (erc-member-ignore-case (car x) (symbol-value list))))))
+ quoted)
+ (setq quoted (regexp-quote entry))
+ (when (pcase erc-match-quote-when-adding
+ ('ask (unless (string= quoted entry)
+ (y-or-n-p
+ (format "Use regexp-quoted form (%s) instead? " quoted))))
+ ('t (not alt))
+ ('nil alt))
+ (setq entry quoted))
(if (erc-member-ignore-case entry (symbol-value list))
(error "\"%s\" is already on the list" entry)
(set list (cons entry (symbol-value list))))))
@@ -327,10 +345,11 @@ car is the string."
(symbol-value list))))))
;;;###autoload
-(defun erc-add-pal ()
+(defun erc-add-pal (&optional arg)
"Add pal interactively to `erc-pals'."
- (interactive)
- (erc-add-entry-to-list 'erc-pals "Add pal: "
(erc-get-server-nickname-alist)))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-pals "Add pal: "
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-pal ()
@@ -339,11 +358,11 @@ car is the string."
(erc-remove-entry-from-list 'erc-pals "Delete pal: "))
;;;###autoload
-(defun erc-add-fool ()
+(defun erc-add-fool (&optional arg)
"Add fool interactively to `erc-fools'."
- (interactive)
+ (interactive "P")
(erc-add-entry-to-list 'erc-fools "Add fool: "
- (erc-get-server-nickname-alist)))
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-fool ()
@@ -352,10 +371,10 @@ car is the string."
(erc-remove-entry-from-list 'erc-fools "Delete fool: "))
;;;###autoload
-(defun erc-add-keyword ()
+(defun erc-add-keyword (&optional arg)
"Add keyword interactively to `erc-keywords'."
- (interactive)
- (erc-add-entry-to-list 'erc-keywords "Add keyword: "))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil arg))
;;;###autoload
(defun erc-delete-keyword ()
@@ -364,10 +383,10 @@ car is the string."
(erc-remove-entry-from-list 'erc-keywords "Delete keyword: "))
;;;###autoload
-(defun erc-add-dangerous-host ()
+(defun erc-add-dangerous-host (&optional arg)
"Add dangerous-host interactively to `erc-dangerous-hosts'."
- (interactive)
- (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: "))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil arg))
;;;###autoload
(defun erc-delete-dangerous-host ()
@@ -388,19 +407,19 @@ NICKUSERHOST will be ignored."
(defun erc-match-pal-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-pals'.
MSG will be ignored."
- (and nickuserhost
+ (and nickuserhost erc-pals
(erc-list-match erc-pals nickuserhost)))
(defun erc-match-fool-p (nickuserhost msg)
"Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool."
- (and msg nickuserhost
+ (and msg nickuserhost erc-fools
(or (erc-list-match erc-fools nickuserhost)
(erc-match-directed-at-fool-p msg))))
(defun erc-match-keyword-p (_nickuserhost msg)
"Check whether any keyword of `erc-keywords' matches for MSG.
NICKUSERHOST will be ignored."
- (and msg
+ (and msg erc-keywords
(erc-list-match
(mapcar (lambda (x)
(if (listp x)
@@ -412,7 +431,7 @@ NICKUSERHOST will be ignored."
(defun erc-match-dangerous-host-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-dangerous-hosts'.
MSG will be ignored."
- (and nickuserhost
+ (and nickuserhost erc-dangerous-hosts
(erc-list-match erc-dangerous-hosts nickuserhost)))
(defun erc-match-directed-at-fool-p (msg)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index c54b12fcb0..d8fb879819 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -996,8 +996,8 @@ Rename the current buffer if its NID has grown."
"Return a list of target BUFFERS, newest to oldest."
(sort buffers
(lambda (a b)
- (> (with-current-buffer a (erc-networks--id-ts erc-networks--id))
- (with-current-buffer b (erc-networks--id-ts erc-networks--id))))))
+ (> (erc-networks--id-ts (buffer-local-value 'erc-networks--id a))
+ (erc-networks--id-ts (buffer-local-value 'erc-networks--id b))))))
;;;; Buffer association
@@ -1256,7 +1256,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.el b/lisp/erc/erc.el
index 151d75e7ce..db39e341b2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1651,7 +1651,7 @@ Defaults to the server buffer."
"IRC port to use for encrypted connections if it cannot be \
detected otherwise.")
-(defcustom erc-join-buffer 'buffer
+(defcustom erc-join-buffer 'bury
"Determines how to display a newly created IRC buffer.
The available choices are:
@@ -1662,6 +1662,7 @@ The available choices are:
`bury' - bury it in a new buffer,
`buffer' - in place of the current buffer,
any other value - in place of the current buffer."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-buffers
:type '(choice (const :tag "Split window and select" window)
(const :tag "Split window, don't select" window-noselect)
@@ -2148,7 +2149,7 @@ removed from the list will be disabled."
(display-buffer buffer)
(switch-to-buffer-other-window buffer)))
('window-noselect
- (display-buffer buffer))
+ (display-buffer buffer '(nil (inhibit-same-window . t))))
('bury
nil)
('frame
@@ -2571,7 +2572,8 @@ workaround."
(with-current-buffer (get-buffer-create "*erc-protocol*")
(save-excursion
(goto-char (point-max))
- (let ((inhibit-read-only t))
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t))
(insert (if outbound
(concat ts esid " >> " string)
;; Cope with multi-line messages
@@ -2747,8 +2749,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)
@@ -6283,9 +6284,7 @@ The addressed target is the string before the first colon
in MSG."
(defun erc-list-match (lst str)
"Return non-nil if any regexp in LST matches STR."
- (memq nil (mapcar (lambda (regexp)
- (not (string-match regexp str)))
- lst)))
+ (and lst (string-match (string-join lst "\\|") str)))
;; other "toggles"
@@ -6962,6 +6961,8 @@ shortened server name instead."
(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
@@ -7326,7 +7327,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
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 822cc94149..ac82e3f225 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -378,6 +378,31 @@ to writing a completion function."
args)
posns)))
+(defun eshell--pcomplete-executables ()
+ "Complete amongst a list of directories and executables.
+
+Wrapper for `pcomplete-executables' or `pcomplete-dirs-or-entries',
+depending on the value of `eshell-force-execution'.
+
+Adds path prefix to candidates independent of `action' value."
+ ;; `pcomplete-entries' returns filenames without path on `action' to
+ ;; use current string directory as done in `completion-file-name-table'
+ ;; when `action' is nil to construct executable candidates.
+ (let ((table (if eshell-force-execution
+ (pcomplete-dirs-or-entries nil #'file-readable-p)
+ (pcomplete-executables))))
+ (lambda (string pred action)
+ (let ((cands (funcall table string pred action)))
+ (if (eq action t)
+ (let ((specdir (file-name-directory string)))
+ (mapcar
+ (lambda (cand)
+ (if (stringp cand)
+ (file-name-concat specdir cand)
+ cand))
+ cands))
+ cands)))))
+
(defun eshell--complete-commands-list ()
"Generate list of applicable, visible commands."
;; Building the commands list can take quite a while, especially over Tramp
@@ -392,9 +417,7 @@ to writing a completion function."
(completion-table-dynamic
(lambda (filename)
(if (file-name-directory filename)
- (if eshell-force-execution
- (pcomplete-dirs-or-entries nil #'file-readable-p)
- (pcomplete-executables))
+ (eshell--pcomplete-executables)
(let* ((paths (eshell-get-path))
(cwd (file-name-as-directory
(expand-file-name default-directory)))
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 58b7a83c09..9722aeae18 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -202,7 +202,7 @@ The basic syntax is:
[a-b] [a-b] matches a character or range
[^a] [^a] excludes a character or range
-If any characters in PATTERN have the text property `eshell-escaped'
+If any characters in PATTERN have the text property `escaped'
set to true, then these characters will match themselves in the
resulting regular expression."
(let ((matched-in-pattern 0) ; How much of PATTERN handled
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-term.el b/lisp/eshell/em-term.el
index a4fa699aa9..6811e70313 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -153,7 +153,7 @@ behavior for short-lived processes, see bug#18108."
If either COMMAND or a subcommand in ARGS (e.g. git log) is a
visual command, returns non-nil."
(let ((command (file-name-nondirectory command)))
- (and (eshell-interactive-output-p)
+ (and (eshell-interactive-output-p 'all)
(or (member command eshell-visual-commands)
(member (car args)
(cdr (assoc command eshell-visual-subcommands)))
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 8e44a88459..f87cc2f20a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -29,6 +29,9 @@
(require 'esh-util)
+(eval-when-compile
+ (require 'cl-lib))
+
(defgroup eshell-arg nil
"Argument parsing involves transforming the arguments passed on the
command line into equivalent Lisp forms that, when evaluated, will
@@ -147,6 +150,10 @@ return the result of the parse as a sexp. It is also
responsible for
moving the point forward to reflect the amount of input text that was
parsed.
+If the hook determines that it has reached the end of an argument, it
+should call `eshell-finish-arg' to complete processing of the current
+argument and proceed to the next.
+
If no function handles the current character at point, it will be
treated as a literal character."
:type 'hook
@@ -244,10 +251,16 @@ convert the result to a number as well."
eshell-current-modifiers (cdr eshell-current-modifiers))))
(setq eshell-current-modifiers nil))
-(defun eshell-finish-arg (&optional argument)
- "Finish the current ARGUMENT being processed."
- (if argument
- (setq eshell-current-argument argument))
+(defun eshell-finish-arg (&rest arguments)
+ "Finish the current argument being processed.
+If any ARGUMENTS are specified, they will be added to the final
+argument list in place of the value of the current argument."
+ (when arguments
+ (if (= (length arguments) 1)
+ (setq eshell-current-argument (car arguments))
+ (cl-assert (and (not eshell-arg-listified)
+ (not eshell-current-modifiers)))
+ (setq eshell-current-argument (cons 'eshell-flatten-args arguments))))
(throw 'eshell-arg-done t))
(defun eshell-quote-argument (string)
@@ -272,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)
@@ -287,7 +299,11 @@ Point is left at the end of the arguments."
(if (= (point) here)
(error "Failed to parse argument `%s'"
(buffer-substring here (point-max))))
- (and arg (nconc args (list arg)))))))
+ (when arg
+ (nconc args
+ (if (eq (car-safe arg) 'eshell-flatten-args)
+ (cdr arg)
+ (list arg))))))))
(throw 'eshell-incomplete (if (listp delim)
delim
(list delim (point) (cdr args)))))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 2f77f3f497..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))
@@ -810,8 +809,6 @@ This macro calls itself recursively, with NOTFIRST non-nil."
`(let ((nextproc
(eshell-do-pipelines (quote ,(cdr pipeline)) t)))
(eshell-set-output-handle ,eshell-output-handle
- 'append nextproc)
- (eshell-set-output-handle ,eshell-error-handle
'append nextproc)))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
@@ -842,8 +839,6 @@ This is used on systems where async subprocesses are not
supported."
,(when (cdr pipeline)
`(let ((output-marker ,(point-marker)))
(eshell-set-output-handle ,eshell-output-handle
- 'append output-marker)
- (eshell-set-output-handle ,eshell-error-handle
'append output-marker)))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
@@ -1279,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)
@@ -1347,6 +1343,15 @@ case."
(apply func-or-form args)))))
(and result (funcall printer result))
result)
+ (eshell-pipe-broken
+ ;; If FUNC-OR-FORM tried and failed to write some output to a
+ ;; process, it will raise an `eshell-pipe-broken' signal (this is
+ ;; analogous to SIGPIPE on POSIX systems). In this case, set the
+ ;; command status to some non-zero value to indicate an error; to
+ ;; match GNU/Linux, we use 141, which the numeric value of
+ ;; SIGPIPE on GNU/Linux (13) with the high bit (2^7) set.
+ (setq eshell-last-command-status 141)
+ nil)
(error
(setq eshell-last-command-status 1)
(let ((msg (error-message-string err)))
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-io.el b/lisp/eshell/esh-io.el
index e5977c9580..4620565f85 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -154,6 +154,14 @@ not be added to this variable."
;;; Internal Variables:
+(defconst eshell-redirection-operators-alist
+ '(("<" . input) ; FIXME: Not supported yet.
+ (">" . overwrite)
+ (">>" . append)
+ (">>>" . insert))
+ "An association list of redirection operators to symbols
+describing the mode, e.g. for using with `eshell-get-target'.")
+
(defvar eshell-current-handles nil)
(defvar eshell-last-command-status 0
@@ -173,53 +181,104 @@ not be added to this variable."
(defun eshell-io-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the I/O subsystem code."
(add-hook 'eshell-parse-argument-hook
- 'eshell-parse-redirection nil t)
+ #'eshell-parse-redirection nil t)
(make-local-variable 'eshell-current-redirections)
(add-hook 'eshell-pre-rewrite-command-hook
- 'eshell-strip-redirections nil t)
+ #'eshell-strip-redirections nil t)
(add-function :filter-return (local 'eshell-post-rewrite-command-function)
#'eshell--apply-redirections))
(defun eshell-parse-redirection ()
- "Parse an output redirection, such as `2>'."
- (if (and (not eshell-current-quoted)
- (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
+ "Parse an output redirection, such as `2>' or `>&'."
+ (when (not eshell-current-quoted)
+ (cond
+ ;; Copying a handle (e.g. `2>&1').
+ ((looking-at (rx (? (group digit))
+ (group (or "<" ">"))
+ "&" (group digit)
+ (* (syntax whitespace))))
+ (let ((source (string-to-number (or (match-string 1) "1")))
+ (mode (cdr (assoc (match-string 2)
+ eshell-redirection-operators-alist)))
+ (target (string-to-number (match-string 3))))
+ (when (eq mode 'input)
+ (error "Eshell does not support input redirection"))
+ (goto-char (match-end 0))
+ (eshell-finish-arg (list 'eshell-copy-output-handle
+ source target))))
+ ;; Shorthand for redirecting both stdout and stderr (e.g. `&>').
+ ((looking-at (rx (or (seq (group (** 1 3 ">")) "&")
+ (seq "&" (group-n 1 (** 1 3 ">"))))
+ (* (syntax whitespace))))
+ (if eshell-current-argument
+ (eshell-finish-arg)
+ (goto-char (match-end 0))
+ (eshell-finish-arg
+ (let ((mode (cdr (assoc (match-string 1)
+ eshell-redirection-operators-alist))))
+ (list 'eshell-set-all-output-handles
+ (list 'quote mode))))))
+ ;; Shorthand for piping both stdout and stderr (i.e. `|&').
+ ((looking-at (rx "|&" (* (syntax whitespace))))
+ (if eshell-current-argument
+ (eshell-finish-arg)
+ (goto-char (match-end 0))
+ (eshell-finish-arg
+ '(eshell-copy-output-handle eshell-error-handle
+ eshell-output-handle)
+ '(eshell-operator "|"))))
+ ;; Regular redirecting (e.g. `2>').
+ ((looking-at (rx (? (group digit))
+ (group (or "<" (** 1 3 ">")))
+ (* (syntax whitespace))))
(if eshell-current-argument
- (eshell-finish-arg)
- (let ((sh (match-string 1))
- (oper (match-string 2))
-; (th (match-string 3))
- )
- (if (string= oper "<")
- (error "Eshell does not support input redirection"))
- (eshell-finish-arg
- (prog1
- (list 'eshell-set-output-handle
- (or (and sh (string-to-number sh)) 1)
- (list 'quote
- (aref [overwrite append insert]
- (1- (length oper)))))
- (goto-char (match-end 0))))))))
+ (eshell-finish-arg)
+ (let ((source (if (match-string 1)
+ (string-to-number (match-string 1))
+ eshell-output-handle))
+ (mode (cdr (assoc (match-string 2)
+ eshell-redirection-operators-alist))))
+ (when (eq mode 'input)
+ (error "Eshell does not support input redirection"))
+ (goto-char (match-end 0))
+ (eshell-finish-arg
+ ;; Note: the target will be set later by
+ ;; `eshell-strip-redirections'.
+ (list 'eshell-set-output-handle
+ source (list 'quote mode)))))))))
(defun eshell-strip-redirections (terms)
"Rewrite any output redirections in TERMS."
(setq eshell-current-redirections (list t))
(let ((tl terms)
- (tt (cdr terms)))
+ (tt (cdr terms)))
(while tt
- (if (not (and (consp (car tt))
- (eq (caar tt) 'eshell-set-output-handle)))
- (setq tt (cdr tt)
- tl (cdr tl))
- (unless (cdr tt)
- (error "Missing redirection target"))
- (nconc eshell-current-redirections
- (list (list 'ignore
- (append (car tt) (list (cadr tt))))))
- (setcdr tl (cddr tt))
- (setq tt (cddr tt))))
+ (cond
+ ;; Strip `eshell-copy-output-handle'.
+ ((and (consp (car tt))
+ (eq (caar tt) 'eshell-copy-output-handle))
+ (nconc eshell-current-redirections
+ (list (car tt)))
+ (setcdr tl (cddr tt))
+ (setq tt (cdr tt)))
+ ;; Strip `eshell-set-output-handle' or
+ ;; `eshell-set-all-output-handles' and the term immediately
+ ;; after (the redirection target).
+ ((and (consp (car tt))
+ (memq (caar tt) '(eshell-set-output-handle
+ eshell-set-all-output-handles)))
+ (unless (cdr tt)
+ (error "Missing redirection target"))
+ (nconc eshell-current-redirections
+ (list (list 'ignore
+ (append (car tt) (list (cadr tt))))))
+ (setcdr tl (cddr tt))
+ (setq tt (cddr tt)))
+ (t
+ (setq tt (cdr tt)
+ tl (cdr tl)))))
(setq eshell-current-redirections
- (cdr eshell-current-redirections))))
+ (cdr eshell-current-redirections))))
(defun eshell--apply-redirections (cmd)
"Apply any redirection which were specified for COMMAND."
@@ -236,22 +295,21 @@ The default location for standard output and standard
error will go to
STDOUT and STDERR, respectively.
OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert';
a nil value of mode defaults to `insert'."
- (let ((handles (make-vector eshell-number-of-handles nil))
- (output-target (eshell-get-target stdout output-mode))
- (error-target (eshell-get-target stderr error-mode)))
+ (let* ((handles (make-vector eshell-number-of-handles nil))
+ (output-target (eshell-get-target stdout output-mode))
+ (error-target (if stderr
+ (eshell-get-target stderr error-mode)
+ output-target)))
(aset handles eshell-output-handle (cons output-target 1))
- (aset handles eshell-error-handle
- (cons (if stderr error-target output-target) 1))
+ (aset handles eshell-error-handle (cons error-target 1))
handles))
(defun eshell-protect-handles (handles)
"Protect the handles in HANDLES from a being closed."
- (let ((idx 0))
- (while (< idx eshell-number-of-handles)
- (if (aref handles idx)
- (setcdr (aref handles idx)
- (1+ (cdr (aref handles idx)))))
- (setq idx (1+ idx))))
+ (dotimes (idx eshell-number-of-handles)
+ (when (aref handles idx)
+ (setcdr (aref handles idx)
+ (1+ (cdr (aref handles idx))))))
handles)
(defun eshell-close-handles (&optional exit-code result handles)
@@ -278,6 +336,40 @@ the value already set in `eshell-last-command-result'."
(eshell-close-target target (= eshell-last-command-status 0)))
(setcar handle nil))))))
+(defun eshell-set-output-handle (index mode &optional target handles)
+ "Set handle INDEX for the current HANDLES to point to TARGET using MODE.
+If HANDLES is nil, use `eshell-current-handles'."
+ (when target
+ (let ((handles (or handles eshell-current-handles)))
+ (if (and (stringp target)
+ (string= target (null-device)))
+ (aset handles index nil)
+ (let ((where (eshell-get-target target mode))
+ (current (car (aref handles index))))
+ (if (listp current)
+ (unless (member where current)
+ (setq current (append current (list where))))
+ (setq current (list where)))
+ (if (not (aref handles index))
+ (aset handles index (cons nil 1)))
+ (setcar (aref handles index) current))))))
+
+(defun eshell-copy-output-handle (index index-to-copy &optional handles)
+ "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES.
+If HANDLES is nil, use `eshell-current-handles'."
+ (let* ((handles (or handles eshell-current-handles))
+ (handle-to-copy (car (aref handles index-to-copy))))
+ (setcar (aref handles index)
+ (if (listp handle-to-copy)
+ (copy-sequence handle-to-copy)
+ handle-to-copy))))
+
+(defun eshell-set-all-output-handles (mode &optional target handles)
+ "Set output and error HANDLES to point to TARGET using MODE.
+If HANDLES is nil, use `eshell-current-handles'."
+ (eshell-set-output-handle eshell-output-handle mode target handles)
+ (eshell-copy-output-handle eshell-error-handle eshell-output-handle handles))
+
(defun eshell-close-target (target status)
"Close an output TARGET, passing STATUS as the result.
STATUS should be non-nil on successful termination of the output."
@@ -390,28 +482,20 @@ it defaults to `insert'."
(error "Invalid redirection target: %s"
(eshell-stringify target)))))
-(defun eshell-set-output-handle (index mode &optional target)
- "Set handle INDEX, using MODE, to point to TARGET."
- (when target
- (if (and (stringp target)
- (string= target (null-device)))
- (aset eshell-current-handles index nil)
- (let ((where (eshell-get-target target mode))
- (current (car (aref eshell-current-handles index))))
- (if (and (listp current)
- (not (member where current)))
- (setq current (append current (list where)))
- (setq current (list where)))
- (if (not (aref eshell-current-handles index))
- (aset eshell-current-handles index (cons nil 1)))
- (setcar (aref eshell-current-handles index) current)))))
-
-(defun eshell-interactive-output-p ()
- "Return non-nil if current handles are bound for interactive display."
- (and (eq (car (aref eshell-current-handles
- eshell-output-handle)) t)
- (eq (car (aref eshell-current-handles
- eshell-error-handle)) t)))
+(defun eshell-interactive-output-p (&optional index handles)
+ "Return non-nil if the specified handle is bound for interactive display.
+HANDLES is the set of handles to check; if nil, use
+`eshell-current-handles'.
+
+INDEX is the handle index to check. If nil, check
+`eshell-output-handle'. If `all', check both
+`eshell-output-handle' and `eshell-error-handle'."
+ (let ((handles (or handles eshell-current-handles))
+ (index (or index eshell-output-handle)))
+ (if (eq index 'all)
+ (and (eq (car (aref handles eshell-output-handle)) t)
+ (eq (car (aref handles eshell-error-handle)) t))
+ (eq (car (aref handles index)) t))))
(defvar eshell-print-queue nil)
(defvar eshell-print-queue-count -1)
@@ -498,10 +582,16 @@ Returns what was actually sent, or nil if nothing was
sent."
((eshell-processp target)
(unless (stringp object)
(setq object (eshell-stringify object)))
- (condition-case nil
+ (condition-case err
(process-send-string target object)
- ;; If `process-send-string' raises an error, treat it as a broken pipe.
- (error (signal 'eshell-pipe-broken (list target)))))
+ (error
+ ;; If `process-send-string' raises an error and the process has
+ ;; finished, treat it as a broken pipe. Otherwise, just
+ ;; re-throw the signal.
+ (if (memq (process-status target)
+ '(run stop open closed))
+ (signal (car err) (cdr err))
+ (signal 'eshell-pipe-broken (list target))))))
((consp target)
(apply (car target) object (cdr target))))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index ecbcf88b97..92523fd99e 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -175,9 +175,6 @@ This is used by `eshell-watch-for-password-prompt'."
"A function called from beginning of line to skip the prompt."
:type '(choice (const nil) function))
-(define-obsolete-variable-alias 'eshell-status-in-modeline
- 'eshell-status-in-mode-line "24.3")
-
(defcustom eshell-status-in-mode-line t
"If non-nil, let the user know a command is running in the mode line."
:type 'boolean)
@@ -334,7 +331,6 @@ and the hook `eshell-exit-hook'."
(setq-local require-final-newline nil)
(setq-local max-lisp-eval-depth (max 3000 max-lisp-eval-depth))
- (setq-local max-specpdl-size (max 6000 max-lisp-eval-depth))
(setq-local eshell-last-input-start (point-marker))
(setq-local eshell-last-input-end (point-marker))
@@ -602,7 +598,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
@@ -691,7 +686,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 c367b5cd64..bb928fc5fb 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -99,7 +99,13 @@ information, for example."
(defvar eshell-current-subjob-p nil)
(defvar eshell-process-list nil
- "A list of the current status of subprocesses.")
+ "A list of the current status of subprocesses.
+Each element has the form (PROC . SUBJOB-P), where PROC is the
+process object and SUBJOB-P is non-nil if the process is a
+subjob.
+
+To add or remove elements of this list, see
+`eshell-record-process-object' and `eshell-remove-process-entry'.")
(declare-function eshell-send-eof-to-process "esh-mode")
(declare-function eshell-tail-process "esh-cmd")
@@ -229,21 +235,30 @@ The prompt will be set to PROMPT."
(declare-function eshell-interactive-print "esh-mode" (string))
(eshell-interactive-print
(format "[%s] %d\n" (process-name object) (process-id object))))
- (setq eshell-process-list
- (cons (list object eshell-current-handles
- eshell-current-subjob-p nil nil)
- eshell-process-list)))
+ (push (cons object eshell-current-subjob-p) eshell-process-list))
(defun eshell-remove-process-entry (entry)
"Record the process ENTRY as fully completed."
(if (and (eshell-processp (car entry))
- (nth 2 entry)
+ (cdr entry)
eshell-done-messages-in-minibuffer)
(message "[%s]+ Done %s" (process-name (car entry))
(process-command (car entry))))
(setq eshell-process-list
(delq entry eshell-process-list)))
+(defun eshell-record-process-properties (process &optional index)
+ "Record Eshell bookkeeping properties for PROCESS.
+`eshell-insertion-filter' and `eshell-sentinel' will use these to
+do their jobs.
+
+INDEX is the index of the output handle to use for writing; if
+nil, write to `eshell-output-handle'."
+ (process-put process :eshell-handles eshell-current-handles)
+ (process-put process :eshell-handle-index (or index eshell-output-handle))
+ (process-put process :eshell-pending nil)
+ (process-put process :eshell-busy nil))
+
(defvar eshell-scratch-buffer " *eshell-scratch*"
"Scratch buffer for holding Eshell's input/output.")
(defvar eshell-last-sync-output-start nil
@@ -262,9 +277,37 @@ Used only on systems which do not support async
subprocesses.")
eshell-delete-exited-processes
delete-exited-processes))
(process-environment (eshell-environment-variables))
- proc decoding encoding changed)
+ (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))
+ (car (aref eshell-current-handles eshell-error-handle)))
+ (eshell-protect-handles eshell-current-handles)
+ (setq stderr-proc
+ (make-pipe-process
+ :name (concat (file-name-nondirectory command) "-stderr")
+ :buffer (current-buffer)
+ :filter (if (eshell-interactive-output-p eshell-error-handle)
+ #'eshell-output-filter
+ #'eshell-insertion-filter)
+ :sentinel #'eshell-sentinel))
+ (eshell-record-process-properties stderr-proc eshell-error-handle))
(setq proc
(let ((command (file-local-name (expand-file-name command)))
(conn-type (pcase (bound-and-true-p eshell-in-pipeline-p)
@@ -281,8 +324,10 @@ Used only on systems which do not support async
subprocesses.")
#'eshell-insertion-filter)
:sentinel #'eshell-sentinel
:connection-type conn-type
+ :stderr stderr-proc
:file-handler t)))
(eshell-record-process-object proc)
+ (eshell-record-process-properties proc)
(run-hook-with-args 'eshell-exec-hook proc)
(when (fboundp 'process-coding-system)
(let ((coding-systems (process-coding-system proc)))
@@ -296,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))
@@ -363,36 +408,36 @@ PROC is the process for which we're inserting output.
STRING is the
output."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
- (let ((entry (assq proc eshell-process-list)))
- (when entry
- (setcar (nthcdr 3 entry)
- (concat (nth 3 entry) string))
- (unless (nth 4 entry) ; already being handled?
- (while (nth 3 entry)
- (let ((data (nth 3 entry)))
- (setcar (nthcdr 3 entry) nil)
- (setcar (nthcdr 4 entry) t)
- (unwind-protect
- (condition-case nil
- (eshell-output-object data nil (cadr entry))
- ;; FIXME: We want to send SIGPIPE to the process
- ;; here. However, remote processes don't
- ;; currently support that, and not all systems
- ;; have SIGPIPE in the first place (e.g. MS
- ;; Windows). In these cases, just delete the
- ;; process; this is reasonably close to the
- ;; right behavior, since the default action for
- ;; SIGPIPE is to terminate the process. For use
- ;; cases where SIGPIPE is truly needed, using an
- ;; external pipe operator (`*|') may work
- ;; instead (e.g. when working with remote
- ;; processes).
- (eshell-pipe-broken
- (if (or (process-get proc 'remote-pid)
- (eq system-type 'windows-nt))
- (delete-process proc)
- (signal-process proc 'SIGPIPE))))
- (setcar (nthcdr 4 entry) nil))))))))))
+ (process-put proc :eshell-pending
+ (concat (process-get proc :eshell-pending)
+ string))
+ (unless (process-get proc :eshell-busy) ; Already being handled?
+ (while (process-get proc :eshell-pending)
+ (let ((handles (process-get proc :eshell-handles))
+ (index (process-get proc :eshell-handle-index))
+ (data (process-get proc :eshell-pending)))
+ (process-put proc :eshell-pending nil)
+ (process-put proc :eshell-busy t)
+ (unwind-protect
+ (condition-case nil
+ (eshell-output-object data index handles)
+ ;; FIXME: We want to send SIGPIPE to the process
+ ;; here. However, remote processes don't currently
+ ;; support that, and not all systems have SIGPIPE in
+ ;; the first place (e.g. MS Windows). In these
+ ;; cases, just delete the process; this is
+ ;; reasonably close to the right behavior, since the
+ ;; default action for SIGPIPE is to terminate the
+ ;; process. For use cases where SIGPIPE is truly
+ ;; needed, using an external pipe operator (`*|')
+ ;; may work instead (e.g. when working with remote
+ ;; processes).
+ (eshell-pipe-broken
+ (if (or (process-get proc 'remote-pid)
+ (eq system-type 'windows-nt))
+ (delete-process proc)
+ (signal-process proc 'SIGPIPE))))
+ (process-put proc :eshell-busy nil))))))))
(defun eshell-sentinel (proc string)
"Generic sentinel for command processes. Reports only signals.
@@ -400,37 +445,39 @@ PROC is the process that's exiting. STRING is the exit
message."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(unwind-protect
- (when-let ((entry (assq proc eshell-process-list)))
- (unwind-protect
- (unless (string= string "run")
- ;; Write the exit message if the status is
- ;; abnormal and the process is already writing
- ;; to the terminal.
- (when (and (eq proc (eshell-tail-process))
- (not (string-match "^\\(finished\\|exited\\)"
- string)))
- (funcall (process-filter proc) proc string))
- (let ((handles (nth 1 entry))
- (str (prog1 (nth 3 entry)
- (setf (nth 3 entry) nil)))
- (status (process-exit-status proc)))
- ;; If we're in the middle of handling output
- ;; from this process then schedule the EOF for
- ;; later.
- (letrec ((finish-io
- (lambda ()
- (if (nth 4 entry)
- (run-at-time 0 nil finish-io)
- (when str
- (ignore-error 'eshell-pipe-broken
- (eshell-output-object
- str nil handles)))
- (eshell-close-handles
- status (list 'quote (= status 0))
- handles)))))
- (funcall finish-io))))
- (eshell-remove-process-entry entry)))
- (eshell-kill-process-function proc string)))))
+ (unless (string= string "run")
+ ;; Write the exit message if the status is abnormal and
+ ;; the process is already writing to the terminal.
+ (when (and (eq proc (eshell-tail-process))
+ (not (string-match "^\\(finished\\|exited\\)"
+ string)))
+ (funcall (process-filter proc) proc string))
+ (let* ((handles (process-get proc :eshell-handles))
+ (index (process-get proc :eshell-handle-index))
+ (data (process-get proc :eshell-pending))
+ ;; Only get the status for the primary subprocess,
+ ;; not the pipe process (if any).
+ (status (when (= index eshell-output-handle)
+ (process-exit-status proc))))
+ (process-put proc :eshell-pending nil)
+ ;; If we're in the middle of handling output from this
+ ;; process then schedule the EOF for later.
+ (letrec ((finish-io
+ (lambda ()
+ (if (process-get proc :eshell-busy)
+ (run-at-time 0 nil finish-io)
+ (when data
+ (ignore-error 'eshell-pipe-broken
+ (eshell-output-object
+ data index handles)))
+ (eshell-close-handles
+ status
+ (when status (list 'quote (= status 0)))
+ handles)))))
+ (funcall finish-io))))
+ (when-let ((entry (assq proc eshell-process-list)))
+ (eshell-remove-process-entry entry))
+ (eshell-kill-process-function proc string)))))
(defun eshell-process-interact (func &optional all query)
"Interact with a process, using PROMPT if more than one, via FUNC.
@@ -441,7 +488,7 @@ If QUERY is non-nil, query the user with QUERY before
calling FUNC."
(if (and (memq (process-status (car entry))
'(run stop open closed))
(or all
- (not (nth 2 entry)))
+ (not (cdr entry)))
(or (not query)
(y-or-n-p (format-message query
(process-name (car entry))))))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 9258ca5e40..f47373c115 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 additonal 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
@@ -412,7 +455,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 2f6614b5d7..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)
@@ -490,8 +531,11 @@ Possible variable references are:
;; by `eshell-do-eval', which requires very
;; particular forms in order to work
;; properly. See bug#54190.
- (list (function (lambda ()
- (delete-file ,temp))))))
+ (list (function
+ (lambda ()
+ (delete-file ,temp)
+ (when-let ((buffer (get-file-buffer
,temp)))
+ (kill-buffer buffer)))))))
(eshell-apply-indices ,temp indices
,eshell-current-quoted)))
(goto-char (1+ end)))))))
((eq (char-after) ?\()
@@ -558,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
@@ -586,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:
@@ -643,23 +728,24 @@ For example, to retrieve the second element of a user's
record in
"Reference VALUE using the given INDEX."
(when (and (stringp index) (get-text-property 0 'number index))
(setq index (string-to-number index)))
- (if (stringp index)
- (cdr (assoc index value))
- (cond
- ((ring-p value)
- (if (> index (ring-length value))
- (error "Index exceeds length of ring")
- (ring-ref value index)))
- ((listp value)
- (if (> index (length value))
- (error "Index exceeds length of list")
- (nth index value)))
- ((vectorp value)
- (if (> index (length value))
- (error "Index exceeds length of vector")
- (aref value index)))
- (t
- (error "Invalid data type for indexing")))))
+ (if (integerp index)
+ (cond
+ ((ring-p value)
+ (if (> index (ring-length value))
+ (error "Index exceeds length of ring")
+ (ring-ref value index)))
+ ((listp value)
+ (if (> index (length value))
+ (error "Index exceeds length of list")
+ (nth index value)))
+ ((vectorp value)
+ (if (> index (length value))
+ (error "Index exceeds length of vector")
+ (aref value index)))
+ (t
+ (error "Invalid data type for indexing")))
+ ;; INDEX is some non-integer value, so treat VALUE as an alist.
+ (cdr (assoc index value))))
;;;_* Variable name completion
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 2c472a2afa..e0c927cad4 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -194,17 +194,6 @@ shells such as bash, zsh, rc, 4dos."
;; The following user options modify the behavior of Eshell overall.
(defvar eshell-buffer-name)
-(defun eshell-add-to-window-buffer-names ()
- "Add `eshell-buffer-name' to `same-window-buffer-names'."
- (declare (obsolete nil "24.3"))
- (add-to-list 'same-window-buffer-names eshell-buffer-name))
-
-(defun eshell-remove-from-window-buffer-names ()
- "Remove `eshell-buffer-name' from `same-window-buffer-names'."
- (declare (obsolete nil "24.3"))
- (setq same-window-buffer-names
- (delete eshell-buffer-name same-window-buffer-names)))
-
(defcustom eshell-load-hook nil
"A hook run once Eshell has been loaded."
:type 'hook
diff --git a/lisp/faces.el b/lisp/faces.el
index 0246e038dd..09e8110449 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -666,21 +666,28 @@ If FACE is a face-alias, get the documentation for the
target face."
(defun set-face-attribute (face frame &rest args)
"Set attributes of FACE on FRAME from ARGS.
-This function overrides the face attributes specified by FACE's
-face spec. It is mostly intended for internal use only.
-
-If FRAME is nil, set the attributes for all existing frames, as
-well as the default for new frames. If FRAME is t, change the
-default for new frames only. As an exception, to reset the value
-of some attribute to `unspecified' in a way that overrides the
-non-`unspecified' value defined by the face's spec in `defface',
-for new frames, you must explicitly call this function with FRAME
-set to t and the attribute's value set to `unspecified'; just
-using FRAME of nil will not affect new frames in this case.
-
-ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a
-valid face attribute name. All attributes can be set to
-`unspecified'; this fact is not further mentioned below.
+This function overrides the face attributes specified by FACE's face spec.
+It is mostly intended for internal use.
+
+If FRAME is a frame, set the FACE's attributes only for that frame. If
+FRAME is nil, set attribute values for all existing frames, as well as
+the default for new frames. If FRAME is t, change the default values
+of attributes for new frames.
+
+ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid face
+attribute name and VALUE must be a value that is valid for ATTRIBUTE,
+as described below for each attribute.
+
+In addition to the attribute values listed below, all attributes can
+also be set to the special value `unspecified', which means the face
+doesn't by itself specify a value for the attribute.
+
+When a new frame is created, attribute values in the FACE's `defface'
+spec normally override the `unspecified' values in the FACE's
+default attributes. To avoid that, i.e. to cause ATTRIBUTE's value
+be reset to `unspecified' when creating new frames, disregarding
+what the FACE's face spec says, call this function with FRAME set to
+t and the ATTRIBUTE's value set to `unspecified'.
The following attributes are recognized:
@@ -994,9 +1001,6 @@ Use `set-face-attribute' to \"unspecify\" underlining."
(interactive (read-face-and-attribute :underline))
(set-face-attribute face frame :underline underline))
-(define-obsolete-function-alias 'set-face-underline-p
- 'set-face-underline "24.3")
-
(defun set-face-inverse-video (face inverse-video-p &optional frame)
"Specify whether face FACE is in inverse video.
@@ -2056,7 +2060,7 @@ IF MULTIPLE is non-nil, return a list of faces.
Return nil if there is no face at point.
-This function is not meant for handling faces programatically; to
+This function is not meant for handling faces programmatically; to
do that, use `get-text-property' and `get-char-property'."
(let (faces)
(when text
@@ -2544,7 +2548,6 @@ default."
:version "21.1"
:group 'basic-faces)
-;; Definition stolen from linum.el.
(defface line-number
'((t :inherit (shadow default)))
"Face for displaying line numbers.
@@ -2978,7 +2981,7 @@ bindings. See also the face `tooltip'."
:group 'help)
(defface glyphless-char
- '((((type tty)) :inherit underline)
+ '((((type tty)) :inherit escape-glyph :underline t)
(((type pc)) :inherit escape-glyph)
(t :height 0.6))
"Face for displaying non-graphic characters (e.g. U+202A (LRE)).
@@ -3167,12 +3170,6 @@ also the same size as FACE on FRAME, or fail."
(car fonts))
(frame-parameter nil 'font)))
-(defcustom font-list-limit 100
- "This variable is obsolete and has no effect."
- :type 'integer
- :group 'display)
-(make-obsolete-variable 'font-list-limit nil "24.3")
-
(define-obsolete-function-alias 'face-background-pixmap #'face-stipple "29.1")
(define-obsolete-function-alias 'set-face-background-pixmap #'set-face-stipple
"29.1")
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 88b4bce9fd..482ac3764a 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1504,7 +1504,11 @@ which may actually result in an URL rather than a
filename."
(progn
(push elem file-name-handler-alist)
(if (ffap-url-p guess)
- (read-file-name prompt guess guess)
+ ;; We're using the default file name prompter here -- it
+ ;; allows you to switch back to reading a file name,
+ ;; while other prompters, like ido, really expect a
+ ;; file, and don't allow you to edit it if it's an URL.
+ (funcall #'read-file-name-default prompt guess guess)
(unless guess
(setq guess default-directory))
(unless (ffap-file-remote-p guess)
@@ -1623,9 +1627,9 @@ and `ffap-url-at-point'."
((or (not ffap-newfile-prompt)
(file-exists-p filename)
(y-or-n-p "File does not exist, create buffer? "))
- (find-file
- ;; expand-file-name fixes "~/~/.emacs" bug
- (expand-file-name filename)))
+ (funcall ffap-file-finder
+ ;; expand-file-name fixes "~/~/.emacs" bug
+ (expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-missing (list "Opening file buffer"
"No such file or directory"
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 94e07289e3..6b13ed0b72 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -339,6 +339,7 @@ DESC is the back-end descriptor. ACTIONS is a list of:
"Add a watch for FILE in DIR with FLAGS, using inotify."
(inotify-add-watch dir
(append
+ '(dont-follow)
(and (memq 'change flags)
'(create delete delete-self modify move-self move))
(and (memq 'attribute-change flags)
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 cf2a522193..a282532258 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)
@@ -851,15 +852,20 @@ resulting list of directory names. For an empty path
element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
(when (stringp search-path)
- (let ((spath (substitute-env-vars search-path)))
+ (let ((spath (substitute-env-vars search-path))
+ (double-slash-special-p
+ (memq system-type '(windows-nt cygwin ms-dos))))
(mapcar (lambda (f)
(if (equal "" f) nil
(let ((dir (file-name-as-directory f)))
;; Previous implementation used `substitute-in-file-name'
- ;; which collapse multiple "/" in front. Do the same for
- ;; backward compatibility.
- (if (string-match "\\`/+" dir)
- (substring dir (1- (match-end 0))) dir))))
+ ;; which collapses multiple "/" in front, while
+ ;; preserving double slash where it matters. Do
+ ;; the same for backward compatibility.
+ (if (string-match "\\`//+" dir)
+ (substring dir (- (match-end 0)
+ (if double-slash-special-p 2 1)))
+ dir))))
(split-string spath path-separator)))))
(defun cd-absolute (dir)
@@ -2074,12 +2080,6 @@ this function prepends a \"|\" to the final result if
necessary."
(uniquify--create-file-buffer-advice buf filename)
buf))
-(defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
- "Regexp to match the automounter prefix in a directory name."
- :group 'files
- :type 'regexp)
-(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
-
(defvar abbreviated-home-dir nil
"Regexp matching the user's homedir at the beginning of file name.
The value includes abbreviation according to `directory-abbrev-alist'.")
@@ -2087,8 +2087,7 @@ The value includes abbreviation according to
`directory-abbrev-alist'.")
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
This also substitutes \"~\" for the user's home directory (unless the
-home directory is a root directory) and removes automounter prefixes
-\(see the variable `automount-dir-prefix').
+home directory is a root directory).
When this function is first called, it caches the user's home
directory as a regexp in `abbreviated-home-dir', and reuses it
@@ -2099,11 +2098,6 @@ started Emacs, set `abbreviated-home-dir' to nil so it
will be recalculated)."
(save-match-data ;FIXME: Why?
(if-let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
(funcall handler 'abbreviate-file-name filename)
- (if (and automount-dir-prefix
- (string-match automount-dir-prefix filename)
- (file-exists-p (file-name-directory
- (substring filename (1- (match-end 0))))))
- (setq filename (substring filename (1- (match-end 0)))))
;; Avoid treating /home/foo as /home/Foo during `~' substitution.
(let ((case-fold-search (file-name-case-insensitive-p filename)))
;; If any elt of directory-abbrev-alist matches this name,
@@ -2170,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.
@@ -2373,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
@@ -2386,16 +2380,15 @@ the various files."
'buffer-file-name buffer)))
(and file (file-exists-p file))))))))
;; Let user know if there is a buffer with the same truename.
- (if other
- (progn
- (or nowarn
- find-file-suppress-same-file-warnings
- (string-equal filename (buffer-file-name other))
- (files--message "%s and %s are the same file"
- filename (buffer-file-name other)))
- ;; Optionally also find that buffer.
- (if (or find-file-existing-other-name find-file-visit-truename)
- (setq buf other))))
+ (when other
+ (or nowarn
+ find-file-suppress-same-file-warnings
+ (string-equal filename (buffer-file-name other))
+ (files--message "%s and %s are the same file"
+ filename (buffer-file-name other)))
+ ;; Optionally also find that buffer.
+ (if (or find-file-existing-other-name find-file-visit-truename)
+ (setq buf other)))
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
(when (eq (abort-if-file-too-large
@@ -2718,7 +2711,8 @@ unless NOMODES is non-nil."
(file-newer-than-file-p (or buffer-auto-save-file-name
(make-auto-save-file-name))
buffer-file-name))
- (format "%s has auto save data; consider M-x
recover-this-file"
+ (format (substitute-command-keys
+ "%s has auto save data; consider \\`M-x
recover-this-file'")
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
@@ -3023,6 +3017,7 @@
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
;; either user's dot-files or under /etc or some such
("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'"
. conf-mode)
+ ("/\\.mailmap\\'" . conf-unix-mode)
;; alas not all ~/.*rc files are like this
("/\\.\\(?:asound\\|enigma\\|fetchmail\\|gltron\\|gtk\\|hxplayer\\|mairix\\|mbsync\\|msmtp\\|net\\|neverball\\|nvidia-settings-\\|offlineimap\\|qt/.+\\|realplayer\\|reportbug\\|rtorrent\\.\\|screen\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'"
. conf-mode)
("/\\.\\(?:gdbtkinit\\|grip\\|mpdconf\\|notmuch-config\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'"
. conf-mode)
@@ -3338,6 +3333,7 @@ checks if it uses an interpreter listed in
`interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the file name against the entries in `auto-mode-alist',
then matches the buffer beginning against `magic-fallback-mode-alist'.
+It also obeys `major-mode-remap-alist'.
If `enable-local-variables' is nil, or if the file name matches
`inhibit-local-variables-regexps', this function does not check
@@ -3475,6 +3471,17 @@ we don't actually set it to the same mode the buffer
already has."
(unless done
(set-buffer-major-mode (current-buffer)))))
+(defvar-local set-auto-mode--last nil
+ "Remember the mode we have set via `set-auto-mode-0'.")
+
+(defcustom major-mode-remap-alist nil
+ "Alist mapping file-specified mode to actual mode.
+Every entry is of the form (MODE . FUNCTION) which means that in order
+to activate the major mode MODE (specified via something like
+`auto-mode-alist', file-local variables, ...) we should actually call
+FUNCTION instead."
+ :type '(alist (symbol) (function)))
+
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
;; same one we already have, don't actually reset it. We don't want to lose
@@ -3485,10 +3492,15 @@ If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is
chased of
any aliases and compared to current major mode. If they are the
same, do nothing and return nil."
(unless (and keep-mode-if-same
- (eq (indirect-function mode)
- (indirect-function major-mode)))
+ (or (eq (indirect-function mode)
+ (indirect-function major-mode))
+ (and set-auto-mode--last
+ (eq mode (car set-auto-mode--last))
+ (eq major-mode (cdr set-auto-mode--last)))))
(when mode
- (funcall mode)
+ (funcall (alist-get mode major-mode-remap-alist mode))
+ (unless (eq mode major-mode)
+ (setq set-auto-mode--last (cons mode major-mode)))
mode)))
(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
@@ -3518,7 +3530,8 @@ have no effect."
;; interpreter invocation. The same holds
;; for '\" in man pages (preprocessor
;; magic for the `man' program).
- (and (looking-at file-auto-mode-skip) 2)) t)
+ (and (looking-at file-auto-mode-skip) 2))
+ t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
@@ -3600,7 +3613,6 @@ asking you for confirmation."
inhibit-quit
load-path
max-lisp-eval-depth
- max-specpdl-size
minor-mode-map-alist
minor-mode-overriding-map-alist
mode-line-format
@@ -3851,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)))
@@ -4733,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.
@@ -4873,6 +4885,14 @@ Interactively, this prompts for NEW-LOCATION."
(expand-file-name
(file-name-nondirectory (buffer-name))
default-directory)))))
+ ;; If the user has given a directory name, the file should be moved
+ ;; there (under the same file name).
+ (when (file-directory-p new-location)
+ (unless buffer-file-name
+ (user-error "Can't rename buffer to a directory file name"))
+ (setq new-location (expand-file-name
+ (file-name-nondirectory buffer-file-name)
+ new-location)))
(when (and buffer-file-name
(file-exists-p buffer-file-name))
(rename-file buffer-file-name new-location))
@@ -5181,7 +5201,7 @@ On most systems, this will be true:
(setq filename nil))))
components))
-(defun file-parent-directory (filename)
+(defun file-name-parent-directory (filename)
"Return the directory name of the parent directory of FILENAME.
If FILENAME is at the root of the filesystem, return nil.
If FILENAME is relative, it is interpreted to be relative
@@ -5191,7 +5211,9 @@ to `default-directory', and the result will also be
relative."
(cond
;; filename is at top-level, therefore no parent
((or (null parent)
- (file-equal-p parent expanded-filename))
+ ;; `equal' is enough, we don't need to resolve symlinks here
+ ;; with `file-equal-p', also for performance
+ (equal parent expanded-filename))
nil)
;; filename is relative, return relative parent
((not (file-name-absolute-p filename))
@@ -5712,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
@@ -6093,14 +6116,6 @@ prints a message in the minibuffer. Instead, use
`set-buffer-modified-p'."
"Modification-flag cleared"))
(set-buffer-modified-p arg))
-(defun toggle-read-only (&optional arg interactive)
- "Change whether this buffer is read-only."
- (declare (obsolete read-only-mode "24.3"))
- (interactive (list current-prefix-arg t))
- (if interactive
- (call-interactively 'read-only-mode)
- (read-only-mode (or arg 'toggle))))
-
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
Set mark after the inserted text.
@@ -6141,16 +6156,17 @@ recent files are first."
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
(dir (file-name-directory filename)))
- (sort
- (seq-filter
- (lambda (candidate)
- (and (backup-file-name-p candidate)
- (string= (file-name-sans-versions candidate) filename)))
- (mapcar
- (lambda (file)
- (concat dir file))
- (file-name-all-completions (file-name-nondirectory filename) dir)))
- #'file-newer-than-file-p)))
+ (when (file-directory-p dir)
+ (sort
+ (seq-filter
+ (lambda (candidate)
+ (and (backup-file-name-p candidate)
+ (string= (file-name-sans-versions candidate) filename)))
+ (mapcar
+ (lambda (file)
+ (concat dir file))
+ (file-name-all-completions (file-name-nondirectory filename) dir)))
+ #'file-newer-than-file-p))))
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
@@ -6330,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
@@ -6627,9 +6644,14 @@ preserve markers and overlays, at the price of being
slower."
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
(let ((revert-buffer-in-progress-p t)
- (revert-buffer-preserve-modes preserve-modes))
+ (revert-buffer-preserve-modes preserve-modes)
+ (state (and (boundp 'read-only-mode--state)
+ (list read-only-mode--state))))
(funcall (or revert-buffer-function #'revert-buffer--default)
- ignore-auto noconfirm)))
+ ignore-auto noconfirm)
+ (when state
+ (setq buffer-read-only (car state))
+ (setq-local read-only-mode--state (car state)))))
(defun revert-buffer--default (ignore-auto noconfirm)
"Default function for `revert-buffer'.
@@ -8279,10 +8301,10 @@ CHAR is in [ugoa] and represents the category of users
(Owner, Group,
Others, or All) for whom to produce the mask.
The bit-mask that is returned extracts from mode bits the access rights
for the specified category of users."
- (cond ((= char ?u) #o4700)
- ((= char ?g) #o2070)
- ((= char ?o) #o1007)
- ((= char ?a) #o7777)
+ (cond ((eq char ?u) #o4700)
+ ((eq char ?g) #o2070)
+ ((eq char ?o) #o1007)
+ ((eq char ?a) #o7777)
(t (error "%c: Bad `who' character" char))))
(defun file-modes-char-to-right (char &optional from)
@@ -8290,22 +8312,22 @@ for the specified category of users."
CHAR is in [rwxXstugo] and represents symbolic access permissions.
If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
(or from (setq from 0))
- (cond ((= char ?r) #o0444)
- ((= char ?w) #o0222)
- ((= char ?x) #o0111)
- ((= char ?s) #o6000)
- ((= char ?t) #o1000)
+ (cond ((eq char ?r) #o0444)
+ ((eq char ?w) #o0222)
+ ((eq char ?x) #o0111)
+ ((eq char ?s) #o6000)
+ ((eq char ?t) #o1000)
;; Rights relative to the previous file modes.
- ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
- ((= char ?u) (let ((uright (logand #o4700 from)))
- ;; FIXME: These divisions/shifts seem to be right
- ;; for the `7' part of the #o4700 mask, but not
- ;; for the `4' part. Same below for `g' and `o'.
- (+ uright (/ uright #o10) (/ uright #o100))))
- ((= char ?g) (let ((gright (logand #o2070 from)))
- (+ gright (/ gright #o10) (* gright #o10))))
- ((= char ?o) (let ((oright (logand #o1007 from)))
- (+ oright (* oright #o10) (* oright #o100))))
+ ((eq char ?X) (if (= (logand from #o111) 0) 0 #o0111))
+ ((eq char ?u) (let ((uright (logand #o4700 from)))
+ ;; FIXME: These divisions/shifts seem to be right
+ ;; for the `7' part of the #o4700 mask, but not
+ ;; for the `4' part. Same below for `g' and `o'.
+ (+ uright (/ uright #o10) (/ uright #o100))))
+ ((eq char ?g) (let ((gright (logand #o2070 from)))
+ (+ gright (/ gright #o10) (* gright #o10))))
+ ((eq char ?o) (let ((oright (logand #o1007 from)))
+ (+ oright (* oright #o10) (* oright #o100))))
(t (error "%c: Bad right character" char))))
(defun file-modes-rights-to-number (rights who-mask &optional from)
@@ -8638,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 4831bf167d..aeebd907c3 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -358,8 +358,6 @@ Don't forget to check out
`filesets-menu-ensure-use-cached'."
:value filesets-be-docile-flag)
(sexp :tag "Other" :value nil))))
-(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
- 'filesets-cache-fill-content-hook "24.3")
(defcustom filesets-cache-fill-content-hook nil
"Hook run when writing the contents of filesets' cache file.
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 614ff420f2..646779fc91 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -193,18 +193,32 @@ The value could be an alist or a symbol whose value is an
alist.
Each element of the alist has the form
(REGEXP (EXTENSION...))
-or
- (REGEXP FUNCTION)
where REGEXP is the regular expression matching a file's extension,
-EXTENSIONs is the list of literal file-name extensions to search for,
-and FUNCTION is a function of one argument, the current file's name,
-that returns the list of extensions to search for.
-The list of extensions should contain the most used extensions before the
-others, since the search algorithm searches sequentially through each
-directory specified in `ff-search-directories'. If a file is not found,
-a new one is created with the first matching extension (`.cc' yields `.hh').
-This alist should be set by the major mode."
+and EXTENSIONs is the list of literal file-name extensions to search
+for. The list of extensions should contain the most used extensions
+before the others, since the search algorithm searches sequentially
+through each directory specified in `ff-search-directories'.
+
+Alist elements can also be of the form
+
+ (REGEXP FUNCTION)
+
+where FUNCTION is a function of one argument, the current file's name,
+that returns the list of possible names of the corresponding files, with
+or without leading directories. Note the difference: FUNCTION returns
+the list of file names, not their extensions. This is for the case when
+REGEXP is not enough to determine the file name of the other file.
+
+If a file is not found, a new one is created with the first
+matching extension or name (e.g., `.cc' yields `.hh').
+
+This alist should be set by the major mode.
+
+Note: if an element of the alist names a FUNCTION as its cdr, that
+function must return a non-nil list of file-names. It cannot
+return nil, nor can it signal in any way a failure to find a suitable
+list of file names."
:type '(choice (repeat (list regexp (choice (repeat string) function)))
symbol))
@@ -615,7 +629,7 @@ name of the first file found."
(while (and suffixes (not found))
(setq filename (concat fname-stub this-suffix))
- (setq file (concat dir "/" filename))
+ (setq file (expand-file-name filename dir))
(if (not ff-quiet-mode)
(message "Finding %s..." file))
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index e825d9cba0..62b4ef625d 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -166,7 +166,8 @@ It is a function which takes two arguments, the directory
and its parent."
;;;###autoload
(defun find-lisp-find-dired (dir regexp)
- "Find files in DIR, matching REGEXP."
+ "Find the files within DIR whose names match REGEXP.
+A Dired buffer with the results will be opened."
(interactive "DFind files in directory: \nsMatching regexp: ")
(let ((find-lisp-regexp regexp))
(find-lisp-find-dired-internal
@@ -175,34 +176,54 @@ It is a function which takes two arguments, the directory
and its parent."
'find-lisp-default-directory-predicate
"*Find Lisp Dired*")))
+(defun find-lisp-find-dired-other-window (dir regexp)
+ "Same as `find-lisp-find-dired', but use another window."
+ (interactive "DFind files in directory: \nsMatching regexp: ")
+ (let ((find-lisp-regexp regexp))
+ (find-lisp-find-dired-internal
+ dir
+ 'find-lisp-default-file-predicate
+ 'find-lisp-default-directory-predicate
+ "*Find Lisp Dired*"
+ 'OTHER-WINDOW)))
+
;; Just the subdirectories
;;;###autoload
(defun find-lisp-find-dired-subdirectories (dir)
"Find all subdirectories of DIR."
- (interactive "DFind subdirectories of directory: ")
+ (interactive "DFind dired subdirectories of directory: ")
(find-lisp-find-dired-internal
dir
'find-lisp-file-predicate-is-directory
'find-lisp-default-directory-predicate
"*Find Lisp Dired Subdirectories*"))
+;;;###autoload
+(defun find-lisp-find-dired-subdirs-other-window (dir)
+ "Same as `find-lisp-find-dired-subdirectories', but use another window."
+ (interactive "DDired descendent dirs of directory: ")
+ (find-lisp-find-dired-internal dir
+ 'find-lisp-file-predicate-is-directory
+ 'find-lisp-default-directory-predicate
+ "*Find Lisp Dired Subdirectories*"
+ 'OTHER-WINDOW))
+
;; Most of this is lifted from find-dired.el
;;
(defun find-lisp-find-dired-internal (dir file-predicate
- directory-predicate buffer-name)
+ directory-predicate buffer-name
+ &optional other-window)
"Run find (Lisp version) and go into Dired mode on a buffer of the output."
- (let ((dired-buffers dired-buffers)
- (regexp find-lisp-regexp))
- ;; Expand DIR ("" means default-directory), and make sure it has a
- ;; trailing slash.
+ (let ((dired-buffers dired-buffers)
+ (regexp find-lisp-regexp))
+ ;; Expand DIR ("" means `default-directory'), ensuring a trailing slash.
(setq dir (file-name-as-directory (expand-file-name dir)))
;; Check that it's really a directory.
(or (file-directory-p dir)
(error "find-dired needs a directory: %s" dir))
- (or
- (and (buffer-name)
- (string= buffer-name (buffer-name)))
- (switch-to-buffer (get-buffer-create buffer-name)))
+ (unless (and (buffer-name) (string= buffer-name (buffer-name)))
+ (let ((buf (get-buffer-create buffer-name)))
+ (if other-window (pop-to-buffer buf) (switch-to-buffer buf))))
(widen)
(kill-all-local-variables)
(setq buffer-read-only nil)
@@ -278,10 +299,19 @@ It is a function which takes two arguments, the directory
and its parent."
(revert-buffer))
(defun find-lisp-find-dired-insert-file (file buffer)
+ "Insert line for FILE in BUFFER.
+FILE is a file or a directory name.
+
+This function heeds `dired-actual-switches'."
(set-buffer buffer)
(insert find-lisp-line-indent
- (find-lisp-format file (file-attributes file 'string) (list "")
- nil)))
+ (find-lisp-format
+ (propertize file 'dired-filename t)
+ (file-attributes file 'string)
+ (or (and dired-actual-switches
+ (split-string-and-unquote dired-actual-switches))
+ (list ""))
+ nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lifted from ls-lisp. We don't want to require it, because that
@@ -289,15 +319,14 @@ It is a function which takes two arguments, the directory
and its parent."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun find-lisp-format (file-name file-attr switches now)
- "Format one line of long ls output for file FILE-NAME.
+ "Format one line of long `ls' output for file or directory FILE-NAME.
FILE-ATTR and FILE-SIZE give the file's attributes and size.
SWITCHES and TIME-INDEX give the full switch list and time data."
(let ((file-type (file-attribute-type file-attr)))
- (concat (if (memq ?i switches) ; inode number
- (format "%6d " (file-attribute-inode-number file-attr)))
- ;; nil is treated like "" in concat
- (if (memq ?s switches) ; size in K
- (format "%4d " (1+ (/ (file-attribute-size file-attr) 1024))))
+ (concat (and (memq ?i switches) ; inode number
+ (format "%6d " (file-attribute-inode-number file-attr)))
+ (and (memq ?s switches) ; size in K
+ (format "%4d " (1+ (/ (file-attribute-size file-attr) 1024))))
(file-attribute-modes file-attr)
(format " %3d %-8s %-8s %8d "
(file-attribute-link-number file-attr)
@@ -309,14 +338,14 @@ SWITCHES and TIME-INDEX give the full switch list and
time data."
(if (numberp (file-attribute-group-id file-attr))
(int-to-string (file-attribute-group-id file-attr))
(file-attribute-group-id file-attr)))
- (file-attribute-size file-attr)
- )
+ (file-attribute-size file-attr))
(find-lisp-format-time file-attr switches now)
" "
file-name
- (if (stringp file-type) ; is a symbolic link
- (concat " -> " file-type)
- "")
+ (and (eq t file-type) (memq ?F switches)
+ "/") ; Add `/' for dir if `F' switch
+ (and (stringp file-type)
+ (concat " -> " file-type)) ; Add " -> " for symbolic link
"\n")))
(defun find-lisp-time-index (switches)
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 b6f4150964..d132de3a32 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -633,16 +633,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)
@@ -1002,7 +992,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
@@ -1152,7 +1142,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
@@ -1211,8 +1201,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))))
@@ -1307,8 +1296,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-spec.el b/lisp/format-spec.el
index 45c19aebc8..60ff9f9086 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -59,6 +59,18 @@ value associated with ?b in SPECIFICATION, either padding it
with
leading zeros or truncating leading characters until it's ten
characters wide\".
+the substitution for a specification character can also be a
+function, taking no arguments and returning a string to be used
+for the replacement. It will only be called if FORMAT uses that
+character. For example:
+
+ (format-spec \"%n\"
+ \\=`((?n . ,(lambda ()
+ (read-number \"Number: \")))))
+
+Note that it is best to make sure the function is not quoted,
+like above, so that it is compiled by the byte-compiler.
+
Any text properties of FORMAT are copied to the result, with any
text properties of a %-spec itself copied to its substitution.
@@ -94,14 +106,15 @@ is returned, where each format spec is its own element."
(width (match-string 2))
(trunc (match-string 3))
(char (string-to-char (match-string 4)))
- (text (assq char specification)))
+ (text (let ((res (cdr (assq char specification))))
+ (if (functionp res) (funcall res) res))))
(when (and split
(not (= (1- beg) split-start)))
(push (buffer-substring split-start (1- beg)) split-result))
(cond (text
;; Handle flags.
(setq text (format-spec--do-flags
- (format "%s" (cdr text))
+ (format "%s" text)
(format-spec--parse-flags flags)
(and width (string-to-number width))
(and trunc (car (read-from-string trunc 1)))))
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..b97fdbe04c 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1928,8 +1928,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 +1954,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/frame.el b/lisp/frame.el
index 9476cb0ec4..400f8a44ee 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -64,7 +64,7 @@ handles the corresponding kind of display.")
;; But that's not necessary, because the default is to have one.
;; By not specifying it here, we let an X resource specify it.
(defcustom initial-frame-alist nil
- "Alist of parameters for the initial X window frame.
+ "Alist of parameters for the initial window-system (a.k.a. \"GUI\") frame.
You can set this in your init file; for example,
(setq initial-frame-alist
@@ -77,17 +77,20 @@ If the value calls for a frame without a minibuffer, and
you have
not created a minibuffer frame on your own, a minibuffer frame is
created according to `minibuffer-frame-alist'.
-You can specify geometry-related options for just the initial
-frame by setting this variable in your init file; however, they
-won't take effect until Emacs reads your init file, which happens
-after creating the initial frame. If you want the initial frame
-to have the proper geometry as soon as it appears, you need to
-use this three-step process:
+Emacs reads your main init file after creating the initial frame,
+so setting it there won't have the expected effect. Instead, you
+can set it in `early-init-file'.
+
+If you're using X, and you want (for instance) to have different
+geometries on different displays, you need to use this three-step
+process:
+
* Specify X resources to give the geometry you want.
* Set `default-frame-alist' to override these options so that they
don't affect subsequent frames.
-* Set `initial-frame-alist' in a way that matches the X resources,
- to override what you put in `default-frame-alist'."
+* Set `initial-frame-alist' in your normal init file in a way
+ that matches the X resources, to override what you put in
+ `default-frame-alist'."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value")))
@@ -1790,7 +1793,7 @@ of frames like calls to map a frame or change its
visibility."
(insert (format ", DS=%sx%s" (nth 0 item) (nth 1 item))))
(insert "\n"))
((and (eq (nth 0 item) frame) (= (nth 1 item) 5))
- ;; Length 5 is an `adjust-frame-size' item.
+ ;; Length 5 is an 'adjust_frame_size' item.
(insert (format "%s (%s)" (nth 3 item) (nth 2 item)))
(setq item (nth 0 (cdr entry)))
(unless (and (= (nth 0 item) (nth 2 item))
@@ -2422,9 +2425,9 @@ It may be less than the total screen size, owing to space
taken up
by window manager features (docks, taskbars, etc.). The precise
details depend on the platform and environment.
-The `source' attribute describes the source from which the information
-was obtained. On X, this may be one of: \"Gdk\", \"XRandr\", \"Xinerama\",
-or \"fallback\".
+The `source' attribute describes the source from which the
+information was obtained. On X, this may be one of: \"Gdk\",
+\"XRandR 1.5\", \"XRandr\", \"Xinerama\", or \"fallback\".
A frame is dominated by a physical monitor when either the
largest area of the frame resides in the monitor, or the monitor
@@ -2513,6 +2516,7 @@ symbols."
((eq frame-type 'pgtk)
(pgtk-device-class name))
(t (cond
+ ((not name) nil)
((string= name "Virtual core pointer")
'core-pointer)
((string= name "Virtual core keyboard")
@@ -3048,16 +3052,8 @@ See also `toggle-frame-maximized'."
;; Misc.
-;; Only marked as obsolete in 24.3.
-(define-obsolete-variable-alias 'automatic-hscrolling
- 'auto-hscroll-mode "22.1")
-
(make-variable-buffer-local 'show-trailing-whitespace)
-;; Defined in dispnew.c.
-(make-obsolete-variable
- 'window-system-version "it does not give useful information." "24.3")
-
(defun set-frame-property--interactive (prompt number)
"Get a value for `set-frame-width' or `set-frame-height', prompting with
PROMPT.
Offer NUMBER as default value, if it is a natural number."
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 2c9d1b316e..bbc90493af 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -193,7 +193,6 @@ This hook will be installed if the variable
hosts-generic-mode
java-manifest-generic-mode
java-properties-generic-mode
- javascript-generic-mode
show-tabs-generic-mode
vrml-generic-mode)
"List of generic modes that are defined by default.")
@@ -489,12 +488,6 @@ like an INI file. You can add this hook to
`find-file-hook'."
nil
"Generic mode for Sys V pkginfo files."))
-;; Javascript mode
-;; Obsolete; defer to js-mode from js.el.
-(when (memq 'javascript-generic-mode generic-extras-enable-list)
- (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
- (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3"))
-
;; VRML files
(when (memq 'vrml-generic-mode generic-extras-enable-list)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 83ba72c091..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
@@ -8550,17 +8525,13 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-(defvar gnus-prev-page-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] #'gnus-button-prev-page)
- (define-key map "\r" #'gnus-button-prev-page)
- map))
+(defvar-keymap gnus-prev-page-map
+ "<mouse-2>" #'gnus-button-prev-page
+ "RET" #'gnus-button-prev-page)
-(defvar gnus-next-page-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] #'gnus-button-next-page)
- (define-key map "\r" #'gnus-button-next-page)
- map))
+(defvar-keymap gnus-next-page-map
+ "<mouse-2>" #'gnus-button-next-page
+ "RET" #'gnus-button-next-page)
(defun gnus-insert-prev-page-button ()
(let ((b (point)) e
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-cloud.el b/lisp/gnus/gnus-cloud.el
index 9bd9f2155f..0e38fc0680 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -84,6 +84,7 @@ easy interactive way to set this from the Server buffer."
(defun gnus-cloud-make-chunk (elems)
(with-temp-buffer
+ (set-buffer-multibyte nil)
(insert (format "Gnus-Cloud-Version %s\n" gnus-cloud-version))
(insert (gnus-cloud-insert-data elems))
(buffer-string)))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index ddd939794d..5a0cf77a32 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -36,15 +36,12 @@
(define-derived-mode gnus-custom-mode fundamental-mode "Gnus Customize"
"Major mode for editing Gnus customization buffers.
-The following commands are available:
+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-click] Activate button under the mouse pointer.
+\\[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 fcad601d0c..e69f0857e7 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1717,9 +1717,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is
not updated."
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
(setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification
- (list (propertize mode-string
- 'face 'mode-line-buffer-id))))
+ (gnus-mode-line-buffer-identification (list mode-string)))
(set-buffer-modified-p modified))))))
(defun gnus-group-group-name ()
@@ -2423,44 +2421,37 @@ the ephemeral group."
(regexp-quote address)
"\\(?:\\'\\|[ ,>]\\)"))
(delim (concat "^" message-unix-mail-delimiter)))
- (let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
- (with-temp-file tmpfile
- (mm-disable-multibyte)
- (dolist (id ids)
- (let ((file (expand-file-name id (locate-user-emacs-file
- "debbugs-cache"))))
- (if (and (not gnus-plugged)
- (file-exists-p file))
- (insert-file-contents file)
- ;; Pass non-nil VISIT to avoid errors with non-nil
- ;; `url-automatic-caching' (bug#26063, bug#29008)
- ;; and immediately unvisit.
- ;; FIXME: This masks real errors!
- (url-insert-file-contents (format mbox-url id) t)
- (setq buffer-file-name nil))))
- (goto-char (point-min))
- ;; Throw an informative error early instead of passing nonsense
- ;; to `gnus-group-read-ephemeral-group' (bug#36433).
- (unless (save-excursion (re-search-forward delim nil t))
- (error "Invalid mbox format for bug IDs: %s"
- (string-join ids ", ")))
- (while (re-search-forward delim nil t)
- (narrow-to-region (point)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (unless (string-match-p address-re
- (concat (message-fetch-field "to") " "
- (message-fetch-field "cc")))
- (goto-char (point-min))
- (if (not (re-search-forward "^To:" nil t))
- (insert "To: " address "\n")
- (message-next-header)
- (skip-chars-backward "\t\n ")
- (insert ", " address)))
- (goto-char (point-max))
- (widen))))
+ (with-temp-file tmpfile
+ (mm-disable-multibyte)
+ (dolist (id ids)
+ (let ((file (expand-file-name id (locate-user-emacs-file
+ "debbugs-cache"))))
+ (if (and (not gnus-plugged)
+ (file-exists-p file))
+ (insert-file-contents-literally file)
+ (url-insert-file-contents-literally (format mbox-url id)))))
+ (goto-char (point-min))
+ ;; Throw an informative error early instead of passing nonsense
+ ;; to `gnus-group-read-ephemeral-group' (bug#36433).
+ (unless (save-excursion (re-search-forward delim nil t))
+ (error "Invalid mbox format for bug IDs: %s"
+ (string-join ids ", ")))
+ (while (re-search-forward delim nil t)
+ (narrow-to-region (point)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (unless (string-match-p address-re
+ (concat (message-fetch-field "to") " "
+ (message-fetch-field "cc")))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^To:" nil t))
+ (insert "To: " address "\n")
+ (message-next-header)
+ (skip-chars-backward "\t\n ")
+ (insert ", " address)))
+ (goto-char (point-max))
+ (widen)))
(gnus-group-read-ephemeral-group
(concat "nndoc+ephemeral:bug#" (string-join ids ","))
`(nndoc ,tmpfile
@@ -2660,6 +2651,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 327dba95c0..b8f7e7a08f 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -2247,11 +2247,9 @@ article came from is also searched."
(forward-line)))))
groups))
-(defvar gnus-search-minibuffer-map
- (let ((km (make-sparse-keymap)))
- (set-keymap-parent km minibuffer-local-map)
- (define-key km (kbd "TAB") #'completion-at-point)
- km))
+(defvar-keymap gnus-search-minibuffer-map
+ :parent minibuffer-local-map
+ "TAB" #'completion-at-point)
(defun gnus-search--complete-key-data ()
"Potentially return completion data for a search key or value."
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index e659a648e1..315381a6dd 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -829,9 +829,10 @@ claim them."
(erase-buffer))
(gnus-browse-mode)
(setq mode-line-buffer-identification
- (list
- (format
- "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+ (gnus-mode-line-buffer-identification
+ (list
+ (format
+ "Gnus: %%b {%s:%s}" (car method) (cadr method)))))
(let ((buffer-read-only nil)
name
(prefix (let ((gnus-select-method orig-select-method))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 7700e6bd43..4963fd083f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -294,8 +294,6 @@ claim them."
function
(repeat function)))
-(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks
- 'gnus-subscribe-newsgroup-functions "24.3")
(defcustom gnus-subscribe-newsgroup-functions nil
"Hooks run after you subscribe to a new group.
The hooks will be called with new group's name as argument."
@@ -1812,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 dde60caee7..18ba55a439 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -6207,8 +6207,7 @@ If WHERE is `summary', the summary mode line format will
be used."
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification
- (list (propertize mode-string
- 'face 'mode-line-buffer-id))))
+ (list mode-string)))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
@@ -9857,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/gnus.el b/lisp/gnus/gnus.el
index 0afd873a5d..778a46dab3 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -310,12 +310,15 @@ be set in `.emacs' instead."
:type 'boolean)
(defun gnus-mode-line-buffer-identification (line)
- (let ((str (car-safe line)))
+ (let* ((str (car-safe line))
+ (str (if (stringp str)
+ (car (propertized-buffer-identification str))
+ str)))
(if (or (not (fboundp 'find-image))
(not (display-graphic-p))
(not (stringp str))
(not (string-match "^Gnus:" str)))
- line
+ (list str)
(let ((load-path (append (mm-image-load-path) load-path)))
;; Add the Gnus logo.
(add-text-properties
@@ -2232,7 +2235,7 @@ Disabling the agent may result in noticeable loss of
performance."
(symbol :tag "Parameter")
(sexp :tag "Value"))))
-(defcustom gnus-user-agent '(emacs gnus type)
+(defcustom gnus-user-agent '(gnus)
"Which information should be exposed in the User-Agent header.
Can be a list of symbols or a string. Valid symbols are `gnus'
@@ -2240,7 +2243,7 @@ Can be a list of symbols or a string. Valid symbols are
`gnus'
addition to the Emacs version, you can add `config' (show system
configuration) or `type' (show system type). If you set it to a
string, be sure to use a valid format, see RFC 2616."
- :version "22.1"
+ :version "29.1"
:group 'gnus-message
:type '(choice (list (set :inline t
(const :value gnus :tag "Gnus version")
@@ -2250,25 +2253,6 @@ string, be sure to use a valid format, see RFC 2616."
(const :value config :tag "system
configuration"))))
(string)))
-;; Convert old (< 2005-01-10) symbol type values:
-(when (symbolp gnus-user-agent)
- (setq gnus-user-agent
- (cond ((eq gnus-user-agent 'emacs-gnus-config)
- '(emacs gnus config))
- ((eq gnus-user-agent 'emacs-gnus-type)
- '(emacs gnus type))
- ((eq gnus-user-agent 'emacs-gnus)
- '(emacs gnus))
- ((eq gnus-user-agent 'gnus)
- '(gnus))
- (t gnus-user-agent)))
- (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent)
- (sit-for 1)
- (if (get 'gnus-user-agent 'saved-value)
- (customize-save-variable 'gnus-user-agent gnus-user-agent)
- (gnus-message 1 "Edit your init file to make this change permanent.")
- (sit-for 2)))
-
(defcustom gnus-agent-eagerly-store-articles t
"If non-nil, cache articles eagerly.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index b98e623db8..24cba97718 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -888,9 +888,22 @@ symbol `never', the posting is not allowed. If it is the
symbol
;; FIXME: This is related to `mail-specify-envelope-from' but works
;; differently (bug#36937).
nil
- "Non-nil means don't add \"-f username\" to the sendmail command line.
-See `feedmail-sendmail-f-doesnt-sell-me-out' for an explanation
-of what the \"-f\" parameter does."
+ "Non-nil means don't add \"-f username\" to the \"sendmail\" command line.
+The \"sendmail\" program has a useful feature to let you set the
+envelope FROM address via a command line option, \"-f\".
+Unfortunately, it also has a widely disliked default behavior of
+disclosing your actual user name anyway by inserting an
+unattractive warning in the headers. It looks something like
+this:
+
+ X-Authentication-Warning: u1.example.com: niceguy set
+ sender to niceguy@example.com using -f
+
+It is possible to configure \"sendmail\" to not do this, but such a
+reconfiguration is not an option for some users.
+
+Note that this user option is mostly useful for actual \"sendmail\"
+installations, which are rare these days."
:group 'message-sending
:link '(custom-manual "(message)Mail Variables")
:type 'boolean)
@@ -2159,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)))
@@ -3195,7 +3207,8 @@ Like `text-mode', but with these additional commands:
;;
(setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t)
- (setq-local message-encoded-mail-cache nil))
+ (setq-local message-encoded-mail-cache nil)
+ (setq-local image-crop-buffer-text-function #'message--update-image-crop))
(defun message-setup-fill-variables ()
"Setup message fill variables."
@@ -3551,7 +3564,12 @@ of lines before the signature intact."
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
-Prefix arg means justify as well."
+Prefix arg means justify as well.
+
+This function tries to guess what the quote prefix is based on
+the text on the current line before point. If point is at the
+start of the line, the formatted text (if any) is filled without
+a quote prefix."
(interactive (list (if current-prefix-arg 'full)) message-mode)
(unless (message-in-body-p)
(error "This command only works in the body of the message"))
@@ -3928,8 +3946,7 @@ However, if `message-yank-prefix' is non-nil, insert that
prefix on each line."
(if all-removed
(goto-char start)
(forward-line 1))))
- ;; Delete blank lines at the start of the buffer.
- (goto-char (point-min))
+ ;; Delete blank lines at the start of the cited text.
(while (and (eolp) (not (eobp)))
(delete-line))
;; Delete blank lines at the end of the buffer.
@@ -4344,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)
@@ -4368,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
@@ -5175,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)
@@ -7291,7 +7305,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
@@ -7352,7 +7365,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
@@ -8591,7 +8603,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
@@ -8910,19 +8921,26 @@ used to take the screenshot."
:max-width (truncate (* (frame-pixel-width) 0.8))
:max-height (truncate (* (frame-pixel-height) 0.8))
:scale 1)
- (format "<#part type=\"%s\" disposition=inline data-encoding=base64
raw=t>\n%s\n<#/part>"
- type
- ;; Get a base64 version of the image -- this avoids later
- ;; complications if we're auto-saving the buffer and
- ;; restoring from a file.
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert image)
- (base64-encode-region (point-min) (point-max) t)
- (buffer-string)))
+ (message--image-part-string type image)
nil nil t)
(insert "\n\n"))
+(defun message--image-part-string (type image)
+ (format "<#part type=\"%s\" disposition=inline data-encoding=base64
raw=t>\n%s\n<#/part>"
+ type
+ ;; Get a base64 version of the image -- this avoids later
+ ;; complications if we're auto-saving the buffer and
+ ;; restoring from a file.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (base64-encode-region (point-min) (point-max) t)
+ (buffer-string))))
+
+(declare-function image-crop--content-type "image-crop")
+(defun message--update-image-crop (_text image)
+ (message--image-part-string (image-crop--content-type image) image))
+
(declare-function gnus-url-unhex-string "gnus-util")
(defun message-parse-mailto-url (url)
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-decode.el b/lisp/gnus/mm-decode.el
index 1417ecdccc..5268f192c6 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -117,7 +117,8 @@
(cond ((fboundp 'libxml-parse-html-region) 'shr)
((executable-find "w3m") 'gnus-w3m)
((executable-find "links") 'links)
- ((executable-find "lynx") 'lynx))
+ ((executable-find "lynx") 'lynx)
+ (t 'shr))
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
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/nndiary.el b/lisp/gnus/nndiary.el
index 27204b3618..ab9c6dd74f 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -165,22 +165,16 @@ In order to make this clear, here are some examples:
:type 'boolean)
-(define-obsolete-variable-alias 'nndiary-request-create-group-hooks
- 'nndiary-request-create-group-functions "24.3")
(defcustom nndiary-request-create-group-functions nil
"Hook run after `nndiary-request-create-group' is executed.
The hook functions will be called with the full group name as argument."
:type 'hook)
-(define-obsolete-variable-alias 'nndiary-request-update-info-hooks
- 'nndiary-request-update-info-functions "24.3")
(defcustom nndiary-request-update-info-functions nil
"Hook run after `nndiary-request-update-info' is executed.
The hook functions will be called with the full group name as argument."
:type 'hook)
-(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks
- 'nndiary-request-accept-article-functions "24.3")
(defcustom nndiary-request-accept-article-functions nil
"Hook run before accepting an article.
Executed near the beginning of `nndiary-request-accept-article'.
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/score-mode.el b/lisp/gnus/score-mode.el
index 8e27e87939..4c9d73a6e5 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -45,13 +45,11 @@
(defvar gnus-score-edit-exit-function nil
"Function run on exit from the score buffer.")
-(defvar gnus-score-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map emacs-lisp-mode-map)
- (define-key map "\C-c\C-c" 'gnus-score-edit-exit)
- (define-key map "\C-c\C-d" 'gnus-score-edit-insert-date)
- (define-key map "\C-c\C-p" 'gnus-score-pretty-print)
- map))
+(defvar-keymap gnus-score-mode-map
+ :parent emacs-lisp-mode-map
+ "C-c C-c" #'gnus-score-edit-exit
+ "C-c C-d" #'gnus-score-edit-insert-date
+ "C-c C-p" #'gnus-score-pretty-print)
(defvar score-mode-syntax-table
(let ((table (copy-syntax-table lisp-mode-syntax-table)))
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index fd2791f5c5..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))
@@ -614,12 +614,10 @@ A string or a list of strings is returned."
(defvar smime-buffer "*SMIME*")
-(defvar smime-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'smime-exit)
- (define-key map "f" 'smime-certificate-info)
- map))
+(defvar-keymap smime-mode-map
+ :suppress t
+ "q" #'smime-exit
+ "f" #'smime-certificate-info)
(autoload 'gnus-completing-read "gnus-util")
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 1ccf9bb428..e29f763dab 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -229,7 +229,7 @@ interactive command."
(lambda (f) (if want-command
(commandp f)
(or (fboundp f) (get f 'function-documentation))))
- t nil nil
+ 'confirm nil nil
(and fn (symbol-name fn)))))
(unless (equal val "")
(setq fn (intern val)))
@@ -457,7 +457,9 @@ the C sources, too."
load-path '(".el" ".elc") 'readable))))))))
(cond
- ((and (not file-name) (subrp type))
+ ((and (not file-name)
+ (subrp type)
+ (not (subr-native-elisp-p type)))
;; A built-in function. The form is from `describe-function-1'.
(if (or (get-buffer " *DOC*")
(and also-c-source
@@ -515,8 +517,11 @@ the C sources, too."
(let ((pt2 (with-current-buffer standard-output (point)))
(remapped (command-remapping function)))
(unless (memq remapped '(ignore undefined))
- (let* ((all-keys (where-is-internal
- (or remapped function) overriding-local-map nil nil))
+ (let* ((all-keys
+ (with-current-buffer
+ (or describe-function-orig-buffer (current-buffer))
+ (where-is-internal
+ (or remapped function) overriding-local-map nil nil)))
(seps (seq-group-by
(lambda (key)
(and (vectorp key)
@@ -583,36 +588,43 @@ the C sources, too."
keys))
(defun help-fns--insert-menu-bindings (menus heading)
- (seq-do-indexed
- (lambda (menu i)
- (insert
- (cond ((zerop i) "")
- ((= i (1- (length menus))) " and ")
- (t ", ")))
- (let ((map (lookup-key global-map (seq-take menu 1)))
- (start (point)))
- (seq-do-indexed
- (lambda (entry level)
- (when (symbolp map)
- (setq map (symbol-function map)))
- (when-let ((elem (assq entry (cdr map))))
- (when heading
- (insert heading)
- (setq heading nil start (point)))
- (when (> level 0)
- (insert
- (if (char-displayable-p ?→)
- " → "
- " => ")))
- (if (eq (nth 1 elem) 'menu-item)
- (progn
- (insert (nth 2 elem))
- (setq map (cadddr elem)))
- (insert (nth 1 elem))
- (setq map (cddr elem)))))
- (cdr (seq-into menu 'list)))
- (put-text-property start (point) 'face 'help-key-binding)))
- menus))
+ (let ((strings nil))
+ ;; First collect all the printed representations of menus.
+ (dolist (menu menus)
+ (let ((map (lookup-key global-map (seq-take menu 1)))
+ (string nil))
+ (seq-do-indexed
+ (lambda (entry level)
+ (when (symbolp map)
+ (setq map (symbol-function map)))
+ (when-let ((elem (assq entry (cdr map))))
+ (when (> level 0)
+ (push (if (char-displayable-p ?→)
+ " → "
+ " => ")
+ string))
+ (if (eq (nth 1 elem) 'menu-item)
+ (progn
+ (push (nth 2 elem) string)
+ (setq map (cadddr elem)))
+ (push (nth 1 elem) string)
+ (setq map (cddr elem)))))
+ (cdr (seq-into menu 'list)))
+ (when string
+ (push string strings))))
+ ;; Then output them.
+ (when strings
+ (when heading
+ (insert heading))
+ (seq-do-indexed
+ (lambda (string i)
+ (insert
+ (cond ((zerop i) "")
+ ((= i (1- (length menus))) " and ")
+ (t ", "))
+ (propertize (string-join (nreverse string))
+ 'face 'help-key-binding)))
+ strings))))
(defun help-fns--compiler-macro (function)
(pcase-dolist (`(,type . ,handler)
@@ -657,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)))
@@ -709,13 +721,13 @@ the C sources, too."
(get function
'derived-mode-parent))))
(when parent-mode
- (insert (substitute-command-keys " Parent mode: `"))
+ (insert (substitute-quotes " Parent mode: `"))
(let ((beg (point)))
(insert (format "%s" parent-mode))
(make-text-button beg (point)
'type 'help-function
'help-args (list parent-mode)))
- (insert (substitute-command-keys "'.\n")))))
+ (insert (substitute-quotes "'.\n")))))
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
@@ -1156,7 +1168,8 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro 100)
(defun help-fns--generalized-variable (function)
- (when (and (get function 'gv-expander)
+ (when (and (symbolp function)
+ (get function 'gv-expander)
;; Don't mention obsolete generalized variables.
(not (get function 'byte-obsolete-generalized-variable)))
(insert (format-message " `%s' is also a " function)
@@ -1556,7 +1569,7 @@ This cancels value editing without updating the value."
(princ " This variable may be risky if used as a \
file-local variable.\n")
(when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
+ (princ (substitute-quotes
" However, you have added it to \
`safe-local-variable-values'.\n")))))
@@ -1606,8 +1619,8 @@ variable.\n")))
(insert-text-button
file 'type 'help-dir-local-var-def
'help-args (list variable file)))
- (princ (substitute-command-keys "'.\n"))))
- (princ (substitute-command-keys
+ (princ (substitute-quotes "'.\n"))))
+ (princ (substitute-quotes
" This variable's value is file-local.\n")))))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-watchpoints)
@@ -1687,10 +1700,10 @@ variable.\n")))
((not permanent-local))
((bufferp locus)
(princ
- (substitute-command-keys
+ (substitute-quotes
" This variable's buffer-local value is permanent.\n")))
(t
- (princ (substitute-command-keys
+ (princ (substitute-quotes
" This variable's value is permanent \
if it is given a local binding.\n"))))))
@@ -1767,9 +1780,9 @@ If FRAME is omitted or nil, use the selected frame."
(setq help-mode--current-data (list :symbol f))
(setq help-mode--current-data (list :symbol f
:file file-name))
- (princ (substitute-command-keys "Defined in `"))
+ (princ (substitute-quotes "Defined in `"))
(princ (help-fns-short-filename file-name))
- (princ (substitute-command-keys "'"))
+ (princ (substitute-quotes "'"))
;; Make a hyperlink to the library.
(save-excursion
(re-search-backward
@@ -2179,8 +2192,7 @@ documentation for the major and minor modes of that
buffer."
;; Document the minor modes fully.
(insert (buttonize
(propertize pretty-minor-mode 'help-minor-mode mode)
- (lambda (mode)
- (describe-function mode))
+ #'describe-function
mode))
(let ((indicator
(format-mode-line (assq mode minor-mode-alist))))
@@ -2189,7 +2201,8 @@ documentation for the major and minor modes of that
buffer."
"no indicator"
(format "indicator%s"
indicator)))))
- (insert (help-split-fundoc (documentation mode) nil 'doc)))))
+ (insert (or (help-split-fundoc (documentation mode) nil 'doc)
+ "No docstring")))))
(forward-line -1)
(fill-paragraph nil)
(forward-paragraph 1)
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 15ab3192ad..b25a8ce299 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))
@@ -1204,7 +1343,16 @@ Otherwise, return a new string."
(delete-char 2)
(let* ((fun (intern (buffer-substring (point) (1- end-point))))
(key (with-current-buffer orig-buf
- (where-is-internal fun keymap t))))
+ (where-is-internal fun
+ (and keymap
+ (list keymap))
+ t))))
+ ;; If we're looking in a particular keymap which has
+ ;; no binding, then we need to redo the lookup, with
+ ;; the global map as well this time.
+ (when (and (not key) keymap)
+ (setq key (with-current-buffer orig-buf
+ (where-is-internal fun keymap t))))
(if (not key)
;; Function is not on any key.
(let ((op (point)))
@@ -1260,9 +1408,9 @@ Otherwise, return a new string."
(cond
((null this-keymap)
(insert "\nUses keymap "
- (substitute-command-keys "`")
+ (substitute-quotes "`")
(symbol-name name)
- (substitute-command-keys "'")
+ (substitute-quotes "'")
", which is not currently defined.\n")
(unless generate-summary
(setq keymap nil)))
@@ -1291,6 +1439,18 @@ Otherwise, return a new string."
(t (forward-char 1)))))
(buffer-string)))))
+(defun substitute-quotes (string)
+ "Substitute quote characters for display.
+Each grave accent \\=` is replaced by left quote, and each
+apostrophe \\=' is replaced by right quote. Left and right quote
+characters are specified by `text-quoting-style'."
+ (cond ((eq (text-quoting-style) 'curve)
+ (string-replace "`" "‘"
+ (string-replace "'" "’" string)))
+ ((eq (text-quoting-style) 'straight)
+ (string-replace "`" "'" string))
+ (t string)))
+
(defvar help--keymaps-seen nil)
(defun describe-map-tree (startmap &optional partial shadow prefix title
no-menu transl always-title mention-shadow
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 7f965486ea..b8d25bfb1f 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -687,7 +687,7 @@ If there is no byte at the target address move to the last
byte in that line."
(defun hexl-beginning-of-buffer (arg)
"Move to the beginning of the hexl buffer.
-Leaves `hexl-mark' at previous position.
+Leaves mark at previous position.
With prefix arg N, puts point N bytes of the way from the true beginning."
(interactive "p")
(push-mark)
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 4832dd9023..00748e12da 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -118,7 +118,6 @@
;;
;; Other interactive functions (that could be bound if desired):
;; `highlight-changes-mode'
-;; `highlight-changes-toggle-visibility'
;; `highlight-changes-remove-highlight'
;; `highlight-compare-with-file'
;; `highlight-compare-buffers'
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index e5ca6819f0..87bea1017f 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -154,6 +154,13 @@ non-selected window. Hl-Line mode uses the function
When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
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 (and global-hl-line-mode
+ (eq arg 'toggle))
+ (setq hl-line-mode nil)
+ (setq-local global-hl-line-mode nil)
+ (global-hl-line-unhighlight))
(if hl-line-mode
(progn
;; In case `kill-all-local-variables' is called.
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index bf7446f151..34092b1417 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -226,7 +226,6 @@ to make them safe."
:tag "html-quote-regex"
:type '(regexp))
-(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook
"24.3")
(defcustom hfy-post-html-hook nil
"List of functions to call after creating and filling the HTML buffer.
These functions will be called with the HTML buffer as the current buffer."
@@ -1540,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)))))))
@@ -1574,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)))))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index b1fcf9ae71..0a63e0a1dd 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -1,7 +1,6 @@
;;; icomplete.el --- minibuffer completion incremental feedback -*-
lexical-binding: t -*-
-;; Copyright (C) 1992-1994, 1997, 1999, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Created: Mar 1993 Ken Manheimer, klm@nist.gov - first release to usenet
@@ -140,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
@@ -173,15 +172,13 @@ Used to implement the option
`icomplete-show-matches-on-no-input'.")
(let ((non-essential t)) ;E.g. don't prompt for password!
(icomplete-exhibit)))
-(defvar icomplete-minibuffer-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\M-\t] #'icomplete-force-complete)
- (define-key map [remap minibuffer-complete-and-exit] #'icomplete-ret)
- (define-key map [?\C-j] #'icomplete-force-complete-and-exit)
- (define-key map [?\C-.] #'icomplete-forward-completions)
- (define-key map [?\C-,] #'icomplete-backward-completions)
- map)
- "Keymap used by `icomplete-mode' in the minibuffer.")
+(defvar-keymap icomplete-minibuffer-map
+ :doc "Keymap used by `icomplete-mode' in the minibuffer."
+ "C-M-i" #'icomplete-force-complete
+ "C-j" #'icomplete-force-complete-and-exit
+ "C-." #'icomplete-forward-completions
+ "C-," #'icomplete-backward-completions
+ "<remap> <minibuffer-complete-and-exit>" #'icomplete-ret)
(defun icomplete-ret ()
"Exit minibuffer for icomplete."
@@ -393,22 +390,20 @@ if that doesn't produce a completion match."
(delete-region (1+ (point)) (point-max)))))
(t (call-interactively 'backward-delete-char))))
-(defvar icomplete-fido-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-k") #'icomplete-fido-kill)
- (define-key map (kbd "C-d") #'icomplete-fido-delete-char)
- (define-key map (kbd "RET") #'icomplete-fido-ret)
- (define-key map (kbd "C-m") #'icomplete-fido-ret)
- (define-key map (kbd "DEL") #'icomplete-fido-backward-updir)
- (define-key map (kbd "M-j") #'icomplete-fido-exit)
- (define-key map (kbd "C-s") #'icomplete-forward-completions)
- (define-key map (kbd "C-r") #'icomplete-backward-completions)
- (define-key map (kbd "<right>") #'icomplete-forward-completions)
- (define-key map (kbd "<left>") #'icomplete-backward-completions)
- (define-key map (kbd "C-.") #'icomplete-forward-completions)
- (define-key map (kbd "C-,") #'icomplete-backward-completions)
- map)
- "Keymap used by `fido-mode' in the minibuffer.")
+(defvar-keymap icomplete-fido-mode-map
+ :doc "Keymap used by `fido-mode' in the minibuffer."
+ "C-k" #'icomplete-fido-kill
+ "C-d" #'icomplete-fido-delete-char
+ "RET" #'icomplete-fido-ret
+ "C-m" #'icomplete-fido-ret
+ "DEL" #'icomplete-fido-backward-updir
+ "M-j" #'icomplete-fido-exit
+ "C-s" #'icomplete-forward-completions
+ "C-r" #'icomplete-backward-completions
+ "<right>" #'icomplete-forward-completions
+ "<left>" #'icomplete-backward-completions
+ "C-." #'icomplete-forward-completions
+ "C-," #'icomplete-backward-completions)
(defun icomplete--fido-mode-setup ()
"Setup `fido-mode''s minibuffer."
@@ -634,16 +629,14 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(completion--cache-all-sorted-completions beg end (cons comp
all))))
finally return all)))
-(defvar icomplete-vertical-mode-minibuffer-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-n") #'icomplete-forward-completions)
- (define-key map (kbd "C-p") #'icomplete-backward-completions)
- (define-key map (kbd "<down>") #'icomplete-forward-completions)
- (define-key map (kbd "<up>") #'icomplete-backward-completions)
- (define-key map (kbd "M-<") #'icomplete-vertical-goto-first)
- (define-key map (kbd "M->") #'icomplete-vertical-goto-last)
- map)
- "Keymap used by `icomplete-vertical-mode' in the minibuffer.")
+(defvar-keymap icomplete-vertical-mode-minibuffer-map
+ :doc "Keymap used by `icomplete-vertical-mode' in the minibuffer."
+ "C-n" #'icomplete-forward-completions
+ "C-p" #'icomplete-backward-completions
+ "<down>" #'icomplete-forward-completions
+ "<up>" #'icomplete-backward-completions
+ "M-<" #'icomplete-vertical-goto-first
+ "M->" #'icomplete-vertical-goto-last)
(defun icomplete--vertical-minibuffer-setup ()
"Setup the minibuffer for vertical display of completion candidates."
diff --git a/lisp/ido.el b/lisp/ido.el
index 134081d675..77e4dd447d 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1507,15 +1507,18 @@ Removes badly formatted data and ignored directories."
(add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup)
(add-hook 'choose-completion-string-functions
#'ido-choose-completion-string))
+(defun ido--ffap-find-file (file)
+ (find-file file))
+
(define-minor-mode ido-everywhere
"Toggle use of Ido for all buffer/file reading."
:global t
(remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer)
(when (boundp 'ffap-file-finder)
- (remove-function ffap-file-finder #'ido-find-file)
+ (remove-function ffap-file-finder #'ido--ffap-find-file)
(when ido-mode
- (add-function :override ffap-file-finder #'ido-find-file)))
+ (add-function :override ffap-file-finder #'ido--ffap-find-file)))
(when ido-everywhere
(if (not ido-mode)
(ido-mode 'both)
@@ -3912,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
@@ -3966,7 +3969,7 @@ If `ido-change-word-sub' cannot be found in WORD, return
nil."
(if (and (eq last-command this-command) temp-buf)
;; scroll buffer
(let (win (buf (current-buffer)))
- (display-buffer temp-buf nil nil)
+ (display-buffer temp-buf)
(set-buffer temp-buf)
(setq win (get-buffer-window temp-buf))
(if (pos-visible-in-window-p (point-max) win)
@@ -3981,7 +3984,10 @@ If `ido-change-word-sub' cannot be found in WORD, return
nil."
(set-buffer buf))
(setq display-it t))
(if (and ido-completion-buffer display-it)
- (with-output-to-temp-buffer ido-completion-buffer
+ (with-temp-buffer-window ido-completion-buffer
+ '((display-buffer-reuse-window display-buffer-at-bottom)
+ (window-height . fit-window-to-buffer))
+ nil
(let* ((comps
(cond
(ido-directory-too-big
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 47c1792118..fd41afa243 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -472,6 +472,34 @@ nonempty, then flushes the buffer."
;; Set the process mark in the current buffer to POS.
(set-marker (process-mark (get-buffer-process (current-buffer))) pos))
+;;; Input fontification
+
+(defcustom ielm-fontify-input-enable t
+ "Enable fontification of input in ielm buffers.
+This variable only has effect when creating an ielm buffer. Use
+the command `comint-fontify-input-mode' to toggle fontification
+of input in an already existing ielm buffer."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom ielm-indirect-setup-hook nil
+ "Hook run in an indirect buffer for input fontification.
+Input fontification and indentation of an IELM buffer, if
+enabled, is performed in an indirect buffer, whose indentation
+and syntax highlighting are set up with `emacs-lisp-mode'. In
+addition to `comint-indirect-setup-hook', run this hook with the
+indirect buffer as the current buffer after its setup is done.
+This can be used to further customize fontification and other
+behavior of the indirect buffer."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defun ielm-indirect-setup-hook ()
+ "Run `ielm-indirect-setup-hook'."
+ (run-hooks 'ielm-indirect-setup-hook))
+
;;; Major mode
(define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM"
@@ -526,6 +554,10 @@ The behavior of IELM may be customized with the following
variables:
Customized bindings may be defined in `ielm-map', which currently contains:
\\{ielm-map}"
:syntax-table emacs-lisp-mode-syntax-table
+ :after-hook
+ (and (null comint-use-prompt-regexp)
+ ielm-fontify-input-enable
+ (comint-fontify-input-mode))
(setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
(setq-local paragraph-separate "\\'")
@@ -564,6 +596,10 @@ Customized bindings may be defined in `ielm-map', which
currently contains:
(setq-local font-lock-defaults
'(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w"))))
+ (add-hook 'comint-indirect-setup-hook
+ #'ielm-indirect-setup-hook 'append t)
+ (setq comint-indirect-setup-function #'emacs-lisp-mode)
+
;; A dummy process to keep comint happy. It will never get any input
(unless (comint-check-proc (current-buffer))
;; Was cat, but on non-Unix platforms that might not exist, so
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
deleted file mode 100644
index 9f12354111..0000000000
--- a/lisp/image-dired.el
+++ /dev/null
@@ -1,3080 +0,0 @@
-;;; image-dired.el --- use dired to browse and manipulate your images -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
-
-;; Version: 0.4.11
-;; Keywords: multimedia
-;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; BACKGROUND
-;; ==========
-;;
-;; I needed a program to browse, organize and tag my pictures. I got
-;; tired of the old gallery program I used as it did not allow
-;; multi-file operations easily. Also, it put things out of my
-;; control. Image viewing programs I tested did not allow multi-file
-;; operations or did not do what I wanted it to.
-;;
-;; So, I got the idea to use the wonderful functionality of Emacs and
-;; `dired' to do it. It would allow me to do almost anything I wanted,
-;; which is basically just to browse all my pictures in an easy way,
-;; letting me manipulate and tag them in various ways. `dired' already
-;; provide all the file handling and navigation facilities; I only
-;; needed to add some functions to display the images.
-;;
-;; I briefly tried out thumbs.el, and although it seemed more
-;; powerful than this package, it did not work the way I wanted to. It
-;; was too slow to create thumbnails of all files in a directory (I
-;; currently keep all my 2000+ images in the same directory) and
-;; browsing the thumbnail buffer was slow too. image-dired.el will not
-;; create thumbnails until they are needed and the browsing is done
-;; quickly and easily in Dired. I copied a great deal of ideas and
-;; code from there though... :)
-;;
-;; `image-dired' stores the thumbnail files in `image-dired-dir'
-;; using the file name format ORIGNAME.thumb.ORIGEXT. For example
-;; ~/.emacs.d/image-dired/myimage01.thumb.jpg. The "database" is for
-;; now just a plain text file with the following format:
-;;
-;; file-name-non-directory;comment:comment-text;tag1;tag2;tag3;...;tagN
-;;
-;;
-;; PREREQUISITES
-;; =============
-;;
-;; * The GraphicsMagick or ImageMagick package; Image-Dired uses
-;; whichever is available.
-;;
-;; A) For GraphicsMagick, `gm' is used.
-;; Find it here: http://www.graphicsmagick.org/
-;;
-;; B) For ImageMagick, `convert' and `mogrify' are used.
-;; Find it here: https://www.imagemagick.org.
-;;
-;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
-;; needed.
-;;
-;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool'
is
-;; needed. It can be found here: https://exiftool.org/. This
-;; function is, among other things, used for writing comments to
-;; image files using `image-dired-thumbnail-set-image-description'.
-;;
-;;
-;; USAGE
-;; =====
-;;
-;; This information has been moved to the manual. Type `C-h r' to open
-;; the Emacs manual and go to the node Thumbnails by typing `g
-;; Image-Dired RET'.
-;;
-;; Quickstart: M-x image-dired RET DIRNAME RET
-;;
-;; where DIRNAME is a directory containing image files.
-;;
-;; LIMITATIONS
-;; ===========
-;;
-;; * Supports all image formats that Emacs and convert supports, but
-;; the thumbnails are hard-coded to JPEG or PNG format. It uses
-;; JPEG by default, but can optionally follow the Thumbnail Managing
-;; Standard (v0.9.0, Dec 2020), which mandates PNG. See the user
-;; option `image-dired-thumbnail-storage'.
-;;
-;; * WARNING: The "database" format used might be changed so keep a
-;; backup of `image-dired-db-file' when testing new versions.
-;;
-;; TODO
-;; ====
-;;
-;; * Investigate if it is possible to also write the tags to the image
-;; files.
-;;
-;; * From thumbs.el: Add an option for clean-up/max-size functionality
-;; for thumbnail directory.
-;;
-;; * From thumbs.el: Add setroot function.
-;;
-;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find
out
-;; which is best, saving old batch just before inserting new, or
-;; saving the current batch in the ring when inserting it. Adding
-;; it probably needs rewriting `image-dired-display-thumbs' to be more
general.
-;;
-;; * Find some way of toggling on and off really nice keybindings in
-;; Dired (for example, using C-n or <down> instead of C-S-n).
-;; Richard suggested that we could keep C-t as prefix for
-;; image-dired commands as it is currently not used in Dired. He
-;; also suggested that `dired-next-line' and `dired-previous-line'
-;; figure out if image-dired is enabled in the current buffer and,
-;; if it is, call `image-dired-dired-next-line' and
`image-dired-dired-previous-line',
-;; respectively. Update: This is partly done; some bindings have
-;; now been added to Dired.
-;;
-;; * In some way keep track of buffers and windows and stuff so that
-;; it works as the user expects.
-;;
-;; * More/better documentation.
-
-;;; Code:
-
-(require 'dired)
-(require 'exif)
-(require 'image-mode)
-(require 'widget)
-(require 'xdg)
-
-(eval-when-compile
- (require 'cl-lib)
- (require 'wid-edit))
-
-
-;;; Customizable variables
-
-(defgroup image-dired nil
- "Use Dired to browse your images as thumbnails, and more."
- :prefix "image-dired-"
- :link '(info-link "(emacs) Image-Dired")
- :group 'multimedia)
-
-(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
- "Directory where thumbnail images are stored.
-
-The value of this option will be ignored if Image-Dired is
-customized to use the Thumbnail Managing Standard; they will be
-saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See
-`image-dired-thumbnail-storage'."
- :type 'directory)
-
-(defcustom image-dired-thumbnail-storage 'use-image-dired-dir
- "How `image-dired' stores thumbnail files.
-There are two ways that Image-Dired can store and generate
-thumbnails. If you set this variable to one of the two following
-values, they will be stored in the JPEG format:
-
-- `use-image-dired-dir' means that the thumbnails are stored in a
- central directory.
-
-- `per-directory' means that each thumbnail is stored in a
- subdirectory called \".image-dired\" in the same directory
- where the image file is.
-
-It can also use the \"Thumbnail Managing Standard\", which allows
-sharing of thumbnails across different programs. Thumbnails will
-be stored in \"$XDG_CACHE_HOME/thumbnails/\" instead of in
-`image-dired-dir'. Thumbnails are saved in the PNG format, and
-can be one of the following sizes:
-
-- `standard' means use thumbnails sized 128x128.
-- `standard-large' means use thumbnails sized 256x256.
-- `standard-x-large' means use thumbnails sized 512x512.
-- `standard-xx-large' means use thumbnails sized 1024x1024.
-
-For more information on the Thumbnail Managing Standard, see:
-https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html";
- :type '(choice :tag "How to store thumbnail files"
- (const :tag "Use image-dired-dir" use-image-dired-dir)
- (const :tag "Thumbnail Managing Standard (normal 128x128)"
- standard)
- (const :tag "Thumbnail Managing Standard (large 256x256)"
- standard-large)
- (const :tag "Thumbnail Managing Standard (larger 512x512)"
- standard-x-large)
- (const :tag "Thumbnail Managing Standard (extra large
1024x1024)"
- standard-xx-large)
- (const :tag "Per-directory" per-directory))
- :version "29.1")
-
-(defconst image-dired--thumbnail-standard-sizes
- '( standard standard-large
- standard-x-large standard-xx-large)
- "List of symbols representing thumbnail sizes in Thumbnail Managing
Standard.")
-
-(defcustom image-dired-db-file
- (expand-file-name ".image-dired_db" image-dired-dir)
- "Database file where file names and their associated tags are stored."
- :type 'file)
-
-(defcustom image-dired-cmd-create-thumbnail-program
- (if (executable-find "gm") "gm" "convert")
- "Executable used to create thumbnail.
-Used together with `image-dired-cmd-create-thumbnail-options'."
- :type 'file
- :version "29.1")
-
-(defcustom image-dired-cmd-create-thumbnail-options
- (let ((opts '("-size" "%wx%h" "%f[0]"
- "-resize" "%wx%h>"
- "-strip" "jpeg:%t")))
- (if (executable-find "gm") (cons "convert" opts) opts))
- "Options of command used to create thumbnail image.
-Used with `image-dired-cmd-create-thumbnail-program'.
-Available format specifiers are: %w which is replaced by
-`image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height',
-%f which is replaced by the file name of the original image and %t
-which is replaced by the file name of the thumbnail file."
- :version "29.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-cmd-pngnq-program
- ;; Prefer pngquant to pngnq-s9 as it is faster on my machine.
- ;; The project also seems more active than the alternatives.
- ;; Prefer pngnq-s9 to pngnq as it fixes bugs in pngnq.
- ;; The pngnq project seems dead (?) since 2011 or so.
- (or (executable-find "pngquant")
- (executable-find "pngnq-s9")
- (executable-find "pngnq"))
- "The file name of the `pngquant' or `pngnq' program.
-It quantizes colors of PNG images down to 256 colors or fewer
-using the NeuQuant algorithm."
- :version "29.1"
- :type '(choice (const :tag "Not Set" nil) file))
-
-(defcustom image-dired-cmd-pngnq-options
- (if (executable-find "pngquant")
- '("--ext" "-nq8.png" "%t") ; same extension as "pngnq"
- '("-f" "%t"))
- "Arguments to pass `image-dired-cmd-pngnq-program'.
-Available format specifiers are the same as in
-`image-dired-cmd-create-thumbnail-options'."
- :type '(repeat (string :tag "Argument"))
- :version "29.1")
-
-(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
- "The file name of the `pngcrush' program.
-It optimizes the compression of PNG images. Also it adds PNG textual chunks
-with the information required by the Thumbnail Managing Standard."
- :type '(choice (const :tag "Not Set" nil) file))
-
-(defcustom image-dired-cmd-pngcrush-options
- `("-q"
- "-text" "b" "Description" "Thumbnail of file://%f"
- "-text" "b" "Software" ,(emacs-version)
- ;; "-text b \"Thumb::Image::Height\" \"%oh\" "
- ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
- ;; "-text b \"Thumb::Image::Width\" \"%ow\" "
- "-text" "b" "Thumb::MTime" "%m"
- ;; "-text b \"Thumb::Size\" \"%b\" "
- "-text" "b" "Thumb::URI" "file://%f"
- "%q" "%t")
- "Arguments for `image-dired-cmd-pngcrush-program'.
-Available format specifiers are the same as in
-`image-dired-cmd-create-thumbnail-options', with %q for a
-temporary file name (typically generated by pnqnq)."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
- "The file name of the `optipng' program."
- :version "26.1"
- :type '(choice (const :tag "Not Set" nil) file))
-
-(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
- "Arguments passed to `image-dired-cmd-optipng-program'.
-Available format specifiers are described in
-`image-dired-cmd-create-thumbnail-options'."
- :version "26.1"
- :type '(repeat (string :tag "Argument"))
- :link '(url-link "man:optipng(1)"))
-
-(defcustom image-dired-cmd-create-standard-thumbnail-options
- (append '("-size" "%wx%h" "%f[0]")
- (unless (or image-dired-cmd-pngcrush-program
- image-dired-cmd-pngnq-program)
- (list
- "-set" "Thumb::MTime" "%m"
- "-set" "Thumb::URI" "file://%f"
- "-set" "Description" "Thumbnail of file://%f"
- "-set" "Software" (emacs-version)))
- '("-thumbnail" "%wx%h>" "png:%t"))
- "Options for creating thumbnails according to the Thumbnail Managing
Standard.
-Available format specifiers are the same as in
-`image-dired-cmd-create-thumbnail-options', with %m for file modification
time."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-cmd-rotate-original-program
- "jpegtran"
- "Executable used to rotate original image.
-Used together with `image-dired-cmd-rotate-original-options'."
- :type 'file)
-
-(defcustom image-dired-cmd-rotate-original-options
- '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
- "Arguments of command used to rotate original image.
-Used with `image-dired-cmd-rotate-original-program'.
-Available format specifiers are: %d which is replaced by the
-number of (positive) degrees to rotate the image, normally 90 or
-270 \(for 90 degrees right and left), %o which is replaced by the
-original image file name and %t which is replaced by
-`image-dired-temp-image-file'."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-temp-rotate-image-file
- (expand-file-name ".image-dired_rotate_temp" image-dired-dir)
- "Temporary file for rotate operations."
- :type 'file)
-
-(defcustom image-dired-rotate-original-ask-before-overwrite t
- "Confirm overwrite of original file after rotate operation.
-If non-nil, ask user for confirmation before overwriting the
-original file with `image-dired-temp-rotate-image-file'."
- :type 'boolean)
-
-(defcustom image-dired-cmd-write-exif-data-program
- "exiftool"
- "Program used to write EXIF data to image.
-Used together with `image-dired-cmd-write-exif-data-options'."
- :type 'file)
-
-(defcustom image-dired-cmd-write-exif-data-options
- '("-%t=%v" "%f")
- "Arguments of command used to write EXIF data.
-Used with `image-dired-cmd-write-exif-data-program'.
-Available format specifiers are: %f which is replaced by
-the image file name, %t which is replaced by the tag name and %v
-which is replaced by the tag value."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-thumb-size
- (cond
- ((eq 'standard image-dired-thumbnail-storage) 128)
- ((eq 'standard-large image-dired-thumbnail-storage) 256)
- ((eq 'standard-x-large image-dired-thumbnail-storage) 512)
- ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024)
- (t 100))
- "Size of thumbnails, in pixels.
-This is the default size for both `image-dired-thumb-width'
-and `image-dired-thumb-height'.
-
-The value of this option will be ignored if Image-Dired is
-customized to use the Thumbnail Managing Standard; the standard
-sizes will be used instead. See `image-dired-thumbnail-storage'."
- :type 'integer)
-
-(defcustom image-dired-thumb-width image-dired-thumb-size
- "Width of thumbnails, in pixels."
- :type 'integer)
-
-(defcustom image-dired-thumb-height image-dired-thumb-size
- "Height of thumbnails, in pixels."
- :type 'integer)
-
-(defcustom image-dired-thumb-relief 2
- "Size of button-like border around thumbnails."
- :type 'integer)
-
-(defcustom image-dired-thumb-margin 2
- "Size of the margin around thumbnails.
-This is where you see the cursor."
- :type 'integer)
-
-(defcustom image-dired-thumb-visible-marks t
- "Make marks and flags visible in thumbnail buffer.
-If non-nil, apply the `image-dired-thumb-mark' face to marked
-images and `image-dired-thumb-flagged' to images flagged for
-deletion."
- :type 'boolean
- :version "28.1")
-
-(defface image-dired-thumb-mark
- '((((class color) (min-colors 16)) :background "DarkOrange")
- (((class color)) :foreground "yellow"))
- "Face for marked images in thumbnail buffer."
- :version "29.1")
-
-(defface image-dired-thumb-flagged
- '((((class color) (min-colors 88) (background light)) :background "Red3")
- (((class color) (min-colors 88) (background dark)) :background "Pink")
- (((class color) (min-colors 16) (background light)) :background "Red3")
- (((class color) (min-colors 16) (background dark)) :background "Pink")
- (((class color) (min-colors 8)) :background "red")
- (t :inverse-video t))
- "Face for images flagged for deletion in thumbnail buffer."
- :version "29.1")
-
-(defcustom image-dired-line-up-method 'dynamic
- "Default method for line-up of thumbnails in thumbnail buffer.
-Used by `image-dired-display-thumbs' and other functions that needs
-to line-up thumbnails. Dynamic means to use the available width of
-the window containing the thumbnail buffer, Fixed means to use
-`image-dired-thumbs-per-row', Interactive is for asking the user,
-and No line-up means that no automatic line-up will be done."
- :type '(choice :tag "Default line-up method"
- (const :tag "Dynamic" dynamic)
- (const :tag "Fixed" fixed)
- (const :tag "Interactive" interactive)
- (const :tag "No line-up" none)))
-
-(defcustom image-dired-thumbs-per-row 3
- "Number of thumbnails to display per row in thumb buffer."
- :type 'integer)
-
-(defcustom image-dired-track-movement t
- "The current state of the tracking and mirroring.
-For more information, see the documentation for
-`image-dired-toggle-movement-tracking'."
- :type 'boolean)
-
-(defcustom image-dired-append-when-browsing nil
- "Append thumbnails in thumbnail buffer when browsing.
-If non-nil, using `image-dired-next-line-and-display' and
-`image-dired-previous-line-and-display' will leave a trail of thumbnail
-images in the thumbnail buffer. If you enable this and want to clean
-the thumbnail buffer because it is filled with too many thumbnails,
-just call `image-dired-display-thumb' to display only the image at point.
-This value can be toggled using `image-dired-toggle-append-browsing'."
- :type 'boolean)
-
-(defcustom image-dired-dired-disp-props t
- "If non-nil, display properties for Dired file when browsing.
-Used by `image-dired-next-line-and-display',
-`image-dired-previous-line-and-display' and
`image-dired-mark-and-display-next'.
-If the database file is large, this can slow down image browsing in
-Dired and you might want to turn it off."
- :type 'boolean)
-
-(defcustom image-dired-display-properties-format "%b: %f (%t): %c"
- "Display format for thumbnail properties.
-%b is replaced with associated Dired buffer name, %f with file
-name (without path) of original image file, %t with the list of
-tags and %c with the comment."
- :type 'string)
-
-(defcustom image-dired-external-viewer
- ;; TODO: Use mailcap, dired-guess-shell-alist-default,
- ;; dired-view-command-alist.
- (cond ((executable-find "display"))
- ((executable-find "xli"))
- ((executable-find "qiv") "qiv -t")
- ((executable-find "feh") "feh"))
- "Name of external viewer.
-Including parameters. Used when displaying original image from
-`image-dired-thumbnail-mode'."
- :version "28.1"
- :type '(choice string
- (const :tag "Not Set" nil)))
-
-(defcustom image-dired-main-image-directory
- (or (xdg-user-dir "PICTURES") "~/pics/")
- "Name of main image directory, if any.
-Used by `image-dired-copy-with-exif-file-name'."
- :type 'string
- :version "29.1")
-
-(defcustom image-dired-show-all-from-dir-max-files 500
- "Maximum number of files in directory before prompting.
-
-If there are more image files than this in a selected directory,
-the `image-dired-show-all-from-dir' command will ask for
-confirmation before creating the thumbnail buffer. If this
-variable is nil, it will never ask."
- :type '(choice integer
- (const :tag "Disable warning" nil))
- :version "29.1")
-
-(defcustom image-dired-marking-shows-next t
- "If non-nil, marking, unmarking or flagging an image shows the next image.
-
-This affects the following commands:
-\\<image-dired-thumbnail-mode-map>
- `image-dired-flag-thumb-original-file' (bound to
\\[image-dired-flag-thumb-original-file])
- `image-dired-mark-thumb-original-file' (bound to
\\[image-dired-mark-thumb-original-file])
- `image-dired-unmark-thumb-original-file' (bound to
\\[image-dired-unmark-thumb-original-file])"
- :type 'boolean
- :version "29.1")
-
-
-;;; Util functions
-
-(defvar image-dired-debug nil
- "Non-nil means enable debug messages.")
-
-(defun image-dired-debug-message (&rest args)
- "Display debug message ARGS when `image-dired-debug' is non-nil."
- (when image-dired-debug
- (apply #'message args)))
-
-(defmacro image-dired--with-db-file (&rest body)
- "Run BODY in a temp buffer containing `image-dired-db-file'.
-Return the last form in BODY."
- (declare (indent 0) (debug t))
- `(with-temp-buffer
- (if (file-exists-p image-dired-db-file)
- (insert-file-contents image-dired-db-file))
- ,@body))
-
-(defun image-dired-dir ()
- "Return the current thumbnail directory (from variable `image-dired-dir').
-Create the thumbnail directory if it does not exist."
- (let ((image-dired-dir (file-name-as-directory
- (expand-file-name image-dired-dir))))
- (unless (file-directory-p image-dired-dir)
- (with-file-modes #o700
- (make-directory image-dired-dir t))
- (message "Thumbnail directory created: %s" image-dired-dir))
- image-dired-dir))
-
-(defun image-dired-insert-image (file type relief margin)
- "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point."
- (let ((i `(image :type ,type
- :file ,file
- :relief ,relief
- :margin ,margin)))
- (insert-image i)))
-
-(defun image-dired-get-thumbnail-image (file)
- "Return the image descriptor for a thumbnail of image file FILE."
- (unless (string-match-p (image-file-name-regexp) file)
- (error "%s is not a valid image file" file))
- (let* ((thumb-file (image-dired-thumb-name file))
- (thumb-attr (file-attributes thumb-file)))
- (when (or (not thumb-attr)
- (time-less-p (file-attribute-modification-time thumb-attr)
- (file-attribute-modification-time
- (file-attributes file))))
- (image-dired-create-thumb file thumb-file))
- (create-image thumb-file)))
-
-(defun image-dired-insert-thumbnail (file original-file-name
- associated-dired-buffer)
- "Insert thumbnail image FILE.
-Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
- (let (beg end)
- (setq beg (point))
- (image-dired-insert-image
- file
- ;; Thumbnails are created asynchronously, so we might not yet
- ;; have a file. But if it exists, it might have been cached from
- ;; before and we should use it instead of our current settings.
- (or (and (file-exists-p file)
- (image-type-from-file-header file))
- (and (memq image-dired-thumbnail-storage
- image-dired--thumbnail-standard-sizes)
- 'png)
- 'jpeg)
- image-dired-thumb-relief
- image-dired-thumb-margin)
- (setq end (point))
- (add-text-properties
- beg end
- (list 'image-dired-thumbnail t
- 'original-file-name original-file-name
- 'associated-dired-buffer associated-dired-buffer
- 'tags (image-dired-list-tags original-file-name)
- 'mouse-face 'highlight
- 'comment (image-dired-get-comment original-file-name)))))
-
-(defun image-dired-thumb-name (file)
- "Return absolute file name for thumbnail FILE.
-Depending on the value of `image-dired-thumbnail-storage', the
-file name of the thumbnail will vary:
-- For `use-image-dired-dir', make a SHA1-hash of the image file's
- directory name and add that to make the thumbnail file name
- unique.
-- For `per-directory' storage, just add a subdirectory.
-- For `standard' storage, produce the file name according to the
- Thumbnail Managing Standard. Among other things, an MD5-hash
- of the image file's directory name will be added to the
- filename.
-See also `image-dired-thumbnail-storage'."
- (cond ((memq image-dired-thumbnail-storage
- image-dired--thumbnail-standard-sizes)
- (let ((thumbdir (cl-case image-dired-thumbnail-storage
- (standard "thumbnails/normal")
- (standard-large "thumbnails/large")
- (standard-x-large "thumbnails/x-large")
- (standard-xx-large "thumbnails/xx-large"))))
- (expand-file-name
- ;; MD5 is mandated by the Thumbnail Managing Standard.
- (concat (md5 (concat "file://" (expand-file-name file))) ".png")
- (expand-file-name thumbdir (xdg-cache-home)))))
- ((eq 'use-image-dired-dir image-dired-thumbnail-storage)
- (let* ((f (expand-file-name file))
- (hash
- (md5 (file-name-as-directory (file-name-directory f)))))
- (format "%s%s%s.thumb.%s"
- (file-name-as-directory (expand-file-name
(image-dired-dir)))
- (file-name-base f)
- (if hash (concat "_" hash) "")
- (file-name-extension f))))
- ((eq 'per-directory image-dired-thumbnail-storage)
- (let ((f (expand-file-name file)))
- (format "%s.image-dired/%s.thumb.%s"
- (file-name-directory f)
- (file-name-base f)
- (file-name-extension f))))))
-
-(defun image-dired--check-executable-exists (executable)
- (unless (executable-find (symbol-value executable))
- (error "Executable %S not found" executable)))
-
-
-;;; Creating thumbnails
-
-(defun image-dired-thumb-size (dimension)
- "Return thumb size depending on `image-dired-thumbnail-storage'.
-DIMENSION should be either the symbol `width' or `height'."
- (cond
- ((eq 'standard image-dired-thumbnail-storage) 128)
- ((eq 'standard-large image-dired-thumbnail-storage) 256)
- ((eq 'standard-x-large image-dired-thumbnail-storage) 512)
- ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024)
- (t (cl-ecase dimension
- (width image-dired-thumb-width)
- (height image-dired-thumb-height)))))
-
-(defvar image-dired--generate-thumbs-start nil
- "Time when `display-thumbs' was called.")
-
-(defvar image-dired-queue nil
- "List of items in the queue.
-Each item has the form (ORIGINAL-FILE TARGET-FILE).")
-
-(defvar image-dired-queue-active-jobs 0
- "Number of active jobs in `image-dired-queue'.")
-
-(defvar image-dired-queue-active-limit (min 4 (max 2 (/ (num-processors) 2)))
- "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'
-and remove the cached thumbnail files between each trial run.")
-
-(defun image-dired-pngnq-thumb (spec)
- "Quantize thumbnail described by format SPEC with pngnq(1)."
- (let ((process
- (apply #'start-process "image-dired-pngnq" nil
- image-dired-cmd-pngnq-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-pngnq-options))))
- (setf (process-sentinel process)
- (lambda (process status)
- (if (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- ;; Pass off to pngcrush, or just rename the
- ;; THUMB-nq8.png file back to THUMB.png
- (if (and image-dired-cmd-pngcrush-program
- (executable-find image-dired-cmd-pngcrush-program))
- (image-dired-pngcrush-thumb spec)
- (let ((nq8 (cdr (assq ?q spec)))
- (thumb (cdr (assq ?t spec))))
- (rename-file nq8 thumb t)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))))
- process))
-
-(defun image-dired-pngcrush-thumb (spec)
- "Optimize thumbnail described by format SPEC with pngcrush(1)."
- ;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist.
- ;; pngcrush needs an infile and outfile, so we just copy THUMB to
- ;; THUMB-nq8.png and use the latter as a temp file.
- (when (not image-dired-cmd-pngnq-program)
- (let ((temp (cdr (assq ?q spec)))
- (thumb (cdr (assq ?t spec))))
- (copy-file thumb temp)))
- (let ((process
- (apply #'start-process "image-dired-pngcrush" nil
- image-dired-cmd-pngcrush-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-pngcrush-options))))
- (setf (process-sentinel process)
- (lambda (process status)
- (unless (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))
- (when (memq (process-status process) '(exit signal))
- (let ((temp (cdr (assq ?q spec))))
- (delete-file temp)))))
- process))
-
-(defun image-dired-optipng-thumb (spec)
- "Optimize thumbnail described by format SPEC with optipng(1)."
- (let ((process
- (apply #'start-process "image-dired-optipng" nil
- image-dired-cmd-optipng-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-optipng-options))))
- (setf (process-sentinel process)
- (lambda (process status)
- (unless (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))))
- process))
-
-(defun image-dired-create-thumb-1 (original-file thumbnail-file)
- "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
- (image-dired--check-executable-exists
- 'image-dired-cmd-create-thumbnail-program)
- (let* ((width (int-to-string (image-dired-thumb-size 'width)))
- (height (int-to-string (image-dired-thumb-size 'height)))
- (modif-time (format-time-string
- "%s" (file-attribute-modification-time
- (file-attributes original-file))))
- (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
- thumbnail-file))
- (spec
- (list
- (cons ?w width)
- (cons ?h height)
- (cons ?m modif-time)
- (cons ?f original-file)
- (cons ?q thumbnail-nq8-file)
- (cons ?t thumbnail-file)))
- (thumbnail-dir (file-name-directory thumbnail-file))
- process)
- (when (not (file-exists-p thumbnail-dir))
- (with-file-modes #o700
- (make-directory thumbnail-dir t))
- (message "Thumbnail directory created: %s" thumbnail-dir))
-
- ;; Thumbnail file creation processes begin here and are marshaled
- ;; in a queue by `image-dired-create-thumb'.
- (setq process
- (apply #'start-process "image-dired-create-thumbnail" nil
- image-dired-cmd-create-thumbnail-program
- (mapcar
- (lambda (arg) (format-spec arg spec))
- (if (memq image-dired-thumbnail-storage
- image-dired--thumbnail-standard-sizes)
- image-dired-cmd-create-standard-thumbnail-options
- image-dired-cmd-create-thumbnail-options))))
-
- (setf (process-sentinel process)
- (lambda (process status)
- ;; Trigger next in queue once a thumbnail has been created
- (cl-decf image-dired-queue-active-jobs)
- (image-dired-thumb-queue-run)
- (when (= image-dired-queue-active-jobs 0)
- (image-dired-debug-message
- (format-time-string
- "Generated thumbnails in %s.%3N seconds"
- (time-subtract nil
- image-dired--generate-thumbs-start))))
- (if (not (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process))))
- (message "Thumb could not be created for %s: %s"
- (abbreviate-file-name original-file)
- (string-replace "\n" "" status))
- (set-file-modes thumbnail-file #o600)
- (clear-image-cache thumbnail-file)
- ;; PNG thumbnail has been created since we are
- ;; following the XDG thumbnail spec, so try to optimize
- (when (memq image-dired-thumbnail-storage
- image-dired--thumbnail-standard-sizes)
- (cond
- ((and image-dired-cmd-pngnq-program
- (executable-find image-dired-cmd-pngnq-program))
- (image-dired-pngnq-thumb spec))
- ((and image-dired-cmd-pngcrush-program
- (executable-find image-dired-cmd-pngcrush-program))
- (image-dired-pngcrush-thumb spec))
- ((and image-dired-cmd-optipng-program
- (executable-find image-dired-cmd-optipng-program))
- (image-dired-optipng-thumb spec)))))))
- process))
-
-(defun image-dired-thumb-queue-run ()
- "Run a queued job if one exists and not too many jobs are running.
-Queued items live in `image-dired-queue'."
- (while (and image-dired-queue
- (< image-dired-queue-active-jobs
- image-dired-queue-active-limit))
- (cl-incf image-dired-queue-active-jobs)
- (apply #'image-dired-create-thumb-1 (pop image-dired-queue))))
-
-(defun image-dired-create-thumb (original-file thumbnail-file)
- "Add a job for generating ORIGINAL-FILE thumbnail to `image-dired-queue'.
-The new file will be named THUMBNAIL-FILE."
- (setq image-dired-queue
- (nconc image-dired-queue
- (list (list original-file thumbnail-file))))
- (run-at-time 0 nil #'image-dired-thumb-queue-run))
-
-(defmacro image-dired--with-marked (&rest body)
- "Eval BODY with point on each marked thumbnail.
-If no marked file could be found, execute BODY on the current
-thumbnail."
- `(with-current-buffer image-dired-thumbnail-buffer
- (let (found)
- (save-mark-and-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (image-dired-thumb-file-marked-p)
- (setq found t)
- ,@body)
- (forward-char)))
- (unless found
- ,@body))))
-
-;;;###autoload
-(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
- "Toggle thumbnails in front of file names in the Dired buffer.
-If no marked file could be found, insert or hide thumbnails on the
-current line. ARG, if non-nil, specifies the files to use instead
-of the marked files. If ARG is an integer, use the next ARG (or
-previous -ARG, if ARG<0) files."
- (interactive "P")
- (dired-map-over-marks
- (let ((image-pos (dired-move-to-filename))
- (image-file (dired-get-filename nil t))
- thumb-file
- overlay)
- (when (and image-file
- (string-match-p (image-file-name-regexp) image-file))
- (setq thumb-file (image-dired-get-thumbnail-image image-file))
- ;; If image is not already added, then add it.
- (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
- if (overlay-get ov 'thumb-file) return ov)))
- (if thumb-ov
- (delete-overlay thumb-ov)
- (put-image thumb-file image-pos)
- (setq overlay
- (cl-loop for ov in (overlays-in (point) (1+ (point)))
- if (overlay-get ov 'put-image) return ov))
- (overlay-put overlay 'image-file image-file)
- (overlay-put overlay 'thumb-file thumb-file)))))
- arg ; Show or hide image on ARG next files.
- 'show-progress) ; Update dired display after each image is updated.
- (add-hook 'dired-after-readin-hook
- 'image-dired-dired-after-readin-hook nil t))
-
-(defun image-dired-dired-after-readin-hook ()
- "Relocate existing thumbnail overlays in Dired buffer after reverting.
-Move them to their corresponding files if they still exist.
-Otherwise, delete overlays."
- (mapc (lambda (overlay)
- (when (overlay-get overlay 'put-image)
- (let* ((image-file (overlay-get overlay 'image-file))
- (image-pos (dired-goto-file image-file)))
- (if image-pos
- (move-overlay overlay image-pos image-pos)
- (delete-overlay overlay)))))
- (overlays-in (point-min) (point-max))))
-
-(defun image-dired-next-line-and-display ()
- "Move to next Dired line and display thumbnail image."
- (interactive)
- (dired-next-line 1)
- (image-dired-display-thumbs
- t (or image-dired-append-when-browsing nil) t)
- (if image-dired-dired-disp-props
- (image-dired-dired-display-properties)))
-
-(defun image-dired-previous-line-and-display ()
- "Move to previous Dired line and display thumbnail image."
- (interactive)
- (dired-previous-line 1)
- (image-dired-display-thumbs
- t (or image-dired-append-when-browsing nil) t)
- (if image-dired-dired-disp-props
- (image-dired-dired-display-properties)))
-
-(defun image-dired-toggle-append-browsing ()
- "Toggle `image-dired-append-when-browsing'."
- (interactive)
- (setq image-dired-append-when-browsing
- (not image-dired-append-when-browsing))
- (message "Append browsing %s"
- (if image-dired-append-when-browsing
- "on"
- "off")))
-
-(defun image-dired-mark-and-display-next ()
- "Mark current file in Dired and display next thumbnail image."
- (interactive)
- (dired-mark 1)
- (image-dired-display-thumbs
- t (or image-dired-append-when-browsing nil) t)
- (if image-dired-dired-disp-props
- (image-dired-dired-display-properties)))
-
-(defun image-dired-toggle-dired-display-properties ()
- "Toggle `image-dired-dired-disp-props'."
- (interactive)
- (setq image-dired-dired-disp-props
- (not image-dired-dired-disp-props))
- (message "Dired display properties %s"
- (if image-dired-dired-disp-props
- "on"
- "off")))
-
-(defvar image-dired-thumbnail-buffer "*image-dired*"
- "Image-Dired's thumbnail buffer.")
-
-(defun image-dired-create-thumbnail-buffer ()
- "Create thumb buffer and set `image-dired-thumbnail-mode'."
- (let ((buf (get-buffer-create image-dired-thumbnail-buffer)))
- (with-current-buffer buf
- (setq buffer-read-only t)
- (if (not (eq major-mode 'image-dired-thumbnail-mode))
- (image-dired-thumbnail-mode)))
- buf))
-
-(defvar image-dired-display-image-buffer "*image-dired-display-image*"
- "Where larger versions of the images are display.")
-
-(defvar image-dired-saved-window-configuration nil
- "Saved window configuration.")
-
-;;;###autoload
-(defun image-dired-dired-with-window-configuration (dir &optional arg)
- "Open directory DIR and create a default window configuration.
-
-Convenience command that:
-
- - Opens Dired in folder DIR
- - Splits windows in most useful (?) way
- - Sets `truncate-lines' to t
-
-After the command has finished, you would typically mark some
-image files in Dired and type
-\\[image-dired-display-thumbs] (`image-dired-display-thumbs').
-
-If called with prefix argument ARG, skip splitting of windows.
-
-The current window configuration is saved and can be restored by
-calling `image-dired-restore-window-configuration'."
- (interactive "DDirectory: \nP")
- (let ((buf (image-dired-create-thumbnail-buffer))
- (buf2 (get-buffer-create image-dired-display-image-buffer)))
- (setq image-dired-saved-window-configuration
- (current-window-configuration))
- (dired dir)
- (delete-other-windows)
- (when (not arg)
- (split-window-right)
- (setq truncate-lines t)
- (save-excursion
- (other-window 1)
- (pop-to-buffer-same-window buf)
- (select-window (split-window-below))
- (pop-to-buffer-same-window buf2)
- (other-window -2)))))
-
-(defun image-dired-restore-window-configuration ()
- "Restore window configuration.
-Restore any changes to the window configuration made by calling
-`image-dired-dired-with-window-configuration'."
- (interactive nil image-dired-thumbnail-mode)
- (if image-dired-saved-window-configuration
- (set-window-configuration image-dired-saved-window-configuration)
- (message "No saved window configuration")))
-
-(defun image-dired--line-up-with-method ()
- "Line up thumbnails according to `image-dired-line-up-method'."
- (cond ((eq 'dynamic image-dired-line-up-method)
- (image-dired-line-up-dynamic))
- ((eq 'fixed image-dired-line-up-method)
- (image-dired-line-up))
- ((eq 'interactive image-dired-line-up-method)
- (image-dired-line-up-interactive))
- ((eq 'none image-dired-line-up-method)
- nil)
- (t
- (image-dired-line-up-dynamic))))
-
-;;;###autoload
-(defun image-dired-display-thumbs (&optional arg append do-not-pop)
- "Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'.
-If a thumbnail image does not exist for a file, it is created on the
-fly. With prefix argument ARG, display only thumbnail for file at
-point (this is useful if you have marked some files but want to show
-another one).
-
-Recommended usage is to split the current frame horizontally so that
-you have the Dired buffer in the left window and the
-`image-dired-thumbnail-buffer' buffer in the right window.
-
-With optional argument APPEND, append thumbnail to thumbnail buffer
-instead of erasing it first.
-
-Optional argument DO-NOT-POP controls if `pop-to-buffer' should be
-used or not. If non-nil, use `display-buffer' instead of
-`pop-to-buffer'. This is used from functions like
-`image-dired-next-line-and-display' and
-`image-dired-previous-line-and-display' where we do not want the
-thumbnail buffer to be selected."
- (interactive "P")
- (setq image-dired--generate-thumbs-start (current-time))
- (let ((buf (image-dired-create-thumbnail-buffer))
- thumb-name files dired-buf)
- (if arg
- (setq files (list (dired-get-filename)))
- (setq files (dired-get-marked-files)))
- (setq dired-buf (current-buffer))
- (with-current-buffer buf
- (let ((inhibit-read-only t))
- (if (not append)
- (erase-buffer)
- (goto-char (point-max)))
- (dolist (curr-file files)
- (setq thumb-name (image-dired-thumb-name curr-file))
- (when (not (file-exists-p thumb-name))
- (image-dired-create-thumb curr-file thumb-name))
- (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
- (if do-not-pop
- (display-buffer buf)
- (pop-to-buffer buf))
- (image-dired--line-up-with-method))))
-
-;;;###autoload
-(defun image-dired-show-all-from-dir (dir)
- "Make a thumbnail buffer for all images in DIR and display it.
-Any file matching `image-file-name-regexp' is considered an image
-file.
-
-If the number of image files in DIR exceeds
-`image-dired-show-all-from-dir-max-files', ask for confirmation
-before creating the thumbnail buffer. If that variable is nil,
-never ask for confirmation."
- (interactive "DImage-Dired: ")
- (dired dir)
- (dired-mark-files-regexp (image-file-name-regexp))
- (let ((files (dired-get-marked-files nil nil nil t)))
- (cond ((and (null (cdr files)))
- (message "No image files in directory"))
- ((or (not image-dired-show-all-from-dir-max-files)
- (<= (length (cdr files))
image-dired-show-all-from-dir-max-files)
- (and (> (length (cdr files))
image-dired-show-all-from-dir-max-files)
- (y-or-n-p
- (format
- "Directory contains more than %d image files. Proceed?"
- image-dired-show-all-from-dir-max-files))))
- (image-dired-display-thumbs)
- (pop-to-buffer image-dired-thumbnail-buffer)
- (setq default-directory dir)
- (image-dired-unmark-all-marks))
- (t (message "Image-Dired canceled")))))
-
-;;;###autoload
-(defalias 'image-dired 'image-dired-show-all-from-dir)
-
-
-;;; Tags
-
-(defun image-dired-sane-db-file ()
- "Check if `image-dired-db-file' exists.
-If not, try to create it (including any parent directories).
-Signal error if there are problems creating it."
- (or (file-exists-p image-dired-db-file)
- (let (dir buf)
- (unless (file-directory-p (setq dir (file-name-directory
- image-dired-db-file)))
- (with-file-modes #o700
- (make-directory dir t)))
- (with-current-buffer (setq buf (create-file-buffer
- image-dired-db-file))
- (with-file-modes #o600
- (write-file image-dired-db-file)))
- (kill-buffer buf)
- (file-exists-p image-dired-db-file))
- (error "Could not create %s" image-dired-db-file)))
-
-(defvar image-dired-tag-history nil "Variable holding the tag history.")
-
-(defun image-dired-write-tags (file-tags)
- "Write file tags to database.
-Write each file and tag in FILE-TAGS to the database.
-FILE-TAGS is an alist in the following form:
- ((FILE . TAG) ... )"
- (image-dired-sane-db-file)
- (let (end file tag)
- (image-dired--with-db-file
- (setq buffer-file-name image-dired-db-file)
- (dolist (elt file-tags)
- (setq file (car elt)
- tag (cdr elt))
- (goto-char (point-min))
- (if (search-forward-regexp (format "^%s.*$" file) nil t)
- (progn
- (setq end (point))
- (beginning-of-line)
- (when (not (search-forward (format ";%s" tag) end t))
- (end-of-line)
- (insert (format ";%s" tag))))
- (goto-char (point-max))
- (insert (format "%s;%s\n" file tag))))
- (save-buffer))))
-
-(defun image-dired-remove-tag (files tag)
- "For all FILES, remove TAG from the image database."
- (image-dired-sane-db-file)
- (image-dired--with-db-file
- (setq buffer-file-name image-dired-db-file)
- (let (end)
- (unless (listp files)
- (if (stringp files)
- (setq files (list files))
- (error "Files must be a string or a list of strings!")))
- (dolist (file files)
- (goto-char (point-min))
- (when (search-forward-regexp (format "^%s;" file) nil t)
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (when (search-forward-regexp
- (format "\\(;%s\\)\\($\\|;\\)" tag) end t)
- (delete-region (match-beginning 1) (match-end 1))
- ;; Check if file should still be in the database. If
- ;; it has no tags or comments, it will be removed.
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (when (not (search-forward ";" end t))
- (kill-line 1))))))
- (save-buffer)))
-
-(defun image-dired-list-tags (file)
- "Read all tags for image FILE from the image database."
- (image-dired-sane-db-file)
- (image-dired--with-db-file
- (let (end (tags ""))
- (when (search-forward-regexp (format "^%s" file) nil t)
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (if (search-forward ";" end t)
- (if (search-forward "comment:" end t)
- (if (search-forward ";" end t)
- (setq tags (buffer-substring (point) end)))
- (setq tags (buffer-substring (point) end)))))
- (split-string tags ";"))))
-
-;;;###autoload
-(defun image-dired-tag-files (arg)
- "Tag marked file(s) in Dired. With prefix ARG, tag file at point."
- (interactive "P")
- (let ((tag (completing-read
- "Tags to add (separate tags with a semicolon): "
- image-dired-tag-history nil nil nil 'image-dired-tag-history))
- files)
- (if arg
- (setq files (list (dired-get-filename)))
- (setq files (dired-get-marked-files)))
- (image-dired-write-tags
- (mapcar
- (lambda (x)
- (cons x tag))
- files))))
-
-(defun image-dired-tag-thumbnail ()
- "Tag current or marked thumbnails."
- (interactive)
- (let ((tag (completing-read
- "Tags to add (separate tags with a semicolon): "
- image-dired-tag-history nil nil nil 'image-dired-tag-history)))
- (image-dired--with-marked
- (image-dired-write-tags
- (list (cons (image-dired-original-file-name) tag)))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))))
-
-;;;###autoload
-(defun image-dired-delete-tag (arg)
- "Remove tag for selected file(s).
-With prefix argument ARG, remove tag from file at point."
- (interactive "P")
- (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
- nil nil nil 'image-dired-tag-history))
- files)
- (if arg
- (setq files (list (dired-get-filename)))
- (setq files (dired-get-marked-files)))
- (image-dired-remove-tag files tag)))
-
-(defun image-dired-tag-thumbnail-remove ()
- "Remove tag from current or marked thumbnails."
- (interactive)
- (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
- nil nil nil 'image-dired-tag-history)))
- (image-dired--with-marked
- (image-dired-remove-tag (image-dired-original-file-name) tag)
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))))
-
-
-;;; Thumbnail mode (cont.)
-
-(defun image-dired-original-file-name ()
- "Get original file name for thumbnail or display image at point."
- (get-text-property (point) 'original-file-name))
-
-(defun image-dired-file-name-at-point ()
- "Get abbreviated file name for thumbnail or display image at point."
- (let ((f (image-dired-original-file-name)))
- (when f
- (abbreviate-file-name f))))
-
-(defun image-dired-associated-dired-buffer ()
- "Get associated Dired buffer at point."
- (get-text-property (point) 'associated-dired-buffer))
-
-(defun image-dired-get-buffer-window (buf)
- "Return window where buffer BUF is."
- (get-window-with-predicate
- (lambda (window)
- (equal (window-buffer window) buf))
- nil t))
-
-(defun image-dired-track-original-file ()
- "Track the original file in the associated Dired buffer.
-See documentation for `image-dired-toggle-movement-tracking'.
-Interactive use only useful if `image-dired-track-movement' is nil."
- (interactive)
- (let* ((dired-buf (image-dired-associated-dired-buffer))
- (file-name (image-dired-original-file-name))
- (window (image-dired-get-buffer-window dired-buf)))
- (and (buffer-live-p dired-buf) file-name
- (with-current-buffer dired-buf
- (if (not (dired-goto-file file-name))
- (message "Could not track file")
- (if window (set-window-point window (point))))))))
-
-(defun image-dired-toggle-movement-tracking ()
- "Turn on and off `image-dired-track-movement'.
-Tracking of the movements between thumbnail and Dired buffer so that
-they are \"mirrored\" in the dired buffer. When this is on, moving
-around in the thumbnail or dired buffer will find the matching
-position in the other buffer."
- (interactive)
- (setq image-dired-track-movement (not image-dired-track-movement))
- (message "Movement tracking %s" (if image-dired-track-movement "on" "off")))
-
-(defun image-dired-track-thumbnail ()
- "Track current Dired file's thumb in `image-dired-thumbnail-buffer'.
-This is almost the same as what `image-dired-track-original-file' does,
-but the other way around."
- (let ((file (dired-get-filename))
- prop-val found window)
- (when (get-buffer image-dired-thumbnail-buffer)
- (with-current-buffer image-dired-thumbnail-buffer
- (goto-char (point-min))
- (while (and (not (eobp))
- (not found))
- (if (and (setq prop-val
- (get-text-property (point) 'original-file-name))
- (string= prop-val file))
- (setq found t))
- (if (not found)
- (forward-char 1)))
- (when found
- (if (setq window (image-dired-thumbnail-window))
- (set-window-point window (point)))
- (image-dired-update-header-line))))))
-
-(defun image-dired-dired-next-line (&optional arg)
- "Call `dired-next-line', then track thumbnail.
-This can safely replace `dired-next-line'.
-With prefix argument, move ARG lines."
- (interactive "P")
- (dired-next-line (or arg 1))
- (if image-dired-track-movement
- (image-dired-track-thumbnail)))
-
-(defun image-dired-dired-previous-line (&optional arg)
- "Call `dired-previous-line', then track thumbnail.
-This can safely replace `dired-previous-line'.
-With prefix argument, move ARG lines."
- (interactive "P")
- (dired-previous-line (or arg 1))
- (if image-dired-track-movement
- (image-dired-track-thumbnail)))
-
-(defun image-dired--display-thumb-properties-fun ()
- (let ((old-buf (current-buffer))
- (old-point (point)))
- (lambda ()
- (when (and (equal (current-buffer) old-buf)
- (= (point) old-point))
- (ignore-errors
- (image-dired-update-header-line))))))
-
-(defun image-dired-forward-image (&optional arg wrap-around)
- "Move to next image and display properties.
-Optional prefix ARG says how many images to move; the default is
-one image. Negative means move backwards.
-On reaching end or beginning of buffer, stop and show a message.
-
-If optional argument WRAP-AROUND is non-nil, wrap around: if
-point is on the last image, move to the last one and vice versa."
- (interactive "p")
- (setq arg (or arg 1))
- (let (pos)
- (dotimes (_ (abs arg))
- (if (and (not (if (> arg 0) (eobp) (bobp)))
- (save-excursion
- (forward-char (if (> arg 0) 1 -1))
- (while (and (not (if (> arg 0) (eobp) (bobp)))
- (not (image-dired-image-at-point-p)))
- (forward-char (if (> arg 0) 1 -1)))
- (setq pos (point))
- (image-dired-image-at-point-p)))
- (progn (goto-char pos)
- (image-dired-update-header-line))
- (if wrap-around
- (progn (goto-char (if (> arg 0)
- (point-min)
- ;; There are two spaces after the last image.
- (- (point-max) 2)))
- (image-dired-update-header-line))
- (message "At %s image" (if (> arg 0) "last" "first"))
- (run-at-time 1 nil (image-dired--display-thumb-properties-fun))))))
- (when image-dired-track-movement
- (image-dired-track-original-file)))
-
-(defun image-dired-backward-image (&optional arg)
- "Move to previous image and display properties.
-Optional prefix ARG says how many images to move; the default is
-one image. Negative means move forward.
-On reaching end or beginning of buffer, stop and show a message."
- (interactive "p")
- (image-dired-forward-image (- (or arg 1))))
-
-(defun image-dired-next-line ()
- "Move to next line and display properties."
- (interactive nil image-dired-thumbnail-mode)
- (let ((goal-column (current-column)))
- (forward-line 1)
- (move-to-column goal-column))
- ;; If we end up in an empty spot, back up to the next thumbnail.
- (if (not (image-dired-image-at-point-p))
- (image-dired-backward-image))
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-update-header-line))
-
-
-(defun image-dired-previous-line ()
- "Move to previous line and display properties."
- (interactive nil image-dired-thumbnail-mode)
- (let ((goal-column (current-column)))
- (forward-line -1)
- (move-to-column goal-column))
- ;; If we end up in an empty spot, back up to the next
- ;; thumbnail. This should only happen if the user deleted a
- ;; thumbnail and did not refresh, so it is not very common. But we
- ;; can handle it in a good manner, so why not?
- (if (not (image-dired-image-at-point-p))
- (image-dired-backward-image))
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-update-header-line))
-
-(defun image-dired-beginning-of-buffer ()
- "Move to the first image in the buffer and display properties."
- (interactive nil image-dired-thumbnail-mode)
- (goto-char (point-min))
- (while (and (not (image-at-point-p))
- (not (eobp)))
- (forward-char 1))
- (when image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-update-header-line))
-
-(defun image-dired-end-of-buffer ()
- "Move to the last image in the buffer and display properties."
- (interactive nil image-dired-thumbnail-mode)
- (goto-char (point-max))
- (while (and (not (image-at-point-p))
- (not (bobp)))
- (forward-char -1))
- (when image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-update-header-line))
-
-(defun image-dired-format-properties-string (buf file props comment)
- "Format display properties.
-BUF is the associated Dired buffer, FILE is the original image file
-name, PROPS is a stringified list of tags and COMMENT is the image file's
-comment."
- (format-spec
- image-dired-display-properties-format
- (list
- (cons ?b (or buf ""))
- (cons ?f file)
- (cons ?t (or props ""))
- (cons ?c (or comment "")))))
-
-(defun image-dired-update-header-line ()
- "Update image information in the header line."
- (when (and (not (eobp))
- (memq major-mode '(image-dired-thumbnail-mode
- image-dired-display-image-mode)))
- (let ((file-name (file-name-nondirectory (image-dired-original-file-name)))
- (dired-buf (buffer-name (image-dired-associated-dired-buffer)))
- (props (mapconcat #'identity (get-text-property (point) 'tags) ", "))
- (comment (get-text-property (point) 'comment))
- (message-log-max nil))
- (if file-name
- (setq header-line-format
- (image-dired-format-properties-string
- dired-buf
- file-name
- props
- comment))))))
-
-(defun image-dired-dired-file-marked-p (&optional marker)
- "In Dired, return t if file on current line is marked.
-If optional argument MARKER is non-nil, it is a character to look
-for. The default is to look for `dired-marker-char'."
- (setq marker (or marker dired-marker-char))
- (save-excursion
- (beginning-of-line)
- (and (looking-at dired-re-mark)
- (= (aref (match-string 0) 0) marker))))
-
-(defun image-dired-dired-file-flagged-p ()
- "In Dired, return t if file on current line is flagged for deletion."
- (image-dired-dired-file-marked-p dired-del-marker))
-
-(defmacro image-dired--with-thumbnail-buffer (&rest body)
- (declare (indent defun) (debug t))
- `(if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
- (with-current-buffer buf
- (if-let ((win (get-buffer-window buf)))
- (with-selected-window win
- ,@body)
- ,@body))
- (user-error "No such buffer: %s" image-dired-thumbnail-buffer)))
-
-(defmacro image-dired--on-file-in-dired-buffer (&rest body)
- "Run BODY with point on file at point in Dired buffer.
-Should be called from commands in `image-dired-thumbnail-mode'."
- (declare (indent defun) (debug t))
- `(let ((file-name (image-dired-original-file-name))
- (dired-buf (image-dired-associated-dired-buffer)))
- (if (not (and dired-buf file-name))
- (message "No image, or image with correct properties, at point")
- (with-current-buffer dired-buf
- (when (dired-goto-file file-name)
- ,@body
- (image-dired-thumb-update-marks))))))
-
-(defmacro image-dired--do-mark-command (maybe-next &rest body)
- "Helper macro for the mark, unmark and flag commands.
-Run BODY in Dired buffer.
-If optional argument MAYBE-NEXT is non-nil, show next image
-according to `image-dired-marking-shows-next'."
- (declare (indent defun) (debug t))
- `(image-dired--with-thumbnail-buffer
- (image-dired--on-file-in-dired-buffer
- ,@body)
- ,(when maybe-next
- '(if image-dired-marking-shows-next
- (image-dired-display-next-thumbnail-original)
- (image-dired-next-line)))))
-
-(defun image-dired-mark-thumb-original-file ()
- "Mark original image file in associated Dired buffer."
- (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--do-mark-command t
- (dired-mark 1)))
-
-(defun image-dired-unmark-thumb-original-file ()
- "Unmark original image file in associated Dired buffer."
- (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--do-mark-command t
- (dired-unmark 1)))
-
-(defun image-dired-flag-thumb-original-file ()
- "Flag original image file for deletion in associated Dired buffer."
- (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--do-mark-command t
- (dired-flag-file-deletion 1)))
-
-(defun image-dired-toggle-mark-thumb-original-file ()
- "Toggle mark on original image file in associated Dired buffer."
- (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--do-mark-command nil
- (if (image-dired-dired-file-marked-p)
- (dired-unmark 1)
- (dired-mark 1))))
-
-(defun image-dired-unmark-all-marks ()
- "Remove all marks from all files in associated Dired buffer.
-Also update the marks in the thumbnail buffer."
- (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--do-mark-command nil
- (dired-unmark-all-marks))
- (image-dired--with-thumbnail-buffer
- (image-dired-thumb-update-marks)))
-
-(defun image-dired-jump-original-dired-buffer ()
- "Jump to the Dired buffer associated with the current image file.
-You probably want to use this together with
-`image-dired-track-original-file'."
- (interactive nil image-dired-thumbnail-mode)
- (let ((buf (image-dired-associated-dired-buffer))
- window frame)
- (setq window (image-dired-get-buffer-window buf))
- (if window
- (progn
- (if (not (equal (selected-frame) (setq frame (window-frame window))))
- (select-frame-set-input-focus frame))
- (select-window window))
- (message "Associated dired buffer not visible"))))
-
-;;;###autoload
-(defun image-dired-jump-thumbnail-buffer ()
- "Jump to thumbnail buffer."
- (interactive)
- (let ((window (image-dired-thumbnail-window))
- frame)
- (if window
- (progn
- (if (not (equal (selected-frame) (setq frame (window-frame window))))
- (select-frame-set-input-focus frame))
- (select-window window))
- (message "Thumbnail buffer not visible"))))
-
-(defvar image-dired-thumbnail-mode-line-up-map
- (let ((map (make-sparse-keymap)))
- ;; map it to "g" so that the user can press it more quickly
- (define-key map "g" #'image-dired-line-up-dynamic)
- ;; "f" for "fixed" number of thumbs per row
- (define-key map "f" #'image-dired-line-up)
- ;; "i" for "interactive"
- (define-key map "i" #'image-dired-line-up-interactive)
- map)
- "Keymap for line-up commands in `image-dired-thumbnail-mode'.")
-
-(defvar image-dired-thumbnail-mode-tag-map
- (let ((map (make-sparse-keymap)))
- ;; map it to "t" so that the user can press it more quickly
- (define-key map "t" #'image-dired-tag-thumbnail)
- ;; "r" for "remove"
- (define-key map "r" #'image-dired-tag-thumbnail-remove)
- map)
- "Keymap for tag commands in `image-dired-thumbnail-mode'.")
-
-(defvar image-dired-thumbnail-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [right] #'image-dired-forward-image)
- (define-key map [left] #'image-dired-backward-image)
- (define-key map [up] #'image-dired-previous-line)
- (define-key map [down] #'image-dired-next-line)
- (define-key map "\C-f" #'image-dired-forward-image)
- (define-key map "\C-b" #'image-dired-backward-image)
- (define-key map "\C-p" #'image-dired-previous-line)
- (define-key map "\C-n" #'image-dired-next-line)
-
- (define-key map "<" #'image-dired-beginning-of-buffer)
- (define-key map ">" #'image-dired-end-of-buffer)
- (define-key map (kbd "M-<") #'image-dired-beginning-of-buffer)
- (define-key map (kbd "M->") #'image-dired-end-of-buffer)
-
- (define-key map "d" #'image-dired-flag-thumb-original-file)
- (define-key map [delete] #'image-dired-flag-thumb-original-file)
- (define-key map "m" #'image-dired-mark-thumb-original-file)
- (define-key map "u" #'image-dired-unmark-thumb-original-file)
- (define-key map "U" #'image-dired-unmark-all-marks)
- (define-key map "." #'image-dired-track-original-file)
- (define-key map [tab] #'image-dired-jump-original-dired-buffer)
-
- ;; add line-up map
- (define-key map "g" image-dired-thumbnail-mode-line-up-map)
- ;; add tag map
- (define-key map "t" image-dired-thumbnail-mode-tag-map)
-
- (define-key map "\C-m" #'image-dired-display-thumbnail-original-image)
- (define-key map [C-return] #'image-dired-thumbnail-display-external)
-
- (define-key map "L" #'image-dired-rotate-original-left)
- (define-key map "R" #'image-dired-rotate-original-right)
-
- (define-key map "D" #'image-dired-thumbnail-set-image-description)
- (define-key map "S" #'image-dired-slideshow-start)
- (define-key map "\C-d" #'image-dired-delete-char)
- (define-key map " " #'image-dired-display-next-thumbnail-original)
- (define-key map (kbd "DEL")
#'image-dired-display-previous-thumbnail-original)
- (define-key map "c" #'image-dired-comment-thumbnail)
-
- ;; Mouse
- (define-key map [mouse-2] #'image-dired-mouse-display-image)
- (define-key map [mouse-1] #'image-dired-mouse-select-thumbnail)
- (define-key map [mouse-3] #'image-dired-mouse-select-thumbnail)
- (define-key map [down-mouse-1] #'image-dired-mouse-select-thumbnail)
- (define-key map [down-mouse-2] #'image-dired-mouse-select-thumbnail)
- (define-key map [down-mouse-3] #'image-dired-mouse-select-thumbnail)
- ;; Seems I must first set C-down-mouse-1 to undefined, or else it
- ;; will trigger the buffer menu. If I try to instead bind
- ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message
- ;; about C-mouse-1 not being defined afterwards. Annoying, but I
- ;; probably do not completely understand mouse events.
- (define-key map [C-down-mouse-1] #'undefined)
- (define-key map [C-mouse-1] #'image-dired-mouse-toggle-mark)
- map)
- "Keymap for `image-dired-thumbnail-mode'.")
-
-(easy-menu-define image-dired-thumbnail-mode-menu
image-dired-thumbnail-mode-map
- "Menu for `image-dired-thumbnail-mode'."
- '("Image-Dired"
- ["Display image" image-dired-display-thumbnail-original-image]
- ["Display in external viewer" image-dired-thumbnail-display-external]
- ["Jump to Dired buffer" image-dired-jump-original-dired-buffer]
- "---"
- ["Mark image" image-dired-mark-thumb-original-file]
- ["Unmark image" image-dired-unmark-thumb-original-file]
- ["Unmark all images" image-dired-unmark-all-marks]
- ["Flag for deletion" image-dired-flag-thumb-original-file]
- ["Delete marked images" image-dired-delete-marked]
- "---"
- ["Rotate original right" image-dired-rotate-original-right]
- ["Rotate original left" image-dired-rotate-original-left]
- "---"
- ["Comment thumbnail" image-dired-comment-thumbnail]
- ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
- ["Remove tag from current or marked thumbnails"
- image-dired-tag-thumbnail-remove]
- ["Start slideshow" image-dired-slideshow-start]
- "---"
- ("View Options"
- ["Toggle movement tracking" image-dired-toggle-movement-tracking
- :style toggle
- :selected image-dired-track-movement]
- "---"
- ["Line up thumbnails" image-dired-line-up]
- ["Dynamic line up" image-dired-line-up-dynamic]
- ["Refresh thumb" image-dired-refresh-thumb])
- ["Quit" quit-window]))
-
-(defvar image-dired-display-image-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "S" #'image-dired-slideshow-start)
- (define-key map (kbd "SPC") #'image-dired-display-next-thumbnail-original)
- (define-key map (kbd "DEL")
#'image-dired-display-previous-thumbnail-original)
- (define-key map "n" #'image-dired-display-next-thumbnail-original)
- (define-key map "p" #'image-dired-display-previous-thumbnail-original)
- (define-key map "m" #'image-dired-mark-thumb-original-file)
- (define-key map "d" #'image-dired-flag-thumb-original-file)
- (define-key map "u" #'image-dired-unmark-thumb-original-file)
- (define-key map "U" #'image-dired-unmark-all-marks)
- ;; Disable keybindings from `image-mode-map' that doesn't make sense here.
- (define-key map "o" nil) ; image-save
- map)
- "Keymap for `image-dired-display-image-mode'.")
-
-(define-derived-mode image-dired-thumbnail-mode
- special-mode "image-dired-thumbnail"
- "Browse and manipulate thumbnail images using Dired.
-Use `image-dired-minor-mode' to get a nice setup."
- :interactive nil
- (buffer-disable-undo)
- (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil
t)
- (setq-local window-resize-pixelwise t)
- (setq-local bookmark-make-record-function #'image-dired-bookmark-make-record)
- ;; Use approximately as much vertical spacing as horizontal.
- (setq-local line-spacing (frame-char-width)))
-
-
-;;; Display image mode
-
-(define-derived-mode image-dired-display-image-mode
- image-mode "image-dired-image-display"
- "Mode for displaying and manipulating original image.
-Resized or in full-size."
- :interactive nil
- (add-hook 'file-name-at-point-functions #'image-dired-file-name-at-point nil
t))
-
-(defvar image-dired-minor-mode-map
- (let ((map (make-sparse-keymap)))
- ;; (set-keymap-parent map dired-mode-map)
- ;; Hijack previous and next line movement. Let C-p and C-b be
- ;; though...
- (define-key map "p" #'image-dired-dired-previous-line)
- (define-key map "n" #'image-dired-dired-next-line)
- (define-key map [up] #'image-dired-dired-previous-line)
- (define-key map [down] #'image-dired-dired-next-line)
-
- (define-key map (kbd "C-S-n") #'image-dired-next-line-and-display)
- (define-key map (kbd "C-S-p") #'image-dired-previous-line-and-display)
- (define-key map (kbd "C-S-m") #'image-dired-mark-and-display-next)
-
- (define-key map "\C-td" #'image-dired-display-thumbs)
- (define-key map [tab] #'image-dired-jump-thumbnail-buffer)
- (define-key map "\C-ti" #'image-dired-dired-display-image)
- (define-key map "\C-tx" #'image-dired-dired-display-external)
- (define-key map "\C-ta" #'image-dired-display-thumbs-append)
- (define-key map "\C-t." #'image-dired-display-thumb)
- (define-key map "\C-tc" #'image-dired-dired-comment-files)
- (define-key map "\C-tf" #'image-dired-mark-tagged-files)
- map)
- "Keymap for `image-dired-minor-mode'.")
-
-(easy-menu-define image-dired-minor-mode-menu image-dired-minor-mode-map
- "Menu for `image-dired-minor-mode'."
- '("Image-dired"
- ["Display thumb for next file" image-dired-next-line-and-display]
- ["Display thumb for previous file" image-dired-previous-line-and-display]
- ["Mark and display next" image-dired-mark-and-display-next]
- "---"
- ["Create thumbnails for marked files" image-dired-create-thumbs]
- "---"
- ["Display thumbnails append" image-dired-display-thumbs-append]
- ["Display this thumbnail" image-dired-display-thumb]
- ["Display image" image-dired-dired-display-image]
- ["Display in external viewer" image-dired-dired-display-external]
- "---"
- ["Toggle display properties" image-dired-toggle-dired-display-properties
- :style toggle
- :selected image-dired-dired-disp-props]
- ["Toggle append browsing" image-dired-toggle-append-browsing
- :style toggle
- :selected image-dired-append-when-browsing]
- ["Toggle movement tracking" image-dired-toggle-movement-tracking
- :style toggle
- :selected image-dired-track-movement]
- "---"
- ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer]
- ["Mark tagged files" image-dired-mark-tagged-files]
- ["Comment files" image-dired-dired-comment-files]
- ["Copy with EXIF file name" image-dired-copy-with-exif-file-name]))
-
-;;;###autoload
-(define-minor-mode image-dired-minor-mode
- "Setup easy-to-use keybindings for the commands to be used in Dired mode.
-Note that n, p and <down> and <up> will be hijacked and bound to
-`image-dired-dired-next-line' and `image-dired-dired-previous-line'."
- :keymap image-dired-minor-mode-map)
-
-(declare-function clear-image-cache "image.c" (&optional filter))
-
-(defun image-dired-create-thumbs (&optional arg)
- "Create thumbnail images for all marked files in Dired.
-With prefix argument ARG, create thumbnails even if they already exist
-\(i.e. use this to refresh your thumbnails)."
- (interactive "P")
- (let (thumb-name)
- (dolist (curr-file (dired-get-marked-files))
- (setq thumb-name (image-dired-thumb-name curr-file))
- ;; If the user overrides the exist check, we must clear the
- ;; image cache so that if the user wants to display the
- ;; thumbnail, it is not fetched from cache.
- (when arg
- (clear-image-cache (expand-file-name thumb-name)))
- (when (or (not (file-exists-p thumb-name))
- arg)
- (image-dired-create-thumb curr-file thumb-name)))))
-
-
-;;; Slideshow
-
-(defcustom image-dired-slideshow-delay 5.0
- "Seconds to wait before showing the next image in a slideshow.
-This is used by `image-dired-slideshow-start'."
- :type 'float
- :version "29.1")
-
-(define-obsolete-variable-alias 'image-dired-slideshow-timer
- 'image-dired--slideshow-timer "29.1")
-(defvar image-dired--slideshow-timer nil
- "Slideshow timer.")
-
-(defvar image-dired--slideshow-initial nil)
-
-(defun image-dired-slideshow-step ()
- "Step to next image in a slideshow."
- (if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
- (with-current-buffer buf
- (image-dired-display-next-thumbnail-original))
- (image-dired-slideshow-stop)))
-
-(defun image-dired-slideshow-start (&optional arg)
- "Start a slideshow, waiting `image-dired-slideshow-delay' between images.
-
-With prefix argument ARG, wait that many seconds before going to
-the next image.
-
-With a negative prefix argument, prompt user for the delay."
- (interactive "P" image-dired-thumbnail-mode image-dired-display-image-mode)
- (let ((delay (if (not arg)
- image-dired-slideshow-delay
- (if (> arg 0)
- arg
- (string-to-number
- (let ((delay (number-to-string
image-dired-slideshow-delay)))
- (read-string
- (format-prompt "Delay, in seconds. Decimals are
accepted" delay))
- delay))))))
- (setq image-dired--slideshow-timer
- (run-with-timer
- 0 delay
- 'image-dired-slideshow-step))
- (add-hook 'post-command-hook 'image-dired-slideshow-stop)
- (setq image-dired--slideshow-initial t)
- (message "Running slideshow; use any command to stop")))
-
-(defun image-dired-slideshow-stop ()
- "Cancel slideshow."
- ;; Make sure we don't immediately stop after
- ;; `image-dired-slideshow-start'.
- (unless image-dired--slideshow-initial
- (remove-hook 'post-command-hook 'image-dired-slideshow-stop)
- (cancel-timer image-dired--slideshow-timer))
- (setq image-dired--slideshow-initial nil))
-
-
-;;; Thumbnail mode (cont. 3)
-
-(defun image-dired-delete-char ()
- "Remove current thumbnail from thumbnail buffer and line up."
- (interactive nil image-dired-thumbnail-mode)
- (let ((inhibit-read-only t))
- (delete-char 1)
- (when (= (following-char) ?\s)
- (delete-char 1))))
-
-;;;###autoload
-(defun image-dired-display-thumbs-append ()
- "Append thumbnails to `image-dired-thumbnail-buffer'."
- (interactive)
- (image-dired-display-thumbs nil t t))
-
-;;;###autoload
-(defun image-dired-display-thumb ()
- "Shorthand for `image-dired-display-thumbs' with prefix argument."
- (interactive)
- (image-dired-display-thumbs t nil t))
-
-(defun image-dired-line-up ()
- "Line up thumbnails according to `image-dired-thumbs-per-row'.
-See also `image-dired-line-up-dynamic'."
- (interactive)
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (and (not (image-dired-image-at-point-p))
- (not (eobp)))
- (delete-char 1))
- (while (not (eobp))
- (forward-char)
- (while (and (not (image-dired-image-at-point-p))
- (not (eobp)))
- (delete-char 1)))
- (goto-char (point-min))
- (let ((seen 0)
- (thumb-prev-pos 0)
- (thumb-width-chars
- (ceiling (/ (+ (* 2 image-dired-thumb-relief)
- (* 2 image-dired-thumb-margin)
- (image-dired-thumb-size 'width))
- (float (frame-char-width))))))
- (while (not (eobp))
- (forward-char)
- (if (= image-dired-thumbs-per-row 1)
- (insert "\n")
- (cl-incf thumb-prev-pos thumb-width-chars)
- (insert (propertize " " 'display `(space :align-to ,thumb-prev-pos)))
- (cl-incf seen)
- (when (and (= seen (- image-dired-thumbs-per-row 1))
- (not (eobp)))
- (forward-char)
- (insert "\n")
- (setq seen 0)
- (setq thumb-prev-pos 0)))))
- (goto-char (point-min))))
-
-(defun image-dired-line-up-dynamic ()
- "Line up thumbnails images dynamically.
-Calculate how many thumbnails fit."
- (interactive)
- (let* ((char-width (frame-char-width))
- (width (image-dired-window-width-pixels
(image-dired-thumbnail-window)))
- (image-dired-thumbs-per-row
- (/ width
- (+ (* 2 image-dired-thumb-relief)
- (* 2 image-dired-thumb-margin)
- (image-dired-thumb-size 'width)
- char-width))))
- (image-dired-line-up)))
-
-(defun image-dired-line-up-interactive ()
- "Line up thumbnails interactively.
-Ask user how many thumbnails should be displayed per row."
- (interactive)
- (let ((image-dired-thumbs-per-row
- (string-to-number (read-string "How many thumbs per row: "))))
- (if (not (> image-dired-thumbs-per-row 0))
- (message "Number must be greater than 0")
- (image-dired-line-up))))
-
-(defun image-dired-thumbnail-display-external ()
- "Display original image for thumbnail at point using external viewer."
- (interactive)
- (let ((file (image-dired-original-file-name)))
- (if (not (image-dired-image-at-point-p))
- (message "No thumbnail at point")
- (if (not file)
- (message "No original file name found")
- (start-process "image-dired-thumb-external" nil
- image-dired-external-viewer file)))))
-
-;;;###autoload
-(defun image-dired-dired-display-external ()
- "Display file at point using an external viewer."
- (interactive)
- (let ((file (dired-get-filename)))
- (start-process "image-dired-external" nil
- image-dired-external-viewer file)))
-
-(defun image-dired-window-width-pixels (window)
- "Calculate WINDOW width in pixels."
- (* (window-width window) (frame-char-width)))
-
-(defun image-dired-display-window ()
- "Return window where `image-dired-display-image-buffer' is visible."
- (get-window-with-predicate
- (lambda (window)
- (equal (buffer-name (window-buffer window))
image-dired-display-image-buffer))
- nil t))
-
-(defun image-dired-thumbnail-window ()
- "Return window where `image-dired-thumbnail-buffer' is visible."
- (get-window-with-predicate
- (lambda (window)
- (equal (buffer-name (window-buffer window)) image-dired-thumbnail-buffer))
- nil t))
-
-(defun image-dired-associated-dired-buffer-window ()
- "Return window where associated Dired buffer is visible."
- (let (buf)
- (if (image-dired-image-at-point-p)
- (progn
- (setq buf (image-dired-associated-dired-buffer))
- (get-window-with-predicate
- (lambda (window)
- (equal (window-buffer window) buf))))
- (error "No thumbnail image at point"))))
-
-(defun image-dired-display-image (file &optional _ignored)
- "Display image FILE in image buffer.
-Use this when you want to display the image, in a new window.
-The window will use `image-dired-display-image-mode' which is
-based on `image-mode'."
- (declare (advertised-calling-convention (file) "29.1"))
- (setq file (expand-file-name file))
- (when (not (file-exists-p file))
- (error "No such file: %s" file))
- (let ((buf (get-buffer image-dired-display-image-buffer))
- (cur-win (selected-window)))
- (when buf
- (kill-buffer buf))
- (when-let ((buf (find-file-noselect file nil t)))
- (pop-to-buffer buf)
- (rename-buffer image-dired-display-image-buffer)
- (image-dired-display-image-mode)
- (select-window cur-win))))
-
-(defun image-dired-display-thumbnail-original-image (&optional arg)
- "Display current thumbnail's original image in display buffer.
-See documentation for `image-dired-display-image' for more information.
-With prefix argument ARG, display image in its original size."
- (interactive "P")
- (let ((file (image-dired-original-file-name)))
- (if (not (string-equal major-mode "image-dired-thumbnail-mode"))
- (message "Not in image-dired-thumbnail-mode")
- (if (not (image-dired-image-at-point-p))
- (message "No thumbnail at point")
- (if (not file)
- (message "No original file name found")
- (image-dired-display-image file arg))))))
-
-
-;;;###autoload
-(defun image-dired-dired-display-image (&optional arg)
- "Display current image file.
-See documentation for `image-dired-display-image' for more information.
-With prefix argument ARG, display image in its original size."
- (interactive "P")
- (image-dired-display-image (dired-get-filename) arg))
-
-(defun image-dired-image-at-point-p ()
- "Return non-nil if there is an `image-dired' thumbnail at point."
- (get-text-property (point) 'image-dired-thumbnail))
-
-(defun image-dired-refresh-thumb ()
- "Force creation of new image for current thumbnail."
- (interactive nil image-dired-thumbnail-mode)
- (let* ((file (image-dired-original-file-name))
- (thumb (expand-file-name (image-dired-thumb-name file))))
- (clear-image-cache (expand-file-name thumb))
- (image-dired-create-thumb file thumb)))
-
-(defun image-dired-rotate-original (degrees)
- "Rotate original image DEGREES degrees."
- (image-dired--check-executable-exists
- 'image-dired-cmd-rotate-original-program)
- (if (not (image-dired-image-at-point-p))
- (message "No image at point")
- (let* ((file (image-dired-original-file-name))
- (spec
- (list
- (cons ?d degrees)
- (cons ?o (expand-file-name file))
- (cons ?t image-dired-temp-rotate-image-file))))
- (unless (eq 'jpeg (image-type file))
- (user-error "Only JPEG images can be rotated"))
- (if (not (= 0 (apply #'call-process
image-dired-cmd-rotate-original-program
- nil nil nil
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-rotate-original-options))))
- (error "Could not rotate image")
- (image-dired-display-image image-dired-temp-rotate-image-file)
- (if (or (and image-dired-rotate-original-ask-before-overwrite
- (y-or-n-p
- "Rotate to temp file OK. Overwrite original image? "))
- (not image-dired-rotate-original-ask-before-overwrite))
- (progn
- (copy-file image-dired-temp-rotate-image-file file t)
- (image-dired-refresh-thumb))
- (image-dired-display-image file))))))
-
-(defun image-dired-rotate-original-left ()
- "Rotate original image left (counter clockwise) 90 degrees.
-The result of the rotation is displayed in the image display area
-and a confirmation is needed before the original image files is
-overwritten. This confirmation can be turned off using
-`image-dired-rotate-original-ask-before-overwrite'."
- (interactive)
- (image-dired-rotate-original "270"))
-
-(defun image-dired-rotate-original-right ()
- "Rotate original image right (clockwise) 90 degrees.
-The result of the rotation is displayed in the image display area
-and a confirmation is needed before the original image files is
-overwritten. This confirmation can be turned off using
-`image-dired-rotate-original-ask-before-overwrite'."
- (interactive)
- (image-dired-rotate-original "90"))
-
-
-;;; EXIF support
-
-(defun image-dired-get-exif-file-name (file)
- "Use the image's EXIF information to return a unique file name.
-The file name should be unique as long as you do not take more than
-one picture per second. The original file name is suffixed at the end
-for traceability. The format of the returned file name is
-YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
-`image-dired-copy-with-exif-file-name'."
- (let (data no-exif-data-found)
- (if (not (eq 'jpeg (image-type (expand-file-name file))))
- (setq no-exif-data-found t
- data (format-time-string
- "%Y:%m:%d %H:%M:%S"
- (file-attribute-modification-time
- (file-attributes (expand-file-name file)))))
- (setq data (exif-field 'date-time (exif-parse-file
- (expand-file-name file)))))
- (while (string-match "[ :]" data)
- (setq data (replace-match "_" nil nil data)))
- (format "%s%s%s" data
- (if no-exif-data-found
- "_noexif_"
- "_")
- (file-name-nondirectory file))))
-
-(defun image-dired-thumbnail-set-image-description ()
- "Set the ImageDescription EXIF tag for the original image.
-If the image already has a value for this tag, it is used as the
-default value at the prompt."
- (interactive)
- (if (not (image-dired-image-at-point-p))
- (message "No thumbnail at point")
- (let* ((file (image-dired-original-file-name))
- (old-value (or (exif-field 'description (exif-parse-file file))
"")))
- (if (eq 0
- (image-dired-set-exif-data file "ImageDescription"
- (read-string "Value of ImageDescription: "
- old-value)))
- (message "Successfully wrote ImageDescription tag")
- (error "Could not write ImageDescription tag")))))
-
-(defun image-dired-set-exif-data (file tag-name tag-value)
- "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE."
- (image-dired--check-executable-exists
- 'image-dired-cmd-write-exif-data-program)
- (let ((spec
- (list
- (cons ?f (expand-file-name file))
- (cons ?t tag-name)
- (cons ?v tag-value))))
- (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-write-exif-data-options))))
-
-(defun image-dired-copy-with-exif-file-name ()
- "Copy file with unique name to main image directory.
-Copy current or all marked files in Dired to a new file in your
-main image directory, using a file name generated by
-`image-dired-get-exif-file-name'. A typical usage for this if when
-copying images from a digital camera into the image directory.
-
- Typically, you would open up the folder with the incoming
-digital images, mark the files to be copied, and execute this
-function. The result is a couple of new files in
-`image-dired-main-image-directory' called
-2005_05_08_12_52_00_dscn0319.jpg,
-2005_05_08_14_27_45_dscn0320.jpg etc."
- (interactive)
- (let (new-name
- (files (dired-get-marked-files)))
- (mapc
- (lambda (curr-file)
- (setq new-name
- (format "%s/%s"
- (file-name-as-directory
- (expand-file-name image-dired-main-image-directory))
- (image-dired-get-exif-file-name curr-file)))
- (message "Copying %s to %s" curr-file new-name)
- (copy-file curr-file new-name))
- files)))
-
-;;; Thumbnail mode (cont.)
-
-(defun image-dired-display-next-thumbnail-original (&optional arg)
- "Move to the next image in the thumbnail buffer and display it.
-With prefix ARG, move that many thumbnails."
- (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired--with-thumbnail-buffer
- (image-dired-forward-image arg t)
- (image-dired-display-thumbnail-original-image)))
-
-(defun image-dired-display-previous-thumbnail-original (arg)
- "Move to the previous image in the thumbnail buffer and display it.
-With prefix ARG, move that many thumbnails."
- (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode)
- (image-dired-display-next-thumbnail-original (- arg)))
-
-
-;;; Image Comments
-
-(defun image-dired-write-comments (file-comments)
- "Write file comments to database.
-Write file comments to one or more files.
-FILE-COMMENTS is an alist on the following form:
- ((FILE . COMMENT) ... )"
- (image-dired-sane-db-file)
- (let (end comment-beg-pos comment-end-pos file comment)
- (image-dired--with-db-file
- (setq buffer-file-name image-dired-db-file)
- (dolist (elt file-comments)
- (setq file (car elt)
- comment (cdr elt))
- (goto-char (point-min))
- (if (search-forward-regexp (format "^%s.*$" file) nil t)
- (progn
- (setq end (point))
- (beginning-of-line)
- ;; Delete old comment, if any
- (when (search-forward ";comment:" end t)
- (setq comment-beg-pos (match-beginning 0))
- ;; Any tags after the comment?
- (if (search-forward ";" end t)
- (setq comment-end-pos (- (point) 1))
- (setq comment-end-pos end))
- ;; Delete comment tag and comment
- (delete-region comment-beg-pos comment-end-pos))
- ;; Insert new comment
- (beginning-of-line)
- (unless (search-forward ";" end t)
- (end-of-line)
- (insert ";"))
- (insert (format "comment:%s;" comment)))
- ;; File does not exist in database - add it.
- (goto-char (point-max))
- (insert (format "%s;comment:%s\n" file comment))))
- (save-buffer))))
-
-(defun image-dired-update-property (prop value)
- "Update text property PROP with value VALUE at point."
- (let ((inhibit-read-only t))
- (put-text-property
- (point) (1+ (point))
- prop
- value)))
-
-;;;###autoload
-(defun image-dired-dired-comment-files ()
- "Add comment to current or marked files in Dired."
- (interactive)
- (let ((comment (image-dired-read-comment)))
- (image-dired-write-comments
- (mapcar
- (lambda (curr-file)
- (cons curr-file comment))
- (dired-get-marked-files)))))
-
-(defun image-dired-comment-thumbnail ()
- "Add comment to current thumbnail in thumbnail buffer."
- (interactive)
- (let* ((file (image-dired-original-file-name))
- (comment (image-dired-read-comment file)))
- (image-dired-write-comments (list (cons file comment)))
- (image-dired-update-property 'comment comment))
- (image-dired-update-header-line))
-
-(defun image-dired-read-comment (&optional file)
- "Read comment for an image.
-Optionally use old comment from FILE as initial value."
- (let ((comment
- (read-string
- "Comment: "
- (if file (image-dired-get-comment file)))))
- comment))
-
-(defun image-dired-get-comment (file)
- "Get comment for file FILE."
- (image-dired-sane-db-file)
- (image-dired--with-db-file
- (let (end comment-beg-pos comment-end-pos comment)
- (when (search-forward-regexp (format "^%s" file) nil t)
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (when (search-forward ";comment:" end t)
- (setq comment-beg-pos (point))
- (if (search-forward ";" end t)
- (setq comment-end-pos (- (point) 1))
- (setq comment-end-pos end))
- (setq comment (buffer-substring
- comment-beg-pos comment-end-pos))))
- comment)))
-
-;;;###autoload
-(defun image-dired-mark-tagged-files (regexp)
- "Use REGEXP to mark files with matching tag.
-A `tag' is a keyword, a piece of meta data, associated with an
-image file and stored in image-dired's database file. This command
-lets you input a regexp and this will be matched against all tags
-on all image files in the database file. The files that have a
-matching tag will be marked in the Dired buffer."
- (interactive "sMark tagged files (regexp): ")
- (image-dired-sane-db-file)
- (let ((hits 0)
- files)
- (image-dired--with-db-file
- ;; Collect matches
- (while (search-forward-regexp "\\(^[^;\n]+\\);\\(.*\\)" nil t)
- (let ((file (match-string 1))
- (tags (split-string (match-string 2) ";")))
- (when (seq-find (lambda (tag)
- (string-match-p regexp tag))
- tags)
- (push file files)))))
- ;; Mark files
- (dolist (curr-file files)
- ;; I tried using `dired-mark-files-regexp' but it was waaaay to
- ;; slow. Don't bother about hits found in other directories
- ;; than the current one.
- (when (string= (file-name-as-directory
- (expand-file-name default-directory))
- (file-name-as-directory
- (file-name-directory curr-file)))
- (setq curr-file (file-name-nondirectory curr-file))
- (goto-char (point-min))
- (when (search-forward-regexp (format "\\s %s$" curr-file) nil t)
- (setq hits (+ hits 1))
- (dired-mark 1))))
- (message "%d files with matching tag marked" hits)))
-
-
-
-;;; Mouse support
-
-(defun image-dired-mouse-display-image (event)
- "Use mouse EVENT, call `image-dired-display-image' to display image.
-Track this in associated Dired buffer if `image-dired-track-movement' is
-non-nil."
- (interactive "e")
- (mouse-set-point event)
- (goto-char (posn-point (event-end event)))
- (unless (image-at-point-p)
- (image-dired-backward-image))
- (let ((file (image-dired-original-file-name)))
- (when file
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-display-image file))))
-
-(defun image-dired-mouse-select-thumbnail (event)
- "Use mouse EVENT to select thumbnail image.
-Track this in associated Dired buffer if `image-dired-track-movement' is
-non-nil."
- (interactive "e")
- (mouse-set-point event)
- (goto-char (posn-point (event-end event)))
- (unless (image-at-point-p)
- (image-dired-backward-image))
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-update-header-line))
-
-
-
-;;; Dired marks and tags
-
-(defun image-dired-thumb-file-marked-p (&optional flagged)
- "Check if file is marked in associated Dired buffer.
-If optional argument FLAGGED is non-nil, check if file is flagged
-for deletion instead."
- (let ((file-name (image-dired-original-file-name))
- (dired-buf (image-dired-associated-dired-buffer)))
- (when (and dired-buf file-name)
- (with-current-buffer dired-buf
- (save-excursion
- (when (dired-goto-file file-name)
- (if flagged
- (image-dired-dired-file-flagged-p)
- (image-dired-dired-file-marked-p))))))))
-
-(defun image-dired-thumb-file-flagged-p ()
- "Check if file is flagged for deletion in associated Dired buffer."
- (image-dired-thumb-file-marked-p t))
-
-(defun image-dired-delete-marked ()
- "Delete current or marked thumbnails and associated images."
- (interactive)
- (image-dired--with-marked
- (image-dired-delete-char)
- (unless (bobp)
- (backward-char)))
- (image-dired--line-up-with-method)
- (with-current-buffer (image-dired-associated-dired-buffer)
- (dired-do-delete)))
-
-(defun image-dired-thumb-update-marks ()
- "Update the marks in the thumbnail buffer."
- (when image-dired-thumb-visible-marks
- (with-current-buffer image-dired-thumbnail-buffer
- (save-mark-and-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (not (eobp))
- (with-silent-modifications
- (cond ((image-dired-thumb-file-marked-p)
- (add-face-text-property (point) (1+ (point))
- 'image-dired-thumb-mark))
- ((image-dired-thumb-file-flagged-p)
- (add-face-text-property (point) (1+ (point))
- 'image-dired-thumb-flagged))
- (t (remove-text-properties (point) (1+ (point))
- '(face
image-dired-thumb-mark)))))
- (forward-char)))))))
-
-(defun image-dired-mouse-toggle-mark-1 ()
- "Toggle Dired mark for current thumbnail.
-Track this in associated Dired buffer if
-`image-dired-track-movement' is non-nil."
- (when image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-toggle-mark-thumb-original-file))
-
-(defun image-dired-mouse-toggle-mark (event)
- "Use mouse EVENT to toggle Dired mark for thumbnail.
-Toggle marks of all thumbnails in region, if it's active.
-Track this in associated Dired buffer if
-`image-dired-track-movement' is non-nil."
- (interactive "e")
- (if (use-region-p)
- (let ((end (region-end)))
- (save-excursion
- (goto-char (region-beginning))
- (while (<= (point) end)
- (when (image-dired-image-at-point-p)
- (image-dired-mouse-toggle-mark-1))
- (forward-char))))
- (mouse-set-point event)
- (goto-char (posn-point (event-end event)))
- (image-dired-mouse-toggle-mark-1))
- (image-dired-thumb-update-marks))
-
-(defun image-dired-dired-display-properties ()
- "Display properties for Dired file in the echo area."
- (interactive)
- (let* ((file (dired-get-filename))
- (file-name (file-name-nondirectory file))
- (dired-buf (buffer-name (current-buffer)))
- (props (mapconcat #'identity (image-dired-list-tags file) ", "))
- (comment (image-dired-get-comment file))
- (message-log-max nil))
- (if file-name
- (message "%s"
- (image-dired-format-properties-string
- dired-buf
- file-name
- props
- comment)))))
-
-
-
-;;; Gallery support
-
-;; TODO:
-;; * Support gallery creation when using per-directory thumbnail
-;; storage.
-;; * Enhanced gallery creation with basic CSS-support and pagination
-;; of tag pages with many pictures.
-
-(defgroup image-dired-gallery nil
- "Image-Dired support for generating a HTML gallery."
- :prefix "image-dired-"
- :group 'image-dired
- :version "29.1")
-
-(defcustom image-dired-gallery-dir
- (expand-file-name ".image-dired_gallery" image-dired-dir)
- "Directory to store generated gallery html pages.
-The name of this directory needs to be \"shared\" to the public
-so that it can access the index.html page that image-dired creates."
- :type 'directory)
-
-(defcustom image-dired-gallery-image-root-url
- "https://example.org/image-diredpics";
- "URL where the full size images are to be found on your web server.
-Note that this URL has to be configured on your web server.
-Image-Dired expects to find pictures in this directory.
-This is used by `image-dired-gallery-generate'."
- :type 'string
- :version "29.1")
-
-(defcustom image-dired-gallery-thumb-image-root-url
- "https://example.org/image-diredthumbs";
- "URL where the thumbnail images are to be found on your web server.
-Note that URL path has to be configured on your web server.
-Image-Dired expects to find pictures in this directory.
-This is used by `image-dired-gallery-generate'."
- :type 'string
- :version "29.1")
-
-(defcustom image-dired-gallery-hidden-tags
- (list "private" "hidden" "pending")
- "List of \"hidden\" tags.
-Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
- :type '(repeat string))
-
-(defvar image-dired-tag-file-list nil
- "List to store tag-file structure.")
-
-(defvar image-dired-file-tag-list nil
- "List to store file-tag structure.")
-
-(defvar image-dired-file-comment-list nil
- "List to store file comments.")
-
-(defun image-dired--add-to-tag-file-lists (tag file)
- "Helper function used from `image-dired--create-gallery-lists'.
-
-Add TAG to FILE in one list and FILE to TAG in the other.
-
-Lisp structures look like the following:
-
-image-dired-file-tag-list:
-
- ((\"filename1\" \"tag1\" \"tag2\" \"tag3\" ...)
- (\"filename2\" \"tag1\" \"tag2\" \"tag3\" ...)
- ...)
-
-image-dired-tag-file-list:
-
- ((\"tag1\" \"filename1\" \"filename2\" \"filename3\" ...)
- (\"tag2\" \"filename1\" \"filename2\" \"filename3\" ...)
- ...)"
- ;; Add tag to file list
- (let (curr)
- (if image-dired-file-tag-list
- (if (setq curr (assoc file image-dired-file-tag-list))
- (setcdr curr (cons tag (cdr curr)))
- (setcdr image-dired-file-tag-list
- (cons (list file tag) (cdr image-dired-file-tag-list))))
- (setq image-dired-file-tag-list (list (list file tag))))
- ;; Add file to tag list
- (if image-dired-tag-file-list
- (if (setq curr (assoc tag image-dired-tag-file-list))
- (if (not (member file curr))
- (setcdr curr (cons file (cdr curr))))
- (setcdr image-dired-tag-file-list
- (cons (list tag file) (cdr image-dired-tag-file-list))))
- (setq image-dired-tag-file-list (list (list tag file))))))
-
-(defun image-dired--add-to-file-comment-list (file comment)
- "Helper function used from `image-dired--create-gallery-lists'.
-
-For FILE, add COMMENT to list.
-
-Lisp structure looks like the following:
-
-image-dired-file-comment-list:
-
- ((\"filename1\" . \"comment1\")
- (\"filename2\" . \"comment2\")
- ...)"
- (if image-dired-file-comment-list
- (if (not (assoc file image-dired-file-comment-list))
- (setcdr image-dired-file-comment-list
- (cons (cons file comment)
- (cdr image-dired-file-comment-list))))
- (setq image-dired-file-comment-list (list (cons file comment)))))
-
-(defun image-dired--create-gallery-lists ()
- "Create temporary lists used by `image-dired-gallery-generate'."
- (image-dired-sane-db-file)
- (image-dired--with-db-file
- (let (end beg file row-tags)
- (setq image-dired-tag-file-list nil)
- (setq image-dired-file-tag-list nil)
- (setq image-dired-file-comment-list nil)
- (goto-char (point-min))
- (while (search-forward-regexp "^." nil t)
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (setq beg (point))
- (unless (search-forward ";" end nil)
- (error "Something is really wrong, check format of database"))
- (setq row-tags (split-string
- (buffer-substring beg end) ";"))
- (setq file (car row-tags))
- (dolist (x (cdr row-tags))
- (if (not (string-match "^comment:\\(.*\\)" x))
- (image-dired--add-to-tag-file-lists x file)
- (image-dired--add-to-file-comment-list file (match-string 1 x)))))))
- ;; Sort tag-file list
- (setq image-dired-tag-file-list
- (sort image-dired-tag-file-list
- (lambda (x y)
- (string< (car x) (car y))))))
-
-(defun image-dired--hidden-p (file)
- "Return t if image FILE has a \"hidden\" tag."
- (cl-loop for tag in (cdr (assoc file image-dired-file-tag-list))
- if (member tag image-dired-gallery-hidden-tags) return t))
-
-(defun image-dired-gallery-generate ()
- "Generate gallery pages.
-First we create a couple of Lisp structures from the database to make
-it easier to generate, then HTML-files are created in
-`image-dired-gallery-dir'."
- (interactive)
- (if (eq 'per-directory image-dired-thumbnail-storage)
- (error "Currently, gallery generation is not supported \
-when using per-directory thumbnail file storage"))
- (image-dired--create-gallery-lists)
- (let ((tags image-dired-tag-file-list)
- (index-file (format "%s/index.html" image-dired-gallery-dir))
- count tag tag-file
- comment file-tags tag-link tag-link-list)
- ;; Make sure gallery root exist
- (if (file-exists-p image-dired-gallery-dir)
- (if (not (file-directory-p image-dired-gallery-dir))
- (error "Variable image-dired-gallery-dir is not a directory"))
- ;; FIXME: Should we set umask to 077 here, as we do for thumbnails?
- (make-directory image-dired-gallery-dir))
- ;; Open index file
- (with-temp-file index-file
- (if (file-exists-p index-file)
- (insert-file-contents index-file))
- (insert "<html>\n")
- (insert " <body>\n")
- (insert " <h2>Image-Dired Gallery</h2>\n")
- (insert (format "<p>\n Gallery generated %s\n <p>\n"
- (current-time-string)))
- (insert " <h3>Tag index</h3>\n")
- (setq count 1)
- ;; Pre-generate list of all tag links
- (dolist (curr tags)
- (setq tag (car curr))
- (when (not (member tag image-dired-gallery-hidden-tags))
- (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag))
- (if tag-link-list
- (setq tag-link-list
- (append tag-link-list (list (cons tag tag-link))))
- (setq tag-link-list (list (cons tag tag-link))))
- (setq count (1+ count))))
- (setq count 1)
- ;; Main loop where we generated thumbnail pages per tag
- (dolist (curr tags)
- (setq tag (car curr))
- ;; Don't display hidden tags
- (when (not (member tag image-dired-gallery-hidden-tags))
- ;; Insert link to tag page in index
- (insert (format " %s<br>\n" (cdr (assoc tag tag-link-list))))
- ;; Open per-tag file
- (setq tag-file (format "%s/%s.html" image-dired-gallery-dir count))
- (with-temp-file tag-file
- (if (file-exists-p tag-file)
- (insert-file-contents tag-file))
- (erase-buffer)
- (insert "<html>\n")
- (insert " <body>\n")
- (insert " <p><a href=\"index.html\">Index</a></p>\n")
- (insert (format " <h2>Images with tag "%s"</h2>" tag))
- ;; Main loop for files per tag page
- (dolist (file (cdr curr))
- (unless (image-dired-hidden-p file)
- ;; Insert thumbnail with link to full image
- (insert
- (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
- image-dired-gallery-image-root-url
- (file-name-nondirectory file)
- image-dired-gallery-thumb-image-root-url
- (file-name-nondirectory (image-dired-thumb-name file))
file))
- ;; Insert comment, if any
- (if (setq comment (cdr (assoc file
image-dired-file-comment-list)))
- (insert (format "<br>\n%s<br>\n" comment))
- (insert "<br>\n"))
- ;; Insert links to other tags, if any
- (when (> (length
- (setq file-tags (assoc file
image-dired-file-tag-list))) 2)
- (insert "[ ")
- (dolist (extra-tag file-tags)
- ;; Only insert if not file name or the main tag
- (if (and (not (equal extra-tag tag))
- (not (equal extra-tag file)))
- (insert
- (format "%s " (cdr (assoc extra-tag tag-link-list))))))
- (insert "]<br>\n"))))
- (insert " <p><a href=\"index.html\">Index</a></p>\n")
- (insert " </body>\n")
- (insert "</html>\n"))
- (setq count (1+ count))))
- (insert " </body>\n")
- (insert "</html>"))))
-
-
-;;; Tag support
-
-(defvar image-dired-widget-list nil
- "List to keep track of meta data in edit buffer.")
-
-(declare-function widget-forward "wid-edit" (arg))
-
-;;;###autoload
-(defun image-dired-dired-edit-comment-and-tags ()
- "Edit comment and tags of current or marked image files.
-Edit comment and tags for all marked image files in an
-easy-to-use form."
- (interactive)
- (setq image-dired-widget-list nil)
- ;; Setup buffer.
- (let ((files (dired-get-marked-files)))
- (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*")
- (kill-all-local-variables)
- (let ((inhibit-read-only t))
- (erase-buffer))
- (remove-overlays)
- ;; Some help for the user.
- (widget-insert
-"\nEdit comments and tags for each image. Separate multiple tags
-with a comma. Move forward between fields using TAB or RET.
-Move to the previous field using backtab (S-TAB). Save by
-activating the Save button at the bottom of the form or cancel
-the operation by activating the Cancel button.\n\n")
- ;; Here comes all images and a comment and tag field for each
- ;; image.
- (let (thumb-file img comment-widget tag-widget)
-
- (dolist (file files)
-
- (setq thumb-file (image-dired-thumb-name file)
- img (create-image thumb-file))
-
- (insert-image img)
- (widget-insert "\n\nComment: ")
- (setq comment-widget
- (widget-create 'editable-field
- :size 60
- :format "%v "
- :value (or (image-dired-get-comment file) "")))
- (widget-insert "\nTags: ")
- (setq tag-widget
- (widget-create 'editable-field
- :size 60
- :format "%v "
- :value (or (mapconcat
- #'identity
- (image-dired-list-tags file)
- ",") "")))
- ;; Save information in all widgets so that we can use it when
- ;; the user saves the form.
- (setq image-dired-widget-list
- (append image-dired-widget-list
- (list (list file comment-widget tag-widget))))
- (widget-insert "\n\n")))
-
- ;; Footer with Save and Cancel button.
- (widget-insert "\n")
- (widget-create 'push-button
- :notify
- (lambda (&rest _ignore)
- (image-dired-save-information-from-widgets)
- (bury-buffer)
- (message "Done"))
- "Save")
- (widget-insert " ")
- (widget-create 'push-button
- :notify
- (lambda (&rest _ignore)
- (bury-buffer)
- (message "Operation canceled"))
- "Cancel")
- (widget-insert "\n")
- (use-local-map widget-keymap)
- (widget-setup)
- ;; Jump to the first widget.
- (widget-forward 1)))
-
-(defun image-dired-save-information-from-widgets ()
- "Save information found in `image-dired-widget-list'.
-Use the information in `image-dired-widget-list' to save comments and
-tags to their respective image file. Internal function used by
-`image-dired-dired-edit-comment-and-tags'."
- (let (file comment tag-string tag-list lst)
- (image-dired-write-comments
- (mapcar
- (lambda (widget)
- (setq file (car widget)
- comment (widget-value (cadr widget)))
- (cons file comment))
- image-dired-widget-list))
- (image-dired-write-tags
- (dolist (widget image-dired-widget-list lst)
- (setq file (car widget)
- tag-string (widget-value (car (cddr widget)))
- tag-list (split-string tag-string ","))
- (dolist (tag tag-list)
- (push (cons file tag) lst))))))
-
-
-;;; bookmark.el support
-
-(declare-function bookmark-make-record-default
- "bookmark" (&optional no-file no-context posn))
-(declare-function bookmark-prop-get "bookmark" (bookmark prop))
-
-(defun image-dired-bookmark-name ()
- "Create a default bookmark name for the current EWW buffer."
- (file-name-nondirectory
- (directory-file-name
- (file-name-directory (image-dired-original-file-name)))))
-
-(defun image-dired-bookmark-make-record ()
- "Create a bookmark for the current EWW buffer."
- `(,(image-dired-bookmark-name)
- ,@(bookmark-make-record-default t)
- (location . ,(file-name-directory (image-dired-original-file-name)))
- (image-dired-file . ,(file-name-nondirectory
(image-dired-original-file-name)))
- (handler . image-dired-bookmark-jump)))
-
-;;;###autoload
-(defun image-dired-bookmark-jump (bookmark)
- "Default bookmark handler for Image-Dired buffers."
- ;; User already cached thumbnails, so disable any checking.
- (let ((image-dired-show-all-from-dir-max-files nil))
- (image-dired (bookmark-prop-get bookmark 'location))
- ;; TODO: Go to the bookmarked file, if it exists.
- ;; (bookmark-prop-get bookmark 'image-dired-file)
- (goto-char (point-min))))
-
-(put 'image-dired-bookmark-jump 'bookmark-handler-type "Image-Dired")
-
-;;; Obsolete
-
-;;;###autoload
-(define-obsolete-function-alias 'tumme #'image-dired "24.4")
-
-;;;###autoload
-(define-obsolete-function-alias 'image-dired-setup-dired-keybindings
- #'image-dired-minor-mode "26.1")
-
-(defcustom image-dired-temp-image-file
- (expand-file-name ".image-dired_temp" image-dired-dir)
- "Name of temporary image file used by various commands."
- :type 'file)
-(make-obsolete-variable 'image-dired-temp-image-file
- "no longer used." "29.1")
-
-(defcustom image-dired-cmd-create-temp-image-program
- (if (executable-find "gm") "gm" "convert")
- "Executable used to create temporary image.
-Used together with `image-dired-cmd-create-temp-image-options'."
- :type 'file
- :version "29.1")
-(make-obsolete-variable 'image-dired-cmd-create-temp-image-program
- "no longer used." "29.1")
-
-(defcustom image-dired-cmd-create-temp-image-options
- (let ((opts '("-size" "%wx%h" "%f[0]"
- "-resize" "%wx%h>"
- "-strip" "jpeg:%t")))
- (if (executable-find "gm") (cons "convert" opts) opts))
- "Options of command used to create temporary image for display window.
-Used together with `image-dired-cmd-create-temp-image-program',
-Available format specifiers are: %w and %h which are replaced by
-the calculated max size for width and height in the image display window,
-%f which is replaced by the file name of the original image and %t which
-is replaced by the file name of the temporary file."
- :version "29.1"
- :type '(repeat (string :tag "Argument")))
-(make-obsolete-variable 'image-dired-cmd-create-temp-image-options
- "no longer used." "29.1")
-
-(defcustom image-dired-display-window-width-correction 1
- "Number to be used to correct image display window width.
-Change if the default (1) does not work (i.e. if the image does not
-completely fit)."
- :type 'integer)
-(make-obsolete-variable 'image-dired-display-window-width-correction
- "no longer used." "29.1")
-
-(defcustom image-dired-display-window-height-correction 0
- "Number to be used to correct image display window height.
-Change if the default (0) does not work (i.e. if the image does not
-completely fit)."
- :type 'integer)
-(make-obsolete-variable 'image-dired-display-window-height-correction
- "no longer used." "29.1")
-
-(defun image-dired-display-window-width (window)
- "Return width, in pixels, of WINDOW."
- (declare (obsolete nil "29.1"))
- (- (image-dired-window-width-pixels window)
- image-dired-display-window-width-correction))
-
-(defun image-dired-display-window-height (window)
- "Return height, in pixels, of WINDOW."
- (declare (obsolete nil "29.1"))
- (- (image-dired-window-height-pixels window)
- image-dired-display-window-height-correction))
-
-(defun image-dired-window-height-pixels (window)
- "Calculate WINDOW height in pixels."
- (declare (obsolete nil "29.1"))
- ;; Note: The mode-line consumes one line
- (* (- (window-height window) 1) (frame-char-height)))
-
-(defcustom image-dired-cmd-read-exif-data-program "exiftool"
- "Program used to read EXIF data to image.
-Used together with `image-dired-cmd-read-exif-data-options'."
- :type 'file)
-(make-obsolete-variable 'image-dired-cmd-read-exif-data-program
- "use `exif-parse-file' and `exif-field' instead."
"29.1")
-
-(defcustom image-dired-cmd-read-exif-data-options '("-s" "-s" "-s" "-%t" "%f")
- "Arguments of command used to read EXIF data.
-Used with `image-dired-cmd-read-exif-data-program'.
-Available format specifiers are: %f which is replaced
-by the image file name and %t which is replaced by the tag name."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-(make-obsolete-variable 'image-dired-cmd-read-exif-data-options
- "use `exif-parse-file' and `exif-field' instead."
"29.1")
-
-(defun image-dired-get-exif-data (file tag-name)
- "From FILE, return EXIF tag TAG-NAME."
- (declare (obsolete "use `exif-parse-file' and `exif-field' instead."
"29.1"))
- (image-dired--check-executable-exists
- 'image-dired-cmd-read-exif-data-program)
- (let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
- (spec (list (cons ?f file) (cons ?t tag-name)))
- tag-value)
- (with-current-buffer buf
- (delete-region (point-min) (point-max))
- (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
- nil t nil
- (mapcar
- (lambda (arg) (format-spec arg spec))
- image-dired-cmd-read-exif-data-options))
- 0))
- (error "Could not get EXIF tag")
- (goto-char (point-min))
- ;; Clean buffer from newlines and carriage returns before
- ;; getting final info
- (while (search-forward-regexp "[\n\r]" nil t)
- (replace-match "" nil t))
- (setq tag-value (buffer-substring (point-min) (point-max)))))
- tag-value))
-
-(defcustom image-dired-cmd-rotate-thumbnail-program
- (if (executable-find "gm") "gm" "mogrify")
- "Executable used to rotate thumbnail.
-Used together with `image-dired-cmd-rotate-thumbnail-options'."
- :type 'file
- :version "29.1")
-(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-program nil "29.1")
-
-(defcustom image-dired-cmd-rotate-thumbnail-options
- (let ((opts '("-rotate" "%d" "%t")))
- (if (executable-find "gm") (cons "mogrify" opts) opts))
- "Arguments of command used to rotate thumbnail image.
-Used with `image-dired-cmd-rotate-thumbnail-program'.
-Available format specifiers are: %d which is replaced by the
-number of (positive) degrees to rotate the image, normally 90 or 270
-\(for 90 degrees right and left), %t which is replaced by the file name
-of the thumbnail file."
- :version "29.1"
- :type '(repeat (string :tag "Argument")))
-(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1")
-
-(defun image-dired-rotate-thumbnail (degrees)
- "Rotate thumbnail DEGREES degrees."
- (declare (obsolete image-dired-refresh-thumb "29.1"))
- (image-dired--check-executable-exists
- 'image-dired-cmd-rotate-thumbnail-program)
- (if (not (image-dired-image-at-point-p))
- (message "No thumbnail at point")
- (let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
- (thumb (expand-file-name file))
- (spec (list (cons ?d degrees) (cons ?t thumb))))
- (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil
nil
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-rotate-thumbnail-options))
- (clear-image-cache thumb))))
-
-(defun image-dired-rotate-thumbnail-left ()
- "Rotate thumbnail left (counter clockwise) 90 degrees."
- (declare (obsolete image-dired-refresh-thumb "29.1"))
- (interactive)
- (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
- (image-dired-rotate-thumbnail "270")))
-
-(defun image-dired-rotate-thumbnail-right ()
- "Rotate thumbnail counter right (clockwise) 90 degrees."
- (declare (obsolete image-dired-refresh-thumb "29.1"))
- (interactive)
- (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
- (image-dired-rotate-thumbnail "90")))
-
-(defun image-dired-modify-mark-on-thumb-original-file (command)
- "Modify mark in Dired buffer.
-COMMAND is one of `mark' for marking file in Dired, `unmark' for
-unmarking file in Dired or `flag' for flagging file for delete in
-Dired."
- (declare (obsolete image-dired--on-file-in-dired-buffer "29.1"))
- (let ((file-name (image-dired-original-file-name))
- (dired-buf (image-dired-associated-dired-buffer)))
- (if (not (and dired-buf file-name))
- (message "No image, or image with correct properties, at point")
- (with-current-buffer dired-buf
- (message "%s" file-name)
- (when (dired-goto-file file-name)
- (cond ((eq command 'mark) (dired-mark 1))
- ((eq command 'unmark) (dired-unmark 1))
- ((eq command 'toggle)
- (if (image-dired-dired-file-marked-p)
- (dired-unmark 1)
- (dired-mark 1)))
- ((eq command 'flag) (dired-flag-file-deletion 1)))
- (image-dired-thumb-update-marks))))))
-
-(defun image-dired-display-current-image-full ()
- "Display current image in full size."
- (declare (obsolete image-transform-original "29.1"))
- (interactive nil image-dired-thumbnail-mode)
- (let ((file (image-dired-original-file-name)))
- (if file
- (progn
- (image-dired-display-image file)
- (with-current-buffer image-dired-display-image-buffer
- (image-transform-original)))
- (error "No original file name at point"))))
-
-(defun image-dired-display-current-image-sized ()
- "Display current image in sized to fit window dimensions."
- (declare (obsolete image-mode-fit-frame "29.1"))
- (interactive nil image-dired-thumbnail-mode)
- (let ((file (image-dired-original-file-name)))
- (if file
- (progn
- (image-dired-display-image file))
- (error "No original file name at point"))))
-
-(defun image-dired-add-to-tag-file-list (tag file)
- "Add relation between TAG and FILE."
- (declare (obsolete nil "29.1"))
- (let (curr)
- (if image-dired-tag-file-list
- (if (setq curr (assoc tag image-dired-tag-file-list))
- (if (not (member file curr))
- (setcdr curr (cons file (cdr curr))))
- (setcdr image-dired-tag-file-list
- (cons (list tag file) (cdr image-dired-tag-file-list))))
- (setq image-dired-tag-file-list (list (list tag file))))))
-
-(defun image-dired-display-thumb-properties ()
- "Display thumbnail properties in the echo area."
- (declare (obsolete image-dired-update-header-line "29.1"))
- (image-dired-update-header-line))
-
-(defvar image-dired-slideshow-count 0
- "Keeping track on number of images in slideshow.")
-(make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1")
-
-(defvar image-dired-slideshow-times 0
- "Number of pictures to display in slideshow.")
-(make-obsolete-variable 'image-dired-slideshow-times "no longer used." "29.1")
-
-(define-obsolete-function-alias 'image-dired-create-display-image-buffer
- #'ignore "29.1")
-(define-obsolete-function-alias 'image-dired-create-gallery-lists
- #'image-dired--create-gallery-lists "29.1")
-(define-obsolete-function-alias 'image-dired-add-to-file-comment-list
- #'image-dired--add-to-file-comment-list "29.1")
-(define-obsolete-function-alias 'image-dired-add-to-tag-file-lists
- #'image-dired--add-to-tag-file-lists "29.1")
-(define-obsolete-function-alias 'image-dired-hidden-p
- #'image-dired--hidden-p "29.1")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;; TEST-SECTION ;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defvar image-dired-dir-max-size 12300000)
-
-;; (defun image-dired-test-clean-old-files ()
-;; "Clean `image-dired-dir' from old thumbnail files.
-;; \"Oldness\" measured using last access time. If the total size of all
-;; thumbnail files in `image-dired-dir' is larger than
'image-dired-dir-max-size',
-;; old files are deleted until the max size is reached."
-;; (let* ((files
-;; (sort
-;; (mapcar
-;; (lambda (f)
-;; (let ((fattribs (file-attributes f)))
-;; `(,(file-attribute-access-time fattribs)
-;; ,(file-attribute-size fattribs) ,f)))
-;; (directory-files (image-dired-dir) t ".+\\.thumb\\..+$"))
-;; ;; Sort function. Compare time between two files.
-;; (lambda (l1 l2)
-;; (time-less-p (car l1) (car l2)))))
-;; (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
-;; (while (> dirsize image-dired-dir-max-size)
-;; (y-or-n-p
-;; (format "Size of thumbnail directory: %d, delete old file %s? "
-;; dirsize (cadr (cdar files))))
-;; (delete-file (cadr (cdar files)))
-;; (setq dirsize (- dirsize (car (cdar files))))
-;; (setq files (cdr files)))))
-
-(provide 'image-dired)
-
-;;; image-dired.el ends here
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 0ed88e8e74..63f9e1100c 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -91,9 +91,10 @@ the variable is set using \\[customize]."
"\\'"))))
(mapconcat
#'identity
- (delq nil (list exts-regexp
- image-file-name-regexps
- (car (rassq 'imagemagick image-type-file-name-regexps))))
+ (delq nil
+ (nconc (list exts-regexp
+ (car (rassq 'imagemagick
image-type-file-name-regexps)))
+ (ensure-list image-file-name-regexps)))
"\\|")))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 9485f1e006..bd208fbad4 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -498,8 +498,8 @@ image as text, when opening such images in `image-mode'."
"s s" #'image-transform-set-scale
"s r" #'image-transform-set-rotation
"s m" #'image-transform-set-smoothing
- "s o" #'image-transform-original
- "s 0" #'image-transform-reset
+ "s o" #'image-transform-reset-to-original
+ "s 0" #'image-transform-reset-to-initial
;; Multi-frame keys
"RET" #'image-toggle-animation
@@ -523,6 +523,9 @@ image as text, when opening such images in `image-mode'."
"S-SPC" #'image-scroll-down
"DEL" #'image-scroll-down
+ ;; Misc
+ "W" #'image-mode-wallpaper-set
+
;; Remapped
"<remap> <forward-char>" #'image-forward-hscroll
"<remap> <backward-char>" #'image-backward-hscroll
@@ -567,9 +570,9 @@ image as text, when opening such images in `image-mode'."
:help "Set rotation angle of the image"]
["Set Smoothing..." image-transform-set-smoothing
:help "Toggle smoothing"]
- ["Original Size" image-transform-original
+ ["Original Size" image-transform-reset-to-original
:help "Reset image to actual size"]
- ["Reset to Default Size" image-transform-reset
+ ["Reset to Default Size" image-transform-reset-to-initial
:help "Reset all image transformations to initial size"]
"--"
["Show Thumbnails"
@@ -663,6 +666,9 @@ Key bindings:
"(New file)")
"Empty buffer"))
(image-mode--display)
+ (setq-local image-crop-buffer-text-function
+ ;; Use the binary image data directly for the buffer text.
+ (lambda (_text image) image))
;; Ensure that we recognize externally parsed image formats in
;; commands like `n'.
(when image-use-external-converter
@@ -1051,7 +1057,13 @@ Otherwise, display the image by calling `image-mode'."
(defun image-fit-to-window (window)
"Adjust size of image to display it exactly in WINDOW boundaries."
- (when (window-live-p window)
+ (when (and (window-live-p window)
+ ;; Don't resize anything if we're in the minibuffer
+ ;; (which may transitively change the window sizes if you
+ ;; hit TAB, for instance).
+ (not (minibuffer-window-active-p (selected-window)))
+ ;; Don't resize if there's a message in the echo area.
+ (not (current-message)))
(with-current-buffer (window-buffer window)
(when (derived-mode-p 'image-mode)
(let ((spec (image-get-display-property)))
@@ -1262,7 +1274,7 @@ If N is negative, go to the previous file."
(save-window-excursion
(switch-to-buffer (cdr buffer) t t)
(cl-case (car buffer)
- ('dired
+ (dired
(dired-goto-file file)
(let (found)
(while (and (not found)
@@ -1280,9 +1292,9 @@ If N is negative, go to the previous file."
;; If we didn't find a next/prev file, then restore
;; point.
(dired-goto-file file))))
- ('archive
+ (archive
(setq next (archive-next-file-displayer file regexp n)))
- ('tar
+ (tar
(setq next (tar-next-file-displayer file regexp n))))))
next))
@@ -1358,16 +1370,6 @@ If no such buffer exists, it will be opened."
(message "%s%s" (capitalize (substring string 0 1))
(substring string 1)))))
-(defun image-mode--images-in-directory (file)
- (let* ((dir (file-name-directory buffer-file-name))
- (files (directory-files dir nil
- (image-file-name-regexp) t)))
- ;; Add the current file to the list of images if necessary, in
- ;; case it does not match `image-file-name-regexp'.
- (unless (member file files)
- (push file files))
- (sort files 'string-lessp)))
-
;;; Support for bookmark.el
(declare-function bookmark-make-record-default
@@ -1387,7 +1389,18 @@ If no such buffer exists, it will be opened."
(prog1 (bookmark-default-handler bmk)
(when (not (string= image-type (bookmark-prop-get bmk 'image-type)))
(image-toggle-display))))
+
+;;; Setting the wallpaper
+
+(defun image-mode-wallpaper-set ()
+ "Set the desktop background to the current image.
+This uses `wallpaper-set' (which see)."
+ (interactive nil image-mode)
+ (wallpaper-set buffer-file-name))
+
+
+;;; Image transformation
(defsubst image-transform-width (width height)
"Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
@@ -1593,14 +1606,14 @@ ROTATION should be in degrees."
(setq image--transform-smoothing smoothing)
(image-toggle-display-image))
-(defun image-transform-original ()
+(defun image-transform-reset-to-original ()
"Display the current image with the original (actual) size and rotation."
(interactive nil image-mode)
(setq image-transform-resize nil
image-transform-scale 1)
(image-toggle-display-image))
-(defun image-transform-reset ()
+(defun image-transform-reset-to-initial ()
"Display the current image with the default (initial) size and rotation."
(interactive nil image-mode)
(setq image-transform-resize image-auto-resize
@@ -1609,6 +1622,20 @@ ROTATION should be in degrees."
image--transform-smoothing nil)
(image-toggle-display-image))
+(defun image-mode--images-in-directory (file)
+ (declare (obsolete nil "29.1"))
+ (let* ((dir (file-name-directory buffer-file-name))
+ (files (directory-files dir nil
+ (image-file-name-regexp) t)))
+ ;; Add the current file to the list of images if necessary, in
+ ;; case it does not match `image-file-name-regexp'.
+ (unless (member file files)
+ (push file files))
+ (sort files 'string-lessp)))
+
+(define-obsolete-function-alias 'image-transform-original
#'image-transform-reset-to-original "29.1")
+(define-obsolete-function-alias 'image-transform-reset
#'image-transform-reset-to-initial "29.1")
+
(provide 'image-mode)
;;; image-mode.el ends here
diff --git a/lisp/image.el b/lisp/image.el
index 9311125450..b6817d3fda 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -174,12 +174,15 @@ or \"ffmpeg\") is installed."
(defvar-keymap image-map
:doc "Map put into text properties on images."
- "-" #'image-decrease-size
- "+" #'image-increase-size
- "r" #'image-rotate
- "o" #'image-save
- "h" #'image-flip-horizontally
- "v" #'image-flip-vertically
+ "i" (define-keymap
+ "-" #'image-decrease-size
+ "+" #'image-increase-size
+ "r" #'image-rotate
+ "o" #'image-save
+ "c" #'image-crop
+ "x" #'image-cut
+ "h" #'image-flip-horizontally
+ "v" #'image-flip-vertically)
"C-<wheel-down>" #'image-mouse-decrease-size
"C-<mouse-5>" #'image-mouse-decrease-size
"C-<wheel-up>" #'image-mouse-increase-size
@@ -474,8 +477,9 @@ must be available."
;;;###autoload
(defun create-image (file-or-data &optional type data-p &rest props)
- "Create an image.
-FILE-OR-DATA is an image file name or image data.
+ "Create an image from FILE-OR-DATA.
+FILE-OR-DATA is an image file name or image data. If it is a relative
+file name, the function will look for it along `image-load-path'.
Optional TYPE is a symbol describing the image type. If TYPE is omitted
or nil, try to determine the image type from its first few bytes
@@ -492,11 +496,7 @@ automatically scaled up in proportion to the default font.
Value is the image created, or nil if images of type TYPE are not supported.
-Images should not be larger than specified by `max-image-size'.
-
-Image file names that are not absolute are searched for in the
-\"images\" sub-directory of `data-directory' and
-`x-bitmap-file-path' (in that order)."
+Images should not be larger than specified by `max-image-size'."
(let ((data-format
;; Pass the image format, if any, if this is data.
(and data-p (or (plist-get props :format) t))))
@@ -1152,41 +1152,43 @@ has no effect."
(imagemagick-register-types)
+(defvar-keymap image--repeat-map
+ "+" #'image-increase-size
+ "-" #'image-decrease-size
+ "r" #'image-rotate)
+
(defun image-increase-size (&optional n position)
"Increase the image size by a factor of N.
If N is 3, then the image size will be increased by 30%. The
default is 20%."
(interactive "P")
+ (image--delayed-change-size (if n
+ (1+ (/ (prefix-numeric-value n) 10.0))
+ 1.2)
+ position)
+ (set-transient-map image--repeat-map nil nil
+ "Use %k for further adjustments"))
+
+(defun image--delayed-change-size (size position)
;; Wait for a bit of idle-time before actually performing the change,
;; so as to batch together sequences of closely consecutive size changes.
;; `image--change-size' just changes one value in a plist. The actual
;; image resizing happens later during redisplay. So if those
;; consecutive calls happen without any redisplay between them,
;; the costly operation of image resizing should happen only once.
- (run-with-idle-timer 0.3 nil
- #'image--change-size
- (if n
- (1+ (/ (prefix-numeric-value n) 10.0))
- 1.2)
- position))
+ (run-with-idle-timer 0.3 nil #'image--change-size size position))
(defun image-decrease-size (&optional n position)
"Decrease the image size by a factor of N.
If N is 3, then the image size will be decreased by 30%. The
default is 20%."
(interactive "P")
- ;; Wait for a bit of idle-time before actually performing the change,
- ;; so as to batch together sequences of closely consecutive size changes.
- ;; `image--change-size' just changes one value in a plist. The actual
- ;; image resizing happens later during redisplay. So if those
- ;; consecutive calls happen without any redisplay between them,
- ;; the costly operation of image resizing should happen only once.
- (run-with-idle-timer 0.3 nil
- #'image--change-size
- (if n
- (- 1 (/ (prefix-numeric-value n) 10.0))
- 0.8)
- position))
+ (image--delayed-change-size (if n
+ (- 1 (/ (prefix-numeric-value n) 10.0))
+ 0.8)
+ position)
+ (set-transient-map image--repeat-map nil nil
+ "Use %k for further adjustments"))
(defun image-mouse-increase-size (&optional event)
"Increase the image size using the mouse."
@@ -1271,7 +1273,9 @@ rotations by only multiples of 90 degrees."
(or angle 90))
;; We don't want to exceed 360 degrees rotation,
;; because it's not seen as valid in Exif data.
- 360)))))
+ 360))))
+ (set-transient-map image--repeat-map nil nil
+ "Use %k for further adjustments"))
(defun image-save ()
"Save the image under point.
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index b25968af53..53d2074ed7 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -271,13 +271,13 @@ VALUE is an integer representing BYTES characters."
"Do type-based post-processing of the value."
(cl-case type
;; Chop off trailing zero byte.
- ('ascii (substring value 0 (1- (length value))))
- ('rational (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert value)
- (goto-char (point-min))
- (cons (exif--read-number 4 le)
- (exif--read-number 4 le))))
+ (ascii (substring value 0 (1- (length value))))
+ (rational (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert value)
+ (goto-char (point-min))
+ (cons (exif--read-number 4 le)
+ (exif--read-number 4 le))))
(otherwise value)))
(defun exif--read-chunk (bytes)
diff --git a/lisp/image/image-crop.el b/lisp/image/image-crop.el
new file mode 100644
index 0000000000..7fbbf85f93
--- /dev/null
+++ b/lisp/image/image-crop.el
@@ -0,0 +1,452 @@
+;;; image-crop.el --- Image Cropping -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Keywords: multimedia
+
+;; 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 package provides an interface for cropping images
+;; interactively, but relies on external programs to do the actual
+;; modifications to files.
+
+;;; Code:
+
+(require 'svg)
+(require 'text-property-search)
+(eval-when-compile (require 'subr-x))
+
+(defvar image-scaling-factor)
+(declare-function image-property "image.el" (image property))
+(declare-function image-size "image.c" (spec &optional pixels frame))
+(declare-function imagep "image.c" (spec))
+
+(defgroup image-crop ()
+ "Image cropping."
+ :group 'image)
+
+(defvar image-crop-exif-rotate nil
+ "If non-nil, rotate images by updating exif data.
+If nil, rotate the images \"physically\".")
+
+(defcustom image-crop-resize-command '("convert" "-resize" "%wx" "-" "%f:-")
+ "Command to resize an image.
+The following `format-spec' elements are allowed:
+
+%w: Width.
+%f: Result file type."
+ :type '(repeat string)
+ :version "29.1")
+
+(defcustom image-crop-cut-command '("convert" "-draw" "rectangle %l,%t %r,%b"
+ "-fill" "%c"
+ "-" "%f:-")
+ "Command to cut a rectangle out of an image.
+
+The following `format-spec' elements are allowed:
+%l: Left.
+%t: Top.
+%r: Right.
+%b: Bottom.
+%c: Color.
+%f: Result file type."
+ :type '(repeat string)
+ :version "29.1")
+
+(defcustom image-crop-crop-command '("convert" "+repage" "-crop" "%wx%h+%l+%t"
+ "-" "%f:-")
+ "Command to crop an image.
+
+The following `format-spec' elements are allowed:
+%l: Left.
+%t: Top.
+%w: Width.
+%h: Height.
+%f: Result file type."
+ :type '(repeat string)
+ :version "29.1")
+
+(defcustom image-crop-rotate-command '("convert" "-rotate" "%r" "-" "%f:-")
+ "Command to rotate an image.
+
+The following `format-spec' elements are allowed:
+%r: Rotation (in degrees).
+%f: Result file type."
+ :type '(repeat string)
+ :version "29.1")
+
+(defvar image-crop-buffer-text-function #'image-crop--default-buffer-text
+ "Function to return the buffer text for the cropped image.
+After cropping an image, the displayed image will be updated to
+show the cropped image in the buffer. Different modes will have
+different ways to represent this image data in a buffer. For
+instance, an HTML-based mode might want to represent the image
+with <img src=\"data:...base64...\">, but that's up to the mode.
+
+The default action is to not alter the buffer text at all.
+
+The function is called with two arguments: The first is the
+original buffer text, and the second parameter is the cropped
+image data.")
+
+(defcustom image-cut-color "black"
+ "Color to use for the rectangle cut from the image."
+ :type 'string
+ :version "29.1")
+
+;;;###autoload
+(defun image-cut (&optional color)
+ "Cut a rectangle from the image under point, filling it with COLOR.
+COLOR defaults to the value of `image-cut-color'.
+Interactively, with prefix argument, prompt for COLOR to use."
+ (interactive (list (and current-prefix-arg (read-color "Use color: "))))
+ (image-crop (if (zerop (length color)) image-cut-color color)))
+
+;;;###autoload
+(defun image-crop (&optional cut)
+ "Crop the image under point.
+If CUT is non-nil, remove a rectangle from the image instead of
+cropping the image. In that case CUT should be the name of a
+color to fill the rectangle.
+
+While cropping the image, the following key bindings are available:
+
+`q': Exit without changing anything.
+`RET': Crop/cut the image.
+`m': Make mouse movements move the rectangle instead of altering the
+ rectangle shape.
+`s': Same as `m', but make the rectangle into a square first.
+
+After cropping an image, you can save it by `M-x image-save' or
+\\<image-map>\\[image-save] when point is over the image."
+ (interactive)
+ (unless (image-type-available-p 'svg)
+ (error "SVG support is needed to crop images"))
+ (unless (executable-find (car image-crop-crop-command))
+ (error "Couldn't find %s command to crop the image"
+ (car image-crop-crop-command)))
+ (let ((image (get-text-property (point) 'display)))
+ (unless (imagep image)
+ (user-error "No image under point"))
+ (when (overlays-at (point))
+ (user-error "Can't edit images that have overlays"))
+ ;; We replace the image under point with an SVG image that looks
+ ;; just like that image. That allows us to draw lines over it.
+ ;; At the end, we replace that SVG with a cropped version of the
+ ;; original image.
+ (let* ((data (cl-getf (cdr image) :data))
+ (undo-handle (prepare-change-group))
+ (type (cond
+ ((cl-getf (cdr image) :format)
+ (format "%s" (cl-getf (cdr image) :format)))
+ (data
+ (image-crop--content-type data))))
+ (image-scaling-factor 1)
+ (orig-point (point))
+ (size (image-size image t))
+ (svg (svg-create (car size) (cdr size)
+ :xmlns:xlink "http://www.w3.org/1999/xlink";
+ :stroke-width 5))
+ ;; We want to get the original text that's covered by the
+ ;; image so that we can restore it.
+ (image-start
+ (save-excursion
+ (let ((match (text-property-search-backward 'display image)))
+ (if match
+ (prop-match-end match)
+ (point-min)))))
+ (image-end
+ (save-excursion
+ (let ((match (text-property-search-forward 'display image)))
+ (if match
+ (prop-match-beginning match)
+ (point-max)))))
+ (text (buffer-substring image-start image-end))
+ (inhibit-read-only t)
+ orig-data svg-end)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (if (null data)
+ (insert-file-contents-literally (cl-getf (cdr image) :file))
+ (insert data))
+ (let ((image-crop-exif-rotate nil))
+ (image-crop--possibly-rotate-buffer image))
+ (setq orig-data (buffer-string))
+ (setq type (image-crop--content-type orig-data))
+ (image-crop--process image-crop-resize-command
+ `((?w . 600)
+ (?f . ,(cadr (split-string type "/")))))
+ (setq data (buffer-string)))
+ (svg-embed svg data type t
+ :width (car size)
+ :height (cdr size))
+ (with-buffer-unmodified-if-unchanged
+ (delete-region image-start image-end)
+ (svg-insert-image svg)
+ (setq svg-end (point))
+ (let ((area (condition-case _
+ (save-excursion
+ (forward-line 1)
+ (image-crop--crop-image-1
+ svg (if cut "cut" "crop")))
+ (quit nil))))
+ (message (substitute-command-keys
+ "Type \\[image-save] to save %s image to file")
+ (if cut "cut" "cropped"))
+ (delete-region image-start svg-end)
+ (if area
+ (image-crop--crop-image-update
+ area orig-data size type cut text)
+ ;; If the user didn't complete the crop, re-insert the
+ ;; original image (and text).
+ (insert text)
+ (goto-char orig-point))
+ (undo-amalgamate-change-group undo-handle))))))
+
+(defun image-crop--crop-image-update (area data size type cut text)
+ (let* ((image-scaling-factor 1)
+ (osize (image-size (create-image data nil t) t))
+ (factor (/ (float (car osize)) (car size)))
+ ;; width x height + left + top
+ (width (abs (truncate (* factor (- (cl-getf area :right)
+ (cl-getf area :left))))))
+ (height (abs (truncate (* factor (- (cl-getf area :bottom)
+ (cl-getf area :top))))))
+ (left (truncate (* factor (min (cl-getf area :left)
+ (cl-getf area :right)))))
+ (top (truncate (* factor (min (cl-getf area :top)
+ (cl-getf area :bottom))))))
+ (image-crop--insert-image-data
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert data)
+ (if cut
+ (image-crop--process image-crop-cut-command
+ `((?l . ,left)
+ (?t . ,top)
+ (?r . ,(+ left width))
+ (?b . ,(+ top height))
+ (?c . ,cut)
+ (?f . ,(cadr (split-string type "/")))))
+ (image-crop--process image-crop-crop-command
+ `((?l . ,left)
+ (?t . ,top)
+ (?w . ,width)
+ (?h . ,height)
+ (?f . ,(cadr (split-string type "/"))))))
+ (buffer-string))
+ text)))
+
+(defun image-crop--width (area)
+ (- (plist-get area :right) (plist-get area :left)))
+
+(defun image-crop--height (area)
+ (- (plist-get area :bottom) (plist-get area :top)))
+
+(defun image-crop--crop-image-1 (svg op)
+ (track-mouse
+ (cl-loop
+ with prompt = (format
+ (substitute-command-keys
+ "Select area for %s (click \\`mouse-1' and drag)")
+ op)
+ and state = 'begin
+ and area = (list :left 0
+ :top 0
+ :right 0
+ :bottom 0)
+ and corner = nil
+ for event = (read-event prompt)
+ do (cond
+ ;; Go to "square" mode.
+ ((eql event ?s)
+ (setq state 'move-unclick
+ prompt (format "Move square for %s" op))
+ (let ((size (min (image-crop--width area) (image-crop--height
area))))
+ (setf (plist-get area :right) (+ (plist-get area :left) size)
+ (plist-get area :bottom) (+ (plist-get area :top) size))))
+ ;; Go to "move" move.
+ ((eql event ?m)
+ (setq state 'move-unclick
+ prompt (format "Move for %s" op)))
+ ;; We have a (relevant) mouse event.
+ ((and (consp event)
+ (consp (cadr event))
+ (nth 7 (cadr event))
+ ;; Only do things if point is over the SVG being
+ ;; tracked.
+ (eq (cl-getf (cdr (nth 7 (cadr event))) :type)
+ 'svg))
+ (let ((pos (nth 8 (cadr event))))
+ (cl-case state
+ (begin
+ (cond
+ ((eq (car event) 'down-mouse-1)
+ (setq state 'stretch
+ prompt (format "Stretch to end point for %s" op))
+ (setf (cl-getf area :left) (car pos)
+ (cl-getf area :top) (cdr pos)
+ (cl-getf area :right) (car pos)
+ (cl-getf area :bottom) (cdr pos)))))
+ (stretch
+ (cond
+ ((eq (car event) 'mouse-movement)
+ (setf (cl-getf area :right) (car pos)
+ (cl-getf area :bottom) (cdr pos)))
+ ((memq (car event) '(mouse-1 drag-mouse-1))
+ (setq state 'corner
+ prompt (format
+ (substitute-command-keys
+ (concat
+ "Type \\`RET' to %s, or click and drag "
+ "\\`mouse-1' to adjust corners"))
+ op)))))
+ (corner
+ (cond
+ ((eq (car event) 'down-mouse-1)
+ ;; Find out what corner we're close to.
+ (setq corner (image-crop--find-corner
+ area pos
+ '((:left :top)
+ (:left :bottom)
+ (:right :top)
+ (:right :bottom))))
+ (when corner
+ (setq state 'adjust
+ prompt (format
+ (substitute-command-keys
+ "Adjusting %s area (release \\`mouse-1' to
confirm)")
+ op))))))
+ (adjust
+ (cond
+ ((memq (car event) '(mouse drag-mouse-1))
+ (setq state 'corner
+ prompt (format "Choose corner to adjust area for %s"
op)))
+ ((eq (car event) 'mouse-movement)
+ (setf (cl-getf area (car corner)) (car pos)
+ (cl-getf area (cadr corner)) (cdr pos)))))
+ (move-unclick
+ (cond
+ ((eq (car event) 'down-mouse-1)
+ (setq state 'move-click
+ prompt (format "Move for %s" op)))))
+ (move-click
+ (cond
+ ((eq (car event) 'mouse-movement)
+ (setf (cl-getf area :right)
+ (+ (car pos) (image-crop--width area)))
+ (setf (cl-getf area :left) (car pos))
+ (setf (cl-getf area :bottom)
+ (+ (cdr pos) (image-crop--height area)))
+ (setf (cl-getf area :top) (cdr pos)))
+ ((memq (car event) '(mouse-1 drag-mouse-1))
+ (setq state 'move-unclick
+ prompt (format "Click to move for %s" op)))))))))
+ do (svg-rectangle svg (cl-getf area :left) (cl-getf area :top)
+ (image-crop--width area) (image-crop--height area)
+ :stroke-color "red" :stroke-width 2
+ :fill-opacity 0.3 :fill "black" :id "rect")
+ while (not (member event '(return ?q)))
+ finally (return (and (eq event 'return)
+ area)))))
+
+(defun image-crop--find-corner (area pos corners)
+ (cl-loop for corner in corners
+ ;; We accept 10 pixels off.
+ when (and (< (- (car pos) 10)
+ (cl-getf area (car corner))
+ (+ (car pos) 10))
+ (< (- (cdr pos) 10)
+ (cl-getf area (cadr corner))
+ (+ (cdr pos) 10)))
+ return corner))
+
+(defun image-crop--content-type (image)
+ ;; Get the MIME type by running "file" over it.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (call-process-region (point-min) (point-max)
+ "file" t (current-buffer) nil
+ "--mime-type" "-")
+ (cadr (split-string (buffer-string)))))
+
+(defun image-crop--possibly-rotate-buffer (image)
+ (when (imagep image)
+ (let ((content-type (image-crop--content-type (buffer-string))))
+ (when (image-property image :rotation)
+ (cond
+ ;; We can rotate jpegs losslessly by setting the correct
+ ;; orientation.
+ ((and image-crop-exif-rotate
+ (equal content-type "image/jpeg")
+ (executable-find "exiftool"))
+ (call-process-region
+ (point-min) (point-max) "exiftool" t (list (current-buffer) nil) nil
+ (format "-Orientation#=%d"
+ (cl-case (truncate (image-property image :rotation))
+ (0 0)
+ (90 6)
+ (180 3)
+ (270 8)
+ (otherwise 0)))
+ "-o" "-" "-"))
+ ;; Most other image formats have to be reencoded to do
+ ;; rotation.
+ (t
+ (image-crop--process
+ image-crop-rotate-command
+ `((?r . ,(image-property image :rotation))
+ (?f . ,(cadr (split-string content-type "/")))))
+ (when (and (equal content-type "image/jpeg")
+ (executable-find "exiftool"))
+ (call-process-region
+ (point-min) (point-max) "exiftool"
+ t (list (current-buffer) nil) nil
+ "-Orientation#=0"
+ "-o" "-" "-")))))
+ (when (image-property image :width)
+ (image-crop--process
+ image-crop-resize-command
+ `((?w . ,(image-property image :width))
+ (?f . ,(cadr (split-string content-type "/")))))))))
+
+(defun image-crop--insert-image-data (image text)
+ (insert-image
+ (create-image image nil t
+ :max-width (- (frame-pixel-width) 50)
+ :max-height (- (frame-pixel-height) 150))
+ (funcall image-crop-buffer-text-function text image)
+ nil nil t))
+
+(defun image-crop--process (command expansions)
+ "Use `call-process-region' with COMMAND expanded with EXPANSIONS."
+ (apply
+ #'call-process-region (point-min) (point-max)
+ (format-spec (car command) expansions)
+ t (list (current-buffer) nil) nil
+ (mapcar (lambda (elem)
+ (format-spec elem expansions))
+ (cdr command))))
+
+(defun image-crop--default-buffer-text (text _image)
+ (substring-no-properties text))
+
+(provide 'image-crop)
+
+;;; image-crop.el ends here
diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el
new file mode 100644
index 0000000000..46adf3f26f
--- /dev/null
+++ b/lisp/image/image-dired-dired.el
@@ -0,0 +1,412 @@
+;;; image-dired-dired.el --- Dired specific commands for Image-Dired -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
+
+;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
+;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: multimedia
+
+;; 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:
+
+;; See the description of the `image-dired' package.
+
+;;; Code:
+
+(require 'image-dired)
+
+(defgroup image-dired-dired nil
+ "Dired specific commands for Image-Dired."
+ :prefix "image-dired-dired-"
+ :link '(info-link "(emacs) Image-Dired")
+ :group 'image-dired)
+
+(define-obsolete-variable-alias 'image-dired-append-when-browsing
+ 'image-dired-dired-append-when-browsing "29.1")
+(defcustom image-dired-dired-append-when-browsing nil
+ "Append thumbnails in thumbnail buffer when browsing.
+If non-nil, using `image-dired-next-line-and-display' and
+`image-dired-previous-line-and-display' will leave a trail of thumbnail
+images in the thumbnail buffer. If you enable this and want to clean
+the thumbnail buffer because it is filled with too many thumbnails,
+just call `image-dired-display-thumb' to display only the image at point.
+This value can be toggled using `image-dired-toggle-append-browsing'."
+ :type 'boolean)
+
+(defcustom image-dired-dired-disp-props t
+ "If non-nil, display properties for Dired file when browsing.
+Used by `image-dired-next-line-and-display',
+`image-dired-previous-line-and-display' and
`image-dired-mark-and-display-next'.
+If the database file is large, this can slow down image browsing in
+Dired and you might want to turn it off."
+ :type 'boolean)
+
+;;;###autoload
+(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
+ "Toggle thumbnails in front of file names in the Dired buffer.
+If no marked file could be found, insert or hide thumbnails on the
+current line. ARG, if non-nil, specifies the files to use instead
+of the marked files. If ARG is an integer, use the next ARG (or
+previous -ARG, if ARG<0) files."
+ (interactive "P" dired-mode)
+ (setq image-dired--generate-thumbs-start (current-time))
+ (dired-map-over-marks
+ (let ((image-pos (dired-move-to-filename))
+ (image-file (dired-get-filename nil t))
+ thumb-file
+ overlay)
+ (when (and image-file
+ (string-match-p (image-dired--file-name-regexp) image-file))
+ (setq thumb-file (create-image
+ (image-dired--get-create-thumbnail-file image-file)))
+ ;; If image is not already added, then add it.
+ (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
+ if (overlay-get ov 'thumb-file) return ov)))
+ (if thumb-ov
+ (delete-overlay thumb-ov)
+ (put-image thumb-file image-pos)
+ (setq overlay
+ (cl-loop for ov in (overlays-in (point) (1+ (point)))
+ if (overlay-get ov 'put-image) return ov))
+ (overlay-put overlay 'image-file image-file)
+ (overlay-put overlay 'thumb-file thumb-file)))))
+ ;; Show or hide thumbnail on ARG next files.
+ arg)
+ (add-hook 'dired-after-readin-hook
+ 'image-dired-dired-after-readin-hook nil t))
+
+(defun image-dired-dired-after-readin-hook ()
+ "Relocate existing thumbnail overlays in Dired buffer after reverting.
+Move them to their corresponding files if they still exist.
+Otherwise, delete overlays.
+Used by `image-dired-dired-toggle-marked-thumbs'."
+ (mapc (lambda (overlay)
+ (when (overlay-get overlay 'put-image)
+ (let* ((image-file (overlay-get overlay 'image-file))
+ (image-pos (dired-goto-file image-file)))
+ (if image-pos
+ (move-overlay overlay image-pos image-pos)
+ (delete-overlay overlay)))))
+ (overlays-in (point-min) (point-max))))
+
+(defun image-dired-next-line-and-display ()
+ "Move to next Dired line and display thumbnail image."
+ (interactive nil dired-mode)
+ (dired-next-line 1)
+ (image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
+ (if image-dired-dired-disp-props
+ (image-dired-dired-display-properties)))
+
+(defun image-dired-previous-line-and-display ()
+ "Move to previous Dired line and display thumbnail image."
+ (interactive nil dired-mode)
+ (dired-previous-line 1)
+ (image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
+ (if image-dired-dired-disp-props
+ (image-dired-dired-display-properties)))
+
+(defun image-dired-toggle-append-browsing ()
+ "Toggle `image-dired-dired-append-when-browsing'."
+ (interactive nil dired-mode)
+ (setq image-dired-dired-append-when-browsing
+ (not image-dired-dired-append-when-browsing))
+ (message "Append browsing %s"
+ (if image-dired-dired-append-when-browsing
+ "on"
+ "off")))
+
+(defun image-dired-mark-and-display-next ()
+ "Mark current file in Dired and display next thumbnail image."
+ (interactive nil dired-mode)
+ (dired-mark 1)
+ (image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
+ (if image-dired-dired-disp-props
+ (image-dired-dired-display-properties)))
+
+(defun image-dired-toggle-dired-display-properties ()
+ "Toggle `image-dired-dired-disp-props'."
+ (interactive nil dired-mode)
+ (setq image-dired-dired-disp-props
+ (not image-dired-dired-disp-props))
+ (message "Dired display properties %s"
+ (if image-dired-dired-disp-props
+ "on"
+ "off")))
+
+(defun image-dired-track-thumbnail ()
+ "Track current Dired file's thumb in `image-dired-thumbnail-buffer'.
+This is almost the same as what `image-dired-track-original-file' does,
+but the other way around."
+ (let ((file (dired-get-filename))
+ prop-val found window)
+ (when (get-buffer image-dired-thumbnail-buffer)
+ (with-current-buffer image-dired-thumbnail-buffer
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not found))
+ (if (and (setq prop-val
+ (get-text-property (point) 'original-file-name))
+ (string= prop-val file))
+ (setq found t))
+ (if (not found)
+ (forward-char 1)))
+ (when found
+ (if (setq window (image-dired-thumbnail-window))
+ (set-window-point window (point)))
+ (image-dired--update-header-line))))))
+
+(defun image-dired-dired-next-line (&optional arg)
+ "Call `dired-next-line', then track thumbnail.
+This can safely replace `dired-next-line'.
+With prefix argument, move ARG lines."
+ (interactive "P" dired-mode)
+ (dired-next-line (or arg 1))
+ (if image-dired-track-movement
+ (image-dired-track-thumbnail)))
+
+(defun image-dired-dired-previous-line (&optional arg)
+ "Call `dired-previous-line', then track thumbnail.
+This can safely replace `dired-previous-line'.
+With prefix argument, move ARG lines."
+ (interactive "P" dired-mode)
+ (dired-previous-line (or arg 1))
+ (if image-dired-track-movement
+ (image-dired-track-thumbnail)))
+
+;;;###autoload
+(defun image-dired-jump-thumbnail-buffer ()
+ "Jump to thumbnail buffer."
+ (interactive nil dired-mode)
+ (let ((window (image-dired-thumbnail-window))
+ frame)
+ (if window
+ (progn
+ (if (not (equal (selected-frame) (setq frame (window-frame window))))
+ (select-frame-set-input-focus frame))
+ (select-window window))
+ (message "Thumbnail buffer not visible"))))
+
+(defvar-keymap image-dired-minor-mode-map
+ :doc "Keymap for `image-dired-minor-mode'."
+ "<remap> <dired-previous-line>" #'image-dired-dired-previous-line
+ "<remap> <dired-next-line>" #'image-dired-dired-next-line
+ "C-S-n" #'image-dired-next-line-and-display
+ "C-S-p" #'image-dired-previous-line-and-display
+ "C-S-m" #'image-dired-mark-and-display-next
+ "<tab>" #'image-dired-jump-thumbnail-buffer
+
+ :menu
+ '("Image-Dired"
+ ["Display thumb for next file" image-dired-next-line-and-display]
+ ["Display thumb for previous file" image-dired-previous-line-and-display]
+ ["Mark and display next" image-dired-mark-and-display-next]
+ "---"
+ ["Create thumbnails for marked files" image-dired-create-thumbs]
+ "---"
+ ["Display thumbnails append" image-dired-display-thumbs-append]
+ ["Display this thumbnail" image-dired-display-thumb]
+ ["Display image" image-dired-dired-display-image]
+ ["Display in external viewer" image-dired-dired-display-external]
+ "---"
+ ["Toggle display properties" image-dired-toggle-dired-display-properties
+ :style toggle
+ :selected image-dired-dired-disp-props]
+ ["Toggle append browsing" image-dired-toggle-append-browsing
+ :style toggle
+ :selected image-dired-dired-append-when-browsing]
+ ["Toggle movement tracking" image-dired-toggle-movement-tracking
+ :style toggle
+ :selected image-dired-track-movement]
+ "---"
+ ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer]
+ ["Mark tagged files" image-dired-mark-tagged-files]
+ ["Comment files" image-dired-dired-comment-files]
+ ["Copy with EXIF file name" image-dired-copy-with-exif-file-name]))
+
+;;;###autoload
+(define-minor-mode image-dired-minor-mode
+ "Setup easy-to-use keybindings for Image-Dired in Dired mode.
+
+This minor mode adds these additional bindings:
+\\<image-dired-minor-mode-map>
+ \\[image-dired-next-line-and-display] Move to next line and
display \
+thumbnail image.
+ \\[image-dired-previous-line-and-display] Move to previous line \
+and display thumbnail image.
+ \\[image-dired-mark-and-display-next] Mark current file and
display \
+next thumbnail image.
+ \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail
buffer.
+
+For reference, these are the default Image-Dired bindings that
+are always available in Dired:
+\\<dired-mode-map>
+ \\[image-dired-display-thumbs] Display thumbnails of all
marked files.
+ \\[image-dired-tag-files] Tag marked file(s).
+ \\[image-dired-delete-tag] Remove tag for selected file(s).
+ \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail
buffer.
+ \\[image-dired-dired-display-image] Display current image file.
+ \\[image-dired-dired-display-external] Display file at point \
+using an external viewer.
+ \\[image-dired-display-thumbs-append] Append thumbnails to \
+thumbnail buffer.
+ \\[image-dired-display-thumb] Display thumbnails of all
marked files.
+ \\[image-dired-dired-comment-files] Add comment to current or \
+marked files in Dired.
+ \\[image-dired-mark-tagged-files] Use REGEXP to mark files with \
+matching tag.
+ \\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in \
+front of file names.
+ \\[image-dired-dired-edit-comment-and-tags] Edit comment and tags \
+of marked images."
+ :keymap image-dired-minor-mode-map)
+
+(declare-function clear-image-cache "image.c" (&optional filter))
+
+(defun image-dired-create-thumbs (&optional arg)
+ "Create thumbnail images for all marked files in Dired.
+With prefix argument ARG, create thumbnails even if they already exist
+\(i.e. use this to refresh your thumbnails)."
+ (interactive "P" dired-mode)
+ (let (thumb-name)
+ (dolist (curr-file (dired-get-marked-files))
+ (setq thumb-name (image-dired-thumb-name curr-file))
+ ;; If the user overrides the exist check, we must clear the
+ ;; image cache so that if the user wants to display the
+ ;; thumbnail, it is not fetched from cache.
+ (when arg
+ (clear-image-cache (expand-file-name thumb-name)))
+ (when (or (not (file-exists-p thumb-name))
+ arg)
+ (image-dired-create-thumb curr-file thumb-name)))))
+
+;;;###autoload
+(defun image-dired-display-thumbs-append ()
+ "Append thumbnails to `image-dired-thumbnail-buffer'."
+ (interactive nil dired-mode)
+ (image-dired-display-thumbs nil t t))
+
+;;;###autoload
+(defun image-dired-display-thumb ()
+ "Shorthand for `image-dired-display-thumbs' with prefix argument."
+ (interactive nil dired-mode)
+ (image-dired-display-thumbs t nil t))
+
+;;;###autoload
+(defun image-dired-dired-display-external ()
+ "Display file at point using an external viewer."
+ (interactive nil dired-mode)
+ (let ((file (dired-get-filename)))
+ (start-process "image-dired-external" nil
+ image-dired-external-viewer file)))
+
+;;;###autoload
+(defun image-dired-dired-display-image (&optional _)
+ "Display current image file.
+See documentation for `image-dired-display-image' for more information."
+ (declare (advertised-calling-convention () "29.1"))
+ (interactive nil dired-mode)
+ (image-dired-display-image (dired-get-filename)))
+
+(defun image-dired-copy-with-exif-file-name ()
+ "Copy file with unique name to main image directory.
+Copy current or all marked files in Dired to a new file in your
+main image directory, using a file name generated by
+`image-dired-get-exif-file-name'. A typical usage for this if when
+copying images from a digital camera into the image directory.
+
+ Typically, you would open up the folder with the incoming
+digital images, mark the files to be copied, and execute this
+function. The result is a couple of new files in
+`image-dired-main-image-directory' called
+2005_05_08_12_52_00_dscn0319.jpg,
+2005_05_08_14_27_45_dscn0320.jpg etc."
+ (interactive nil dired-mode)
+ (let (new-name
+ (files (dired-get-marked-files)))
+ (mapc
+ (lambda (curr-file)
+ (setq new-name
+ (format "%s/%s"
+ (file-name-as-directory
+ (expand-file-name image-dired-main-image-directory))
+ (image-dired-get-exif-file-name curr-file)))
+ (message "Copying %s to %s" curr-file new-name)
+ (copy-file curr-file new-name))
+ files)))
+
+;;;###autoload
+(defun image-dired-mark-tagged-files (regexp)
+ "Use REGEXP to mark files with matching tag.
+A `tag' is a keyword, a piece of meta data, associated with an
+image file and stored in image-dired's database file. This command
+lets you input a regexp and this will be matched against all tags
+on all image files in the database file. The files that have a
+matching tag will be marked in the Dired buffer."
+ (interactive "sMark tagged files (regexp): " dired-mode)
+ (image-dired-sane-db-file)
+ (let ((hits 0)
+ files)
+ (image-dired--with-db-file
+ ;; Collect matches
+ (while (search-forward-regexp "\\(^[^;\n]+\\);\\(.*\\)" nil t)
+ (let ((file (match-string 1))
+ (tags (split-string (match-string 2) ";")))
+ (when (seq-find (lambda (tag)
+ (string-match-p regexp tag))
+ tags)
+ (push file files)))))
+ ;; Mark files
+ (dolist (curr-file files)
+ ;; I tried using `dired-mark-files-regexp' but it was waaaay to
+ ;; slow. Don't bother about hits found in other directories
+ ;; than the current one.
+ (when (string= (file-name-as-directory
+ (expand-file-name default-directory))
+ (file-name-as-directory
+ (file-name-directory curr-file)))
+ (setq curr-file (file-name-nondirectory curr-file))
+ (goto-char (point-min))
+ (when (search-forward-regexp (format "\\s %s$" curr-file) nil t)
+ (setq hits (+ hits 1))
+ (dired-mark 1))))
+ (message "%d files with matching tag marked" hits)))
+
+(defun image-dired-dired-display-properties ()
+ "Display properties for Dired file in the echo area."
+ (interactive nil dired-mode)
+ (let* ((file-name (dired-get-filename))
+ (dired-buf (buffer-name (current-buffer)))
+ (image-count "") ; TODO
+ (props (string-join (image-dired-list-tags file-name) ", "))
+ (comment (image-dired-get-comment file-name))
+ (message-log-max nil))
+ (if file-name
+ (message "%s"
+ (image-dired-format-properties-string
+ dired-buf
+ file-name
+ image-count
+ props
+ comment)))))
+
+(provide 'image-dired-dired)
+
+;; Local Variables:
+;; nameless-current-name: "image-dired"
+;; End:
+
+;;; image-dired-dired.el ends here
diff --git a/lisp/image/image-dired-external.el
b/lisp/image/image-dired-external.el
new file mode 100644
index 0000000000..b1f8a6c228
--- /dev/null
+++ b/lisp/image/image-dired-external.el
@@ -0,0 +1,473 @@
+;;; image-dired-external.el --- External process support for Image-Dired -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
+
+;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
+;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: multimedia
+
+;; 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:
+
+;; See the description of the `image-dired' package.
+
+;;; Code:
+
+(require 'dired)
+(require 'exif)
+
+(require 'image-dired-util)
+
+(declare-function image-dired-display-image "image-dired")
+(declare-function clear-image-cache "image.c" (&optional filter))
+
+(defvar image-dired-dir)
+(defvar image-dired-thumb-size)
+(defvar image-dired-main-image-directory)
+(defvar image-dired-rotate-original-ask-before-overwrite)
+(defvar image-dired-thumbnail-storage)
+
+(defgroup image-dired-external nil
+ "External process support for Image-Dired."
+ :prefix "image-dired-"
+ :link '(info-link "(emacs) Image-Dired")
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-create-thumbnail-program
+ (if (executable-find "gm") "gm" "convert")
+ "Executable used to create thumbnail.
+Used together with `image-dired-cmd-create-thumbnail-options'."
+ :type 'file
+ :version "29.1")
+
+(defcustom image-dired-cmd-create-thumbnail-options
+ (let ((opts '("-size" "%wx%h" "%f[0]"
+ "-resize" "%wx%h>"
+ "-strip" "jpeg:%t")))
+ (if (executable-find "gm") (cons "convert" opts) opts))
+ "Options of command used to create thumbnail image.
+Used with `image-dired-cmd-create-thumbnail-program'.
+Available format specifiers are:
+ %s, %w and %h, which are replaced by `image-dired-thumb-size'
+ %f which is replaced by the file name of the original image and
+ %t which is replaced by the file name of the thumbnail file."
+ :type '(repeat (string :tag "Argument"))
+ :version "29.1")
+
+(defcustom image-dired-cmd-pngnq-program
+ ;; Prefer pngquant to pngnq-s9 as it is faster on my machine.
+ ;; The project also seems more active than the alternatives.
+ ;; Prefer pngnq-s9 to pngnq as it fixes bugs in pngnq.
+ ;; The pngnq project seems dead (?) since 2011 or so.
+ (or (executable-find "pngquant")
+ (executable-find "pngnq-s9")
+ (executable-find "pngnq"))
+ "The file name of the `pngquant' or `pngnq' program.
+It quantizes colors of PNG images down to 256 colors or fewer
+using the NeuQuant algorithm."
+ :version "29.1"
+ :type '(choice (const :tag "Not Set" nil) file))
+
+(defcustom image-dired-cmd-pngnq-options
+ (if (executable-find "pngquant")
+ '("--ext" "-nq8.png" "%t") ; same extension as "pngnq"
+ '("-f" "%t"))
+ "Arguments to pass `image-dired-cmd-pngnq-program'.
+Available format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options'."
+ :type '(repeat (string :tag "Argument"))
+ :version "29.1")
+
+(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
+ "The file name of the `pngcrush' program.
+It optimizes the compression of PNG images. Also it adds PNG textual chunks
+with the information required by the Thumbnail Managing Standard."
+ :type '(choice (const :tag "Not Set" nil) file))
+
+(defcustom image-dired-cmd-pngcrush-options
+ `("-q"
+ "-text" "b" "Description" "Thumbnail of file://%f"
+ "-text" "b" "Software" ,(emacs-version)
+ ;; "-text b \"Thumb::Image::Height\" \"%oh\" "
+ ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
+ ;; "-text b \"Thumb::Image::Width\" \"%ow\" "
+ "-text" "b" "Thumb::MTime" "%m"
+ ;; "-text b \"Thumb::Size\" \"%b\" "
+ "-text" "b" "Thumb::URI" "file://%f"
+ "%q" "%t")
+ "Arguments for `image-dired-cmd-pngcrush-program'.
+The available %-format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options', with \"%q\" for a
+temporary file name (typically generated by pnqnq)."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
+ "The file name of the `optipng' program."
+ :version "26.1"
+ :type '(choice (const :tag "Not Set" nil) file))
+
+(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
+ "Arguments passed to `image-dired-cmd-optipng-program'.
+Available format specifiers are described in
+`image-dired-cmd-create-thumbnail-options'."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
+ :link '(url-link "man:optipng(1)"))
+
+(defcustom image-dired-cmd-create-standard-thumbnail-options
+ (let ((opts (list
+ "-size" "%wx%h" "%f[0]"
+ "-set" "Thumb::MTime" "%m"
+ "-set" "Thumb::URI" "file://%f"
+ "-set" "Description" "Thumbnail of file://%f"
+ "-set" "Software" (emacs-version)
+ "-thumbnail" "%wx%h>" "png:%t")))
+ (if (executable-find "gm") (cons "convert" opts) opts))
+ "Options for creating thumbnails according to the Thumbnail Managing
Standard.
+The available %-format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options', with \"%m\" for file
+modification time."
+ :type '(repeat (string :tag "Argument"))
+ :version "29.1")
+
+(defcustom image-dired-cmd-rotate-original-program "jpegtran"
+ "Executable used to rotate original image.
+Used together with `image-dired-cmd-rotate-original-options'."
+ :type 'file)
+
+(defcustom image-dired-cmd-rotate-original-options
+ '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
+ "Arguments of command used to rotate original image.
+Used with `image-dired-cmd-rotate-original-program'.
+Available format specifiers are: %d which is replaced by the
+number of (positive) degrees to rotate the image, normally 90 or
+270 \(for 90 degrees right and left), %o which is replaced by the
+original image file name and %t which is replaced by
+`image-dired-temp-image-file'."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom image-dired-temp-rotate-image-file
+ (expand-file-name ".image-dired_rotate_temp"
+ (locate-user-emacs-file "image-dired/"))
+ "Temporary file for rotate operations."
+ :type 'file)
+
+(defcustom image-dired-cmd-write-exif-data-program "exiftool"
+ "Program used to write EXIF data to image.
+Used together with `image-dired-cmd-write-exif-data-options'."
+ :type 'file)
+
+(defcustom image-dired-cmd-write-exif-data-options '("-%t=%v" "%f")
+ "Arguments of command used to write EXIF data.
+Used with `image-dired-cmd-write-exif-data-program'.
+Available format specifiers are: %f which is replaced by
+the image file name, %t which is replaced by the tag name and %v
+which is replaced by the tag value."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument")))
+
+
+;;; Util functions
+
+(defun image-dired--check-executable-exists (executable)
+ (unless (executable-find (symbol-value executable))
+ (error "Executable %S not found" executable)))
+
+
+;;; Creating thumbnails
+
+(defun image-dired--thumb-size (&optional _)
+ "Return thumb size depending on `image-dired-thumbnail-storage'."
+ (declare (advertised-calling-convention () "29.1"))
+ (pcase image-dired-thumbnail-storage
+ ('standard 128)
+ ('standard-large 256)
+ ('standard-x-large 512)
+ ('standard-xx-large 1024)
+ (_ image-dired-thumb-size)))
+
+(defvar image-dired--generate-thumbs-start nil
+ "Time when `display-thumbs' was called.")
+
+(defvar image-dired-queue nil
+ "List of items in the queue.
+Each item has the form (ORIGINAL-FILE TARGET-FILE).")
+
+(defvar image-dired-queue-active-jobs 0
+ "Number of active jobs in `image-dired-queue'.")
+
+(defvar image-dired-queue-active-limit (min 4 (max 2 (/ (num-processors) 2)))
+ "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 `clear-image-cache'
+and remove the cached thumbnail files between each trial run.")
+
+(defun image-dired-pngnq-thumb (spec)
+ "Quantize thumbnail described by format SPEC with pngnq(1)."
+ (let ((process
+ (apply #'start-process "image-dired-pngnq" nil
+ image-dired-cmd-pngnq-program
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-pngnq-options))))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ ;; Pass off to pngcrush, or just rename the
+ ;; THUMB-nq8.png file back to THUMB.png
+ (if (and image-dired-cmd-pngcrush-program
+ (executable-find image-dired-cmd-pngcrush-program))
+ (image-dired-pngcrush-thumb spec)
+ (let ((nq8 (cdr (assq ?q spec)))
+ (thumb (cdr (assq ?t spec))))
+ (rename-file nq8 thumb t)))
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status)))))
+ process))
+
+(defun image-dired-pngcrush-thumb (spec)
+ "Optimize thumbnail described by format SPEC with pngcrush(1)."
+ ;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist.
+ ;; pngcrush needs an infile and outfile, so we just copy THUMB to
+ ;; THUMB-nq8.png and use the latter as a temp file.
+ (when (not image-dired-cmd-pngnq-program)
+ (let ((temp (cdr (assq ?q spec)))
+ (thumb (cdr (assq ?t spec))))
+ (copy-file thumb temp)))
+ (let ((process
+ (apply #'start-process "image-dired-pngcrush" nil
+ image-dired-cmd-pngcrush-program
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-pngcrush-options))))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (unless (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status)))
+ (when (memq (process-status process) '(exit signal))
+ (let ((temp (cdr (assq ?q spec))))
+ (delete-file temp)))))
+ process))
+
+(defun image-dired-optipng-thumb (spec)
+ "Optimize thumbnail described by format SPEC with optipng(1)."
+ (let ((process
+ (apply #'start-process "image-dired-optipng" nil
+ image-dired-cmd-optipng-program
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-optipng-options))))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (unless (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status)))))
+ process))
+
+(defun image-dired-create-thumb-1 (original-file thumbnail-file)
+ "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-create-thumbnail-program)
+ (let* ((size (number-to-string (image-dired--thumb-size)))
+ (modif-time (format-time-string
+ "%s" (file-attribute-modification-time
+ (file-attributes original-file))))
+ (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
+ thumbnail-file))
+ (spec `((?s . ,size) (?w . ,size) (?h . ,size)
+ (?m . ,modif-time)
+ (?f . ,original-file)
+ (?q . ,thumbnail-nq8-file)
+ (?t . ,thumbnail-file)))
+ (thumbnail-dir (file-name-directory thumbnail-file))
+ process)
+ (when (not (file-exists-p thumbnail-dir))
+ (with-file-modes #o700
+ (make-directory thumbnail-dir t))
+ (message "Thumbnail directory created: %s" thumbnail-dir))
+
+ ;; Thumbnail file creation processes begin here and are marshaled
+ ;; in a queue by `image-dired-create-thumb'.
+ (let ((cmd image-dired-cmd-create-thumbnail-program)
+ (args (mapcar
+ (lambda (arg) (format-spec arg spec))
+ (if (memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ image-dired-cmd-create-standard-thumbnail-options
+ image-dired-cmd-create-thumbnail-options))))
+ (image-dired-debug "Running %s %s" cmd (string-join args " "))
+ (setq process
+ (apply #'start-process "image-dired-create-thumbnail" nil
+ cmd args)))
+
+ (setf (process-sentinel process)
+ (lambda (process status)
+ ;; Trigger next in queue once a thumbnail has been created
+ (cl-decf image-dired-queue-active-jobs)
+ (image-dired-thumb-queue-run)
+ (when (= image-dired-queue-active-jobs 0)
+ (image-dired-debug
+ (format-time-string
+ "Generated thumbnails in %s.%3N seconds"
+ (time-subtract nil
+ image-dired--generate-thumbs-start))))
+ (if (not (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process))))
+ (message "Thumb could not be created for %s: %s"
+ (abbreviate-file-name original-file)
+ (string-replace "\n" "" status))
+ (set-file-modes thumbnail-file #o600)
+ (clear-image-cache thumbnail-file)
+ ;; PNG thumbnail has been created since we are
+ ;; following the XDG thumbnail spec, so try to optimize
+ (when (memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ (cond
+ ((and image-dired-cmd-pngnq-program
+ (executable-find image-dired-cmd-pngnq-program))
+ (image-dired-pngnq-thumb spec))
+ ((and image-dired-cmd-pngcrush-program
+ (executable-find image-dired-cmd-pngcrush-program))
+ (image-dired-pngcrush-thumb spec))
+ ((and image-dired-cmd-optipng-program
+ (executable-find image-dired-cmd-optipng-program))
+ (image-dired-optipng-thumb spec)))))))
+ process))
+
+(defun image-dired-thumb-queue-run ()
+ "Run a queued job if one exists and not too many jobs are running.
+Queued items live in `image-dired-queue'."
+ (while (and image-dired-queue
+ (< image-dired-queue-active-jobs
+ image-dired-queue-active-limit))
+ (cl-incf image-dired-queue-active-jobs)
+ (apply #'image-dired-create-thumb-1 (pop image-dired-queue))))
+
+(defun image-dired-create-thumb (original-file thumbnail-file)
+ "Add a job for generating ORIGINAL-FILE thumbnail to `image-dired-queue'.
+The new file will be named THUMBNAIL-FILE."
+ (setq image-dired-queue
+ (nconc image-dired-queue
+ (list (list original-file thumbnail-file))))
+ (run-at-time 0 nil #'image-dired-thumb-queue-run))
+
+(defun image-dired-refresh-thumb ()
+ "Force creation of new image for current thumbnail."
+ (interactive nil image-dired-thumbnail-mode)
+ (let* ((file (image-dired-original-file-name))
+ (thumb (expand-file-name (image-dired-thumb-name file))))
+ (clear-image-cache (expand-file-name thumb))
+ (image-dired-create-thumb file thumb)))
+
+(defun image-dired-rotate-original (degrees)
+ "Rotate original image DEGREES degrees."
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-rotate-original-program)
+ (if (not (image-dired-image-at-point-p))
+ (message "No image at point")
+ (let* ((file (image-dired-original-file-name))
+ (spec
+ (list
+ (cons ?d degrees)
+ (cons ?o (expand-file-name file))
+ (cons ?t image-dired-temp-rotate-image-file))))
+ (unless (eq 'jpeg (image-type file))
+ (user-error "Only JPEG images can be rotated"))
+ (if (not (= 0 (apply #'call-process
image-dired-cmd-rotate-original-program
+ nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-original-options))))
+ (error "Could not rotate image")
+ (image-dired-display-image image-dired-temp-rotate-image-file)
+ (if (or (and image-dired-rotate-original-ask-before-overwrite
+ (y-or-n-p
+ "Rotate to temp file OK. Overwrite original image? "))
+ (not image-dired-rotate-original-ask-before-overwrite))
+ (progn
+ (copy-file image-dired-temp-rotate-image-file file t)
+ (image-dired-refresh-thumb))
+ (image-dired-display-image file))))))
+
+
+;;; EXIF support
+
+(defun image-dired-get-exif-file-name (file)
+ "Use the image's EXIF information to return a unique file name.
+The file name should be unique as long as you do not take more than
+one picture per second. The original file name is suffixed at the end
+for traceability. The format of the returned file name is
+YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
+`image-dired-copy-with-exif-file-name'."
+ (let (data no-exif-data-found)
+ (if (not (eq 'jpeg (image-type (expand-file-name file))))
+ (setq no-exif-data-found t
+ data (format-time-string
+ "%Y:%m:%d %H:%M:%S"
+ (file-attribute-modification-time
+ (file-attributes (expand-file-name file)))))
+ (setq data (exif-field 'date-time (exif-parse-file
+ (expand-file-name file)))))
+ (while (string-match "[ :]" data)
+ (setq data (replace-match "_" nil nil data)))
+ (format "%s%s%s" data
+ (if no-exif-data-found
+ "_noexif_"
+ "_")
+ (file-name-nondirectory file))))
+
+(defun image-dired-thumbnail-set-image-description ()
+ "Set the ImageDescription EXIF tag for the original image.
+If the image already has a value for this tag, it is used as the
+default value at the prompt."
+ (interactive nil image-dired-thumbnail-mode)
+ (if (not (image-dired-image-at-point-p))
+ (message "No thumbnail at point")
+ (let* ((file (image-dired-original-file-name))
+ (old-value (or (exif-field 'description (exif-parse-file file))
"")))
+ (if (eq 0
+ (image-dired-set-exif-data file "ImageDescription"
+ (read-string "Value of
ImageDescription: "
+ old-value)))
+ (message "Successfully wrote ImageDescription tag")
+ (error "Could not write ImageDescription tag")))))
+
+(defun image-dired-set-exif-data (file tag-name tag-value)
+ "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE."
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-write-exif-data-program)
+ (let ((spec
+ (list
+ (cons ?f (expand-file-name file))
+ (cons ?t tag-name)
+ (cons ?v tag-value))))
+ (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-write-exif-data-options))))
+
+(define-obsolete-function-alias 'image-dired-thumb-size
#'image-dired--thumb-size "29.1")
+
+(provide 'image-dired-external)
+
+;; Local Variables:
+;; nameless-current-name: "image-dired"
+;; End:
+
+;;; image-dired-external.el ends here
diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el
new file mode 100644
index 0000000000..dfd6473285
--- /dev/null
+++ b/lisp/image/image-dired-tags.el
@@ -0,0 +1,385 @@
+;;; image-dired-tags.el --- Tag support for Image-Dired -*- lexical-binding:
t -*-
+
+;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
+
+;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
+;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: multimedia
+
+;; 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:
+
+;; See the description of the `image-dired' package.
+
+;;; Code:
+
+(require 'dired)
+
+(require 'image-dired-util)
+
+(declare-function image-dired--with-marked "image-dired")
+
+(defvar image-dired-dir)
+(defvar image-dired-thumbnail-storage)
+(defvar image-dired-tags-db-file)
+
+(defmacro image-dired--with-db-file (&rest body)
+ "Run BODY in a temp buffer containing `image-dired-tags-db-file'.
+Return the last form in BODY."
+ (declare (indent 0) (debug t))
+ `(with-temp-buffer
+ (if (file-exists-p image-dired-tags-db-file)
+ (insert-file-contents image-dired-tags-db-file))
+ ,@body))
+
+(defun image-dired-sane-db-file ()
+ "Check if `image-dired-tags-db-file' exists.
+If not, try to create it (including any parent directories).
+Signal error if there are problems creating it."
+ (or (file-exists-p image-dired-tags-db-file)
+ (let (dir buf)
+ (unless (file-directory-p (setq dir (file-name-directory
+ image-dired-tags-db-file)))
+ (with-file-modes #o700
+ (make-directory dir t)))
+ (with-current-buffer (setq buf (create-file-buffer
+ image-dired-tags-db-file))
+ (with-file-modes #o600
+ (write-file image-dired-tags-db-file)))
+ (kill-buffer buf)
+ (file-exists-p image-dired-tags-db-file))
+ (error "Could not create %s" image-dired-tags-db-file)))
+
+(defvar image-dired-tag-history nil "Variable holding the tag history.")
+
+(defun image-dired-write-tags (file-tags)
+ "Write file tags to database.
+Write each file and tag in FILE-TAGS to the database.
+FILE-TAGS is an alist in the following form:
+ ((FILE . TAG) ... )"
+ (image-dired-sane-db-file)
+ (let (end file tag)
+ (image-dired--with-db-file
+ (setq buffer-file-name image-dired-tags-db-file)
+ (dolist (elt file-tags)
+ (setq file (car elt)
+ tag (cdr elt))
+ (goto-char (point-min))
+ (if (search-forward-regexp (format "^%s.*$" file) nil t)
+ (progn
+ (setq end (point))
+ (beginning-of-line)
+ (when (not (search-forward (format ";%s" tag) end t))
+ (end-of-line)
+ (insert (format ";%s" tag))))
+ (goto-char (point-max))
+ (insert (format "%s;%s\n" file tag))))
+ (save-buffer))))
+
+(defun image-dired-remove-tag (files tag)
+ "For all FILES, remove TAG from the image database."
+ (image-dired-sane-db-file)
+ (image-dired--with-db-file
+ (setq buffer-file-name image-dired-tags-db-file)
+ (let (end)
+ (unless (listp files)
+ (if (stringp files)
+ (setq files (list files))
+ (error "Files must be a string or a list of strings!")))
+ (dolist (file files)
+ (goto-char (point-min))
+ (when (search-forward-regexp (format "^%s;" file) nil t)
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (when (search-forward-regexp
+ (format "\\(;%s\\)\\($\\|;\\)" tag) end t)
+ (delete-region (match-beginning 1) (match-end 1))
+ ;; Check if file should still be in the database.
+ ;; If it has no tags or comments, it will be removed.
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (when (not (search-forward ";" end t))
+ (kill-line 1))))))
+ (save-buffer)))
+
+(defun image-dired-list-tags (file)
+ "Read all tags for image FILE from the image database."
+ (image-dired-sane-db-file)
+ (image-dired--with-db-file
+ (let (end (tags ""))
+ (when (search-forward-regexp (format "^%s" file) nil t)
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (if (search-forward ";" end t)
+ (if (search-forward "comment:" end t)
+ (if (search-forward ";" end t)
+ (setq tags (buffer-substring (point) end)))
+ (setq tags (buffer-substring (point) end)))))
+ (split-string tags ";"))))
+
+;;;###autoload
+(defun image-dired-tag-files (arg)
+ "Tag marked file(s) in Dired. With prefix ARG, tag file at point."
+ (interactive "P" dired-mode)
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history))
+ files)
+ (if arg
+ (setq files (list (dired-get-filename)))
+ (setq files (dired-get-marked-files)))
+ (image-dired-write-tags
+ (mapcar
+ (lambda (x)
+ (cons x tag))
+ files))))
+
+(defun image-dired-tag-thumbnail ()
+ "Tag current or marked thumbnails."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-write-tags
+ (list (cons (image-dired-original-file-name) tag)))
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
+
+;;;###autoload
+(defun image-dired-delete-tag (arg)
+ "Remove tag for selected file(s).
+With prefix argument ARG, remove tag from file at point."
+ (interactive "P" dired-mode)
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history))
+ files)
+ (if arg
+ (setq files (list (dired-get-filename)))
+ (setq files (dired-get-marked-files)))
+ (image-dired-remove-tag files tag)))
+
+(defun image-dired-tag-thumbnail-remove ()
+ "Remove tag from current or marked thumbnails."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-remove-tag (image-dired-original-file-name) tag)
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
+
+(defun image-dired-write-comments (file-comments)
+ "Write file comments to database.
+Write file comments to one or more files.
+FILE-COMMENTS is an alist on the following form:
+ ((FILE . COMMENT) ... )"
+ (image-dired-sane-db-file)
+ (let (end comment-beg-pos comment-end-pos file comment)
+ (image-dired--with-db-file
+ (setq buffer-file-name image-dired-tags-db-file)
+ (dolist (elt file-comments)
+ (setq file (car elt)
+ comment (cdr elt))
+ (goto-char (point-min))
+ (if (search-forward-regexp (format "^%s.*$" file) nil t)
+ (progn
+ (setq end (point))
+ (beginning-of-line)
+ ;; Delete old comment, if any
+ (when (search-forward ";comment:" end t)
+ (setq comment-beg-pos (match-beginning 0))
+ ;; Any tags after the comment?
+ (if (search-forward ";" end t)
+ (setq comment-end-pos (- (point) 1))
+ (setq comment-end-pos end))
+ ;; Delete comment tag and comment
+ (delete-region comment-beg-pos comment-end-pos))
+ ;; Insert new comment
+ (beginning-of-line)
+ (unless (search-forward ";" end t)
+ (end-of-line)
+ (insert ";"))
+ (insert (format "comment:%s;" comment)))
+ ;; File does not exist in database - add it.
+ (goto-char (point-max))
+ (insert (format "%s;comment:%s\n" file comment))))
+ (save-buffer))))
+
+(defun image-dired-update-property (prop value)
+ "Update text property PROP with value VALUE at point."
+ (let ((inhibit-read-only t))
+ (put-text-property
+ (point) (1+ (point))
+ prop
+ value)))
+
+;;;###autoload
+(defun image-dired-dired-comment-files ()
+ "Add comment to current or marked files in Dired."
+ (interactive nil dired-mode)
+ (let ((comment (image-dired-read-comment)))
+ (image-dired-write-comments
+ (mapcar
+ (lambda (curr-file)
+ (cons curr-file comment))
+ (dired-get-marked-files)))))
+
+(defun image-dired-read-comment (&optional file)
+ "Read comment for an image.
+Optionally use old comment from FILE as initial value."
+ (let ((comment
+ (read-string
+ "Comment: "
+ (if file (image-dired-get-comment file)))))
+ comment))
+
+(defun image-dired-get-comment (file)
+ "Get comment for file FILE."
+ (image-dired-sane-db-file)
+ (image-dired--with-db-file
+ (let (end comment-beg-pos comment-end-pos comment)
+ (when (search-forward-regexp (format "^%s" file) nil t)
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (when (search-forward ";comment:" end t)
+ (setq comment-beg-pos (point))
+ (if (search-forward ";" end t)
+ (setq comment-end-pos (- (point) 1))
+ (setq comment-end-pos end))
+ (setq comment (buffer-substring
+ comment-beg-pos comment-end-pos))))
+ comment)))
+
+
+;;; Tag support
+
+(defvar image-dired-widget-list nil
+ "List to keep track of meta data in edit buffer.")
+
+(declare-function widget-forward "wid-edit" (arg))
+
+;;;###autoload
+(defun image-dired-dired-edit-comment-and-tags ()
+ "Edit comment and tags of current or marked image files.
+Edit comment and tags for all marked image files in an
+easy-to-use form."
+ (interactive nil dired-mode)
+ (setq image-dired-widget-list nil)
+ ;; Setup buffer.
+ (let ((files (dired-get-marked-files)))
+ (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*")
+ (kill-all-local-variables)
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (remove-overlays)
+ ;; Some help for the user.
+ (widget-insert
+ (substitute-command-keys
+ "\\<widget-field-keymap>
+Edit comments and tags for each image. Separate multiple tags
+with a comma. Move forward between fields using \\[widget-forward] \
+or \\[widget-field-activate].
+Move to the previous field using \\[widget-backward]. Save by
+activating the \"Save\" button at the bottom of the form or
+cancel the operation by activating the \"Cancel\" button.\n\n"))
+ ;; Here comes all images and a comment and tag field for each
+ ;; image.
+ (let (thumb-file img comment-widget tag-widget)
+
+ (dolist (file files)
+
+ (setq thumb-file (image-dired-thumb-name file)
+ img (create-image thumb-file))
+
+ (insert-image img)
+ (widget-insert "\n\nComment: ")
+ (setq comment-widget
+ (widget-create 'editable-field
+ :size 60
+ :format "%v "
+ :value (or (image-dired-get-comment file) "")))
+ (widget-insert "\nTags: ")
+ (setq tag-widget
+ (widget-create 'editable-field
+ :size 60
+ :format "%v "
+ :value (or (mapconcat
+ #'identity
+ (image-dired-list-tags file)
+ ",") "")))
+ ;; Save information in all widgets so that we can use it when
+ ;; the user saves the form.
+ (setq image-dired-widget-list
+ (append image-dired-widget-list
+ (list (list file comment-widget tag-widget))))
+ (widget-insert "\n\n")))
+
+ ;; Footer with Save and Cancel button.
+ (widget-insert "\n")
+ (widget-create 'push-button
+ :notify
+ (lambda (&rest _ignore)
+ (image-dired-save-information-from-widgets)
+ (bury-buffer)
+ (message "Done"))
+ "Save")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :notify
+ (lambda (&rest _ignore)
+ (bury-buffer)
+ (message "Operation canceled"))
+ "Cancel")
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ ;; Jump to the first widget.
+ (widget-forward 1)))
+
+(defun image-dired-save-information-from-widgets ()
+ "Save information found in `image-dired-widget-list'.
+Use the information in `image-dired-widget-list' to save comments and
+tags to their respective image file. Internal function used by
+`image-dired-dired-edit-comment-and-tags'."
+ (let (file comment tag-string tag-list lst)
+ (image-dired-write-comments
+ (mapcar
+ (lambda (widget)
+ (setq file (car widget)
+ comment (widget-value (cadr widget)))
+ (cons file comment))
+ image-dired-widget-list))
+ (image-dired-write-tags
+ (dolist (widget image-dired-widget-list lst)
+ (setq file (car widget)
+ tag-string (widget-value (car (cddr widget)))
+ tag-list (split-string tag-string ","))
+ (dolist (tag tag-list)
+ (push (cons file tag) lst))))))
+
+(provide 'image-dired-tags)
+
+;; Local Variables:
+;; nameless-current-name: "image-dired"
+;; End:
+
+;;; image-dired-tags.el ends here
diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el
new file mode 100644
index 0000000000..bc7a355262
--- /dev/null
+++ b/lisp/image/image-dired-util.el
@@ -0,0 +1,186 @@
+;;; image-dired-util.el --- util functions for Image-Dired -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
+
+;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
+;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See the description of the `image-dired' package.
+
+;;; Code:
+
+(require 'xdg)
+(eval-when-compile (require 'cl-lib))
+
+(defvar image-dired-dir)
+(defvar image-dired-thumbnail-storage)
+
+(defconst image-dired--thumbnail-standard-sizes
+ '( standard standard-large
+ standard-x-large standard-xx-large)
+ "List of symbols representing thumbnail sizes in Thumbnail Managing
Standard.")
+
+(defvar image-dired-debug nil
+ "Non-nil means enable debug messages.")
+
+(defun image-dired-debug (&rest args)
+ "Display debug message ARGS when `image-dired-debug' is non-nil."
+ (when image-dired-debug
+ (apply #'message args)))
+
+(defun image-dired-dir ()
+ "Return the current thumbnail directory (from variable `image-dired-dir').
+Create the thumbnail directory if it does not exist."
+ (let ((image-dired-dir
+ (file-name-as-directory
+ (expand-file-name image-dired-dir))))
+ (unless (file-directory-p image-dired-dir)
+ (with-file-modes #o700
+ (make-directory image-dired-dir t))
+ (message "Thumbnail directory created: %s" image-dired-dir))
+ image-dired-dir))
+
+(defun image-dired-thumb-name (file)
+ "Return absolute file name for thumbnail FILE.
+Depending on the value of `image-dired-thumbnail-storage', the
+file name of the thumbnail will vary:
+- For `use-image-dired-dir', make a SHA1-hash of the image file's
+ directory name and add that to make the thumbnail file name
+ unique.
+- For `per-directory' storage, just add a subdirectory.
+- For `standard' storage, produce the file name according to the
+ Thumbnail Managing Standard. Among other things, an MD5-hash
+ of the image file's directory name will be added to the
+ filename.
+See also `image-dired-thumbnail-storage'."
+ (let ((file (expand-file-name file)))
+ (cond ((memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ (let ((thumbdir (cl-case image-dired-thumbnail-storage
+ (standard "thumbnails/normal")
+ (standard-large "thumbnails/large")
+ (standard-x-large "thumbnails/x-large")
+ (standard-xx-large "thumbnails/xx-large"))))
+ (expand-file-name
+ ;; MD5 is mandated by the Thumbnail Managing Standard.
+ (concat (md5 (concat "file://" file)) ".png")
+ (expand-file-name thumbdir (xdg-cache-home)))))
+ ((or (eq 'image-dired image-dired-thumbnail-storage)
+ ;; Maintained for backwards compatibility:
+ (eq 'use-image-dired-dir image-dired-thumbnail-storage))
+ (expand-file-name (format "%s.jpg" (sha1 file))
+ (image-dired-dir)))
+ ((eq 'per-directory image-dired-thumbnail-storage)
+ (expand-file-name (format "%s.thumb.jpg"
+ (file-name-nondirectory file))
+ (expand-file-name
+ ".image-dired"
+ (file-name-directory file)))))))
+
+(defvar image-dired-thumbnail-buffer "*image-dired*"
+ "Image-Dired's thumbnail buffer.")
+
+(defvar image-dired-display-image-buffer "*image-dired-display-image*"
+ "Where larger versions of the images are display.")
+
+(defun image-dired-original-file-name ()
+ "Get original file name for thumbnail or display image at point."
+ (get-text-property (point) 'original-file-name))
+
+(defun image-dired-file-name-at-point ()
+ "Get abbreviated file name for thumbnail or display image at point."
+ (when-let ((f (image-dired-original-file-name)))
+ (abbreviate-file-name f)))
+
+(defun image-dired-associated-dired-buffer ()
+ "Get associated Dired buffer at point."
+ (get-text-property (point) 'associated-dired-buffer))
+
+(defmacro image-dired--with-dired-buffer (&rest body)
+ "Run BODY in associated Dired buffer.
+Should be used by commands in `image-dired-thumbnail-mode'."
+ (declare (indent defun) (debug t))
+ (let ((file (make-symbol "file"))
+ (dired-buf (make-symbol "dired-buf")))
+ `(let ((,file (image-dired-original-file-name))
+ (,dired-buf (image-dired-associated-dired-buffer)))
+ (unless ,file
+ (error "No image at point"))
+ (unless (and ,dired-buf (buffer-live-p ,dired-buf))
+ (error "Cannot find associated Dired buffer for image: %s" ,file))
+ (with-current-buffer ,dired-buf
+ ,@body))))
+
+(defun image-dired-get-buffer-window (buf)
+ "Return window where buffer BUF is."
+ (get-window-with-predicate
+ (lambda (window)
+ (equal (window-buffer window) buf))
+ nil t))
+
+(defun image-dired-display-window ()
+ "Return window where `image-dired-display-image-buffer' is visible."
+ ;; This is obsolete as it is currently unused. Once the window
+ ;; handling gets a rethink, there may or may not be a need to
+ ;; un-obsolete it again.
+ (declare (obsolete nil "29.1"))
+ (get-window-with-predicate
+ (lambda (window)
+ (equal (buffer-name (window-buffer window))
image-dired-display-image-buffer))
+ nil t))
+
+(defun image-dired-thumbnail-window ()
+ "Return window where `image-dired-thumbnail-buffer' is visible."
+ (get-window-with-predicate
+ (lambda (window)
+ (equal (buffer-name (window-buffer window)) image-dired-thumbnail-buffer))
+ nil t))
+
+(defun image-dired-associated-dired-buffer-window ()
+ "Return window where associated Dired buffer is visible."
+ ;; This is obsolete as it is currently unused. Once the window
+ ;; handling gets a rethink, there may or may not be a need to
+ ;; un-obsolete it again.
+ (declare (obsolete nil "29.1"))
+ (let (buf)
+ (if (image-dired-image-at-point-p)
+ (progn
+ (setq buf (image-dired-associated-dired-buffer))
+ (get-window-with-predicate
+ (lambda (window)
+ (equal (window-buffer window) buf))))
+ (error "No thumbnail image at point"))))
+
+(defun image-dired-image-at-point-p ()
+ "Return non-nil if there is an `image-dired' thumbnail at point."
+ (get-text-property (point) 'image-dired-thumbnail))
+
+(defun image-dired-window-width-pixels (window)
+ "Calculate WINDOW width in pixels."
+ (declare (obsolete window-body-width "29.1"))
+ (* (window-width window) (frame-char-width)))
+
+(provide 'image-dired-util)
+
+;; Local Variables:
+;; nameless-current-name: "image-dired"
+;; End:
+
+;;; image-dired-util.el ends here
diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el
new file mode 100644
index 0000000000..d4fd3c62db
--- /dev/null
+++ b/lisp/image/image-dired.el
@@ -0,0 +1,2013 @@
+;;; image-dired.el --- use dired to browse and manipulate your images -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
+
+;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
+;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
+;; Version: 0.5
+;; Keywords: multimedia
+
+;; 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:
+
+;; BACKGROUND
+;; ==========
+;;
+;; I needed a program to browse, organize and tag my pictures. I got
+;; tired of the old gallery program I used as it did not allow
+;; multi-file operations easily. Also, it put things out of my
+;; control. Image viewing programs I tested did not allow multi-file
+;; operations or did not do what I wanted it to.
+;;
+;; So, I got the idea to use the wonderful functionality of Emacs and
+;; `dired' to do it. It would allow me to do almost anything I wanted,
+;; which is basically just to browse all my pictures in an easy way,
+;; letting me manipulate and tag them in various ways. `dired' already
+;; provide all the file handling and navigation facilities; I only
+;; needed to add some functions to display the images.
+;;
+;; I briefly tried out thumbs.el, and although it seemed more
+;; powerful than this package, it did not work the way I wanted to. It
+;; was too slow to create thumbnails of all files in a directory (I
+;; currently keep all my 2000+ images in the same directory) and
+;; browsing the thumbnail buffer was slow too. image-dired.el will not
+;; create thumbnails until they are needed and the browsing is done
+;; quickly and easily in Dired. I copied a great deal of ideas and
+;; code from there though... :)
+;;
+;; `image-dired' stores the thumbnail files in `image-dired-dir'
+;; using the file name format ORIGNAME.thumb.ORIGEXT. For example
+;; ~/.emacs.d/image-dired/myimage01.thumb.jpg. The "database" is for
+;; now just a plain text file with the following format:
+;;
+;; file-name-non-directory;comment:comment-text;tag1;tag2;tag3;...;tagN
+;;
+;; PREREQUISITES
+;; =============
+;;
+;; * The GraphicsMagick or ImageMagick package; Image-Dired uses
+;; whichever is available.
+;;
+;; A) For GraphicsMagick, `gm' is used.
+;; Find it here: http://www.graphicsmagick.org/
+;;
+;; B) For ImageMagick, `convert' and `mogrify' are used.
+;; Find it here: https://www.imagemagick.org.
+;;
+;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
+;; needed.
+;;
+;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool'
is
+;; needed. It can be found here: https://exiftool.org/. This
+;; function is, among other things, used for writing comments to
+;; image files using `image-dired-thumbnail-set-image-description'.
+;;
+;;
+;; USAGE
+;; =====
+;;
+;; This information has been moved to the manual. Type `C-h r' to open
+;; the Emacs manual and go to the node Thumbnails by typing `g
+;; Image-Dired RET'.
+;;
+;; Quickstart: M-x image-dired RET DIRNAME RET
+;;
+;; where DIRNAME is a directory containing image files.
+;;
+;; LIMITATIONS
+;; ===========
+;;
+;; * Supports all image formats that Emacs and convert supports, but
+;; the thumbnails are hard-coded to JPEG or PNG format. It uses
+;; JPEG by default, but can optionally follow the Thumbnail Managing
+;; Standard (v0.9.0, Dec 2020), which mandates PNG. See the user
+;; option `image-dired-thumbnail-storage'.
+;;
+;; * WARNING: The "database" format used might be changed so keep a
+;; backup of `image-dired-tags-db-file' when testing new versions.
+;;
+;; TODO
+;; ====
+;;
+;; * Investigate if it is possible to also write the tags to the image
+;; files.
+;;
+;; * From thumbs.el: Add an option for clean-up/max-size functionality
+;; for thumbnail directory.
+;;
+;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find
out
+;; which is best, saving old batch just before inserting new, or
+;; saving the current batch in the ring when inserting it. Adding
+;; it probably needs rewriting `image-dired-display-thumbs' to be more
general.
+;;
+;; * Find some way of toggling on and off really nice keybindings in
+;; Dired (for example, using C-n or <down> instead of C-S-n).
+;; Richard suggested that we could keep C-t as prefix for
+;; image-dired commands as it is currently not used in Dired. He
+;; also suggested that `dired-next-line' and `dired-previous-line'
+;; figure out if image-dired is enabled in the current buffer and,
+;; if it is, call `image-dired-dired-next-line' and
`image-dired-dired-previous-line',
+;; respectively. Update: This is partly done; some bindings have
+;; now been added to Dired.
+;;
+;; * In some way keep track of buffers and windows and stuff so that
+;; it works as the user expects.
+;;
+;; * More/better documentation.
+
+;;; Code:
+
+(require 'dired)
+(require 'image-mode)
+(require 'widget)
+(require 'xdg)
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'wid-edit))
+
+(require 'image-dired-external)
+(require 'image-dired-tags)
+(require 'image-dired-util)
+
+
+;;; Customizable variables
+
+(defgroup image-dired nil
+ "Use Dired to browse your images as thumbnails, and more."
+ :prefix "image-dired-"
+ :link '(info-link "(emacs) Image-Dired")
+ :group 'multimedia)
+
+(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
+ "Directory where thumbnail images are stored.
+
+The value of this option is ignored if Image-Dired is customized
+to use the Thumbnail Managing Standard; they will be saved in
+\"$XDG_CACHE_HOME/thumbnails/\" instead. See
+`image-dired-thumbnail-storage'."
+ :type 'directory)
+
+(defcustom image-dired-thumbnail-storage 'image-dired
+ "How `image-dired' stores thumbnail files.
+There are three ways that Image-Dired can store and generate
+thumbnails:
+
+ 1. According to the \"Thumbnail Managing Standard\", which allows
+ sharing of thumbnails across different programs. Thumbnails
+ will be stored in \"$XDG_CACHE_HOME/thumbnails/\"
+
+ Set this user option to one of the following values:
+
+ - `standard' means use thumbnails sized 128x128.
+ - `standard-large' means use thumbnails sized 256x256.
+ - `standard-x-large' means use thumbnails sized 512x512.
+ - `standard-xx-large' means use thumbnails sized 1024x1024.
+
+ 2. In the Image-Dired specific directory indicated by
+ `image-dired-dir'.
+
+ Set this user option to `image-dired' to use it (or
+ `use-image-dired-dir', which means the same thing for
+ backwards-compatibility reasons).
+
+ 3. In a subdirectory \".image-dired\" in the same directory
+ where the image files are.
+
+ Set this user option to `per-directory' to use it.
+
+To change the default size of thumbnails with (2) and (3) above,
+customize `image-dired-thumb-size'.
+
+With Thumbnail Managing Standard, save thumbnails in the PNG
+format, as mandated by that standard, and otherwise as JPEG.
+
+For more information on the Thumbnail Managing Standard, see:
+https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html";
+ :type '(choice :tag "How to store thumbnail files"
+ (const :tag "Use image-dired-dir" image-dired)
+ (const :tag "Thumbnail Managing Standard (normal 128x128)"
+ standard)
+ (const :tag "Thumbnail Managing Standard (large 256x256)"
+ standard-large)
+ (const :tag "Thumbnail Managing Standard (larger 512x512)"
+ standard-x-large)
+ (const :tag "Thumbnail Managing Standard (extra large
1024x1024)"
+ standard-xx-large)
+ (const :tag "Per-directory" per-directory))
+ :version "29.1")
+;;;###autoload(put 'image-dired-thumbnail-storage 'safe-local-variable (lambda
(x) (eq x 'per-directory)))
+
+(define-obsolete-variable-alias 'image-dired-db-file
+ 'image-dired-tags-db-file "29.1")
+(defcustom image-dired-tags-db-file
+ (expand-file-name ".image-dired_db" image-dired-dir)
+ "Database file where file names and their associated tags are stored."
+ :type 'file)
+
+(defcustom image-dired-rotate-original-ask-before-overwrite t
+ "Confirm overwrite of original file after rotate operation.
+If non-nil, ask user for confirmation before overwriting the
+original file with `image-dired-temp-rotate-image-file'."
+ :type 'boolean)
+
+(defcustom image-dired-thumb-size
+ ;; This is ignored when using the Thumbnail Managing Standard, but
+ ;; this provides a better default (e.g., when 'image-dired-thumbnail-storage'
+ ;; is `image-dired' in a directory local variables).
+ (pcase image-dired-thumbnail-storage
+ ('standard 128)
+ ('standard-large 256)
+ ('standard-x-large 512)
+ ('standard-xx-large 1024)
+ (_ 128))
+ "Default size of thumbnails in pixels.
+The value of this option is ignored if Image-Dired is customized
+to use the Thumbnail Managing Standard; the standard sizes will
+be used instead. See `image-dired-thumbnail-storage'."
+ :type 'natnum
+ :version "29.1")
+
+(defcustom image-dired-thumb-relief 2
+ "Size of button-like border around thumbnails."
+ :type 'natnum)
+
+(defcustom image-dired-thumb-margin 2
+ "Size of the margin around thumbnails.
+This is where you see the cursor."
+ :type 'natnum)
+
+(defcustom image-dired-thumb-visible-marks t
+ "Make marks and flags visible in thumbnail buffer.
+If non-nil, apply the `image-dired-thumb-mark' face to marked
+images and `image-dired-thumb-flagged' to images flagged for
+deletion."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom image-dired-line-up-method 'dynamic
+ "Default method for line-up of thumbnails in thumbnail buffer.
+Used by `image-dired-display-thumbs' and other functions that needs
+to line-up thumbnails. Dynamic means to use the available width of
+the window containing the thumbnail buffer, Fixed means to use
+`image-dired-thumbs-per-row', Interactive is for asking the user,
+and No line-up means that no automatic line-up will be done."
+ :type '(choice :tag "Default line-up method"
+ (const :tag "Dynamic" dynamic)
+ (const :tag "Fixed" fixed)
+ (const :tag "Interactive" interactive)
+ (const :tag "No line-up" none)))
+
+(defcustom image-dired-thumbs-per-row 3
+ "Number of thumbnails to display per row in thumb buffer."
+ :type 'natnum)
+
+(defcustom image-dired-track-movement t
+ "The current state of the tracking and mirroring.
+For more information, see the documentation for
+`image-dired-toggle-movement-tracking'."
+ :type 'boolean)
+
+(defcustom image-dired-display-properties-format "%n %d/%f %s %t %c"
+ "Display format for thumbnail properties.
+This is used for the header line in the Image-Dired buffer.
+
+The following %-specs are replaced by `format-spec' before
+displaying:
+
+ \"%f\" The file name (without a directory) of the
+ original image file.
+ \"%n\" The number of this image out of the total (e.g. 1/10).
+ \"%b\" The associated Dired buffer name.
+ \"%d\" The name of the directory that the file is in.
+ \"%s\" The image file size.
+ \"%t\" The list of tags (from the Image-Dired database).
+ \"%c\" The comment (from the Image-Dired database)."
+ :type 'string
+ :safe #'stringp
+ :version "29.1")
+
+(defcustom image-dired-external-viewer
+ ;; TODO: Use mailcap, dired-guess-shell-alist-default,
+ ;; dired-view-command-alist.
+ (cond ((executable-find "display") "display")
+ ((executable-find "feh") "feh")
+ ((executable-find "gm") "gm display")
+ ((executable-find "xli") "xli")
+ ((executable-find "qiv") "qiv -t")
+ ((executable-find "xloadimage") "xloadimage"))
+ "Name of external viewer.
+Including parameters. Used when displaying original image from
+`image-dired-thumbnail-mode'."
+ :version "29.1"
+ :type '(choice string
+ (const :tag "Not Set" nil)))
+
+(defcustom image-dired-main-image-directory
+ (or (xdg-user-dir "PICTURES") "~/pics/")
+ "Name of main image directory, if any.
+Used by `image-dired-copy-with-exif-file-name'."
+ :type 'string
+ :version "29.1")
+
+(defcustom image-dired-show-all-from-dir-max-files 1000
+ "Maximum number of files in directory before prompting.
+
+If there are more image files than this in a selected directory,
+the `image-dired-show-all-from-dir' command will ask for
+confirmation before creating the thumbnail buffer. If this
+variable is nil, it will never ask."
+ :type '(choice integer
+ (const :tag "Disable warning" nil))
+ :version "29.1")
+
+(defcustom image-dired-marking-shows-next t
+ "If non-nil, marking, unmarking or flagging an image shows the next image.
+
+This affects the following commands:
+\\<image-dired-thumbnail-mode-map>
+ `image-dired-flag-thumb-original-file' (bound to
\\[image-dired-flag-thumb-original-file])
+ `image-dired-mark-thumb-original-file' (bound to
\\[image-dired-mark-thumb-original-file])
+ `image-dired-unmark-thumb-original-file' (bound to
\\[image-dired-unmark-thumb-original-file])"
+ :type 'boolean
+ :version "29.1")
+
+
+;;; Faces
+
+;;;; Header line
+
+(defface image-dired-thumb-header-file-name
+ '((default :weight bold))
+ "Face for the file name in the header line of the thumbnail buffer."
+ :version "29.1")
+
+(defface image-dired-thumb-header-directory-name
+ '((default :inherit header-line))
+ "Face for the directory name in the header line of the thumbnail buffer."
+ :version "29.1")
+
+(defface image-dired-thumb-header-file-size
+ '((((class color) (min-colors 88)) :foreground "cadet blue")
+ (((class color) (min-colors 16)) :foreground "black")
+ (default :inherit header-line))
+ "Face for the file size in the header line of the thumbnail buffer."
+ :version "29.1")
+
+(defface image-dired-thumb-header-image-count
+ '((default :inherit header-line))
+ "Face for the image count in the header line of the thumbnail buffer."
+ :version "29.1")
+
+;;;; Thumbnail buffer
+
+(defface image-dired-thumb-mark
+ '((((class color) (min-colors 16)) :background "DarkOrange")
+ (((class color)) :foreground "yellow")
+ (default :inherit header-line))
+ "Face for marked images in thumbnail buffer."
+ :version "29.1")
+
+(defface image-dired-thumb-flagged
+ '((((class color) (min-colors 88) (background light)) :background "Red3")
+ (((class color) (min-colors 88) (background dark)) :background "Pink")
+ (((class color) (min-colors 16) (background light)) :background "Red3")
+ (((class color) (min-colors 16) (background dark)) :background "Pink")
+ (((class color) (min-colors 8)) :background "red")
+ (t :inverse-video t))
+ "Face for images flagged for deletion in thumbnail buffer."
+ :version "29.1")
+
+
+;;; Util functions
+
+(defun image-dired--file-name-regexp ()
+ (let ((image-file-name-extensions
+ (append '("pdf") image-file-name-extensions)))
+ (image-file-name-regexp)))
+
+(defun image-dired-insert-image (file type relief margin)
+ "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point."
+ (let ((i `(image :type ,type
+ :file ,file
+ :relief ,relief
+ :margin ,margin)))
+ (insert-image i)))
+
+(defun image-dired--get-create-thumbnail-file (file)
+ "Return the image descriptor for a thumbnail of image file FILE."
+ (unless (string-match-p (image-dired--file-name-regexp) file)
+ (error "%s is not a valid image file" file))
+ (let* ((thumb-file (image-dired-thumb-name file))
+ (thumb-attr (file-attributes thumb-file)))
+ (if (or (not thumb-attr)
+ (time-less-p (file-attribute-modification-time thumb-attr)
+ (file-attribute-modification-time
+ (file-attributes file))))
+ (image-dired-create-thumb file thumb-file)
+ (image-dired-debug "Found thumb for %s: %s"
+ (file-name-nondirectory file)
+ (file-name-nondirectory thumb-file)))
+ thumb-file))
+
+(defun image-dired-insert-thumbnail ( file original-file-name
+ associated-dired-buffer image-number)
+ "Insert thumbnail image FILE.
+Add text properties ORIGINAL-FILE-NAME, ASSOCIATED-DIRED-BUFFER
+and IMAGE-NUMBER."
+ (let (beg end)
+ (setq beg (point))
+ (image-dired-insert-image
+ file
+ ;; Thumbnails are created asynchronously, so we might not yet
+ ;; have a file. But if it exists, it might have been cached from
+ ;; before and we should use it instead of our current settings.
+ (or (and (file-exists-p file)
+ (image-type-from-file-header file))
+ (and (memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ 'png)
+ 'jpeg)
+ image-dired-thumb-relief
+ image-dired-thumb-margin)
+ (setq end (point))
+ (add-text-properties
+ beg end
+ (list 'image-dired-thumbnail t
+ ;; Disable `image-map' on thumbnails.
+ 'keymap nil
+ 'original-file-name original-file-name
+ 'associated-dired-buffer associated-dired-buffer
+ 'image-number image-number
+ 'tags (image-dired-list-tags original-file-name)
+ 'mouse-face 'highlight
+ 'comment (image-dired-get-comment original-file-name)))))
+
+(defmacro image-dired--with-marked (&rest body)
+ "Eval BODY with point on each marked thumbnail.
+If no marked file could be found, execute BODY on the current
+thumbnail. It's expected that a thumbnail is always followed
+by exactly one space or one newline character."
+ `(with-current-buffer image-dired-thumbnail-buffer
+ (let (found)
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (image-dired-thumb-file-marked-p)
+ (setq found t)
+ ,@body)
+ (forward-char 2)))
+ (unless found
+ ,@body))))
+
+(defun image-dired-create-thumbnail-buffer ()
+ "Create thumb buffer and set `image-dired-thumbnail-mode'."
+ (let ((buf (get-buffer-create image-dired-thumbnail-buffer)))
+ (with-current-buffer buf
+ (setq buffer-read-only t)
+ (if (not (eq major-mode 'image-dired-thumbnail-mode))
+ (image-dired-thumbnail-mode)))
+ buf))
+
+(defvar image-dired-saved-window-configuration nil
+ "Saved window configuration.")
+
+
+;;; Starting Image-Dired
+
+;;;###autoload
+(defun image-dired-dired-with-window-configuration (dir &optional arg)
+ "Open directory DIR and create a default window configuration.
+
+Convenience command that:
+
+ - Opens Dired in folder DIR
+ - Splits windows in most useful (?) way
+ - Sets `truncate-lines' to t
+
+After the command has finished, you would typically mark some
+image files in Dired and type
+\\[image-dired-display-thumbs] (`image-dired-display-thumbs').
+
+If called with prefix argument ARG, skip splitting of windows.
+
+The current window configuration is saved and can be restored by
+calling `image-dired-restore-window-configuration'."
+ (interactive "DDirectory: \nP")
+ (let ((buf (image-dired-create-thumbnail-buffer))
+ (buf2 (get-buffer-create image-dired-display-image-buffer)))
+ (setq image-dired-saved-window-configuration
+ (current-window-configuration))
+ (dired dir)
+ (delete-other-windows)
+ (when (not arg)
+ (split-window-right)
+ (setq truncate-lines t)
+ (save-excursion
+ (other-window 1)
+ (pop-to-buffer-same-window buf)
+ (select-window (split-window-below))
+ (pop-to-buffer-same-window buf2)
+ (other-window -2)))))
+
+(defun image-dired-restore-window-configuration ()
+ "Restore window configuration.
+Restore any changes to the window configuration made by calling
+`image-dired-dired-with-window-configuration'."
+ (interactive nil image-dired-thumbnail-mode)
+ (if image-dired-saved-window-configuration
+ (set-window-configuration image-dired-saved-window-configuration)
+ (message "No saved window configuration")))
+
+(defun image-dired--line-up-with-method ()
+ "Line up thumbnails according to `image-dired-line-up-method'."
+ (cond ((eq 'dynamic image-dired-line-up-method)
+ (image-dired-line-up-dynamic))
+ ((eq 'fixed image-dired-line-up-method)
+ (image-dired-line-up))
+ ((eq 'interactive image-dired-line-up-method)
+ (image-dired-line-up-interactive))
+ ((eq 'none image-dired-line-up-method)
+ nil)
+ (t
+ (image-dired-line-up-dynamic))))
+
+(defvar-local image-dired--number-of-thumbnails nil)
+
+;;;###autoload
+(defun image-dired-display-thumbs (&optional arg append do-not-pop)
+ "Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'.
+If a thumbnail image does not exist for a file, it is created on the
+fly. With prefix argument ARG, display only thumbnail for file at
+point (this is useful if you have marked some files but want to show
+another one).
+
+Recommended usage is to split the current frame horizontally so that
+you have the Dired buffer in the left window and the
+`image-dired-thumbnail-buffer' buffer in the right window.
+
+With optional argument APPEND, append thumbnail to thumbnail buffer
+instead of erasing it first.
+
+Optional argument DO-NOT-POP controls if `pop-to-buffer' should be
+used or not. If non-nil, use `display-buffer' instead of
+`pop-to-buffer'. This is used from functions like
+`image-dired-next-line-and-display' and
+`image-dired-previous-line-and-display' where we do not want the
+thumbnail buffer to be selected."
+ (interactive "P" nil dired-mode)
+ (setq image-dired--generate-thumbs-start (current-time))
+ (let ((buf (image-dired-create-thumbnail-buffer))
+ files dired-buf)
+ (if arg
+ (setq files (list (dired-get-filename)))
+ (setq files (dired-get-marked-files)))
+ (setq dired-buf (current-buffer))
+ (with-current-buffer buf
+ (let ((inhibit-read-only t))
+ (if (not append)
+ (progn
+ (setq image-dired--number-of-thumbnails 0)
+ (erase-buffer))
+ (goto-char (point-max)))
+ (dolist (file files)
+ (let ((thumb (image-dired--get-create-thumbnail-file file)))
+ (image-dired-insert-thumbnail
+ thumb file dired-buf
+ (cl-incf image-dired--number-of-thumbnails)))))
+ (if do-not-pop
+ (display-buffer buf)
+ (pop-to-buffer buf))
+ (image-dired--line-up-with-method))))
+
+;;;###autoload
+(defun image-dired-show-all-from-dir (dir)
+ "Make a thumbnail buffer for all images in DIR and display it.
+Any file matching `image-dired--file-name-regexp' is considered an
+image file.
+
+If the number of image files in DIR exceeds
+`image-dired-show-all-from-dir-max-files', ask for confirmation
+before creating the thumbnail buffer. If that variable is nil,
+never ask for confirmation."
+ (interactive "DShow thumbnails for directory: ")
+ (dired dir)
+ (dired-mark-files-regexp (image-dired--file-name-regexp))
+ (let ((files (dired-get-marked-files nil nil nil t)))
+ (cond ((and (null (cdr files)))
+ (message "No image files in directory"))
+ ((or (not image-dired-show-all-from-dir-max-files)
+ (<= (length (cdr files))
image-dired-show-all-from-dir-max-files)
+ (and (> (length (cdr files))
image-dired-show-all-from-dir-max-files)
+ (y-or-n-p
+ (format
+ "Directory contains more than %d image files. Proceed?"
+ image-dired-show-all-from-dir-max-files))))
+ (image-dired-display-thumbs)
+ (let ((inhibit-message t))
+ (dired-unmark-all-marks))
+ (pop-to-buffer image-dired-thumbnail-buffer)
+ (setq default-directory dir)
+ (image-dired--update-header-line))
+ (t (message "Image-Dired canceled")))))
+
+;;;###autoload
+(defalias 'image-dired 'image-dired-show-all-from-dir)
+
+
+;;; Movement tracking
+
+(defun image-dired-track-original-file ()
+ "Track the original file in the associated Dired buffer.
+See `image-dired-toggle-movement-tracking'. Interactive use is
+only useful if `image-dired-track-movement' is nil."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (let ((file-name (image-dired-original-file-name)))
+ (image-dired--with-dired-buffer
+ (if (not (dired-goto-file file-name))
+ (message "Could not find image in Dired buffer for tracking")
+ (when-let (window (image-dired-get-buffer-window (current-buffer)))
+ (set-window-point window (point)))))))
+
+(defun image-dired-toggle-movement-tracking ()
+ "Turn on and off `image-dired-track-movement'.
+Tracking of the movements between thumbnail and Dired buffer so that
+they are \"mirrored\" in the dired buffer. When this is on, moving
+around in the thumbnail or dired buffer will find the matching
+position in the other buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (setq image-dired-track-movement (not image-dired-track-movement))
+ (message "Movement tracking %s" (if image-dired-track-movement "on" "off")))
+
+
+;;; Navigation
+
+(defun image-dired-forward-image (&optional arg wrap-around)
+ "Move to next image in the thumbnail buffer.
+Optional prefix ARG says how many images to move; the default is
+one image. Negative means move backwards.
+On reaching end or beginning of buffer, stop and show a message.
+
+If optional argument WRAP-AROUND is non-nil, wrap around: if
+point is on the last image, move to the last one and vice versa."
+ (interactive "p" image-dired-thumbnail-mode)
+ (setq arg (or arg 1))
+ (let (pos)
+ (dotimes (_ (abs arg))
+ (if (and (not (if (> arg 0) (eobp) (bobp)))
+ (save-excursion
+ (forward-char (if (> arg 0) 1 -1))
+ (while (and (not (if (> arg 0) (eobp) (bobp)))
+ (not (image-dired-image-at-point-p)))
+ (forward-char (if (> arg 0) 1 -1)))
+ (setq pos (point))
+ (image-dired-image-at-point-p)))
+ (goto-char pos)
+ (if wrap-around
+ (goto-char (if (> arg 0)
+ (point-min)
+ ;; There are two spaces after the last image.
+ (- (point-max) 2)))
+ (message "At %s image" (if (> arg 0) "last" "first"))))))
+ (image-dired--update-header-line)
+ (when image-dired-track-movement
+ (image-dired-track-original-file)))
+
+(defun image-dired-backward-image (&optional arg)
+ "Move to previous image in the thumbnail buffer.
+Optional prefix ARG says how many images to move; the default is
+one image. Negative means move forward.
+On reaching end or beginning of buffer, stop and show a message."
+ (interactive "p" image-dired-thumbnail-mode)
+ (image-dired-forward-image (- (or arg 1))))
+
+(defun image-dired--movement-ensure-point-pos (&optional reverse)
+ "Ensure point is on an image."
+ (while (and (not (image-at-point-p))
+ (not (if reverse (bobp) (eobp))))
+ (forward-char (if reverse -1 1))))
+
+(defmacro image-dired--movement-command (to &optional reverse)
+ `(progn
+ (goto-char ,to)
+ (image-dired--movement-ensure-point-pos ,reverse)
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired--update-header-line)))
+
+(defmacro image-dired--movement-command-line (&optional reverse)
+ `(image-dired--movement-command
+ (let ((goal-column (current-column)))
+ (forward-line ,(if reverse -1 1))
+ (move-to-column goal-column)
+ (point))
+ ,reverse))
+
+(defun image-dired-next-line ()
+ "Move to next line in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command-line))
+
+(defun image-dired-previous-line ()
+ "Move to previous line in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command-line 'reverse))
+
+(defun image-dired-beginning-of-buffer ()
+ "Move to the first image in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command (point-min)))
+
+(defun image-dired-end-of-buffer ()
+ "Move to the last image in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command (point-max) 'reverse))
+
+(defun image-dired-move-beginning-of-line ()
+ "Move to the beginning of current line in thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command (pos-bol)))
+
+(defun image-dired-move-end-of-line ()
+ "Move to the end of current line in thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--movement-command (pos-eol) 'reverse))
+
+
+;;; Header line
+
+(defun image-dired-format-properties-string (buf file image-count props
comment)
+ "Format display properties.
+BUF is the associated Dired buffer, FILE is the original image
+file name, IMAGE-COUNT is a string like \"N/M\" where N is the
+number of this image and M is the total number of images, PROPS
+is a stringified list of tags, and COMMENT is the image file's
+comment."
+ (format-spec
+ image-dired-display-properties-format
+ `((?b . ,(or buf ""))
+ (?d . ,(propertize
+ (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory file)))
+ 'face 'image-dired-thumb-header-directory-name))
+ (?f . ,(propertize (file-name-nondirectory file)
+ 'face 'image-dired-thumb-header-file-name))
+ (?n . ,(propertize image-count
+ 'face 'image-dired-thumb-header-image-count))
+ (?s . ,(propertize (if (file-exists-p file)
+ (file-size-human-readable
+ (file-attribute-size
+ (file-attributes file)))
+ "<File missing>")
+ 'face 'image-dired-thumb-header-file-size))
+ (?t . ,(or props ""))
+ (?c . ,(or comment "")))))
+
+(defun image-dired--update-header-line ()
+ "Update image information in the header line."
+ (when (derived-mode-p 'image-dired-thumbnail-mode)
+ (let ((file-name (image-dired-original-file-name))
+ (dired-buf (buffer-name (image-dired-associated-dired-buffer)))
+ (image-count (format "%s/%s"
+ (get-text-property (point) 'image-number)
+ image-dired--number-of-thumbnails))
+ (props (string-join (get-text-property (point) 'tags) ", "))
+ (comment (get-text-property (point) 'comment))
+ (message-log-max nil))
+ (when file-name
+ (setq header-line-format
+ (image-dired-format-properties-string
+ dired-buf
+ file-name
+ image-count
+ props
+ comment))))))
+
+
+;;; Marking and flagging
+
+(defun image-dired-dired-file-marked-p (&optional marker)
+ "In Dired, return t if file on current line is marked.
+If optional argument MARKER is non-nil, it is a character to look
+for. The default is to look for `dired-marker-char'."
+ (setq marker (or marker dired-marker-char))
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at dired-re-mark)
+ (= (aref (match-string 0) 0) marker))))
+
+(defun image-dired-dired-file-flagged-p ()
+ "In Dired, return t if file on current line is flagged for deletion."
+ (image-dired-dired-file-marked-p dired-del-marker))
+
+(defmacro image-dired--on-file-in-dired-buffer (&rest body)
+ "Run BODY with point on file at point in Dired buffer.
+Should be called from commands in `image-dired-thumbnail-mode'."
+ (declare (indent defun) (debug t))
+ `(if-let ((file-name (image-dired-original-file-name)))
+ (image-dired--with-dired-buffer
+ (when (dired-goto-file file-name)
+ ,@body))
+ (message "No image with correct properties at point")))
+
+(defmacro image-dired--with-thumbnail-buffer (&rest body)
+ (declare (indent defun) (debug t))
+ `(if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
+ (with-current-buffer buf
+ (if-let ((win (get-buffer-window buf)))
+ (with-selected-window win
+ ,@body)
+ ,@body))
+ (user-error "No such buffer: %s" image-dired-thumbnail-buffer)))
+
+(defmacro image-dired--do-mark-command (maybe-next update-mark &rest body)
+ "Run BODY in Dired buffer.
+Helper macro for the mark, unmark and flag commands.
+
+If MAYBE-NEXT is non-nil, show next image according to
+`image-dired-marking-shows-next'.
+
+If UPDATE-MARK is non-nil, also update the mark in the thumbnail
+buffer with `image-dired--thumb-update-mark-at-point'."
+ (declare (indent defun) (debug t))
+ `(image-dired--with-thumbnail-buffer
+ (image-dired--on-file-in-dired-buffer
+ ,@body)
+ ,(when update-mark
+ '(image-dired--thumb-update-mark-at-point))
+ ,(when maybe-next
+ '(if image-dired-marking-shows-next
+ (image-dired-display-next)
+ (image-dired-forward-image)))))
+
+(defun image-dired-mark-thumb-original-file ()
+ "Mark original image file in associated Dired buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--do-mark-command t t
+ (dired-mark 1)))
+
+(defun image-dired-unmark-thumb-original-file ()
+ "Unmark original image file in associated Dired buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--do-mark-command t t
+ (dired-unmark 1)))
+
+(defun image-dired-flag-thumb-original-file ()
+ "Flag original image file for deletion in associated Dired buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--do-mark-command t t
+ (dired-flag-file-deletion 1)))
+
+(defun image-dired-unmark-all-marks ()
+ "Remove all marks from all files in associated Dired buffer.
+Also update the marks in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--do-mark-command nil t
+ (dired-unmark-all-marks))
+ (image-dired--with-thumbnail-buffer
+ (image-dired--thumb-update-marks)))
+
+(defun image-dired-jump-original-dired-buffer ()
+ "Jump to the Dired buffer associated with the current image file.
+You probably want to use this together with
+`image-dired-track-original-file'."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--with-dired-buffer
+ (if-let ((window (image-dired-get-buffer-window (current-buffer))))
+ (progn
+ (if (not (equal (selected-frame) (window-frame window)))
+ (select-frame-set-input-focus (window-frame window)))
+ (select-window window))
+ (message "Associated Dired buffer not visible"))))
+
+
+;;; Major modes
+
+(defvar-keymap image-dired-thumbnail-mode-map
+ :doc "Keymap for `image-dired-thumbnail-mode'."
+ "d" #'image-dired-flag-thumb-original-file
+ "<delete>" #'image-dired-flag-thumb-original-file
+ "m" #'image-dired-mark-thumb-original-file
+ "u" #'image-dired-unmark-thumb-original-file
+ "U" #'image-dired-unmark-all-marks
+ "x" #'image-dired-do-flagged-delete
+ "." #'image-dired-track-original-file
+ "<tab>" #'image-dired-jump-original-dired-buffer
+
+ "g g" #'image-dired-line-up-dynamic
+ "g f" #'image-dired-line-up
+ "g i" #'image-dired-line-up-interactive
+
+ "t t" #'image-dired-tag-thumbnail
+ "t r" #'image-dired-tag-thumbnail-remove
+
+ "RET" #'image-dired-display-this
+ "C-<return>" #'image-dired-thumbnail-display-external
+
+ "L" #'image-dired-rotate-original-left
+ "R" #'image-dired-rotate-original-right
+
+ "D" #'image-dired-thumbnail-set-image-description
+ "S" #'image-dired-slideshow-start
+ "C-d" #'image-dired-delete-char
+ "SPC" #'image-dired-display-next
+ "DEL" #'image-dired-display-previous
+ "c" #'image-dired-comment-thumbnail
+ "w" #'image-dired-copy-filename-as-kill
+ "W" #'image-dired-wallpaper-set
+
+ ;; Mouse
+ "<mouse-2>" #'image-dired-mouse-display-image
+ "<double-mouse-1>" #'image-dired-mouse-display-image
+ "<mouse-1>" #'image-dired-mouse-select-thumbnail
+ "<mouse-3>" #'image-dired-mouse-select-thumbnail
+ "<down-mouse-1>" #'image-dired-mouse-select-thumbnail
+ "<down-mouse-2>" #'image-dired-mouse-select-thumbnail
+ "<down-mouse-3>" #'image-dired-mouse-select-thumbnail
+ "C-<down-mouse-1>" #'ignore ; Don't open the buffer menu.
+ "C-<mouse-1>" #'image-dired-mouse-toggle-mark
+
+ "<remap> <forward-char>" #'image-dired-forward-image
+ "<remap> <backward-char>" #'image-dired-backward-image
+ "<remap> <next-line>" #'image-dired-next-line
+ "<remap> <previous-line>" #'image-dired-previous-line
+ "<remap> <left-char>" #'image-dired-backward-image
+ "<remap> <right-char>" #'image-dired-forward-image
+ "<remap> <beginning-of-buffer>" #'image-dired-beginning-of-buffer
+ "<remap> <end-of-buffer>" #'image-dired-end-of-buffer
+ "<remap> <move-beginning-of-line>" #'image-dired-move-beginning-of-line
+ "<remap> <move-end-of-line>" #'image-dired-move-end-of-line
+
+ :menu
+ '("Image-Dired"
+ ["Display image" image-dired-display-this]
+ ["Display in external viewer" image-dired-thumbnail-display-external]
+ ["Jump to Dired buffer" image-dired-jump-original-dired-buffer]
+ "---"
+ ["Mark image" image-dired-mark-thumb-original-file]
+ ["Unmark image" image-dired-unmark-thumb-original-file]
+ ["Unmark all images" image-dired-unmark-all-marks]
+ ["Flag for deletion" image-dired-flag-thumb-original-file]
+ ["Delete flagged images" image-dired-do-flagged-delete]
+ "---"
+ ["Rotate original right" image-dired-rotate-original-right]
+ ["Rotate original left" image-dired-rotate-original-left]
+ "---"
+ ["Comment thumbnail" image-dired-comment-thumbnail]
+ ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
+ ["Remove tag from current or marked thumbnails"
+ image-dired-tag-thumbnail-remove]
+ ["Start slideshow" image-dired-slideshow-start]
+ "---"
+ ("View Options"
+ ["Toggle movement tracking" image-dired-toggle-movement-tracking
+ :style toggle
+ :selected image-dired-track-movement]
+ "---"
+ ["Line up thumbnails" image-dired-line-up]
+ ["Dynamic line up" image-dired-line-up-dynamic]
+ ["Refresh thumb" image-dired-refresh-thumb])
+ ["Quit" quit-window]))
+
+(define-derived-mode image-dired-thumbnail-mode
+ special-mode "image-dired-thumbnail"
+ "Browse and manipulate thumbnail images using Dired.
+Use `image-dired-minor-mode' to get a nice setup."
+ :interactive nil
+ :group 'image-dired
+ (buffer-disable-undo)
+ (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil
t)
+ (setq-local window-resize-pixelwise t)
+ (setq-local bookmark-make-record-function #'image-dired-bookmark-make-record)
+ ;; Use approximately as much vertical spacing as horizontal.
+ (setq-local line-spacing (frame-char-width)))
+
+
+;;; image-dired-image-mode
+
+(define-obsolete-variable-alias 'image-dired-display-image-mode-map
+ 'image-dired-image-mode-map "29.1")
+(defvar-keymap image-dired-image-mode-map
+ :doc "Keymap for `image-dired-image-mode'."
+ "S" #'image-dired-slideshow-start
+ "SPC" #'image-dired-display-next
+ "DEL" #'image-dired-display-previous
+ "n" #'image-dired-display-next
+ "p" #'image-dired-display-previous
+ "m" #'image-dired-mark-thumb-original-file
+ "d" #'image-dired-flag-thumb-original-file
+ "u" #'image-dired-unmark-thumb-original-file
+ "U" #'image-dired-unmark-all-marks
+ ;; Disable keybindings from `image-mode-map' that doesn't make sense here.
+ "o" nil) ; image-save
+
+(define-derived-mode image-dired-image-mode
+ image-mode "image-dired-image-display"
+ "Mode for displaying and manipulating original image.
+Resized or in full-size."
+ :interactive nil
+ :group 'image-dired
+ (setq-local column-number-mode nil)
+ (setq-local line-number-mode nil)
+ (add-hook 'file-name-at-point-functions #'image-dired-file-name-at-point nil
t))
+
+
+;;; Slideshow
+
+(defcustom image-dired-slideshow-delay 5.0
+ "Seconds to wait before showing the next image in a slideshow.
+This is used by `image-dired-slideshow-start'."
+ :type 'float
+ :version "29.1")
+
+(define-obsolete-variable-alias 'image-dired-slideshow-timer
+ 'image-dired--slideshow-timer "29.1")
+(defvar image-dired--slideshow-timer nil
+ "Slideshow timer.")
+
+(defvar image-dired--slideshow-current-delay image-dired-slideshow-delay)
+
+(defun image-dired--slideshow-step ()
+ "Step to the next image in a slideshow."
+ (if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
+ (with-current-buffer buf
+ (image-dired-display-next))
+ (image-dired--slideshow-stop)))
+
+(defun image-dired--slideshow-start-timer ()
+ (image-dired--slideshow-stop-timer)
+ (setq image-dired--slideshow-timer
+ (run-with-timer image-dired--slideshow-current-delay
+ image-dired--slideshow-current-delay
+ 'image-dired--slideshow-step)))
+
+(defun image-dired--slideshow-stop-timer ()
+ (when image-dired--slideshow-timer
+ (cancel-timer image-dired--slideshow-timer)
+ (setq image-dired--slideshow-timer nil)))
+
+(defun image-dired-slideshow-start (&optional arg)
+ "Start a slideshow, waiting `image-dired-slideshow-delay' seconds between
images.
+
+With prefix argument ARG, wait that many seconds before going to
+the next image.
+
+With a negative prefix argument, prompt user for the delay."
+ (interactive "P" image-dired-thumbnail-mode image-dired-image-mode)
+ (let ((delay
+ (cond ((not arg)
+ image-dired-slideshow-delay)
+ ((> arg 0)
+ arg)
+ ((<= arg 0)
+ (string-to-number
+ (let ((delay (number-to-string image-dired-slideshow-delay)))
+ (read-string
+ (format-prompt "Delay, in seconds. Decimals are accepted"
+ delay))
+ delay))))))
+ (image-dired-display-this)
+ (setq image-dired--slideshow-current-delay delay)
+ (add-hook 'post-command-hook 'image-dired--slideshow-stop)))
+
+(defun image-dired--slideshow-show-message (&optional suffix)
+ "Helper function for `image-dired--slideshow-stop'."
+ (message (substitute-command-keys
+ (format
+ (concat
+ "\\[image-dired-display-next] next, "
+ "\\[image-dired-display-previous] previous, "
+ "\\[image-dired-display-this] pause/unpause, "
+ "any other command to stop%s")
+ (or suffix "")))))
+
+(defun image-dired--slideshow-stop ()
+ "Cancel the currently active slideshow."
+ (cond
+ ((memq this-command
+ '( image-dired-slideshow-start
+ image-dired-display-next
+ image-dired-display-previous))
+ (image-dired--slideshow-start-timer)
+ (image-dired--slideshow-show-message))
+ ((eq this-command 'image-dired-display-this)
+ (let ((pause image-dired--slideshow-timer))
+ (if pause
+ (image-dired--slideshow-stop-timer)
+ (image-dired--slideshow-start-timer))
+ (image-dired--slideshow-show-message (and pause " [PAUSED]"))))
+ (t
+ (image-dired--slideshow-stop-timer)
+ (remove-hook 'post-command-hook 'image-dired--slideshow-stop))))
+
+
+;;; Thumbnail layout and display
+
+(defun image-dired-delete-char ()
+ "Remove current thumbnail from thumbnail buffer and line up."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((inhibit-read-only t))
+ (delete-char 1))
+ (let ((pos (point)))
+ (image-dired--line-up-with-method)
+ (goto-char pos)))
+
+(defun image-dired-line-up ()
+ "Line up thumbnails according to `image-dired-thumbs-per-row'.
+See also `image-dired-line-up-dynamic'."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (and (not (image-dired-image-at-point-p))
+ (not (eobp)))
+ (delete-char 1))
+ (while (not (eobp))
+ (forward-char)
+ (while (and (not (image-dired-image-at-point-p))
+ (not (eobp)))
+ (delete-char 1)))
+ (goto-char (point-min))
+ (let ((seen 0)
+ (thumb-prev-pos 0)
+ (thumb-width-chars
+ (ceiling (/ (+ (* 2 image-dired-thumb-relief)
+ (* 2 image-dired-thumb-margin)
+ (image-dired--thumb-size))
+ (float (frame-char-width))))))
+ (while (not (eobp))
+ (forward-char)
+ (if (= image-dired-thumbs-per-row 1)
+ (insert "\n")
+ (cl-incf thumb-prev-pos thumb-width-chars)
+ (insert (propertize " " 'display `(space :align-to ,thumb-prev-pos)))
+ (cl-incf seen)
+ (when (and (= seen (- image-dired-thumbs-per-row 1))
+ (not (eobp)))
+ (forward-char)
+ (insert "\n")
+ (setq seen 0)
+ (setq thumb-prev-pos 0)))))
+ (goto-char (point-min))))
+
+(defun image-dired-line-up-dynamic ()
+ "Line up thumbnails images dynamically.
+Calculate how many thumbnails fit."
+ (interactive nil image-dired-thumbnail-mode)
+ (let* ((char-width (frame-char-width))
+ (width (window-body-width (image-dired-thumbnail-window) t))
+ (image-dired-thumbs-per-row
+ (/ width
+ (+ (* 2 image-dired-thumb-relief)
+ (* 2 image-dired-thumb-margin)
+ (image-dired--thumb-size)
+ char-width))))
+ (image-dired-line-up)))
+
+(defun image-dired-line-up-interactive ()
+ "Line up thumbnails interactively.
+Ask user how many thumbnails should be displayed per row."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((image-dired-thumbs-per-row
+ (string-to-number (read-string "How many thumbs per row: "))))
+ (if (not (> image-dired-thumbs-per-row 0))
+ (message "Number must be greater than 0")
+ (image-dired-line-up))))
+
+
+;;; Display image from thumbnail buffer
+
+(defun image-dired-thumbnail-display-external ()
+ "Display original image for thumbnail at point using external viewer."
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((file (image-dired-original-file-name)))
+ (if (not (image-dired-image-at-point-p))
+ (message "No thumbnail at point")
+ (if (not file)
+ (message "No original file name found")
+ (apply #'start-process "image-dired-thumb-external" nil
+ (append (string-split image-dired-external-viewer " ")
+ (list file)))))))
+
+(defun image-dired-display-image (file &optional _ignored)
+ "Display image FILE in the image buffer window.
+If it is an image, the window will use `image-dired-image-mode'
+which is based on `image-mode'."
+ (declare (advertised-calling-convention (file) "29.1"))
+ (setq file (expand-file-name file))
+ (when (not (file-exists-p file))
+ (error "No such file: %s" file))
+ (let ((buf (get-buffer image-dired-display-image-buffer))
+ (cur-win (selected-window)))
+ (when buf
+ (kill-buffer buf))
+ (when-let ((buf (find-file-noselect file nil t)))
+ (pop-to-buffer buf)
+ (rename-buffer image-dired-display-image-buffer)
+ (if (string-match (image-file-name-regexp) file)
+ (image-dired-image-mode)
+ ;; Support visiting PDF files.
+ (normal-mode))
+ (select-window cur-win))))
+
+(defun image-dired-display-this (&optional arg)
+ "Display current thumbnail's original image in display buffer.
+See documentation for `image-dired-display-image' for more information.
+With prefix argument ARG, display image in its original size."
+ (interactive "P" image-dired-thumbnail-mode)
+ (unless (string-equal major-mode "image-dired-thumbnail-mode")
+ (user-error "Not in `image-dired-thumbnail-mode'"))
+ (let ((file (image-dired-original-file-name)))
+ (cond ((not (image-dired-image-at-point-p))
+ (message "No thumbnail at point"))
+ ((not file)
+ (message "No original file name found"))
+ (t
+ (image-dired-display-image file arg)))))
+
+(defun image-dired-display-next (&optional arg)
+ "Move to the next image in the thumbnail buffer and display it.
+With prefix ARG, move that many thumbnails."
+ (interactive "p" image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--with-thumbnail-buffer
+ (image-dired-forward-image arg t)
+ (image-dired-display-this)))
+
+(defun image-dired-display-previous (arg)
+ "Move to the previous image in the thumbnail buffer and display it.
+With prefix ARG, move that many thumbnails."
+ (interactive "p" image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired-display-next (- arg)))
+
+
+;;; Misc commands
+
+(defun image-dired-rotate-original-left ()
+ "Rotate original image left (counter clockwise) 90 degrees.
+The result of the rotation is displayed in the image display area
+and a confirmation is needed before the original image files is
+overwritten. This confirmation can be turned off using
+`image-dired-rotate-original-ask-before-overwrite'."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--with-marked
+ (image-dired-rotate-original "270")))
+
+(defun image-dired-rotate-original-right ()
+ "Rotate original image right (clockwise) 90 degrees.
+The result of the rotation is displayed in the image display area
+and a confirmation is needed before the original image files is
+overwritten. This confirmation can be turned off using
+`image-dired-rotate-original-ask-before-overwrite'."
+ (interactive nil image-dired-thumbnail-mode)
+ (image-dired--with-marked
+ (image-dired-rotate-original "90")))
+
+(defun image-dired-wallpaper-set (file)
+ "Set the wallpaper to FILE in a graphical environment."
+ (interactive (list (image-dired-original-file-name))
+ image-dired-thumbnail-mode)
+ (wallpaper-set file))
+
+(defun image-dired-comment-thumbnail ()
+ "Add comment to current thumbnail in thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode)
+ (let* ((file (image-dired-original-file-name))
+ (comment (image-dired-read-comment file)))
+ (image-dired-write-comments (list (cons file comment)))
+ (image-dired-update-property 'comment comment))
+ (image-dired--update-header-line))
+
+(defun image-dired-copy-filename-as-kill (&optional arg)
+ "Copy names of marked (or next ARG) files into the kill ring.
+This works as `dired-copy-filename-as-kill' (which see)."
+ (interactive "P" image-dired-thumbnail-mode)
+ (image-dired--with-dired-buffer
+ (dired-copy-filename-as-kill arg)))
+
+
+;;; Mouse support
+
+(defun image-dired-mouse-display-image (event)
+ "Use mouse EVENT, call `image-dired-display-image' to display image.
+Track this in associated Dired buffer if `image-dired-track-movement' is
+non-nil."
+ (interactive "e")
+ (mouse-set-point event)
+ (goto-char (posn-point (event-end event)))
+ (unless (image-at-point-p)
+ (image-dired-backward-image))
+ (let ((file (image-dired-original-file-name)))
+ (when file
+ (if image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired-display-image file))))
+
+(defun image-dired-mouse-select-thumbnail (event)
+ "Use mouse EVENT to select thumbnail image.
+Track this in associated Dired buffer if `image-dired-track-movement' is
+non-nil."
+ (interactive "e")
+ (mouse-set-point event)
+ (goto-char (posn-point (event-end event)))
+ (unless (image-at-point-p)
+ (image-dired-backward-image))
+ (if image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired--update-header-line))
+
+
+
+;;; Dired marks and tags
+
+(defun image-dired-thumb-file-marked-p (&optional flagged)
+ "Check if file is marked in associated Dired buffer.
+If optional argument FLAGGED is non-nil, check if file is flagged
+for deletion instead."
+ (let ((file-name (image-dired-original-file-name)))
+ (image-dired--with-dired-buffer
+ (save-excursion
+ (when (dired-goto-file file-name)
+ (if flagged
+ (image-dired-dired-file-flagged-p)
+ (image-dired-dired-file-marked-p)))))))
+
+(defun image-dired-thumb-file-flagged-p ()
+ "Check if file is flagged for deletion in associated Dired buffer."
+ (image-dired-thumb-file-marked-p t))
+
+(defun image-dired-do-flagged-delete ()
+ "Delete flagged thumbnails and associated images."
+ (interactive nil image-dired-thumbnail-mode)
+ (unless (derived-mode-p 'image-dired-thumbnail-mode)
+ (user-error "Not in `image-dired-thumbnail-mode'"))
+ (image-dired--with-dired-buffer
+ (dired-do-flagged-delete))
+ (let (deletions)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((file-name (image-dired-original-file-name)))
+ (if (image-dired--with-dired-buffer (dired-goto-file file-name))
+ (forward-char 2)
+ (delete-char 1)
+ (forward-char)
+ (setq deletions t))))))
+ (if deletions
+ (image-dired--line-up-with-method))))
+
+(defun image-dired--thumb-update-mark-at-point ()
+ (with-silent-modifications
+ (cond ((image-dired-thumb-file-marked-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-mark))
+ ((image-dired-thumb-file-flagged-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-flagged))
+ (t (remove-text-properties (point) (1+ (point))
+ '(face image-dired-thumb-mark))))))
+
+(defun image-dired--thumb-update-marks ()
+ "Update the marks in the thumbnail buffer.
+It's expected, that a thumbnail is always followed
+by exactly one space or one newline character."
+ (when image-dired-thumb-visible-marks
+ (with-current-buffer image-dired-thumbnail-buffer
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (image-dired--thumb-update-mark-at-point)
+ (forward-char 2)))))))
+
+(defun image-dired-mouse-toggle-mark-1 ()
+ "Toggle Dired mark for current thumbnail.
+Track this in associated Dired buffer if
+`image-dired-track-movement' is non-nil."
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired--do-mark-command nil nil
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1))))
+
+(defun image-dired-mouse-toggle-mark (event)
+ "Use mouse EVENT to toggle Dired mark for thumbnail.
+Toggle marks of all thumbnails in region, if it's active.
+Track this in associated Dired buffer if
+`image-dired-track-movement' is non-nil."
+ (interactive "e")
+ (if (use-region-p)
+ (let ((end (region-end)))
+ (save-excursion
+ (goto-char (region-beginning))
+ (while (<= (point) end)
+ (when (image-dired-image-at-point-p)
+ (image-dired-mouse-toggle-mark-1))
+ (forward-char))))
+ (mouse-set-point event)
+ (goto-char (posn-point (event-end event)))
+ (image-dired-mouse-toggle-mark-1))
+ (image-dired--thumb-update-marks))
+
+
+;;; bookmark.el support
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+
+(defun image-dired-bookmark-name ()
+ "Create a default bookmark name for the current EWW buffer."
+ (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory (image-dired-original-file-name)))))
+
+(defun image-dired-bookmark-make-record ()
+ "Create a bookmark for the current EWW buffer."
+ `(,(image-dired-bookmark-name)
+ ,@(bookmark-make-record-default t)
+ (location . ,(file-name-directory (image-dired-original-file-name)))
+ (image-dired-file . ,(file-name-nondirectory
(image-dired-original-file-name)))
+ (handler . image-dired-bookmark-jump)))
+
+;;;###autoload
+(defun image-dired-bookmark-jump (bookmark)
+ "Default bookmark handler for Image-Dired buffers."
+ ;; User already cached thumbnails, so disable any checking.
+ (let ((image-dired-show-all-from-dir-max-files nil))
+ (image-dired (bookmark-prop-get bookmark 'location))
+ ;; TODO: Go to the bookmarked file, if it exists.
+ ;; (bookmark-prop-get bookmark 'image-dired-file)
+ (goto-char (point-min))))
+
+(put 'image-dired-bookmark-jump 'bookmark-handler-type "Image-Dired")
+
+
+;;; Obsolete
+
+;;;###autoload
+(define-obsolete-function-alias 'tumme #'image-dired "24.4")
+
+;;;###autoload
+(define-obsolete-function-alias 'image-dired-setup-dired-keybindings
+ #'image-dired-minor-mode "26.1")
+
+(make-obsolete-variable 'image-dired-thumb-width
+ 'image-dired-thumb-size "29.1")
+(defcustom image-dired-thumb-width image-dired-thumb-size
+ "Width of thumbnails, in pixels."
+ :type 'natnum)
+
+(make-obsolete-variable 'image-dired-thumb-height
+ 'image-dired-thumb-size "29.1")
+(defcustom image-dired-thumb-height image-dired-thumb-size
+ "Height of thumbnails, in pixels."
+ :type 'natnum)
+
+(defcustom image-dired-temp-image-file
+ (expand-file-name ".image-dired_temp" image-dired-dir)
+ "Name of temporary image file used by various commands."
+ :type 'file)
+(make-obsolete-variable 'image-dired-temp-image-file
+ "no longer used." "29.1")
+
+(defcustom image-dired-cmd-create-temp-image-program
+ (if (executable-find "gm") "gm" "convert")
+ "Executable used to create temporary image.
+Used together with `image-dired-cmd-create-temp-image-options'."
+ :type 'file
+ :version "29.1")
+(make-obsolete-variable 'image-dired-cmd-create-temp-image-program
+ "no longer used." "29.1")
+
+(defcustom image-dired-cmd-create-temp-image-options
+ (let ((opts '("-size" "%wx%h" "%f[0]"
+ "-resize" "%wx%h>"
+ "-strip" "jpeg:%t")))
+ (if (executable-find "gm") (cons "convert" opts) opts))
+ "Options of command used to create temporary image for display window.
+Used together with `image-dired-cmd-create-temp-image-program',
+Available format specifiers are: %w and %h which are replaced by
+the calculated max size for width and height in the image display window,
+%f which is replaced by the file name of the original image and %t which
+is replaced by the file name of the temporary file."
+ :version "29.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-create-temp-image-options
+ "no longer used." "29.1")
+
+(defcustom image-dired-display-window-width-correction 1
+ "Number to be used to correct image display window width.
+Change if the default (1) does not work (i.e. if the image does not
+completely fit)."
+ :type 'integer)
+(make-obsolete-variable 'image-dired-display-window-width-correction
+ "no longer used." "29.1")
+
+(defcustom image-dired-display-window-height-correction 0
+ "Number to be used to correct image display window height.
+Change if the default (0) does not work (i.e. if the image does not
+completely fit)."
+ :type 'integer)
+(make-obsolete-variable 'image-dired-display-window-height-correction
+ "no longer used." "29.1")
+
+(defun image-dired-toggle-mark-thumb-original-file ()
+ "Toggle mark on original image file in associated Dired buffer."
+ (declare (obsolete nil "29.1"))
+ (interactive nil image-dired-thumbnail-mode image-dired-image-mode)
+ (image-dired--do-mark-command nil t
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1))))
+
+(defun image-dired-display-window-width (window)
+ "Return width, in pixels, of WINDOW."
+ (declare (obsolete nil "29.1"))
+ (- (window-body-width window t)
+ image-dired-display-window-width-correction))
+
+(defun image-dired-display-window-height (window)
+ "Return height, in pixels, of WINDOW."
+ (declare (obsolete nil "29.1"))
+ (- (image-dired-window-height-pixels window)
+ image-dired-display-window-height-correction))
+
+(defun image-dired-window-height-pixels (window)
+ "Calculate WINDOW height in pixels."
+ (declare (obsolete nil "29.1"))
+ ;; Note: The mode-line consumes one line
+ (* (- (window-height window) 1) (frame-char-height)))
+
+(defcustom image-dired-cmd-read-exif-data-program "exiftool"
+ "Program used to read EXIF data to image.
+Used together with `image-dired-cmd-read-exif-data-options'."
+ :type 'file)
+(make-obsolete-variable 'image-dired-cmd-read-exif-data-program
+ "use `exif-parse-file' and `exif-field' instead."
"29.1")
+
+(defcustom image-dired-cmd-read-exif-data-options '("-s" "-s" "-s" "-%t" "%f")
+ "Arguments of command used to read EXIF data.
+Used with `image-dired-cmd-read-exif-data-program'.
+Available format specifiers are: %f which is replaced
+by the image file name and %t which is replaced by the tag name."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-read-exif-data-options
+ "use `exif-parse-file' and `exif-field' instead."
"29.1")
+
+(defun image-dired-get-exif-data (file tag-name)
+ "From FILE, return EXIF tag TAG-NAME."
+ (declare (obsolete "use `exif-parse-file' and `exif-field' instead."
"29.1"))
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-read-exif-data-program)
+ (let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
+ (spec (list (cons ?f file) (cons ?t tag-name)))
+ tag-value)
+ (with-current-buffer buf
+ (delete-region (point-min) (point-max))
+ (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
+ nil t nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-read-exif-data-options))
+ 0))
+ (error "Could not get EXIF tag")
+ (goto-char (point-min))
+ ;; Clean buffer from newlines and carriage returns before
+ ;; getting final info
+ (while (search-forward-regexp "[\n\r]" nil t)
+ (replace-match "" nil t))
+ (setq tag-value (buffer-substring (point-min) (point-max)))))
+ tag-value))
+
+(defcustom image-dired-cmd-rotate-thumbnail-program
+ (if (executable-find "gm") "gm" "mogrify")
+ "Executable used to rotate thumbnail.
+Used together with `image-dired-cmd-rotate-thumbnail-options'."
+ :type 'file
+ :version "29.1")
+(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-program nil "29.1")
+
+(defcustom image-dired-cmd-rotate-thumbnail-options
+ (let ((opts '("-rotate" "%d" "%t")))
+ (if (executable-find "gm") (cons "mogrify" opts) opts))
+ "Arguments of command used to rotate thumbnail image.
+Used with `image-dired-cmd-rotate-thumbnail-program'.
+Available format specifiers are: %d which is replaced by the
+number of (positive) degrees to rotate the image, normally 90 or 270
+\(for 90 degrees right and left), %t which is replaced by the file name
+of the thumbnail file."
+ :version "29.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1")
+
+(declare-function clear-image-cache "image.c" (&optional filter))
+
+(defun image-dired-rotate-thumbnail (degrees)
+ "Rotate thumbnail DEGREES degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-rotate-thumbnail-program)
+ (if (not (image-dired-image-at-point-p))
+ (message "No thumbnail at point")
+ (let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
+ (thumb (expand-file-name file))
+ (spec (list (cons ?d degrees) (cons ?t thumb))))
+ (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil
nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-thumbnail-options))
+ (clear-image-cache thumb))))
+
+(defun image-dired-rotate-thumbnail-left ()
+ "Rotate thumbnail left (counter clockwise) 90 degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
+ (image-dired-rotate-thumbnail "270")))
+
+(defun image-dired-rotate-thumbnail-right ()
+ "Rotate thumbnail counter right (clockwise) 90 degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
+ (image-dired-rotate-thumbnail "90")))
+
+(defun image-dired-modify-mark-on-thumb-original-file (command)
+ "Modify mark in Dired buffer.
+COMMAND is one of `mark' for marking file in Dired, `unmark' for
+unmarking file in Dired or `flag' for flagging file for delete in
+Dired."
+ (declare (obsolete image-dired--on-file-in-dired-buffer "29.1"))
+ (let ((file-name (image-dired-original-file-name))
+ (dired-buf (image-dired-associated-dired-buffer)))
+ (if (not (and dired-buf file-name))
+ (message "No image, or image with correct properties, at point")
+ (with-current-buffer dired-buf
+ (message "%s" file-name)
+ (when (dired-goto-file file-name)
+ (cond ((eq command 'mark) (dired-mark 1))
+ ((eq command 'unmark) (dired-unmark 1))
+ ((eq command 'toggle)
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1)))
+ ((eq command 'flag) (dired-flag-file-deletion 1)))
+ (image-dired--thumb-update-marks))))))
+
+(defun image-dired-display-current-image-full ()
+ "Display current image in full size."
+ (declare (obsolete image-transform-reset-to-original "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((file (image-dired-original-file-name)))
+ (if file
+ (progn
+ (image-dired-display-image file)
+ (with-current-buffer image-dired-display-image-buffer
+ (image-transform-reset-to-original)))
+ (error "No original file name at point"))))
+
+(defun image-dired-display-current-image-sized ()
+ "Display current image in sized to fit window dimensions."
+ (declare (obsolete image-mode-fit-frame "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((file (image-dired-original-file-name)))
+ (if file
+ (progn
+ (image-dired-display-image file))
+ (error "No original file name at point"))))
+
+(make-obsolete-variable 'image-dired-tag-file-list nil "29.1")
+(defvar image-dired-tag-file-list nil
+ "List to store tag-file structure.")
+
+(defun image-dired-add-to-tag-file-list (tag file)
+ "Add relation between TAG and FILE."
+ (declare (obsolete nil "29.1"))
+ (let (curr)
+ (if image-dired-tag-file-list
+ (if (setq curr (assoc tag image-dired-tag-file-list))
+ (if (not (member file curr))
+ (setcdr curr (cons file (cdr curr))))
+ (setcdr image-dired-tag-file-list
+ (cons (list tag file) (cdr image-dired-tag-file-list))))
+ (setq image-dired-tag-file-list (list (list tag file))))))
+
+(defvar image-dired-slideshow-count 0
+ "Keeping track on number of images in slideshow.")
+(make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1")
+
+(defvar image-dired-slideshow-times 0
+ "Number of pictures to display in slideshow.")
+(make-obsolete-variable 'image-dired-slideshow-times "no longer used." "29.1")
+
+(make-obsolete-variable 'image-dired-gallery-dir nil "29.1")
+(defcustom image-dired-gallery-dir
+ (expand-file-name ".image-dired_gallery" image-dired-dir)
+ "Directory to store generated gallery html pages.
+The name of this directory needs to be \"shared\" to the public
+so that it can access the index.html page that image-dired creates."
+ :type 'directory)
+
+(make-obsolete-variable 'image-dired-gallery-image-root-url nil "29.1")
+(defcustom image-dired-gallery-image-root-url
+ "https://example.org/image-diredpics";
+ "URL where the full size images are to be found on your web server.
+Note that this URL has to be configured on your web server.
+Image-Dired expects to find pictures in this directory.
+This is used by `image-dired-gallery-generate'."
+ :type 'string
+ :version "29.1")
+
+(make-obsolete-variable 'image-dired-gallery-thumb-image-root-url nil "29.1")
+(defcustom image-dired-gallery-thumb-image-root-url
+ "https://example.org/image-diredthumbs";
+ "URL where the thumbnail images are to be found on your web server.
+Note that URL path has to be configured on your web server.
+Image-Dired expects to find pictures in this directory.
+This is used by `image-dired-gallery-generate'."
+ :type 'string
+ :version "29.1")
+
+(make-obsolete-variable 'image-dired-gallery-hidden-tags nil "29.1")
+(defcustom image-dired-gallery-hidden-tags
+ (list "private" "hidden" "pending")
+ "List of \"hidden\" tags.
+Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
+ :type '(repeat string))
+
+(make-obsolete-variable 'image-dired-file-tag-list nil "29.1")
+(defvar image-dired-file-tag-list nil
+ "List to store file-tag structure.")
+
+(make-obsolete-variable 'image-dired-file-comment-list nil "29.1")
+(defvar image-dired-file-comment-list nil
+ "List to store file comments.")
+
+(defun image-dired--add-to-tag-file-lists (tag file)
+ "Helper function used from `image-dired--create-gallery-lists'.
+
+Add TAG to FILE in one list and FILE to TAG in the other.
+
+Lisp structures look like the following:
+
+image-dired-file-tag-list:
+
+ ((\"filename1\" \"tag1\" \"tag2\" \"tag3\" ...)
+ (\"filename2\" \"tag1\" \"tag2\" \"tag3\" ...)
+ ...)
+
+image-dired-tag-file-list:
+
+ ((\"tag1\" \"filename1\" \"filename2\" \"filename3\" ...)
+ (\"tag2\" \"filename1\" \"filename2\" \"filename3\" ...)
+ ...)"
+ (declare (obsolete nil "29.1"))
+ ;; Add tag to file list
+ (let (curr)
+ (if image-dired-file-tag-list
+ (if (setq curr (assoc file image-dired-file-tag-list))
+ (setcdr curr (cons tag (cdr curr)))
+ (setcdr image-dired-file-tag-list
+ (cons (list file tag) (cdr image-dired-file-tag-list))))
+ (setq image-dired-file-tag-list (list (list file tag))))
+ ;; Add file to tag list
+ (if image-dired-tag-file-list
+ (if (setq curr (assoc tag image-dired-tag-file-list))
+ (if (not (member file curr))
+ (setcdr curr (cons file (cdr curr))))
+ (setcdr image-dired-tag-file-list
+ (cons (list tag file) (cdr image-dired-tag-file-list))))
+ (setq image-dired-tag-file-list (list (list tag file))))))
+
+(defun image-dired--add-to-file-comment-list (file comment)
+ "Helper function used from `image-dired--create-gallery-lists'.
+
+For FILE, add COMMENT to list.
+
+Lisp structure looks like the following:
+
+image-dired-file-comment-list:
+
+ ((\"filename1\" . \"comment1\")
+ (\"filename2\" . \"comment2\")
+ ...)"
+ (declare (obsolete nil "29.1"))
+ (if image-dired-file-comment-list
+ (if (not (assoc file image-dired-file-comment-list))
+ (setcdr image-dired-file-comment-list
+ (cons (cons file comment)
+ (cdr image-dired-file-comment-list))))
+ (setq image-dired-file-comment-list (list (cons file comment)))))
+
+(defun image-dired--create-gallery-lists ()
+ "Create temporary lists used by `image-dired-gallery-generate'."
+ (declare (obsolete nil "29.1"))
+ (image-dired-sane-db-file)
+ (image-dired--with-db-file
+ (let (end beg file row-tags)
+ (setq image-dired-tag-file-list nil)
+ (setq image-dired-file-tag-list nil)
+ (setq image-dired-file-comment-list nil)
+ (goto-char (point-min))
+ (while (search-forward-regexp "^." nil t)
+ (end-of-line)
+ (setq end (point))
+ (beginning-of-line)
+ (setq beg (point))
+ (unless (search-forward ";" end nil)
+ (error "Something is really wrong, check format of database"))
+ (setq row-tags (split-string
+ (buffer-substring beg end) ";"))
+ (setq file (car row-tags))
+ (dolist (x (cdr row-tags))
+ (with-suppressed-warnings
+ ((obsolete image-dired--add-to-tag-file-lists
+ image-dired--add-to-file-comment-list))
+ (if (not (string-match "^comment:\\(.*\\)" x))
+ (image-dired--add-to-tag-file-lists x file)
+ (image-dired--add-to-file-comment-list file (match-string 1
x))))))))
+ ;; Sort tag-file list
+ (setq image-dired-tag-file-list
+ (sort image-dired-tag-file-list
+ (lambda (x y)
+ (string< (car x) (car y))))))
+
+(defun image-dired--hidden-p (file)
+ "Return t if image FILE has a \"hidden\" tag."
+ (declare (obsolete nil "29.1"))
+ (cl-loop for tag in (cdr (assoc file image-dired-file-tag-list))
+ if (member tag image-dired-gallery-hidden-tags) return t))
+
+(defun image-dired-gallery-generate ()
+ "Generate gallery pages.
+First we create a couple of Lisp structures from the database to make
+it easier to generate, then HTML-files are created in
+`image-dired-gallery-dir'."
+ (declare (obsolete nil "29.1"))
+ (interactive)
+ (if (eq 'per-directory image-dired-thumbnail-storage)
+ (error "Currently, gallery generation is not supported \
+when using per-directory thumbnail file storage"))
+ (with-suppressed-warnings ((obsolete image-dired--create-gallery-lists))
+ (image-dired--create-gallery-lists))
+ (let ((tags image-dired-tag-file-list)
+ (index-file (format "%s/index.html" image-dired-gallery-dir))
+ count tag tag-file
+ comment file-tags tag-link tag-link-list)
+ ;; Make sure gallery root exist
+ (if (file-exists-p image-dired-gallery-dir)
+ (if (not (file-directory-p image-dired-gallery-dir))
+ (error "Variable image-dired-gallery-dir is not a directory"))
+ ;; FIXME: Should we set umask to 077 here, as we do for thumbnails?
+ (make-directory image-dired-gallery-dir))
+ ;; Open index file
+ (with-temp-file index-file
+ (if (file-exists-p index-file)
+ (insert-file-contents index-file))
+ (insert "<html>\n")
+ (insert " <body>\n")
+ (insert " <h2>Image-Dired Gallery</h2>\n")
+ (insert (format "<p>\n Gallery generated %s\n <p>\n"
+ (current-time-string)))
+ (insert " <h3>Tag index</h3>\n")
+ (setq count 1)
+ ;; Pre-generate list of all tag links
+ (dolist (curr tags)
+ (setq tag (car curr))
+ (when (not (member tag image-dired-gallery-hidden-tags))
+ (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag))
+ (if tag-link-list
+ (setq tag-link-list
+ (append tag-link-list (list (cons tag tag-link))))
+ (setq tag-link-list (list (cons tag tag-link))))
+ (setq count (1+ count))))
+ (setq count 1)
+ ;; Main loop where we generated thumbnail pages per tag
+ (dolist (curr tags)
+ (setq tag (car curr))
+ ;; Don't display hidden tags
+ (when (not (member tag image-dired-gallery-hidden-tags))
+ ;; Insert link to tag page in index
+ (insert (format " %s<br>\n" (cdr (assoc tag tag-link-list))))
+ ;; Open per-tag file
+ (setq tag-file (format "%s/%s.html" image-dired-gallery-dir count))
+ (with-temp-file tag-file
+ (if (file-exists-p tag-file)
+ (insert-file-contents tag-file))
+ (erase-buffer)
+ (insert "<html>\n")
+ (insert " <body>\n")
+ (insert " <p><a href=\"index.html\">Index</a></p>\n")
+ (insert (format " <h2>Images with tag "%s"</h2>" tag))
+ ;; Main loop for files per tag page
+ (dolist (file (cdr curr))
+ (unless (image-dired-hidden-p file)
+ ;; Insert thumbnail with link to full image
+ (insert
+ (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
+ image-dired-gallery-image-root-url
+ (file-name-nondirectory file)
+ image-dired-gallery-thumb-image-root-url
+ (file-name-nondirectory (image-dired-thumb-name
file)) file))
+ ;; Insert comment, if any
+ (if (setq comment (cdr (assoc file
image-dired-file-comment-list)))
+ (insert (format "<br>\n%s<br>\n" comment))
+ (insert "<br>\n"))
+ ;; Insert links to other tags, if any
+ (when (> (length
+ (setq file-tags (assoc file
image-dired-file-tag-list))) 2)
+ (insert "[ ")
+ (dolist (extra-tag file-tags)
+ ;; Only insert if not file name or the main tag
+ (if (and (not (equal extra-tag tag))
+ (not (equal extra-tag file)))
+ (insert
+ (format "%s " (cdr (assoc extra-tag
tag-link-list))))))
+ (insert "]<br>\n"))))
+ (insert " <p><a href=\"index.html\">Index</a></p>\n")
+ (insert " </body>\n")
+ (insert "</html>\n"))
+ (setq count (1+ count))))
+ (insert " </body>\n")
+ (insert "</html>"))))
+
+(define-obsolete-function-alias 'image-dired-slideshow-step
#'image-dired--slideshow-step "29.1")
+(define-obsolete-function-alias 'image-dired-slideshow-stop
#'image-dired--slideshow-stop "29.1")
+(define-obsolete-function-alias 'image-dired-create-display-image-buffer
+ #'ignore "29.1")
+;; These can't use the #' quote as they point to obsolete names.
+(define-obsolete-function-alias 'image-dired-create-gallery-lists
+ 'image-dired--create-gallery-lists "29.1")
+(define-obsolete-function-alias 'image-dired-add-to-file-comment-list
+ 'image-dired--add-to-file-comment-list "29.1")
+(define-obsolete-function-alias 'image-dired-add-to-tag-file-lists
+ 'image-dired--add-to-tag-file-lists "29.1")
+(define-obsolete-function-alias 'image-dired-hidden-p
+ 'image-dired--hidden-p "29.1")
+(define-obsolete-function-alias 'image-dired-thumb-update-marks
+ #'image-dired--thumb-update-marks "29.1")
+(define-obsolete-function-alias 'image-dired-get-thumbnail-image
+ #'image-dired--get-create-thumbnail-file "29.1")
+(define-obsolete-function-alias 'image-dired-display-thumb-properties
+ #'image-dired--update-header-line "29.1")
+(define-obsolete-function-alias 'image-dired-delete-marked
+ #'image-dired-do-flagged-delete "29.1")
+(define-obsolete-function-alias 'image-dired-display-image-mode
+ #'image-dired-image-mode "29.1")
+(define-obsolete-function-alias 'image-dired-display-thumbnail-original-image
+ #'image-dired-display-this "29.1")
+(define-obsolete-function-alias 'image-dired-display-next-thumbnail-original
+ #'image-dired-display-next "29.1")
+(define-obsolete-function-alias
'image-dired-display-previous-thumbnail-original
+ #'image-dired-display-previous "29.1")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;; TEST-SECTION ;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (defvar image-dired-dir-max-size 12300000)
+
+;; (defun image-dired-test-clean-old-files ()
+;; "Clean `image-dired-dir' from old thumbnail files.
+;; \"Oldness\" measured using last access time. If the total size of all
+;; thumbnail files in `image-dired-dir' is larger than
'image-dired-dir-max-size',
+;; old files are deleted until the max size is reached."
+;; (let* ((files
+;; (sort
+;; (mapcar
+;; (lambda (f)
+;; (let ((fattribs (file-attributes f)))
+;; `(,(file-attribute-access-time fattribs)
+;; ,(file-attribute-size fattribs) ,f)))
+;; (directory-files (image-dired-dir) t ".+\\.thumb\\..+$"))
+;; ;; Sort function. Compare time between two files.
+;; (lambda (l1 l2)
+;; (time-less-p (car l1) (car l2)))))
+;; (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
+;; (while (> dirsize image-dired-dir-max-size)
+;; (y-or-n-p
+;; (format "Size of thumbnail directory: %d, delete old file %s? "
+;; dirsize (cadr (cdar files))))
+;; (delete-file (cadr (cdar files)))
+;; (setq dirsize (- dirsize (car (cdar files))))
+;; (setq files (cdr files)))))
+
+(provide 'image-dired)
+
+;;; image-dired.el ends here
diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
new file mode 100644
index 0000000000..f083477ddf
--- /dev/null
+++ b/lisp/image/wallpaper.el
@@ -0,0 +1,586 @@
+;;; wallpaper.el --- Change the desktop background -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: images
+
+;; 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 the command `wallpaper-set', which sets the
+;; desktop background.
+;;
+;; On GNU/Linux and other Unix-like systems, it uses an external
+;; 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
+;; environments and tools. However, it should be detected
+;; automatically in most cases. If it doesn't work in your
+;; environment, customize the user options `wallpaper-command' and
+;; `wallpaper-command-args'.
+;;
+;; On MS-Windows, it uses the `w32-set-wallpaper' function, and on
+;; Haiku the `haiku-set-wallpaper' function, neither of which relies
+;; on any external commands. The value of `wallpaper-command' and
+;; `wallpaper-command-args' are ignored on such systems.
+;;
+;; On macOS, the "osascript" command is used. You might need to
+;; disable the option "Change picture" in the "Desktop & Screensaver"
+;; preferences for this to work (this was seen with macOS 10.13).
+;; You might also have to tweak some permissions.
+;;
+;; Note: If you find that you need to use a command in your
+;; environment that was not automatically detected, we would love to
+;; hear about it! Please send an email to bug-gnu-emacs@gnu.org and
+;; tell us the command (and all options) that worked for you. You can
+;; also use `M-x report-emacs-bug'.
+
+;;; Code:
+
+(eval-when-compile (require 'subr-x))
+(require 'xdg)
+(require 'cl-macs)
+
+(defvar wallpaper-debug nil
+ "If non-nil, display debug messages.")
+
+(defun wallpaper-debug (&rest args)
+ (when wallpaper-debug
+ (apply #'message
+ (concat "wallpaper-debug: " (car args))
+ (cdr args))))
+
+(defvar wallpaper-set-function
+ (cond ((fboundp 'w32-set-wallpaper)
+ #'w32-set-wallpaper)
+ ((and (fboundp 'haiku-set-wallpaper)
+ (featurep 'haiku))
+ 'haiku-set-wallpaper)
+ (#'wallpaper-default-set-function))
+ "Function used by `wallpaper-set' to set the wallpaper.
+The function takes one argument, FILE, which is the file name of
+the image file to set the wallpaper to.")
+
+(defun wallpaper--use-default-set-function-p ()
+ (eq wallpaper-set-function #'wallpaper-default-set-function))
+
+
+;;; Finding the wallpaper command
+
+(cl-defstruct (wallpaper-setter
+ ;; Get rid of the default constructor (`make-wallpaper-cmd').
+ (:constructor nil)
+ (:constructor
+ wallpaper-setter-create
+ ( name command args-raw
+ &rest rest-plist
+ &aux
+ (args (if (or (listp args-raw) (symbolp args-raw))
+ args-raw
+ (string-split args-raw)))
+ (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 method to set the wallpaper.
+
+NAME is a description of the setter (e.g. the name of the Desktop
+Environment).
+
+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.
+
+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)
+ 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
+ (mapcar
+ (lambda (item)
+ `(wallpaper-setter-create ,@item))
+ items)))
+
+(defvar wallpaper--default-setters
+ (wallpaper--default-methods-create
+
+ ;; macOS.
+ ;; NB. Should come first to override everything else.
+ ("macOS"
+ "osascript"
+ '("-e" "tell application \"Finder\" to set desktop picture to POSIX file
\"%f\"")
+ :predicate (lambda ()
+ (eq system-type 'darwin)))
+
+ ;; Desktop environments.
+ ("Gnome"
+ "gsettings"
+ "set org.gnome.desktop.background picture-uri file://%F"
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (member (downcase (getenv "DESKTOP_SESSION"))
+ '("gnome" "gnome" "gnome-wayland"
"gnome-xorg"
+ "unity" "ubuntu" "pantheon"
"budgie-desktop"
+ "pop")))
+ (member "GNOME" (xdg-current-desktop))
+ (member "Budgie" (xdg-current-desktop))
+ (member "GNOME-Classic" (xdg-current-desktop)))))
+
+ ("KDE Plasma"
+ "plasma-apply-wallpaperimage" "%f"
+ :predicate (lambda ()
+ (member "KDE" (xdg-current-desktop))))
+
+ ("XFCE"
+ "xfconf-query" #'wallpaper-xfce-command-args
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (member (downcase (getenv "DESKTOP_SESSION"))
+ '("xubuntu" "ubuntustudio")))
+ (member "XFCE" (xdg-current-desktop)))))
+
+ ("LXDE"
+ "pcmanfm" "--set-wallpaper=%f"
+ :predicate (lambda ()
+ (member "LXDE" (xdg-current-desktop))))
+
+ ("LXQt"
+ "pcmanfm-qt" "--set-wallpaper=%f" ; "--wallpaper-mode=MODE"
+ :predicate (lambda ()
+ (or (member (and (getenv "DESKTOP_SESSION")
+ (downcase (getenv "DESKTOP_SESSION")))
+ '("lubuntu" "lxqt"))
+ (member "LXQt" (xdg-current-desktop)))))
+
+ ("Mate"
+ "gsettings" "set org.mate.background picture-filename %f"
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (equal "mate" (downcase (getenv "DESKTOP_SESSION"))))
+ (member "MATE" (xdg-current-desktop)))))
+
+ ("Cinnamon"
+ "gsettings" "set org.cinnamon.desktop.background picture-uri file://%F"
+ :predicate (lambda ()
+ (or (equal "cinnamon" (and (getenv "DESKTOP_SESSION")
+ (downcase (getenv
"DESKTOP_SESSION"))))
+ (member "X-Cinnamon" (xdg-current-desktop)))))
+
+ ("Deepin"
+ "gsettings" "set com.deepin.wrap.gnome.desktop.background picture-uri
file://%F"
+ :predicate (lambda ()
+ (member "Deepin" (xdg-current-desktop))))
+
+ ;; Wayland general.
+ ("Sway (Wayland)"
+ "swaybg" "-o * -i %f -m fill"
+ :predicate (lambda ()
+ (and (getenv "WAYLAND_DISPLAY")
+ (getenv "SWAYSOCK")))
+ :init-action (wallpaper--init-action-kill "swaybg")
+ :detach t)
+
+ ("wbg"
+ "wbg" "%f"
+ :predicate (lambda ()
+ (getenv "WAYLAND_DISPLAY"))
+ :init-action (wallpaper--init-action-kill "wbg")
+ :detach t)
+
+ ;; X general.
+ ("GraphicsMagick"
+ "gm" "display -size %wx%h -window root %f")
+
+ ("ImageMagick"
+ "display" "-resize %wx%h -window root %f")
+
+ ("feh"
+ "feh" "--bg-max %f")
+
+ ("fbsetbg"
+ "fbsetbg" "-a %f")
+
+ ("xwallpaper"
+ "xwallpaper" "--zoom %f")
+
+ ("hsetroot"
+ "hsetroot" "-full %f")
+
+ ("xloadimage"
+ "xloadimage" "-onroot -fullscreen %f")
+
+ ("xsetbg"
+ "xsetbg" "%f")
+ )
+ "List of setters used for setting the wallpaper.
+Every item in the list is a structure of type
+`wallpaper-setter' (which see).
+
+This is used by `wallpaper--find-command' to automatically set
+`wallpaper-command', and by `wallpaper--find-command-args' to set
+`wallpaper-command-args'. The setters will be tested in the
+order in which they appear.")
+
+(defun wallpaper-xfce-command-args ()
+ (let ((info
+ (with-temp-buffer
+ (call-process "xfconf-query" nil t nil
+ "-c" "xfce4-desktop"
+ "-p" "/backdrop/single-workspace-mode")
+ (buffer-string))))
+ (list "-c" "xfce4-desktop"
+ "-p" (format "/backdrop/screen%%S/monitor%%M/workspace%s/last-image"
+ (if (equal info "true")
+ "0"
+ "%W"))
+ "-s" "%f")))
+
+(defvar wallpaper--current-setter nil)
+
+(defun wallpaper--find-setter ()
+ (when (wallpaper--use-default-set-function-p)
+ (or (and (wallpaper-setter-p wallpaper--current-setter)
+ wallpaper--current-setter)
+ (setq wallpaper--current-setter
+ (catch 'found
+ (dolist (setter wallpaper--default-setters)
+ (wallpaper-debug "Testing setter %s" (wallpaper-setter-name
setter))
+ (when (and (executable-find (wallpaper-setter-command
setter))
+ (if-let ((pred (wallpaper-setter-predicate
setter)))
+ (funcall pred)
+ t))
+ (wallpaper-debug "Found setter %s" (wallpaper-setter-name
setter))
+ (throw 'found setter))))))))
+
+(defun wallpaper--find-command ()
+ "Return a valid command to set the wallpaper in this environment."
+ (when-let ((setter (wallpaper--find-setter)))
+ (wallpaper-setter-command setter)))
+
+(defun wallpaper--find-command-args ()
+ "Return command line arguments matching `wallpaper-command'."
+ (when-let ((setter (wallpaper--find-setter)))
+ (wallpaper-setter-args setter)))
+
+
+;;; Customizable variables
+
+(defvar wallpaper-command-args) ; silence byte-compiler
+(defun wallpaper--set-wallpaper-command (sym val)
+ "Set `wallpaper-command', and update `wallpaper-command-args'.
+Used to set `wallpaper-command'."
+ ;; Note: `wallpaper-command' is used by `wallpaper--find-command-args'.
+ (prog1 (set-default sym val)
+ (set-default 'wallpaper-command-args
+ (wallpaper--find-command-args))))
+
+(defcustom wallpaper-command (wallpaper--find-command)
+ "Executable used by `wallpaper-set' for setting the wallpaper.
+A suitable command for your environment should be detected
+automatically, so there is usually no need to customize this.
+
+If you set this to any supported command using customize or
+`setopt', the user option `wallpaper-command-args' is
+automatically updated to match. If you need to change this to an
+unsupported command, you will want to manually customize
+`wallpaper-command-args' to match.
+
+The value of this variable is ignored on MS-Windows and Haiku
+systems, where a native API is used instead."
+ :type
+ '(choice
+ (radio
+ (const :tag "gsettings (GNOME)" "gsettings")
+ (const :tag "plasma-apply-wallpaperimage (KDE Plasma)"
"plasma-apply-wallpaperimage")
+ (const :tag "xfconf-query (XFCE)"
"xfconf-query")
+ (const :tag "pcmanf (LXDE)" "pcmanf")
+ (const :tag "pcmanf-qt (LXQt)" "pcmanf-qt")
+ (const :tag "swaybg (Wayland/Sway)" "swaybg")
+ (const :tag "wbg (Wayland)" "wbg")
+ (const :tag "gm (X Window System)" "gm")
+ (const :tag "display (X Window System)" "display")
+ (const :tag "feh (X Window System)" "feh")
+ (const :tag "fbsetbg (X Window System)" "fbsetbg")
+ (const :tag "xwallpaper (X Window System)" "xwallpaper")
+ (const :tag "hsetroot (X Window System)" "hsetroot")
+ (const :tag "xloadimage (X Window System)" "xloadimage")
+ (const :tag "xsetbg (X Window System)" "xsetbg")
+ (const :tag "osascript (macOS)" "osascript"))
+ (const :tag "Other (specify)" string)
+ (const :tag "None" nil))
+ :set #'wallpaper--set-wallpaper-command
+ :group 'image
+ :version "29.1")
+
+(defcustom wallpaper-command-args (wallpaper--find-command-args)
+ "Command line arguments for `wallpaper-command'.
+A suitable command for your environment should be detected
+automatically, so there is usually no need to customize this.
+However, if you do need to change this, you might also want to
+customize `wallpaper-command' to match.
+
+The value is a list of command list arguments to use, or a
+function that returns a list of command line arguments.
+
+In each command line argument, these specifiers will be replaced:
+
+ %f full file name
+ %h height of the selected frame's display (as returned
+ by `display-pixel-height')
+ %w the width of the selected frame's display (as returned
+ by `display-pixel-width').
+ %F full file name URI-encoded
+ %S current X screen (e.g. \"0\")
+ %W current workspace (e.g., \"0\")
+ %M name of the monitor (e.g., \"0\" or \"LVDS\")
+
+If `wallpaper-set' is run from a TTY frame, instead prompt for a
+height and width to use for %h and %w.
+
+The value of this variable is ignored on MS-Windows and Haiku
+systems, where a native API is used instead."
+ :type '(choice (repeat string)
+ function)
+ :group 'image
+ :version "29.1")
+
+
+;;; Utility functions
+
+(defvar wallpaper-default-width 1080
+ "Default width used by `wallpaper-set'.
+This is only used when it can't be detected automatically.
+See also `wallpaper-default-height'.")
+
+(defvar wallpaper-default-height 1920
+ "Default height used by `wallpaper-set'.
+This is only used when it can't be detected automatically.
+See also `wallpaper-default-width'.")
+
+(defun wallpaper--get-height-or-width (desc fun default)
+ (cond ((display-graphic-p) (funcall fun))
+ (noninteractive default)
+ ((read-number (format "Wallpaper %s in pixels: " desc) default))))
+
+(autoload 'ffap-file-at-point "ffap")
+
+(defvar wallpaper-image-file-extensions
+ '("bmp" "gif" "heif" "jpeg" "jpg" "png" "tif" "tiff" "webp")
+ "List of file extensions that `wallpaper-set' will consider for completion.")
+
+(defun wallpaper--image-file-regexp ()
+ (rx-to-string '(: "." (eval `(or ,@wallpaper-image-file-extensions)) eos) t))
+
+(defun wallpaper--get-default-file ()
+ (catch 'found
+ (dolist (file (list buffer-file-name (ffap-file-at-point)))
+ (when (and file (string-match (wallpaper--image-file-regexp) file))
+ (throw 'found (abbreviate-file-name
+ (expand-file-name file)))))))
+
+
+;;; wallpaper-set
+
+(defun wallpaper--x-monitor-name ()
+ "Get the monitor name for `wallpaper-set'.
+On a graphical display, try using the same monitor as the current
+frame.
+On a non-graphical display, try to get the name by connecting to
+the display server directly, and run \"xrandr\" if that doesn't
+work. Prompt for the monitor name if neither method works.
+
+This function is meaningful only on X and is used only there."
+ (if (or (display-graphic-p)
+ noninteractive)
+ (let-alist (car (display-monitor-attributes-list))
+ (if (and .name (member .source '("XRandr" "XRandR 1.5" "Gdk")))
+ .name
+ "0"))
+ (if-let ((name
+ (and (getenv "DISPLAY")
+ (or
+ (cdr (assq 'name
+ (progn
+ (x-open-connection (getenv "DISPLAY"))
+ (car (display-monitor-attributes-list
+ (car (last (terminal-list))))))))
+ (and (executable-find "xrandr")
+ (with-temp-buffer
+ (call-process "xrandr" nil t nil)
+ (goto-char (point-min))
+ (re-search-forward (rx bol
+ (group (+ (not (in " \n"))))
+ " connected")
+ nil t)
+ (match-string 1)))))))
+ ;; Prefer "0" to "default" as that works in XFCE.
+ (if (equal name "default") "0" name)
+ (read-string (format-prompt "Monitor name" nil)))))
+
+(defun wallpaper--format-arg (format file)
+ "Format a `wallpaper-command-args' argument ARG.
+FILE is the image file name."
+ (format-spec
+ format
+ `((?f . ,(expand-file-name file))
+ (?F . ,(lambda ()
+ (mapconcat #'url-hexify-string
+ (file-name-split file)
+ "/")))
+ (?h . ,(lambda ()
+ (wallpaper--get-height-or-width
+ "height"
+ #'display-pixel-height
+ wallpaper-default-height)))
+ (?w . ,(lambda ()
+ (wallpaper--get-height-or-width
+ "width"
+ #'display-pixel-width
+ wallpaper-default-width)))
+ ;; screen number
+ (?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 . ,(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.
+This is the default function for `wallpaper-set-function'."
+ (unless wallpaper-command
+ (error "Couldn't find a command to set the wallpaper with"))
+ (let* ((args (if (functionp wallpaper-command-args)
+ (funcall wallpaper-command-args)
+ wallpaper-command-args))
+ (real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file))
+ args))
+ (bufname (format " *wallpaper-%s*" (random)))
+ (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 " "))
+ (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
+(defun wallpaper-set (file)
+ "Set the desktop background to FILE in a graphical environment.
+
+On GNU/Linux and other Unix-like systems, this relies on an
+external command. Which command to use is automatically detected
+in most cases, but can be manually customized with the user
+options `wallpaper-command' and `wallpaper-command-args'.
+
+On MS-Windows and Haiku systems, no external command is needed,
+so the value of `wallpaper-commands' is ignored."
+ (interactive
+ (let ((default (wallpaper--get-default-file)))
+ (list (read-file-name (format-prompt "Set desktop background to" default)
+ default-directory default
+ t nil
+ (let ((re (wallpaper--image-file-regexp)))
+ (lambda (file-name)
+ (or (file-directory-p file-name)
+ (string-match re file-name))))))))
+ (when (file-directory-p file)
+ (error "Can't set wallpaper to a directory: %s" file))
+ (unless (file-exists-p file)
+ (error "No such file: %s" file))
+ (unless (file-readable-p file)
+ (error "File is not readable: %s" file))
+ (wallpaper-debug "Using image %S:" file)
+ (funcall wallpaper-set-function file))
+
+(provide 'wallpaper)
+
+;;; wallpaper.el ends here
diff --git a/lisp/imenu.el b/lisp/imenu.el
index dcd816cb7a..7f68bd15b9 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -208,6 +208,13 @@ called within a `save-excursion'.
See `imenu--index-alist' for the format of the buffer index alist.")
+;;;###autoload
+(defvar-local imenu-submenus-on-top t
+ "Flag specifying whether items with sublists should be kept at top.
+
+For some indexes, such as those describing sections in a document, it
+makes sense to keep their original order even in the menubar.")
+
;;;###autoload
(defvar-local imenu-prev-index-position-function 'beginning-of-defun
"Function for finding the next index position.
@@ -310,7 +317,7 @@ element recalculates the buffer's index alist.")
(defvar imenu--history-list nil
;; Making this buffer local caused it not to work!
- "History list for `jump-to-function-in-buffer'.")
+ "History list for `imenu-choose-buffer-index'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -373,10 +380,11 @@ The returned alist DOES NOT share structure with
MENULIST."
(if (memq imenu--rescan-item menulist)
(setq keep-at-top (list imenu--rescan-item)
menulist (delq imenu--rescan-item menulist)))
- (dolist (item menulist)
- (when (imenu--subalist-p item)
- (push item keep-at-top)
- (setq menulist (delq item menulist))))
+ (if imenu-submenus-on-top
+ (dolist (item menulist)
+ (when (imenu--subalist-p item)
+ (push item keep-at-top)
+ (setq menulist (delq item menulist)))))
(if imenu-sort-function
(setq menulist (sort menulist imenu-sort-function)))
(if (> (length menulist) imenu-max-items)
diff --git a/lisp/indent.el b/lisp/indent.el
index f52b729051..c7ec5c9a3e 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -695,12 +695,10 @@ A value of nil means a tab stop every `tab-width'
columns."
:safe 'listp
:type '(repeat integer))
-(defvar edit-tab-stops-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" 'edit-tab-stops-note-changes)
- (define-key map "\C-c\C-c" 'edit-tab-stops-note-changes)
- map)
- "Keymap used in `edit-tab-stops'.")
+(defvar-keymap edit-tab-stops-map
+ :doc "Keymap used in `edit-tab-stops'."
+ "C-x C-s" #'edit-tab-stops-note-changes
+ "C-c C-c" #'edit-tab-stops-note-changes)
(defvar edit-tab-stops-buffer nil
"Buffer whose tab stops are being edited.
@@ -734,7 +732,9 @@ You can add or remove colons and then do
\\<edit-tab-stops-map>\\[edit-tab-stops
(while (> count 0)
(insert "0123456789")
(setq count (1- count))))
- (insert "\nTo install changes, type C-c C-c")
+ (insert (substitute-command-keys
+ (concat "\nTo install changes, type \\<edit-tab-stops-map>"
+ "\\[edit-tab-stops-note-changes]")))
(goto-char (point-min)))
(defun edit-tab-stops-note-changes ()
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 7f45f976a2..2eec6f49f5 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -130,7 +130,8 @@ OTHER-MODES is a list of cross references to other help
modes.")
(defun info-lookup--expand-info (info)
;; We have a dynamic doc-spec function.
(when (and (null (nth 3 info))
- (nth 6 info))
+ (nth 6 info)
+ (functionp (nth 6 info)))
(setf (nth 3 info) (funcall (nth 6 info))
(nth 6 info) nil))
info)
@@ -1050,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 fb4c3fd782..02dde50dd6 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -451,6 +451,7 @@ or `Info-virtual-nodes'."
(".info.z" . "gunzip")
(".info.bz2" . ("bzip2" "-dc"))
(".info.xz" . "unxz")
+ (".info.zst" . ("zstd" "-dc"))
(".info" . nil)
("-info.Z" . "uncompress")
("-info.Y" . "unyabba")
@@ -458,6 +459,7 @@ or `Info-virtual-nodes'."
("-info.bz2" . ("bzip2" "-dc"))
("-info.z" . "gunzip")
("-info.xz" . "unxz")
+ ("-info.zst" . ("zstd" "-dc"))
("-info" . nil)
("/index.Z" . "uncompress")
("/index.Y" . "unyabba")
@@ -465,6 +467,7 @@ or `Info-virtual-nodes'."
("/index.z" . "gunzip")
("/index.bz2" . ("bzip2" "-dc"))
("/index.xz" . "unxz")
+ ("/index.zst" . ("zstd" "-dc"))
("/index" . nil)
(".Z" . "uncompress")
(".Y" . "unyabba")
@@ -472,6 +475,7 @@ or `Info-virtual-nodes'."
(".z" . "gunzip")
(".bz2" . ("bzip2" "-dc"))
(".xz" . "unxz")
+ (".zst" . ("zstd" "-dc"))
("" . nil)))
"List of file name suffixes and associated decoding commands.
Each entry should be (SUFFIX . STRING); the file is given to
@@ -759,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*"))))
@@ -1874,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.
@@ -2472,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))
@@ -2531,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)
@@ -4451,9 +4461,12 @@ Advanced commands:
(setq buffer-read-only t)
(setq Info-tag-table-marker (make-marker))
(unless (or (display-multi-font-p)
- (coding-system-equal
- (coding-system-base (terminal-coding-system))
- 'utf-8))
+ (and (coding-system-equal
+ (coding-system-base (terminal-coding-system))
+ 'utf-8)
+ ;; The Linux console has limited character
+ ;; repertoire even when its encoding is UTF-8.
+ (not (equal (tty-type) "linux"))))
(dolist (elt info-symbols-and-replacements)
(let ((ch (car elt))
(repl (cdr elt)))
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index d6e83c81e7..9dcae187f2 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -152,6 +152,9 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry '(#x20000 . #x2FFFF) ?|)
(modify-category-entry '(#x20000 . #x2FFFF) ?C)
(modify-category-entry '(#x20000 . #x2FFFF) ?c)
+(modify-category-entry '(#x30000 . #x323AF) ?|)
+(modify-category-entry '(#x30000 . #x323AF) ?C)
+(modify-category-entry '(#x30000 . #x323AF) ?c)
;; Chinese character set (GB2312)
@@ -227,7 +230,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry #x1B001 ?H)
(modify-category-entry #x1B11F ?H)
(modify-category-entry '(#x1B150 . #x1B152) ?H)
-(modify-category-entry '(#x1B002 . #x1B11E) ?H) ; Hentiagana
+(modify-category-entry '(#x1B002 . #x1B11E) ?H) ; Hentaigana
(modify-category-entry '(#x1AFF0 . #x1B1FF) ?j)
@@ -306,6 +309,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry '(#xfb50 . #xfdcf) ?b)
(modify-category-entry '(#xfdf0 . #xfdff) ?b)
(modify-category-entry '(#xfe70 . #xfefe) ?b)
+(modify-category-entry '(#x10ec0 . #x10eff) ?b)
;; Cyrillic character set (ISO-8859-5)
@@ -615,6 +619,9 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Cyrillic Extended-C
(modify-category-entry '(#x1C80 . #x1C8F) ?y)
+ ;; Cyrillic Extended-D
+ (modify-category-entry '(#x1E030 . #x1E08F) ?y)
+
;; space characters (see section 6.2 in the Unicode Standard)
(set-case-syntax ? " " tbl)
(setq c #x2000)
@@ -1283,16 +1290,24 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x2B1B . #x2B1C)
(#x2B50 . #x2B50)
(#x2B55 . #x2B55)
- (#x2E80 . #x303E)
- (#x3040 . #x3247)
+ (#x2E80 . #x2E99)
+ (#x2E9B . #x2EF3)
+ (#x2F00 . #x2FD5)
+ (#x2FF0 . #x2FFB)
+ (#x3000 . #x303E)
+ (#x3041 . #x3096)
+ (#x3099 . #x30FF)
+ (#x3105 . #x312F)
+ (#x3131 . #x31E3)
+ (#x31F0 . #x3247)
(#x3250 . #x4DBF)
- (#x4E00 . #x9FFF)
+ (#x4E00 . #xA48C)
(#xA490 . #xA4C6)
- (#xA960 . #xA97F)
+ (#xA960 . #xA97C)
(#xAC00 . #xD7A3)
(#xF900 . #xFAFF)
(#xFE10 . #xFE19)
- (#xFE30 . #xFE6F)
+ (#xFE30 . #xFE6B)
(#xFF01 . #xFF60)
(#xFFE0 . #xFFE6)
(#x16FE0 . #x16FE4)
@@ -1300,8 +1315,14 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x17000 . #x187F7)
(#x18800 . #x18AFF)
(#x18B00 . #x18CD5)
- (#x1AFF0 . #x1AFFF)
- (#x1B000 . #x1B152)
+ (#x18D00 . #x18D08)
+ (#x1AFF0 . #x1AFF3)
+ (#x1AFF5 . #x1AFFB)
+ (#x1AFFD . #x1AFFE)
+ (#x1B000 . #x1B122)
+ (#x1B132 . #x1B132)
+ (#x1B150 . #x1B152)
+ (#x1B155 . #x1B155)
(#x1B164 . #x1B167)
(#x1B170 . #x1B2FB)
(#x1F004 . #x1F004)
@@ -1309,7 +1330,12 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x1F18E . #x1F18E)
(#x1F191 . #x1F19A)
(#x1F1AD . #x1F1AD)
- (#x1F200 . #x1F320)
+ (#x1F200 . #x1F202)
+ (#x1F210 . #x1F23B)
+ (#x1F240 . #x1F248)
+ (#x1F250 . #x1F251)
+ (#x1F260 . #x1F265)
+ (#x1F300 . #x1F320)
(#x1F32D . #x1F335)
(#x1F337 . #x1F37C)
(#x1F37E . #x1F393)
@@ -1334,10 +1360,11 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x1F6CC . #x1F6CC)
(#x1F6D0 . #x1F6D2)
(#x1F6D5 . #x1F6D7)
- (#x1F6DD . #x1F6DF)
+ (#x1F6DC . #x1F6DF)
(#x1F6EB . #x1F6EC)
(#x1F6F4 . #x1F6FC)
- (#x1F7E0 . #x1F7F0)
+ (#x1F7E0 . #x1F7EB)
+ (#x1F7F0 . #x1F7F0)
(#x1F90C . #x1F93A)
(#x1F93C . #x1F945)
(#x1F947 . #x1F9FF)
@@ -1345,13 +1372,12 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x1FA60 . #x1FA6D)
(#x1FA70 . #x1FA74)
(#x1FA78 . #x1FA7C)
- (#x1FA80 . #x1FA86)
- (#x1FA90 . #x1FAAC)
- (#x1FAB0 . #x1FABA)
- (#x1FAC0 . #x1FAC5)
- (#x1FAD0 . #x1FAD9)
- (#x1FAE0 . #x1FAE7)
- (#x1FAF0 . #x1FAF6)
+ (#x1FA80 . #x1FA88)
+ (#x1FA90 . #x1FABD)
+ (#x1FABF . #x1FAC5)
+ (#x1FACE . #x1FADB)
+ (#x1FAE0 . #x1FAE8)
+ (#x1FAF0 . #x1FAF8)
(#x1FB00 . #x1FB92)
(#x20000 . #x2FFFF)
(#x30000 . #x3FFFF))))
@@ -1661,12 +1687,14 @@ GROUP must be one of these symbols:
like U+2069 (PDI) and U+202B (RLE).
`variation-selectors':
Characters in the range U+FE00..U+FE0F and
- U+E0100..U+E01EF, used for selecting alternate glyph
- presentations, such as Emoji vs Text presentation, of
- the preceding character(s).
- `no-font': For GUI frames, characters for which no suitable
- font is found; for text-mode frames, characters
- that cannot be encoded by `terminal-coding-system'.
+ U+E0100..U+E01EF, used for choosing between
+ glyph variations, such as Emoji vs Text
+ presentation, of the preceding character(s).
+ `no-font': For GUI frames, characters for which no
+ suitable font is found; for text-mode frames,
+ characters that cannot be encoded by
+ `terminal-coding-system' or those for which
+ the terminal has no glyphs.
METHOD must be one of these symbols:
`zero-width': don't display.
@@ -1680,7 +1708,10 @@ METHOD must be one of these symbols:
Do not set its value directly from Lisp; the value takes effect
only via a custom `:set'
function (`update-glyphless-char-display'), which updates
-`glyphless-char-display'."
+`glyphless-char-display'.
+
+See also the `glyphless-char' face, which is used to display the
+visual representation of these characters."
:version "28.1"
:type '(alist :key-type (symbol :tag "Character Group")
:value-type (symbol :tag "Display Method"))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 8d34aa99c3..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)
@@ -221,6 +221,7 @@
(lycian #x10280)
(carian #x102A0)
(old-italic #x10300)
+ (gothic #x10330 #x10348)
(ugaritic #x10380)
(old-permic #x10350)
(old-persian #x103A0)
@@ -270,6 +271,7 @@
(masaram-gondi #x11D00)
(gunjala-gondi #x11D60)
(makasar #x11EE0 #x11EF7)
+ (kawi #x11F04 #x11F41 #x11F4F)
(cuneiform #x12000)
(cypro-minoan #x12F90)
(egyptian #x13000)
@@ -286,18 +288,21 @@
(byzantine-musical-symbol #x1D000)
(musical-symbol #x1D100)
(ancient-greek-musical-notation #x1D200)
+ (kaktovik-numeral #x1D2C0)
(tai-xuan-jing-symbol #x1D300)
(counting-rod-numeral #x1D360)
(nyiakeng-puachue-hmong #x1e100)
- (toto #x1E290)
- (wancho #x1e2c0)
- (mende-kikakui #x1E810)
- (adlam #x1E900)
- (indic-siyaq-number #x1ec71)
- (ottoman-siyaq-number #x1ed01)
+ (toto #x1E290 #x1E295 #x1E2AD)
+ (wancho #x1E2C0 #x1E2E8 #x1E2EF)
+ (nag-mundari #x1E4D0 #x1E4EB #x1E4F0)
+ (mende-kikakui #x1E810 #x1E8A6)
+ (adlam #x1E900 #x1E943)
+ (indic-siyaq-number #x1EC71 #x1EC9F)
+ (ottoman-siyaq-number #x1ED01 #x1ED27)
(mahjong-tile #x1F000)
(domino-tile #x1F030)
- (emoji #x1F300 #x1F600)))
+ (emoji #x1F300 #x1F600)
+ (chess-symbol . [#x1FA00 #x1FA67])))
(defvar otf-script-alist)
@@ -371,6 +376,7 @@
(knda . kannada)
(knd2 . kannada)
(kana . kana) ; Hiragana
+ (kawi . kawi)
(kali . kayah-li)
(khar . kharoshthi)
(kits . khitan-small-script)
@@ -410,6 +416,7 @@
(mymr . burmese)
(nand . nandinagari)
(nbat . nabataean)
+ (nagm . nag-mundari)
(newa . newa)
(nko\ . nko)
(nshu . nushu)
@@ -772,6 +779,7 @@
lepcha
symbol
braille
+ coptic
yi
syloti-nagri
rejang
@@ -785,6 +793,7 @@
lycian
carian
old-italic
+ gothic
ugaritic
old-persian
deseret
@@ -810,6 +819,7 @@
siddham
modi
makasar
+ kawi
dives-akuru
cuneiform
egyptian
@@ -821,14 +831,21 @@
byzantine-musical-symbol
musical-symbol
ancient-greek-musical-notation
+ kaktovik-numeral
tai-xuan-jing-symbol
counting-rod-numeral
toto
+ wancho
+ nag-mundari
+ mende-kikakui
adlam
tai-tham
+ indic-siyaq-number
+ ottoman-siyaq-number
mahjong-tile
domino-tile
- emoji))
+ emoji
+ chess-symbol))
(set-fontset-font "fontset-default"
script (font-spec :registry "iso10646-1" :script script)
nil 'append))
@@ -974,7 +991,11 @@
(set-fontset-font "fontset-default" symbol-subgroup
"-*-fixed-medium-*-*-*-*-*-*-*-*-*-iso10646-1"
nil 'prepend))
- ;; This sets up the Emoji codepoints to use prettier fonts.
+ ;; This sets up the Emoji codepoints to use prettier fonts:
+ ;; this is fallback, if they don't have color Emoji capabilities...
+ (set-fontset-font "fontset-default" 'emoji
+ '("Noto Emoji" . "iso10646-1") nil 'prepend)
+ ;; ...and this is if they do
(set-fontset-font "fontset-default" 'emoji
'("Noto Color Emoji" . "iso10646-1") nil 'prepend)
diff --git a/lisp/international/latin1-disp.el
b/lisp/international/latin1-disp.el
index af75192793..cb3b429957 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -87,7 +87,7 @@ This option also treats some characters in the
`mule-unicode-...'
charsets if you don't have a Unicode font with which to display them.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `latin1-display'."
+use either \\[customize] or the command `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
@@ -746,7 +746,7 @@ This uses the transliterations of the Lynx browser. The
display isn't
changed if the display can render Unicode characters.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `latin1-display'."
+use either \\[customize] or the command `latin1-display-ucs-per-lynx'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
@@ -756,6 +756,7 @@ use either \\[customize] or the function `latin1-display'."
(latin1-display-ucs-per-lynx 1)
(latin1-display-ucs-per-lynx -1))))
+;;;###autoload
(defun latin1-display-ucs-per-lynx (arg)
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser.
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 12896cc4b0..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.
@@ -1389,9 +1392,6 @@ Maximum length of the history list is determined by the
value
of `history-length', which see.")
(put 'input-method-history 'permanent-local t)
-(define-obsolete-variable-alias
- 'inactivate-current-input-method-function
- 'deactivate-current-input-method-function "24.3")
(defvar-local deactivate-current-input-method-function nil
"Function to call for deactivating the current input method.
Every input method should set this to an appropriate value when activated.
@@ -1524,10 +1524,6 @@ If INPUT-METHOD is nil, deactivate any current input
method."
(setq current-input-method nil)
(force-mode-line-update)))))
-(define-obsolete-function-alias
- 'inactivate-input-method
- 'deactivate-input-method "24.3")
-
(defun set-input-method (input-method &optional interactive)
"Select and activate input method INPUT-METHOD for the current buffer.
This also sets the default input method to the one you specify.
@@ -1741,10 +1737,6 @@ just activated."
:type 'hook
:group 'mule)
-(define-obsolete-variable-alias
- 'input-method-inactivate-hook
- 'input-method-deactivate-hook "24.3")
-
(defcustom input-method-deactivate-hook nil
"Normal hook run just after an input method is deactivated.
@@ -1920,8 +1912,11 @@ The default status is as follows:
(reset-language-environment)
-(defun set-display-table-and-terminal-coding-system (language-name &optional
coding-system display)
- "Set up the display table and terminal coding system for LANGUAGE-NAME."
+(defun set-display-table-and-terminal-coding-system (language-name
+ &optional coding-system
+ display inhibit-refresh)
+ "Set up the display table and terminal coding system for LANGUAGE-NAME.
+If INHIBIT-REFRESH, don't redraw the current frame."
(let ((coding (get-language-info language-name 'unibyte-display)))
(if (and coding
(or (not coding-system)
@@ -1934,7 +1929,8 @@ The default status is as follows:
(when standard-display-table
(dotimes (i 128)
(aset standard-display-table (+ i 128) nil))))
- (set-terminal-coding-system (or coding-system coding) display)))
+ (set-terminal-coding-system (or coding-system coding) display
+ inhibit-refresh)))
(defun set-language-environment (language-name)
"Set up multilingual environment for using LANGUAGE-NAME.
@@ -2671,17 +2667,23 @@ For example, translate \"swedish\" into
\"sv_SE.ISO8859-1\"."
"The currently set locale environment.")
(defmacro with-locale-environment (locale-name &rest body)
- "Execute BODY with the locale set to LOCALE-NAME."
+ "Execute BODY with the locale set to LOCALE-NAME.
+
+Note that changing the locale modifies settings that affect
+the display, such as `terminal-coding-system' and `standard-display-table',
+but this macro does not by itself perform redisplay. If BODY needs to
+display something with LOCALE-NAME's settings, include a call
+to `redraw-frame' in BODY."
(declare (indent 1) (debug (sexp def-body)))
(let ((current (gensym)))
`(let ((,current current-locale-environment))
(unwind-protect
(progn
- (set-locale-environment ,locale-name)
+ (set-locale-environment ,locale-name nil t)
,@body)
- (set-locale-environment ,current)))))
+ (set-locale-environment ,current nil t)))))
-(defun set-locale-environment (&optional locale-name frame)
+(defun set-locale-environment (&optional locale-name frame inhibit-refresh)
"Set up multilingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
the default input method and sometimes other things.
@@ -2710,6 +2712,9 @@ This function sets the `current-locale-environment'
variable. To
change the locale temporarily, `with-locale-environment' can be
used.
+By default, this function will redraw the current frame. If
+INHIBIT-REFRESH is non-nil, this isn't done.
+
See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
(interactive (list (completing-read "Set environment for locale: "
@@ -2819,7 +2824,7 @@ See also `locale-charset-language-names',
`locale-language-names',
(set-language-environment language-name))
(set-display-table-and-terminal-coding-system
- language-name coding-system frame)
+ language-name coding-system frame inhibit-refresh)
;; Set the `keyboard-coding-system' if appropriate (tty
;; only). At least X and MS Windows can generate
@@ -2876,7 +2881,7 @@ See also `locale-charset-language-names',
`locale-language-names',
(or output-coding (setq output-coding code-page-coding))
(unless frame (setq locale-coding-system locale-coding))
(set-keyboard-coding-system code-page-coding frame)
- (set-terminal-coding-system output-coding frame)
+ (set-terminal-coding-system output-coding frame inhibit-refresh)
(setq default-file-name-coding-system ansi-code-page-coding))))
(when (eq system-type 'darwin)
@@ -2887,7 +2892,7 @@ See also `locale-charset-language-names',
`locale-language-names',
;; the locale.
(when (and (null window-system)
(equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal"))
- (set-terminal-coding-system 'utf-8)
+ (set-terminal-coding-system 'utf-8 nil inhibit-refresh)
(set-keyboard-coding-system 'utf-8)))
;; Default to A4 paper if we're not in a C, POSIX or US locale.
@@ -3195,7 +3200,7 @@ Defines the sorting order either by character names or
their codepoints."
:group 'mule
:version "28.1")
-(defun read-char-by-name (prompt)
+(defun read-char-by-name (prompt &optional allow-single)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
Unicode property `name' or `old-name'.
@@ -3216,7 +3221,10 @@ Accept a name like \"CIRCULATION FUNCTION\", a
hexadecimal
number like \"2A10\", or a number in hash notation (e.g.,
\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for
octal). Treat otherwise-ambiguous strings like \"BED\" (U+1F6CF)
-as names, not numbers."
+as names, not numbers.
+
+Optional arg ALLOW-SINGLE non-nil means to additionally allow
+single characters to be treated as standing for themselves."
(let* ((enable-recursive-minibuffers t)
(completion-ignore-case t)
(completion-tab-width 4)
@@ -3239,6 +3247,9 @@ as names, not numbers."
(char
(cond
((char-from-name input t))
+ ((and allow-single
+ (string-match-p "\\`.\\'" input)
+ (ignore-errors (string-to-char input))))
((string-match-p "\\`[[:xdigit:]]+\\'" input)
(ignore-errors (string-to-number input 16)))
((string-match-p "\\`#\\([bBoOxX]\\|[0-9]+[rR]\\)[0-9a-zA-Z]+\\'"
@@ -3248,7 +3259,6 @@ as names, not numbers."
(error "Invalid character"))
char))
-(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3")
(define-key ctl-x-map "8\r" 'insert-char)
(define-key ctl-x-map "8e"
(define-keymap
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/mule.el b/lisp/international/mule.el
index ab74c2cffd..6a794a8410 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -767,7 +767,7 @@ VALUE must be a translation table to use on encoding.
VALUE must be a function to call after some text is inserted and
decoded by the coding system itself and before any functions in
-`after-insert-functions' are called. This function is passed one
+`after-insert-file-functions' are called. This function is passed one
argument: the number of characters in the text to convert, with
point at the start of the text. The function should leave point
and the match data unchanged, and should return the new character
@@ -1362,7 +1362,8 @@ to CODING-SYSTEM."
This is normally set according to the selected language environment.
See also the command `set-terminal-coding-system'.")
-(defun set-terminal-coding-system (coding-system &optional terminal)
+(defun set-terminal-coding-system (coding-system &optional terminal
+ inhibit-refresh)
"Set coding system of terminal output to CODING-SYSTEM.
All text output to TERMINAL will be encoded
with the specified coding system.
@@ -1371,9 +1372,12 @@ For a list of possible values of CODING-SYSTEM, use
\\[list-coding-systems].
The default is determined by the selected language environment
or by the previous use of this command.
-TERMINAL may be a terminal object, a frame, or nil for the
-selected frame's terminal. The setting has no effect on
-graphical terminals."
+Optional argument TERMINAL may be a terminal object or a frame,
+and defaults to the selected frame's terminal. The setting has no
+effect on graphical terminals.
+
+By default, this function will redraw the current frame;
+optional argument INHIBIT-REFRESH, if non-nil, prevents that."
(interactive
(list (let ((default (if (and (not (terminal-coding-system))
default-terminal-coding-system)
@@ -1387,7 +1391,8 @@ graphical terminals."
(if coding-system
(setq default-terminal-coding-system coding-system))
(set-terminal-coding-system-internal coding-system terminal)
- (redraw-frame))
+ (unless inhibit-refresh
+ (redraw-frame)))
(defvar default-keyboard-coding-system nil
"Default value of the keyboard coding system.
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 4bb6dbcc8e..e2ba485bbe 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -540,8 +540,6 @@ This function runs the normal hook `quail-deactivate-hook'."
(interactive)
(quail-activate -1))
-(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3")
-
(defun quail-activate (&optional arg)
"Activate Quail input method.
With ARG, activate Quail input method if and only if arg is positive.
@@ -583,10 +581,6 @@ While this input method is active, the variable
(run-hooks 'quail-activate-hook)
(setq-local input-method-function #'quail-input-method)))
-(define-obsolete-variable-alias
- 'quail-inactivate-hook
- 'quail-deactivate-hook "24.3")
-
(defun quail-exit-from-minibuffer ()
(deactivate-input-method)
(if (<= (minibuffer-depth) 1)
diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el
index 5050b7c030..73b610c034 100644
--- a/lisp/international/rfc1843.el
+++ b/lisp/international/rfc1843.el
@@ -1,4 +1,4 @@
-;;; rfc1843.el --- HZ (rfc1843) decoding -*- lexical-binding:t -*-
+;;; rfc1843.el --- HZ (RFC 1843) decoding -*- lexical-binding:t -*-
;; Copyright (C) 1998-2022 Free Software Foundation, Inc.
@@ -22,6 +22,9 @@
;;; Commentary:
+;; HZ (RFC 1843) decoding. HZ is a data format for exchanging files
+;; of arbitrarily mixed Chinese and ASCII characters.
+;;
;; Test:
;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}")
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 4c498d7f92..9f0ff80e62 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -393,8 +393,6 @@ A nil value means no package is selected.")
(interactive)
(robin-activate -1))
-(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3")
-
(defun robin-activate (&optional arg)
"Activate robin input method.
@@ -423,10 +421,6 @@ While this input method is active, the variable
'robin-activate-hook)
(setq-local input-method-function 'robin-input-method)))
-(define-obsolete-variable-alias
- 'robin-inactivate-hook
- 'robin-deactivate-hook "24.3")
-
(defun robin-exit-from-minibuffer ()
(deactivate-input-method)
(if (<= (minibuffer-depth) 1)
diff --git a/lisp/international/textsec-check.el
b/lisp/international/textsec-check.el
index 567ef73feb..99ffd397e2 100644
--- a/lisp/international/textsec-check.el
+++ b/lisp/international/textsec-check.el
@@ -35,7 +35,7 @@ If nil, these checks are disabled."
:version "29.1")
(defface textsec-suspicious
- '((t (:weight bold :background "red")))
+ '((t (:weight bold :background "red" :foreground "white")))
"Face used to highlight suspicious strings.")
;;;###autoload
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 080045e752..d2a6ee1e9d 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -281,7 +281,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(while (not (eobp))
(let ((ch (following-char))
(pos (point)))
- (cond ((= ch ?C) ; COMMENT
+ (cond ((eq ch ?C) ; COMMENT
(cond ((looking-at "COMMENT")
(let ((pos (match-end 0))
(to (progn (end-of-line) (point))))
@@ -295,7 +295,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(setq tit-comments
(cons (buffer-substring-no-properties pos (point))
tit-comments))))))
- ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT
+ ((eq ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT
(cond ((looking-at "MULTICHOICE:[ \t]*")
(goto-char (match-end 0))
(setq tit-multichoice (looking-at "YES")))
@@ -305,7 +305,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
((looking-at "MOVELEFT:[ \t]*")
(goto-char (match-end 0))
(setq tit-moveleft (tit-read-key-value)))))
- ((= ch ?P) ; PROMPT
+ ((eq ch ?P) ; PROMPT
(cond ((looking-at "PROMPT:[ \t]*")
(goto-char (match-end 0))
(setq tit-prompt (tit-read-key-value))
@@ -316,7 +316,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(if (or (eq (nth 1 split) 32)
(eq (nth 2 split) 32))
(setq tit-prompt (substring tit-prompt 0 -1)))))))
- ((= ch ?B) ; BACKSPACE, BEGINDICTIONARY,
+ ((eq ch ?B) ; BACKSPACE, BEGINDICTIONARY,
; BEGINPHRASE
(cond ((looking-at "BACKSPACE:[ \t]*")
(goto-char (match-end 0))
@@ -325,7 +325,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲,
4:去聲,
(setq tit-dictionary t))
((looking-at "BEGINPHRASE")
(setq tit-dictionary nil))))
- ((= ch ?K) ; KEYPROMPT
+ ((eq ch ?K) ; KEYPROMPT
(cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
(let ((key-char (match-string 1)))
(goto-char (match-end 0))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 31fcf01949..bc3697deb0 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -832,17 +832,15 @@ This is like `describe-bindings', but displays only
Isearch keys."
:image '(isearch-tool-bar-image "left-arrow")))
map))
-(defvar minibuffer-local-isearch-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\r" 'exit-minibuffer)
- (define-key map "\M-\t" 'isearch-complete-edit)
- (define-key map "\C-s" 'isearch-forward-exit-minibuffer)
- (define-key map "\C-r" 'isearch-reverse-exit-minibuffer)
- (define-key map "\C-f" 'isearch-yank-char-in-minibuffer)
- (define-key map [right] 'isearch-yank-char-in-minibuffer)
- map)
- "Keymap for editing Isearch strings in the minibuffer.")
+(defvar-keymap minibuffer-local-isearch-map
+ :doc "Keymap for editing Isearch strings in the minibuffer."
+ :parent minibuffer-local-map
+ "RET" #'exit-minibuffer
+ "M-TAB" #'isearch-complete-edit
+ "C-s" #'isearch-forward-exit-minibuffer
+ "C-r" #'isearch-reverse-exit-minibuffer
+ "C-f" #'isearch-yank-char-in-minibuffer
+ "<right>" #'isearch-yank-char-in-minibuffer)
;; Internal variables declared globally for byte-compiler.
;; These are all set with setq while isearching
@@ -2389,8 +2387,7 @@ type \\[help-command] at that time."
(if (use-region-p) " in region" ""))
isearch-regexp)
t isearch-regexp (or delimited isearch-regexp-function) nil nil
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
+ (use-region-beginning) (use-region-end)
backward))
(and isearch-recursive-edit (exit-recursive-edit)))
@@ -3652,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))
@@ -4512,21 +4508,35 @@ is a list of cons cells of the form (START . END)."
(setq bounds (cdr bounds))))
found))))
-(defun isearch-search-fun-in-text-property (search-fun property)
- "Return the function to search inside text that has the specified PROPERTY.
+(defun isearch-search-fun-in-text-property (search-fun properties)
+ "Return the function to search inside text that has the specified PROPERTIES.
The function will limit the search for matches only inside text which has
-this property in the current buffer.
+at least one of the text PROPERTIES.
The argument SEARCH-FUN provides the function to search text, and
defaults to the value of `isearch-search-fun-default' when nil."
+ (setq properties (ensure-list properties))
(apply-partially
#'search-within-boundaries
search-fun
- (lambda (pos) (get-text-property (if isearch-forward pos
- (max (1- pos) (point-min)))
- property))
- (lambda (pos) (if isearch-forward
- (next-single-property-change pos property)
- (previous-single-property-change pos property)))))
+ (lambda (pos)
+ (let ((pos (if isearch-forward pos (max (1- pos) (point-min)))))
+ (seq-some (lambda (property)
+ (get-text-property pos property))
+ properties)))
+ (lambda (pos)
+ (let ((pos-list (if isearch-forward
+ (mapcar (lambda (property)
+ (next-single-property-change
+ pos property))
+ properties)
+ (mapcar (lambda (property)
+ (previous-single-property-change
+ pos property))
+ properties))))
+ (setq pos-list (delq nil pos-list))
+ (when pos-list (if isearch-forward
+ (seq-min pos-list)
+ (seq-max pos-list)))))))
(defun search-within-boundaries ( search-fun get-fun next-fun
string &optional bound noerror count)
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index be26ca55f0..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
@@ -45,9 +35,12 @@ Preserves the `buffer-modified-p' state of the current
buffer."
:group 'font-lock)
(defcustom jit-lock-chunk-size 1500
- "Jit-lock fontifies chunks of at most this many characters at a time.
+ "Jit-lock asks to fontify chunks of at most this many characters at a time.
+
+The actual size of the fontified chunk of text can be different,
+depending on what the `fontification-functions' actually decide to do.
-This variable controls both `display-time' and stealth fontification.
+This variable controls both display-time and stealth fontifications.
The optimum value is a little over the typical number of buffer
characters which fit in a typical window."
@@ -325,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
@@ -362,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))
@@ -379,13 +372,17 @@ is active."
(or (not (eq jit-lock-defer-time 0))
(input-pending-p))))
;; No deferral.
- (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
+ (let* ((cend (min (point-max) (+ start jit-lock-chunk-size)))
+ (vend (next-single-property-change start 'invisible nil cend)))
+ ;; Presumably if we're called it means `start' is
+ ;; not at EOB (nor invisible) and hence (> vend start).
+ (jit-lock-fontify-now start vend))
;; Record the buffer for later fontification.
(unless (memq (current-buffer) jit-lock-defer-buffers)
(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
@@ -419,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)))
@@ -495,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))
@@ -609,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
@@ -657,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)
@@ -688,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/language/cyrillic.el b/lisp/language/cyrillic.el
index 4576373a6d..a9017062cc 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -131,13 +131,15 @@ Support for Russian using koi8-r and the russian-computer
input method.")
:mime-charset 'koi8-u)
(set-language-info-alist
- "Ukrainian" '((charset koi8-u)
+ "Ukrainian" '((tutorial . "TUTORIAL.uk")
+ (charset koi8-u)
(coding-system koi8-u)
(coding-priority koi8-u)
(nonascii-translation . koi8-u)
(input-method . "ukrainian-computer")
+ (sample-text . "Ukrainian (Українська) Вітаю / Добрий день! /
Привіт")
(documentation
- . "Support for Ukrainian with KOI8-U character set."))
+ . "Support for Ukrainian with koi8-u character set."))
'("Cyrillic"))
;;; ALTERNATIVNYJ stuff
@@ -254,14 +256,6 @@ Support for Russian using koi8-r and the russian-computer
input method.")
\(The name Belarusian replaced Byelorussian in the early 1990s.)"))
'("Cyrillic"))
-(set-language-info-alist
- "Ukrainian" '((coding-system koi8-u)
- (coding-priority koi8-u)
- (input-method . "ukrainian-computer")
- (documentation
- . "Support for Ukrainian with koi8-u character set."))
- '("Cyrillic"))
-
(provide 'cyrillic)
;;; cyrillic.el ends here
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index a0159679da..2f76acfe7c 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -794,15 +794,15 @@ The 2nd and 3rd arguments BEGIN and END specify the
region."
"This function is deprecated."
(interactive "*cInput number: 1.���� 2.���� 3.���� 4.���� 5.����")
(cond
- ((= arg ?1)
+ ((eq arg ?1)
(insert "����"))
- ((= arg ?2)
+ ((eq arg ?2)
(insert "����"))
- ((= arg ?3)
+ ((eq arg ?3)
(insert "����"))
- ((= arg ?4)
+ ((eq arg ?4)
(insert "����"))
- ((= arg ?5)
+ ((eq arg ?5)
(insert "����"))
(t
(error ""))))
@@ -816,7 +816,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
"Convert each fidel characters in the current buffer into a fidel-tex
command."
(interactive)
(let ((buffer-read-only nil)
- comp ch)
+ comp)
;; Special treatment for geminated characters.
;; Geminated characters la", etc. change into \geminateG{\laG}, etc.
@@ -835,21 +835,22 @@ The 2nd and 3rd arguments BEGIN and END specify the
region."
;; Special Ethiopic punctuation.
(goto-char (point-min))
(while (re-search-forward "\\ce[».?]\\|«\\ce" nil t)
- (cond
- ((= (setq ch (preceding-char)) ?\»)
- (delete-char -1)
- (insert "\\rquoteG"))
- ((= ch ?.)
- (delete-char -1)
- (insert "\\dotG"))
- ((= ch ??)
- (delete-char -1)
- (insert "\\qmarkG"))
- (t
- (forward-char -1)
- (delete-char -1)
- (insert "\\lquoteG")
- (forward-char 1))))
+ (let ((ch (preceding-char)))
+ (cond
+ ((eq ch ?\»)
+ (delete-char -1)
+ (insert "\\rquoteG"))
+ ((eq ch ?.)
+ (delete-char -1)
+ (insert "\\dotG"))
+ ((eq ch ??)
+ (delete-char -1)
+ (insert "\\qmarkG"))
+ (t
+ (forward-char -1)
+ (delete-char -1)
+ (insert "\\lquoteG")
+ (forward-char 1)))))
;; Ethiopic characters to TeX macros
(robin-invert-region (point-min) (point-max) "ethiopic-tex")
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 407173827f..4994cfdc7a 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -266,6 +266,27 @@ Meetei language and its script Meetei Mayek are supported
in this
language environment."))
'("Indian"))
+(set-language-info-alist
+ "Wancho" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "wancho")
+ (sample-text . "Wancho (𞋒𞋀𞋉𞋃𞋕) 𞋂𞋈𞋛")
+ (documentation . "\
+Wancho language and its script are supported in this language
+environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Toto" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "toto")
+ (documentation . "\
+Toto language using the Toto script is supported in this language
+environment."))
+ '("Indian"))
+
;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is
;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING).
@@ -340,23 +361,24 @@ language environment."))
(defconst gurmukhi-composable-pattern
(let ((table
- '(("a" . "[\u0A01\u0A02\u0A70]") ; SIGN ADAK BINDI .. BINDI, TIPPI
+ '(("a" . "[\u0A01\u0A02\u0A70\u0A71\u0A75]") ; SIGN ADAK BINDI ..
BINDI, TIPPI, ADDAK, YAKASH
("A" . "\u0A03") ; SIGN VISARGA
- ("V" . "[\u0A05-\u0A14]") ; independent vowel
+ ("V" . "[\u0A05-\u0A14\u0A72\u0A73]") ; independent vowel
("C" . "[\u0A15-\u0A39\u0A59-\u0A5E]") ; consonant
("Y" . "[\u0A2F\u0A30\u0A35\u0A39]") ; YA, RA, VA, HA
("n" . "\u0A3C") ; NUKTA
("v" . "[\u0A3E-\u0A4C]") ; vowel sign
("H" . "\u0A4D") ; VIRAMA
+ ("s" . "\u0A51") ; stress sign
("N" . "\u200C") ; ZWNJ
("J" . "\u200D") ; ZWJ
("X" . "[\u0A00-\u0A7F]")))) ; all coverage
(indian-compose-regexp
(concat
;; consonant-based syllables, or
- "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*n?a?A?\\)\\|"
+ "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*n?a?s?v?A?\\)\\|"
;; syllables with an independent vowel, or
- "Vn?\\(?:J?HY\\)?v*n?a?A?\\|"
+ "Vn?\\(?:J?HY\\)?v*n?a?s?A?\\|"
;; special consonant form, or
"JHY\\|"
;; any other singleton characters
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/lao.el b/lisp/language/lao.el
index 1861eff15e..0ad5b9f84e 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -60,9 +60,9 @@
(len (length chars))
;; Replace `c', `t', `v' to consonant, tone, and vowel.
(regexp (mapconcat (lambda (c)
- (cond ((= c ?c) consonant)
- ((= c ?t) tone)
- ((= c ?v) vowel-upper-lower)
+ (cond ((eq c ?c) consonant)
+ ((eq c ?t) tone)
+ ((eq c ?v) vowel-upper-lower)
(t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 3d5b68f84b..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]")
@@ -269,6 +271,74 @@ using the Kharoṣṭhī script.")))
modifier "*")
1 'font-shape-gstring))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Adlam
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Adlam" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "adlam")
+ (sample-text . "Adlam (𞤀𞤣𞤤𞤢𞤥) 𞤅𞤢𞤤𞤢𞥄𞤥")
+ (documentation . "\
+Fulani language and its script Adlam are supported
+in this language environment."))
+ '("Misc"))
+
+;; Adlam composition rules
+(set-char-table-range
+ composition-function-table
+ '(#x1E900 . #x1E95F)
+ (list (vector
+ "[\x1E900-\x1E95F]+"
+ 0 'font-shape-gstring)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mende Kikakui
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Mende Kikakui" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "mende-kikakui")
+ (sample-text . "Mende Kikakui (𞠀𞠁𞠂) 𞠛𞠉")
+ (documentation . "\
+Mende language and its script Kikakui are supported
+in this language environment."))
+ '("Misc"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Gothic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Gothic" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "gothic")
+ (sample-text . "Gothic (𐌲𐌿𐍄𐌹𐍃𐌺𐌰) 𐌷𐌰𐌹𐌻𐍃 / 𐌷𐌰𐌹𐌻𐌰")
+ (documentation . "\
+Ancient Gothic language using the Gothic script is supported in this
+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)
;;; misc-lang.el ends here
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/ldefs-boot.el b/lisp/ldefs-boot.el
index 07dfc23a09..b992846b0b 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -897,6 +897,15 @@ variable, and is meant to be used in
`compilation-filter-hook'.")
(register-definition-prefixes "ansi-color" '("ansi-color-"))
+;;; Generated autoloads from ansi-osc.el
+
+(autoload 'ansi-osc-compilation-filter "ansi-osc" "\
+Maybe collect OSC control sequences.
+This function depends on the variable `ansi-osc-for-compilation-buffer',
+and is meant to be used in `compilation-filter-hook'.")
+(register-definition-prefixes "ansi-osc" '("ansi-osc-"))
+
+
;;; Generated autoloads from progmodes/antlr-mode.el
(push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions)
@@ -4004,6 +4013,16 @@ FROM is for internal use. It specifies an index in the
STRING
from which to start.
(fn STRING &optional LAX FROM)")
+(autoload 'describe-char-fold-equivalences "char-fold" "\
+Display characters equivalent to CHAR under character-folding.
+Prompt for CHAR (using `read-char-by-name', which see for how to
+specify the character). With no input, i.e. when CHAR is nil,
+describe all available character equivalences of `char-fold-to-regexp'.
+Optional argument LAX (interactively, the prefix argument), if
+non-nil, means also include partially matching ligatures and
+non-canonical equivalences.
+
+(fn CHAR &optional LAX)" t)
(register-definition-prefixes "char-fold" '("char-fold-"))
@@ -4038,14 +4057,10 @@ Returns non-nil if any false statements are found.
(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-spellcheck-documentation-flag 'safe-local-variable #'booleanp)
-(put 'checkdoc-ispell-list-words 'safe-local-variable
#'checkdoc-list-of-strings-p)
+(put 'checkdoc-ispell-list-words 'safe-local-variable #'list-of-strings-p)
(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-verb-check-experimental-flag 'safe-local-variable #'booleanp)
-(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p)
-(autoload 'checkdoc-list-of-strings-p "checkdoc" "\
-Return t when OBJ is a list of strings.
-
-(fn OBJ)")
+(put 'checkdoc-symbol-words 'safe-local-variable #'list-of-strings-p)
(put 'checkdoc-proper-noun-regexp 'safe-local-variable 'stringp)
(put 'checkdoc-common-verbs-regexp 'safe-local-variable 'stringp)
(autoload 'checkdoc "checkdoc" "\
@@ -4306,79 +4321,6 @@ it is disabled.
;;; Generated autoloads from emacs-lisp/cl-generic.el
(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
-(autoload 'cl-defgeneric "cl-generic" "\
-Create a generic function NAME.
-DOC-STRING is the base documentation for this class. A generic
-function has no body, as its purpose is to decide which method body
-is appropriate to use. Specific methods are defined with `cl-defmethod'.
-With this implementation the ARGS are currently ignored.
-OPTIONS-AND-METHODS currently understands:
-- (:documentation DOCSTRING)
-- (declare DECLARATIONS)
-- (:argument-precedence-order &rest ARGS)
-- (:method [QUALIFIERS...] ARGS &rest BODY)
-DEFAULT-BODY, if present, is used as the body of a default method.
-
-(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" nil t)
-(function-put 'cl-defgeneric 'lisp-indent-function 2)
-(function-put 'cl-defgeneric 'doc-string-elt 3)
-(autoload 'cl-generic-define "cl-generic" "\
-
-
-(fn NAME ARGS OPTIONS)")
-(autoload 'cl-defmethod "cl-generic" "\
-Define a new method for generic function NAME.
-This defines an implementation of NAME to use for invocations
-of specific types of arguments.
-
-ARGS is a list of dispatch arguments (see `cl-defun'), but where
-each variable element is either just a single variable name VAR,
-or a list on the form (VAR TYPE).
-
-For instance:
-
- (cl-defmethod foo (bar (format-string string) &optional zot)
- (format format-string bar))
-
-The dispatch arguments have to be among the mandatory arguments, and
-all methods of NAME have to use the same set of arguments for dispatch.
-Each dispatch argument and TYPE are specified in ARGS where the corresponding
-formal argument appears as (VAR TYPE) rather than just VAR.
-
-The optional EXTRA element, on the form `:extra STRING', allows
-you to add more methods for the same specializers and qualifiers.
-These are distinguished by STRING.
-
-The optional argument QUALIFIER is a specifier that modifies how
-the method is combined with other methods, including:
- :before - Method will be called before the primary
- :after - Method will be called after the primary
- :around - Method will be called around everything else
-The absence of QUALIFIER means this is a \"primary\" method.
-The set of acceptable qualifiers and their meaning is defined
-(and can be extended) by the methods of `cl-generic-combine-methods'.
-
-ARGS can also include so-called context specializers, introduced by
-`&context' (which should appear right after the mandatory arguments,
-before any &optional or &rest). They have the form (EXPR TYPE) where
-EXPR is an Elisp expression whose value should match TYPE for the
-method to be applicable.
-
-The set of acceptable TYPEs (also called \"specializers\") is defined
-(and can be extended) by the various methods of `cl-generic-generalizers'.
-
-(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t)
-(function-put 'cl-defmethod 'doc-string-elt 'cl--defmethod-doc-pos)
-(function-put 'cl-defmethod 'lisp-indent-function 'defun)
-(autoload 'cl-generic-define-method "cl-generic" "\
-
-
-(fn NAME QUALIFIERS ARGS CALL-CON FUNCTION)")
-(autoload 'cl-find-method "cl-generic" "\
-
-
-(fn GENERIC QUALIFIERS SPECIALIZERS)")
-(register-definition-prefixes "cl-generic" '("cl-"))
;;; Generated autoloads from emacs-lisp/cl-indent.el
@@ -4466,8 +4408,6 @@ instead.
;;; Generated autoloads from emacs-lisp/cl-lib.el
(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
-(define-obsolete-variable-alias 'custom-print-functions
'cl-custom-print-functions "\
-24.3")
(defvar cl-custom-print-functions nil "\
This is a list of functions that format user objects for printing.
Each function is called in turn with three arguments: the object, the
@@ -4762,14 +4702,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" "\
@@ -7242,6 +7181,14 @@ The mode's hook is called both when the mode is enabled
and when
it is disabled.
(fn &optional ARG)" t)
+(defvar diff-add-log-use-relative-names nil "\
+Use relative file names when generating ChangeLog skeletons.
+The files will be relative to the root directory of the VC
+repository. This option affects the behavior of
+`diff-add-log-current-defuns'.")
+(custom-autoload 'diff-add-log-use-relative-names "diff-mode" t)
+(put 'diff-add-log-use-relative-names 'safe-local-variable #'booleanp)
+(autoload 'diff-vc-deduce-fileset "diff-mode")
(register-definition-prefixes "diff-mode" '("diff-"))
@@ -7570,6 +7517,34 @@ This provides increased compatibility for users who call
this function
in `.emacs'.
(fn ARG)")
+(autoload 'standard-display-by-replacement-char "disp-table" "\
+Produce code to display characters between FROM and TO using REPL.
+This function produces a buffer with code to set up `standard-display-table'
+such that characters that cannot be displayed by the terminal, and
+don't already have their display set up in `standard-display-table', will
+be represented by a replacement character. You can evaluate the produced
+code to use the setup for the current Emacs session, or copy the code
+into your init file, to make Emacs use it for subsequent sessions.
+
+Interactively, the produced code arranges for any character in
+the range [#x100..#x10FFFF] that the terminal cannot display to
+be represented by the #xFFFD Unicode replacement character.
+
+When called from Lisp, FROM and TO define the range of characters for
+which to produce the setup code for `standard-display-table'. If they
+are omitted, they default to #x100 and #x10FFFF respectively, covering
+the entire non-ASCII range of Unicode characters.
+REPL is the replacement character to use. If it's omitted, it defaults
+to #xFFFD, the Unicode replacement character, usually displayed as a
+black diamond with a question mark inside.
+The produced code sets up `standard-display-table' to show REPL with
+the `homoglyph' face, making the replacements stand out on display.
+
+This command is most useful with text-mode terminals, such as the
+Linux console, for which Emacs has a reliable way of determining
+which characters can be displayed and which cannot.
+
+(fn &optional REPL FROM TO)" t)
(register-definition-prefixes "disp-table" '("display-table-print-array"))
@@ -7829,7 +7804,7 @@ Document types are symbols like `dvi', `ps', `pdf',
`epub',
Major mode in DocView buffers.
DocView Mode is an Emacs document viewer. It displays PDF, PS
-and DVI files (as PNG images) in Emacs buffers.
+and DVI files (as PNG or SVG images) in Emacs buffers.
You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to
toggle between displaying the document or editing it as text.
@@ -8064,6 +8039,7 @@ Valid keywords and arguments are:
`nodigits' to suppress digits as prefix arguments.
(fn BS &optional NAME M ARGS)")
+(make-obsolete 'easy-mmode-define-keymap 'define-keymap "29.1")
(autoload 'easy-mmode-defmap "easy-mmode" "\
Define a constant M whose value is the result of `easy-mmode-define-keymap'.
The M, BS, and ARGS arguments are as per that function. DOC is
@@ -8074,6 +8050,7 @@ This macro is deprecated; use `defvar-keymap' instead.
(fn M BS DOC &rest ARGS)" nil t)
(function-put 'easy-mmode-defmap 'doc-string-elt 3)
(function-put 'easy-mmode-defmap 'lisp-indent-function 1)
+(make-obsolete 'easy-mmode-defmap 'defvar-keymap "29.1")
(autoload 'easy-mmode-defsyntax "easy-mmode" "\
Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
@@ -9172,8 +9149,7 @@ the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
-evaluate `(buffer-local-value \\='electric-pair-mode
-(current-buffer))'.
+evaluate `electric-pair-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
@@ -9444,6 +9420,8 @@ Already submitted bugs can be found in the Emacs bug
tracker:
(fn TOPIC &optional UNUSED)" t)
(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
+(autoload 'emacs-build-description "emacsbug" "\
+Insert a description of the current Emacs build in the current buffer." t)
(autoload 'submit-emacs-patch "emacsbug" "\
Send an Emacs patch to the Emacs maintainers.
Interactively, you will be prompted for SUBJECT and a patch FILE
@@ -9451,7 +9429,7 @@ name (which will be attached to the mail). You will end
up in a
Message buffer where you can explain more about the patch.
(fn SUBJECT FILE)" t)
-(register-definition-prefixes "emacsbug" '("emacs-bug--system-description"
"report-emacs-bug-"))
+(register-definition-prefixes "emacsbug" '("report-emacs-bug-"))
;;; Generated autoloads from vc/emerge.el
@@ -11734,6 +11712,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.
@@ -11746,11 +11735,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" "\
@@ -12106,12 +12122,17 @@ Define some key bindings for the `find-function'
family of functions.")
;;; Generated autoloads from find-lisp.el
(autoload 'find-lisp-find-dired "find-lisp" "\
-Find files in DIR, matching REGEXP.
+Find the files within DIR whose names match REGEXP.
+A Dired buffer with the results will be opened.
(fn DIR REGEXP)" t)
(autoload 'find-lisp-find-dired-subdirectories "find-lisp" "\
Find all subdirectories of DIR.
+(fn DIR)" t)
+(autoload 'find-lisp-find-dired-subdirs-other-window "find-lisp" "\
+Same as `find-lisp-find-dired-subdirectories', but use another window.
+
(fn DIR)" t)
(autoload 'find-lisp-find-dired-filter "find-lisp" "\
Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
@@ -12568,6 +12589,18 @@ value associated with ?b in SPECIFICATION, either
padding it with
leading zeros or truncating leading characters until it's ten
characters wide\".
+the substitution for a specification character can also be a
+function, taking no arguments and returning a string to be used
+for the replacement. It will only be called if FORMAT uses that
+character. For example:
+
+ (format-spec \"%n\"
+ \\=`((?n . ,(lambda ()
+ (read-number \"Number: \")))))
+
+Note that it is best to make sure the function is not quoted,
+like above, so that it is compiled by the byte-compiler.
+
Any text properties of FORMAT are copied to the result, with any
text properties of a %-spec itself copied to its substitution.
@@ -14186,7 +14219,9 @@ include it when specifying `grep-command'.
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'.")
+\\[customize] or call the function `grep-apply-setting'.
+
+Also see `grep-command-position'.")
(custom-autoload 'grep-command "grep" nil)
(defvar grep-find-command nil "\
The default find command for \\[grep-find].
@@ -15391,10 +15426,12 @@ 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).
+ (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC
+ FIND-BLOCK-BEGINNING-FUNC FIND-NEXT-BLOCK-FUNC
+ LOOKING-AT-BLOCK-START-P-FUNC).
If non-nil, hideshow will use these values as regexps to define blocks
and comments, respectively for major mode MODE.
@@ -15415,6 +15452,15 @@ cases, FORWARD-SEXP-FUNC specifies another function to
use instead.
See the documentation for `hs-adjust-block-beginning' to see what is the
use of ADJUST-BEG-FUNC.
+See the documentation for `hs-find-block-beginning-func' to see
+what is the use of FIND-BLOCK-BEGINNING-FUNC.
+
+See the documentation for `hs-find-next-block-func' to see what
+is the use of FIND-NEXT-BLOCK-FUNC.
+
+See the documentation for `hs-looking-at-block-start-p-func' to
+see what is the use of LOOKING-AT-BLOCK-START-P-FUNC.
+
If any of the elements is left nil or omitted, hideshow tries to guess
appropriate values. The regexps should not contain leading or trailing
whitespace. Case does not matter.")
@@ -16720,8 +16766,9 @@ and that image type is present in
`image-type-auto-detectable' with a
non-nil value. If that value is non-nil, but not t, then the image type
must be available.")
(autoload 'create-image "image" "\
-Create an image.
-FILE-OR-DATA is an image file name or image data.
+Create an image from FILE-OR-DATA.
+FILE-OR-DATA is an image file name or image data. If it is a relative
+file name, the function will look for it along `image-load-path'.
Optional TYPE is a symbol describing the image type. If TYPE is omitted
or nil, try to determine the image type from its first few bytes
@@ -16740,10 +16787,6 @@ Value is the image created, or nil if images of type
TYPE are not supported.
Images should not be larger than specified by `max-image-size'.
-Image file names that are not absolute are searched for in the
-\"images\" sub-directory of `data-directory' and
-`x-bitmap-file-path' (in that order).
-
(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)")
(autoload 'put-image "image" "\
Put image IMAGE in front of POS in the current buffer.
@@ -16878,17 +16921,39 @@ should output the image in the current buffer,
converted to
(register-definition-prefixes "image-converter" '("image-convert"))
-;;; Generated autoloads from image-dired.el
+;;; Generated autoloads from image/image-crop.el
-(push (purecopy '(image-dired 0 4 11)) package--builtin-versions)
-(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
-Toggle thumbnails in front of file names in the Dired buffer.
-If no marked file could be found, insert or hide thumbnails on the
-current line. ARG, if non-nil, specifies the files to use instead
-of the marked files. If ARG is an integer, use the next ARG (or
-previous -ARG, if ARG<0) files.
+(autoload 'image-cut "image-crop" "\
+Cut a rectangle from the image under point, filling it with COLOR.
+COLOR defaults to the value of `image-cut-color'.
+Interactively, with prefix argument, prompt for COLOR to use.
-(fn &optional ARG)" t)
+(fn &optional COLOR)" t)
+(autoload 'image-crop "image-crop" "\
+Crop the image under point.
+If CUT is non-nil, remove a rectangle from the image instead of
+cropping the image. In that case CUT should be the name of a
+color to fill the rectangle.
+
+While cropping the image, the following key bindings are available:
+
+`q': Exit without changing anything.
+`RET': Crop/cut the image.
+`m': Make mouse movements move the rectangle instead of altering the
+ rectangle shape.
+`s': Same as `m', but make the rectangle into a square first.
+
+After cropping an image, you can save it by `M-x image-save' or
+\\<image-map>\\[image-save] when point is over the image.
+
+(fn &optional CUT)" t)
+(register-definition-prefixes "image-crop" '("image-c"))
+
+
+;;; Generated autoloads from image/image-dired.el
+
+(push (purecopy '(image-dired 0 5)) package--builtin-versions)
+(put 'image-dired-thumbnail-storage 'safe-local-variable (lambda (x) (eq x
'per-directory)))
(autoload 'image-dired-dired-with-window-configuration "image-dired" "\
Open directory DIR and create a default window configuration.
@@ -16929,11 +16994,11 @@ used or not. If non-nil, use `display-buffer'
instead of
`image-dired-previous-line-and-display' where we do not want the
thumbnail buffer to be selected.
-(fn &optional ARG APPEND DO-NOT-POP)" t)
+(fn &optional ARG APPEND DO-NOT-POP)" '(nil dired-mode))
(autoload 'image-dired-show-all-from-dir "image-dired" "\
Make a thumbnail buffer for all images in DIR and display it.
-Any file matching `image-file-name-regexp' is considered an image
-file.
+Any file matching `image-dired--file-name-regexp' is considered an
+image file.
If the number of image files in DIR exceeds
`image-dired-show-all-from-dir-max-files', ask for confirmation
@@ -16942,22 +17007,52 @@ never ask for confirmation.
(fn DIR)" t)
(defalias 'image-dired 'image-dired-show-all-from-dir)
-(autoload 'image-dired-tag-files "image-dired" "\
-Tag marked file(s) in Dired. With prefix ARG, tag file at point.
+(autoload 'image-dired-bookmark-jump "image-dired" "\
+Default bookmark handler for Image-Dired buffers.
-(fn ARG)" t)
-(autoload 'image-dired-delete-tag "image-dired" "\
-Remove tag for selected file(s).
-With prefix argument ARG, remove tag from file at point.
+(fn BOOKMARK)")
+(define-obsolete-function-alias 'tumme #'image-dired "24.4")
+(define-obsolete-function-alias 'image-dired-setup-dired-keybindings
#'image-dired-minor-mode "26.1")
+(register-definition-prefixes "image-dired" '("image-dired-"))
-(fn ARG)" t)
-(autoload 'image-dired-jump-thumbnail-buffer "image-dired" "\
-Jump to thumbnail buffer." t)
-(autoload 'image-dired-minor-mode "image-dired" "\
-Setup easy-to-use keybindings for the commands to be used in Dired mode.
+
+;;; Generated autoloads from image/image-dired-dired.el
-Note that n, p and <down> and <up> will be hijacked and bound to
-`image-dired-dired-next-line' and `image-dired-dired-previous-line'.
+(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired-dired" "\
+Toggle thumbnails in front of file names in the Dired buffer.
+If no marked file could be found, insert or hide thumbnails on the
+current line. ARG, if non-nil, specifies the files to use instead
+of the marked files. If ARG is an integer, use the next ARG (or
+previous -ARG, if ARG<0) files.
+
+(fn &optional ARG)" '(dired-mode))
+(autoload 'image-dired-jump-thumbnail-buffer "image-dired-dired" "\
+Jump to thumbnail buffer." '(dired-mode))
+(autoload 'image-dired-minor-mode "image-dired-dired" "\
+Setup easy-to-use keybindings for Image-Dired in Dired mode.
+
+This minor mode adds these additional bindings:
+\\<image-dired-minor-mode-map>
+ \\[image-dired-next-line-and-display] Move to next line and
display thumbnail image.
+ \\[image-dired-previous-line-and-display] Move to previous line
and display thumbnail image.
+ \\[image-dired-mark-and-display-next] Mark current file and
display next thumbnail image.
+ \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail
buffer.
+
+For reference, these are the default Image-Dired bindings that
+are always available in Dired:
+\\<dired-mode-map>
+ \\[image-dired-display-thumbs] Display thumbnails of all
marked files.
+ \\[image-dired-tag-files] Tag marked file(s).
+ \\[image-dired-delete-tag] Remove tag for selected file(s).
+ \\[image-dired-jump-thumbnail-buffer] Jump to thumbnail
buffer.
+ \\[image-dired-dired-display-image] Display current image file.
+ \\[image-dired-dired-display-external] Display file at point
using an external viewer.
+ \\[image-dired-display-thumbs-append] Append thumbnails to
thumbnail buffer.
+ \\[image-dired-display-thumb] Display thumbnails of all
marked files.
+ \\[image-dired-dired-comment-files] Add comment to current or
marked files in Dired.
+ \\[image-dired-mark-tagged-files] Use REGEXP to mark files with
matching tag.
+ \\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of
file names.
+ \\[image-dired-dired-edit-comment-and-tags] Edit comment and tags
of marked images.
This is a minor mode. If called interactively, toggle the
`Image-Dired minor mode' mode. If the prefix argument is
@@ -16975,21 +17070,19 @@ The mode's hook is called both when the mode is
enabled and when
it is disabled.
(fn &optional ARG)" t)
-(autoload 'image-dired-display-thumbs-append "image-dired" "\
-Append thumbnails to `image-dired-thumbnail-buffer'." t)
-(autoload 'image-dired-display-thumb "image-dired" "\
-Shorthand for `image-dired-display-thumbs' with prefix argument." t)
-(autoload 'image-dired-dired-display-external "image-dired" "\
-Display file at point using an external viewer." t)
-(autoload 'image-dired-dired-display-image "image-dired" "\
+(autoload 'image-dired-display-thumbs-append "image-dired-dired" "\
+Append thumbnails to `image-dired-thumbnail-buffer'." '(dired-mode))
+(autoload 'image-dired-display-thumb "image-dired-dired" "\
+Shorthand for `image-dired-display-thumbs' with prefix argument."
'(dired-mode))
+(autoload 'image-dired-dired-display-external "image-dired-dired" "\
+Display file at point using an external viewer." '(dired-mode))
+(autoload 'image-dired-dired-display-image "image-dired-dired" "\
Display current image file.
See documentation for `image-dired-display-image' for more information.
-With prefix argument ARG, display image in its original size.
-(fn &optional ARG)" t)
-(autoload 'image-dired-dired-comment-files "image-dired" "\
-Add comment to current or marked files in Dired." t)
-(autoload 'image-dired-mark-tagged-files "image-dired" "\
+(fn &optional _)" '(dired-mode))
+(set-advertised-calling-convention 'image-dired-dired-display-image 'nil
'"29.1")
+(autoload 'image-dired-mark-tagged-files "image-dired-dired" "\
Use REGEXP to mark files with matching tag.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
@@ -16997,18 +17090,38 @@ lets you input a regexp and this will be matched
against all tags
on all image files in the database file. The files that have a
matching tag will be marked in the Dired buffer.
-(fn REGEXP)" t)
-(autoload 'image-dired-dired-edit-comment-and-tags "image-dired" "\
+(fn REGEXP)" '(dired-mode))
+(register-definition-prefixes "image-dired-dired" '("image-dired-"))
+
+
+;;; Generated autoloads from image/image-dired-external.el
+
+(register-definition-prefixes "image-dired-external" '("image-dired-"))
+
+
+;;; Generated autoloads from image/image-dired-tags.el
+
+(autoload 'image-dired-tag-files "image-dired-tags" "\
+Tag marked file(s) in Dired. With prefix ARG, tag file at point.
+
+(fn ARG)" '(dired-mode))
+(autoload 'image-dired-delete-tag "image-dired-tags" "\
+Remove tag for selected file(s).
+With prefix argument ARG, remove tag from file at point.
+
+(fn ARG)" '(dired-mode))
+(autoload 'image-dired-dired-comment-files "image-dired-tags" "\
+Add comment to current or marked files in Dired." '(dired-mode))
+(autoload 'image-dired-dired-edit-comment-and-tags "image-dired-tags" "\
Edit comment and tags of current or marked image files.
Edit comment and tags for all marked image files in an
-easy-to-use form." t)
-(autoload 'image-dired-bookmark-jump "image-dired" "\
-Default bookmark handler for Image-Dired buffers.
+easy-to-use form." '(dired-mode))
+(register-definition-prefixes "image-dired-tags" '("image-dired-"))
-(fn BOOKMARK)")
-(define-obsolete-function-alias 'tumme #'image-dired "24.4")
-(define-obsolete-function-alias 'image-dired-setup-dired-keybindings
#'image-dired-minor-mode "26.1")
-(register-definition-prefixes "image-dired" '("image-dired-"))
+
+;;; Generated autoloads from image/image-dired-util.el
+
+(register-definition-prefixes "image-dired-util" '("image-dired-"))
;;; Generated autoloads from image-file.el
@@ -17186,6 +17299,11 @@ an index alist of the current buffer. The function is
called within a `save-excursion'.
See `imenu--index-alist' for the format of the buffer index alist.")
+(defvar-local imenu-submenus-on-top t "\
+Flag specifying whether items with sublists should be kept at top.
+
+For some indexes, such as those describing sections in a document, it
+makes sense to keep their original order even in the menubar.")
(defvar-local imenu-prev-index-position-function 'beginning-of-defun "\
Function for finding the next index position.
@@ -18450,7 +18568,7 @@ This option also treats some characters in the
`mule-unicode-...'
charsets if you don't have a Unicode font with which to display them.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `latin1-display'.")
+use either \\[customize] or the command `latin1-display'.")
(custom-autoload 'latin1-display "latin1-disp" nil)
(autoload 'latin1-display "latin1-disp" "\
Set up Latin-1/ASCII display for the arguments character SETS.
@@ -18466,8 +18584,17 @@ This uses the transliterations of the Lynx browser.
The display isn't
changed if the display can render Unicode characters.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `latin1-display'.")
+use either \\[customize] or the command `latin1-display-ucs-per-lynx'.")
(custom-autoload 'latin1-display-ucs-per-lynx "latin1-disp" nil)
+(autoload 'latin1-display-ucs-per-lynx "latin1-disp" "\
+Set up Latin-1/ASCII display for Unicode characters.
+This uses the transliterations of the Lynx browser.
+
+With argument ARG, turn such display on if ARG is positive, otherwise
+turn it off and display Unicode characters literally. The display
+isn't changed if the display can render Unicode characters.
+
+(fn ARG)" t)
(register-definition-prefixes "latin1-disp" '("latin1-display-"))
@@ -18569,58 +18696,6 @@ sleep in seconds.
(register-definition-prefixes "life" '("life-"))
-;;; Generated autoloads from linum.el
-
-(autoload 'linum-mode "linum" "\
-Toggle display of line numbers in the left margin (Linum mode).
-
-This mode has been largely replaced by `display-line-numbers-mode'
-(which is much faster and has fewer interaction problems with other
-modes).
-
-Linum mode is a buffer-local minor mode.
-
-This is a minor mode. If called interactively, toggle the `Linum
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `linum-mode'.
-
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
-
-(fn &optional ARG)" t)
-(put 'global-linum-mode 'globalized-minor-mode t)
-(defvar global-linum-mode nil "\
-Non-nil if Global Linum mode is enabled.
-See the `global-linum-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `global-linum-mode'.")
-(custom-autoload 'global-linum-mode "linum" nil)
-(autoload 'global-linum-mode "linum" "\
-Toggle Linum mode in all buffers.
-With prefix ARG, enable Global Linum mode if ARG is positive;
-otherwise, disable it.
-
-If called from Lisp, toggle the mode if ARG is `toggle'.
-Enable the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
-
-Linum mode is enabled in all buffers where `linum-on' would do it.
-
-See `linum-mode' for more information on Linum mode.
-
-(fn &optional ARG)" t)
-(register-definition-prefixes "linum" '("linum-"))
-
-
;;; Generated autoloads from cedet/ede/linux.el
(register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-"))
@@ -18641,7 +18716,7 @@ See `linum-mode' for more information on Linum mode.
(put 'generated-autoload-file 'safe-local-variable 'stringp)
(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
(autoload 'loaddefs-generate "loaddefs-gen" "\
-Generate loaddefs files for Lisp files in the directories DIRS.
+Generate loaddefs files for Lisp files in one or more directories given by DIR.
DIR can be either a single directory or a list of directories.
The autoloads will be written to OUTPUT-FILE. If any Lisp file
@@ -18649,7 +18724,7 @@ binds `generated-autoload-file' as a file-local
variable, write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
-directory or directories specified by DIRS.
+directories specified by DIR.
Optional argument EXCLUDED-FILES, if non-nil, should be a list of
files, such as preloaded files, whose autoloads should not be written
@@ -18673,6 +18748,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"))
@@ -18794,6 +18870,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-"))
@@ -20869,6 +20947,11 @@ it is disabled.
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
+;;; Generated autoloads from emacs-lisp/nadvice.el
+
+(push (purecopy '(nadvice 1 0)) package--builtin-versions)
+
+
;;; Generated autoloads from net/net-utils.el
(autoload 'ifconfig "net-utils" "\
@@ -21861,7 +21944,7 @@ Coloring:
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 5 4)) package--builtin-versions)
+(push (purecopy '(org 9 5 5)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -23167,6 +23250,13 @@ Completion rules for the `cvs' command.")
(register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-"))
+;;; Generated autoloads from pcmpl-git.el
+
+(autoload 'pcomplete/git "pcmpl-git" "\
+Completion for the `git' command.")
+(register-definition-prefixes "pcmpl-git" '("pcmpl-git--"))
+
+
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
@@ -23179,7 +23269,16 @@ Completion for GNU `make'.")
Completion for the GNU tar utility.")
(autoload 'pcomplete/find "pcmpl-gnu" "\
Completion for the GNU find utility.")
-(defalias 'pcomplete/gdb 'pcomplete/xargs)
+(autoload 'pcomplete/awk "pcmpl-gnu" "\
+Completion for the `awk' command.")
+(autoload 'pcomplete/gpg "pcmpl-gnu" "\
+Completion for the `gpg` command.")
+(autoload 'pcomplete/gdb "pcmpl-gnu" "\
+Completion for the `gdb' command.")
+(autoload 'pcomplete/emacs "pcmpl-gnu" "\
+Completion for the `emacs' command.")
+(autoload 'pcomplete/emacsclient "pcmpl-gnu" "\
+Completion for the `emacsclient' command.")
(register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-" "pcomplete/find"))
@@ -23191,6 +23290,10 @@ Completion for GNU/Linux `kill', using /proc
filesystem.")
Completion for GNU/Linux `umount'.")
(autoload 'pcomplete/mount "pcmpl-linux" "\
Completion for GNU/Linux `mount'.")
+(autoload 'pcomplete/systemctl "pcmpl-linux" "\
+Completion for the `systemctl' command.")
+(autoload 'pcomplete/journalctl "pcmpl-linux" "\
+Completion for the `journalctl' command.")
(register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-"
"pcomplete-pare-list"))
@@ -23198,6 +23301,8 @@ Completion for GNU/Linux `mount'.")
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
Completion for the `rpm' command.")
+(autoload 'pcomplete/dnf "pcmpl-rpm" "\
+Completion for the `dnf' command.")
(register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-"))
@@ -23209,16 +23314,174 @@ Completion for `cd'.")
(autoload 'pcomplete/rmdir "pcmpl-unix" "\
Completion for `rmdir'.")
(autoload 'pcomplete/rm "pcmpl-unix" "\
-Completion for `rm'.")
+Completion for the `rm' command.")
(autoload 'pcomplete/xargs "pcmpl-unix" "\
Completion for `xargs'.")
-(defalias 'pcomplete/time 'pcomplete/xargs)
+(autoload 'pcomplete/time "pcmpl-unix" "\
+Completion for the `time' command.")
(autoload 'pcomplete/which "pcmpl-unix" "\
Completion for `which'.")
+(autoload 'pcomplete/cat "pcmpl-unix" "\
+Completion for the `cat' command.")
+(autoload 'pcomplete/tac "pcmpl-unix" "\
+Completion for the `tac' command.")
+(autoload 'pcomplete/nl "pcmpl-unix" "\
+Completion for the `nl' command.")
+(autoload 'pcomplete/od "pcmpl-unix" "\
+Completion for the `od' command.")
+(autoload 'pcomplete/base32 "pcmpl-unix" "\
+Completion for the `base32' and `base64' commands.")
+(defalias 'pcomplete/base64 'pcomplete/base32)
+(autoload 'pcomplete/basenc "pcmpl-unix" "\
+Completion for the `basenc' command.")
+(autoload 'pcomplete/fmt "pcmpl-unix" "\
+Completion for the `fmt' command.")
+(autoload 'pcomplete/pr "pcmpl-unix" "\
+Completion for the `pr' command.")
+(autoload 'pcomplete/fold "pcmpl-unix" "\
+Completion for the `fold' command.")
+(autoload 'pcomplete/head "pcmpl-unix" "\
+Completion for the `head' command.")
+(autoload 'pcomplete/tail "pcmpl-unix" "\
+Completion for the `tail' command.")
+(autoload 'pcomplete/split "pcmpl-unix" "\
+Completion for the `split' command.")
+(autoload 'pcomplete/csplit "pcmpl-unix" "\
+Completion for the `csplit' command.")
+(autoload 'pcomplete/wc "pcmpl-unix" "\
+Completion for the `wc' command.")
+(autoload 'pcomplete/sum "pcmpl-unix" "\
+Completion for the `sum' command.")
+(autoload 'pcomplete/cksum "pcmpl-unix" "\
+Completion for the `cksum' command.")
+(autoload 'pcomplete/b2sum "pcmpl-unix" "\
+Completion for the `b2sum' command.")
+(autoload 'pcomplete/md5sum "pcmpl-unix" "\
+Completion for checksum commands.")
+(defalias 'pcomplete/sha1sum 'pcomplete/md5sum)
+(defalias 'pcomplete/sha224sum 'pcomplete/md5sum)
+(defalias 'pcomplete/sha256sum 'pcomplete/md5sum)
+(defalias 'pcomplete/sha384sum 'pcomplete/md5sum)
+(defalias 'pcomplete/sha521sum 'pcomplete/md5sum)
+(autoload 'pcomplete/sort "pcmpl-unix" "\
+Completion for the `sort' command.")
+(autoload 'pcomplete/shuf "pcmpl-unix" "\
+Completion for the `shuf' command.")
+(autoload 'pcomplete/uniq "pcmpl-unix" "\
+Completion for the `uniq' command.")
+(autoload 'pcomplete/comm "pcmpl-unix" "\
+Completion for the `comm' command.")
+(autoload 'pcomplete/ptx "pcmpl-unix" "\
+Completion for the `ptx' command.")
+(autoload 'pcomplete/tsort "pcmpl-unix" "\
+Completion for the `tsort' command.")
+(autoload 'pcomplete/cut "pcmpl-unix" "\
+Completion for the `cut' command.")
+(autoload 'pcomplete/paste "pcmpl-unix" "\
+Completion for the `paste' command.")
+(autoload 'pcomplete/join "pcmpl-unix" "\
+Completion for the `join' command.")
+(autoload 'pcomplete/tr "pcmpl-unix" "\
+Completion for the `tr' command.")
+(autoload 'pcomplete/expand "pcmpl-unix" "\
+Completion for the `expand' command.")
+(autoload 'pcomplete/unexpand "pcmpl-unix" "\
+Completion for the `unexpand' command.")
+(autoload 'pcomplete/ls "pcmpl-unix" "\
+Completion for the `ls' command.")
+(defalias 'pcomplete/dir 'pcomplete/ls)
+(defalias 'pcomplete/vdir 'pcomplete/ls)
+(autoload 'pcomplete/cp "pcmpl-unix" "\
+Completion for the `cp' command.")
+(autoload 'pcomplete/dd "pcmpl-unix" "\
+Completion for the `dd' command.")
+(autoload 'pcomplete/install "pcmpl-unix" "\
+Completion for the `install' command.")
+(autoload 'pcomplete/mv "pcmpl-unix" "\
+Completion for the `mv' command.")
+(autoload 'pcomplete/shred "pcmpl-unix" "\
+Completion for the `shred' command.")
+(autoload 'pcomplete/ln "pcmpl-unix" "\
+Completion for the `ln' command.")
+(autoload 'pcomplete/mkdir "pcmpl-unix" "\
+Completion for the `mkdir' command.")
+(autoload 'pcomplete/mkfifo "pcmpl-unix" "\
+Completion for the `mkfifo' command.")
+(autoload 'pcomplete/mknod "pcmpl-unix" "\
+Completion for the `mknod' command.")
+(autoload 'pcomplete/readlink "pcmpl-unix" "\
+Completion for the `readlink' command.")
(autoload 'pcomplete/chown "pcmpl-unix" "\
Completion for the `chown' command.")
(autoload 'pcomplete/chgrp "pcmpl-unix" "\
Completion for the `chgrp' command.")
+(autoload 'pcomplete/chmod "pcmpl-unix" "\
+Completion for the `chmod' command.")
+(autoload 'pcomplete/touch "pcmpl-unix" "\
+Completion for the `touch' command.")
+(autoload 'pcomplete/df "pcmpl-unix" "\
+Completion for the `df' command.")
+(autoload 'pcomplete/du "pcmpl-unix" "\
+Completion for the `du' command.")
+(autoload 'pcomplete/stat "pcmpl-unix" "\
+Completion for the `stat' command.")
+(autoload 'pcomplete/sync "pcmpl-unix" "\
+Completion for the `sync' command.")
+(autoload 'pcomplete/truncate "pcmpl-unix" "\
+Completion for the `truncate' command.")
+(autoload 'pcomplete/echo "pcmpl-unix" "\
+Completion for the `echo' command.")
+(autoload 'pcomplete/test "pcmpl-unix" "\
+Completion for the `test' command.")
+(defalias (intern "pcomplete/[") 'pcomplete/test)
+(autoload 'pcomplete/tee "pcmpl-unix" "\
+Completion for the `tee' command.")
+(autoload 'pcomplete/basename "pcmpl-unix" "\
+Completion for the `basename' command.")
+(autoload 'pcomplete/dirname "pcmpl-unix" "\
+Completion for the `dirname' command.")
+(autoload 'pcomplete/pathchk "pcmpl-unix" "\
+Completion for the `pathchk' command.")
+(autoload 'pcomplete/mktemp "pcmpl-unix" "\
+Completion for the `mktemp' command.")
+(autoload 'pcomplete/realpath "pcmpl-unix" "\
+Completion for the `realpath' command.")
+(autoload 'pcomplete/id "pcmpl-unix" "\
+Completion for the `id' command.")
+(autoload 'pcomplete/groups "pcmpl-unix" "\
+Completion for the `groups' command.")
+(autoload 'pcomplete/who "pcmpl-unix" "\
+Completion for the `who' command.")
+(autoload 'pcomplete/date "pcmpl-unix" "\
+Completion for the `date' command.")
+(autoload 'pcomplete/nproc "pcmpl-unix" "\
+Completion for the `nproc' command.")
+(autoload 'pcomplete/uname "pcmpl-unix" "\
+Completion for the `uname' command.")
+(autoload 'pcomplete/hostname "pcmpl-unix" "\
+Completion for the `hostname' command.")
+(autoload 'pcomplete/uptime "pcmpl-unix" "\
+Completion for the `uptime' command.")
+(autoload 'pcomplete/chcon "pcmpl-unix" "\
+Completion for the `chcon' command.")
+(autoload 'pcomplete/runcon "pcmpl-unix" "\
+Completion for the `runcon' command.")
+(autoload 'pcomplete/chroot "pcmpl-unix" "\
+Completion for the `chroot' command.")
+(autoload 'pcomplete/env "pcmpl-unix" "\
+Completion for the `env' command.")
+(autoload 'pcomplete/nice "pcmpl-unix" "\
+Completion for the `nice' command.")
+(autoload 'pcomplete/nohup "pcmpl-unix" "\
+Completion for the `nohup' command.")
+(autoload 'pcomplete/stdbuf "pcmpl-unix" "\
+Completion for the `stdbuf' command.")
+(autoload 'pcomplete/timeout "pcmpl-unix" "\
+Completion for the `timeout' command.")
+(autoload 'pcomplete/numfmt "pcmpl-unix" "\
+Completion for the `numfmt' command.")
+(autoload 'pcomplete/seq "pcmpl-unix" "\
+Completion for the `seq' command.")
(autoload 'pcomplete/ssh "pcmpl-unix" "\
Completion rules for the `ssh' command.")
(defalias 'pcomplete/rsh #'pcomplete/ssh)
@@ -23226,13 +23489,25 @@ Completion rules for the `ssh' command.")
Completion rules for the `scp' command.
Includes files as well as host names followed by a colon.")
(autoload 'pcomplete/telnet "pcmpl-unix")
+(autoload 'pcomplete/sudo "pcmpl-unix" "\
+Completion for the `sudo' command.")
(register-definition-prefixes "pcmpl-unix" '("pcmpl-" "pcomplete/"))
;;; Generated autoloads from pcmpl-x.el
+(autoload 'pcomplete/tex "pcmpl-x" "\
+Completion for the `tex' command.")
+(defalias 'pcomplete/pdftex 'pcomplete/tex)
+(defalias 'pcomplete/latex 'pcomplete/tex)
+(defalias 'pcomplete/pdflatex 'pcomplete/tex)
+(autoload 'pcomplete/luatex "pcmpl-x" "\
+Completion for the `luatex' command.")
+(defalias 'pcomplete/lualatex 'pcomplete/luatex)
(autoload 'pcomplete/tlmgr "pcmpl-x" "\
Completion for the `tlmgr' command.")
+(autoload 'pcomplete/rg "pcmpl-x" "\
+Completion for the `rg' command.")
(autoload 'pcomplete/ack "pcmpl-x" "\
Completion for the `ack' command.
Start an argument with `-' to complete short options and `--' for
@@ -23243,6 +23518,8 @@ Completion for the `ag' command.")
(autoload 'pcomplete/bcc32 "pcmpl-x" "\
Completion function for Borland's C++ compiler.")
(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+(autoload 'pcomplete/rclone "pcmpl-x" "\
+Completion for the `rclone' command.")
(register-definition-prefixes "pcmpl-x" '("pcmpl-x-"))
@@ -24282,7 +24559,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 1)) package--builtin-versions)
+(push (purecopy '(project 0 8 2)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -24780,8 +25057,8 @@ Run an inferior Python process.
Argument CMD defaults to `python-shell-calculate-command' return
value. When called interactively with `prefix-arg', it allows
the user to edit such value and choose whether the interpreter
-should be DEDICATED for the current buffer. When numeric prefix
-arg is other than 0 or 4 do not SHOW.
+should be DEDICATED to the current buffer or project. When
+numeric prefix arg is other than 0 or 4 do not SHOW.
For a given buffer and same values of DEDICATED, if a process is
already running for it, it will do nothing. This means that if
@@ -24793,6 +25070,37 @@ Runs the hook `inferior-python-mode-hook' after
process buffer for a list of commands.)
(fn &optional CMD DEDICATED SHOW)" t)
+(autoload 'python-add-import "python" "\
+Add an import statement to the current buffer.
+
+Interactively, ask for an import statement using all imports
+found in the current project as suggestions. With a prefix
+argument, restrict the suggestions to imports defining the symbol
+at point. If there is only one such suggestion, act without
+asking.
+
+When calling from Lisp, use a non-nil NAME to restrict the
+suggestions to imports defining NAME.
+
+(fn NAME)" t)
+(autoload 'python-import-symbol-at-point "python" "\
+Add an import statement for the symbol at point to the current buffer.
+This works like `python-add-import', but with the opposite
+behavior regarding the prefix argument." t)
+(autoload 'python-remove-import "python" "\
+Remove an import statement from the current buffer.
+
+Interactively, ask for an import statement to remove, displaying
+the imports of the current buffer as suggestions. With a prefix
+argument, restrict the suggestions to imports defining the symbol
+at point. If there is only one such suggestion, act without
+asking.
+
+(fn NAME)" t)
+(autoload 'python-sort-imports "python" "\
+Sort Python imports in the current buffer." t)
+(autoload 'python-fix-imports "python" "\
+Add missing imports and remove unused ones from the current buffer." t)
(autoload 'python-mode "python" "\
Major mode for editing Python files.
@@ -25641,6 +25949,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-"))
@@ -25848,7 +26159,7 @@ Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'.")
(custom-autoload 'rmail-displayed-headers "rmail" t)
-(defvar rmail-retry-ignored-headers (purecopy
"^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:")
"\
+(defvar rmail-retry-ignored-headers (concat
"^x-authentication-warning:\\|^x-detected-operating-system:\\|"
"^x-spam[-a-z]*:\\|^arc-.*:\\|"
"^content-type:\\|^content-transfer-encoding:\\|"
"^mime-version:\\|^message-id:\\|^x-google-smtp-source:\\|"
"^x-received:\\|^received-spf:\\|"
"^authentication-results:\\|^dkim-signature:") "\
Headers that should be stripped when retrying a failed message.")
(custom-autoload 'rmail-retry-ignored-headers "rmail" t)
(defvar rmail-highlighted-headers (purecopy "^From:\\|^Subject:") "\
@@ -29151,6 +29462,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.
@@ -29160,6 +29473,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-"))
@@ -29285,6 +29600,10 @@ Studlify-case the current buffer." t)
;;; Generated autoloads from emacs-lisp/subr-x.el
+(defsubst string-join (strings &optional separator) "\
+Join all STRINGS using SEPARATOR.
+Optional argument SEPARATOR must be a string, a vector, or a list of
+characters; nil stands for the empty string." (mapconcat #'identity strings
separator))
(autoload 'string-truncate-left "subr-x" "\
If STRING is longer than LENGTH, return a truncated version.
When truncating, \"...\" is always prepended to the string, so
@@ -30489,9 +30808,9 @@ such as if there are no commands in the file, the value
of `tex-default-mode'
says which mode to use.
(fn)" t)
-(defalias 'TeX-mode #'tex-mode)
-(defalias 'plain-TeX-mode #'plain-tex-mode)
-(defalias 'LaTeX-mode #'latex-mode)
+ (defalias 'TeX-mode #'tex-mode)
+ (defalias 'plain-TeX-mode #'plain-tex-mode)
+ (defalias 'LaTeX-mode #'latex-mode)
(autoload 'plain-tex-mode "tex-mode" "\
Major mode for editing files of input for plain TeX.
Makes $ and } display the characters they match.
@@ -30912,28 +31231,6 @@ Display a list of threads." t)
(register-definition-prefixes "thread" '("thread-list-"))
-;;; Generated autoloads from thumbs.el
-
-(autoload 'thumbs-find-thumb "thumbs" "\
-Display the thumbnail for IMG.
-
-(fn IMG)" t)
-(autoload 'thumbs-show-from-dir "thumbs" "\
-Make a preview buffer for all images in DIR.
-Optional argument REG to select file matching a regexp,
-and SAME-WINDOW to show thumbs in the same window.
-
-(fn DIR &optional REG SAME-WINDOW)" t)
-(autoload 'thumbs-dired-show-marked "thumbs" "\
-In dired, make a thumbs buffer with marked files." t)
-(autoload 'thumbs-dired-show "thumbs" "\
-In dired, make a thumbs buffer with all files in current directory." t)
-(defalias 'thumbs 'thumbs-show-from-dir)
-(autoload 'thumbs-dired-setroot "thumbs" "\
-In dired, call the setroot program on the image at point." t)
-(register-definition-prefixes "thumbs" '("thumbs-"))
-
-
;;; Generated autoloads from emacs-lisp/thunk.el
(push (purecopy '(thunk 1 0)) package--builtin-versions)
@@ -31653,7 +31950,7 @@ the output buffer or changing the window configuration.
Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally.")
(custom-autoload 'tramp-mode "tramp" t)
-(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:" "\
+(defconst tramp-initial-file-name-regexp (rx bos "/" (+ (not (any "/:"))) ":"
(* (not (any "/:"))) ":") "\
Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
(defvar tramp-file-name-regexp tramp-initial-file-name-regexp "\
@@ -31664,7 +31961,7 @@ initial value is overwritten by the car of
`tramp-file-name-structure'.")
(defvar tramp-ignored-file-name-regexp nil "\
Regular expression matching file names that are not under Tramp's control.")
(custom-autoload 'tramp-ignored-file-name-regexp "tramp" t)
-(defconst tramp-autoload-file-name-regexp (concat "\\`/" (if (memq system-type
'(cygwin windows-nt)) "\\(-\\|[^/|:]\\{2,\\}\\)" "[^/|:]+") ":") "\
+(defconst tramp-autoload-file-name-regexp (rx bos "/" (| "-" (>= 2 (not (any
"/:|")))) ":") "\
Regular expression matching file names handled by Tramp autoload.
It must match the initial `tramp-syntax' settings. It should not
match file names at root of the underlying local file system,
@@ -31706,7 +32003,7 @@ It must be supported by libarchive(3).")
List of suffixes which indicate a compressed file.
It must be supported by libarchive(3).")
(defmacro tramp-archive-autoload-file-name-regexp nil "\
-Regular expression matching archive file names." '(concat "\\`" "\\(" ".+"
"\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt
tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'"))
+Regular expression matching archive file names." `(rx bos (group (+ nonl) "."
,(cons '| tramp-archive-suffixes) (32 "." ,(cons '|
tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos))
(autoload 'tramp-archive-file-name-handler "tramp-archive")
(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\
Load Tramp archive file name handler, and perform OPERATION." (defvar
tramp-archive-autoload) (let ((default-directory temporary-file-directory)
(tramp-archive-autoload tramp-archive-enabled)) (apply
#'tramp-autoload-file-name-handler operation args)))
@@ -31729,9 +32026,15 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/tramp-compat.el
+ (defalias 'tramp-compat-rx #'rx)
(register-definition-prefixes "tramp-compat" '("tramp-"))
+;;; Generated autoloads from net/tramp-container.el
+
+(register-definition-prefixes "tramp-container" '("tramp-"))
+
+
;;; Generated autoloads from net/tramp-crypt.el
(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
@@ -32467,6 +32770,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-"))
@@ -32544,14 +32851,14 @@ Fetch a GNU Info URL.
(fn URL)")
-(defalias 'url-rlogin 'url-generic-emulator-loader)
+(define-obsolete-function-alias 'url-rlogin #'url-generic-emulator-loader
"29.1")
(defalias 'url-telnet 'url-generic-emulator-loader)
(defalias 'url-tn3270 'url-generic-emulator-loader)
(autoload 'url-data "url-misc" "\
Fetch a data URL (RFC 2397).
(fn URL)")
-(register-definition-prefixes "url-misc" '("url-do-terminal-emulator"))
+(register-definition-prefixes "url-misc" '("url-"))
;;; Generated autoloads from url/url-news.el
@@ -33030,9 +33337,10 @@ working revisions. With a prefix argument HISTORIC,
it reads two revision
designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
-saving the buffer.
+saving the buffer. The optional argument FILESET can override the
+deduced fileset.
-(fn &optional HISTORIC NOT-URGENT)" t)
+(fn &optional HISTORIC NOT-URGENT FILESET)" t)
(autoload 'vc-diff-mergebase "vc" "\
Report diffs between the merge base of REV1 and REV2 revisions.
The merge base is a common ancestor between REV1 and REV2 revisions.
@@ -33111,6 +33419,12 @@ given, the tag is made as a new branch and the files
are
checked out in that new branch.
(fn DIR NAME BRANCHP)" t)
+(autoload 'vc-create-branch "vc" "\
+Descending recursively from DIR, make a branch called NAME.
+After a new branch is made, the files are checked out in that new branch.
+Uses `vc-create-tag' with the non-nil arg `branchp'.
+
+(fn DIR NAME)" t)
(autoload 'vc-retrieve-tag "vc" "\
For each file in or below DIR, retrieve their tagged version NAME.
NAME can name a branch, in which case this command will switch to the
@@ -33121,8 +33435,16 @@ If NAME is empty, it refers to the latest revisions of
the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped).
+If the prefix argument BRANCHP is given, switch the branch
+and check out the files in that branch.
This function runs the hook `vc-retrieve-tag-hook' when finished.
+(fn DIR NAME &optional BRANCHP)" t)
+(autoload 'vc-switch-branch "vc" "\
+Switch to the branch NAME in the directory DIR.
+If NAME is empty, it refers to the latest revisions of the current branch.
+Uses `vc-retrieve-tag' with the non-nil arg `branchp'.
+
(fn DIR NAME)" t)
(autoload 'vc-print-log "vc" "\
List the change log of the current fileset in a window.
@@ -33152,11 +33474,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" "\
@@ -33214,6 +33538,22 @@ VCS command to run.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch.
+(fn &optional ARG)" t)
+(autoload 'vc-pull-and-push "vc" "\
+First pull, and then push the current branch.
+The push will only be performed if the pull operation was successful.
+
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
+
+On a distributed version control system, this runs a \"pull\"
+operation on the current branch, prompting for the precise
+command if required. Optional prefix ARG non-nil forces a prompt
+for the VCS command to run. If this is successful, a \"push\"
+operation will then be done.
+
+On a non-distributed version control system, this signals an error.
+It also signals an error in a Bazaar bound branch.
+
(fn &optional ARG)" t)
(autoload 'vc-switch-backend "vc" "\
Make BACKEND the current version control system for FILE.
@@ -33263,6 +33603,22 @@ From a program, any ARGS are assumed to be filenames
for which
log entries should be gathered.
(fn &rest ARGS)" t)
+(autoload 'vc-edit-next-command "vc" "\
+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"))
@@ -33382,6 +33738,7 @@ FILE-OR-LIST is the name of a working file; it may be a
list of
files or be nil (to execute commands that don't expect a file
name or set of files). If an optional list of FLAGS is present,
that is inserted into the command line before the filename.
+
Return the return value of the slave command in the synchronous
case, and the process object in the asynchronous case.
@@ -33396,6 +33753,7 @@ case, and the process object in the asynchronous case.
;;; Generated autoloads from vc/vc-git.el
+(put 'vc-git-annotate-switches 'safe-local-variable (lambda (switches) (equal
switches "-w")))
(defun vc-git-registered (file)
"Return non-nil if FILE is registered with git."
(if (vc-find-root file ".git") ; Short cut.
@@ -34255,10 +34613,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
@@ -34555,6 +34909,24 @@ Turn on Viper emulation of Vi in Emacs. See Info node
`(viper)Top'." t)
(register-definition-prefixes "w32-vars" '("w32-"))
+;;; Generated autoloads from image/wallpaper.el
+
+(put 'wallpaper-setter-create 'lisp-indent-function 1)
+(autoload 'wallpaper-set "wallpaper" "\
+Set the desktop background to FILE in a graphical environment.
+
+On GNU/Linux and other Unix-like systems, this relies on an
+external command. Which command to use is automatically detected
+in most cases, but can be manually customized with the user
+options `wallpaper-command' and `wallpaper-command-args'.
+
+On MS-Windows and Haiku systems, no external command is needed,
+so the value of `wallpaper-commands' is ignored.
+
+(fn FILE)" t)
+(register-definition-prefixes "wallpaper" '("wallpaper-"))
+
+
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
@@ -35586,7 +35958,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT.
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 5 0)) package--builtin-versions)
+(push (purecopy '(xref 1 5 1)) package--builtin-versions)
(autoload 'xref-find-backend "xref")
(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
(autoload 'xref-go-back "xref" "\
@@ -35794,7 +36166,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
@@ -35805,6 +36183,7 @@ Zone out, completely." t)
;; no-byte-compile: t
;; version-control: never
;; no-update-autoloads: t
+;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 83fee1e04c..89b9abe137 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -537,10 +537,6 @@ HELP-TEXT is a text set in
`hangul-input-method-help-text'."
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function)))
-(define-obsolete-function-alias
- 'hangul-input-method-inactivate
- #'hangul-input-method-deactivate "24.3")
-
(defun hangul-input-method-help ()
"Describe the current Hangul input method."
(interactive)
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 431d8369c1..31a34bc1de 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)
@@ -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
@@ -2134,5 +2295,119 @@ is."
("`m" ?ꫲ)
("`?" ?꫱))
+(quail-define-package
+ "wancho" "Wancho" "𞋒" t "Wancho phonetic 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)
+ ("0" ?𞋰)
+ ("`0" ?0)
+ ("q" ?𞋠)
+ ("Q" ?𞋡)
+ ("w" ?𞋒)
+ ("e" ?𞋛)
+ ("E" ?𞋧)
+ ("r" ?𞋗)
+ ("t" ?𞋋)
+ ("T" ?𞋌)
+ ("y" ?𞋆)
+ ("Y" ?𞋫)
+ ("u" ?𞋞)
+ ("U" ?𞋪)
+ ("i" ?𞋜)
+ ("I" ?𞋥)
+ ("o" ?𞋕)
+ ("O" ?𞋖)
+ ("`o" ?𞋢)
+ ("`O" ?𞋦)
+ ("p" ?𞋊)
+ ("P" ?𞋇)
+ ("a" ?𞋁)
+ ("A" ?𞋀)
+ ("`a" ?𞋤)
+ ("`A" ?𞋣)
+ ("s" ?𞋎)
+ ("S" ?𞋏)
+ ("d" ?𞋄)
+ ("f" ?𞋍)
+ ("g" ?𞋅)
+ ("h" ?𞋚)
+ ("j" ?𞋐)
+ ("k" ?𞋔)
+ ("K" ?𞋙)
+ ("l" ?𞋈)
+ ("L" ?𞋟)
+ ("z" ?𞋑)
+ ("x" ?𞋩)
+ ("X" ?𞋝)
+ ("c" ?𞋃)
+ ("C" ?𞋬)
+ ("v" ?𞋓)
+ ("V" ?𞋭)
+ ("b" ?𞋂)
+ ("B" ?𞋮)
+ ("n" ?𞋉)
+ ("N" ?𞋯)
+ ("m" ?𞋘)
+ ("M" ?𞋨))
+
+(quail-define-package
+ "toto" "Toto" "𞊒𞊪" nil "Toto script phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?𞊫)
+ ("Q" ?𞊬)
+ ("w" ?𞊜)
+ ("e" ?𞊦)
+ ("E" ?𞊧)
+ ("r" ?𞊟)
+ ("t" ?𞊒)
+ ("y" ?𞊛)
+ ("u" ?𞊥)
+ ("i" ?𞊡)
+ ("I" ?𞊢)
+ ("o" ?𞊪)
+ ("p" ?𞊐)
+ ("a" ?𞊭)
+ ("s" ?𞊙)
+ ("d" ?𞊓)
+ ("f" ?𞊮)
+ ("g" ?𞊕)
+ ("h" ?𞊞)
+ ("j" ?𞊝)
+ ("k" ?𞊔)
+ ("l" ?𞊠)
+ ("z" ?𞊣)
+ ("Z" ?𞊤)
+ ("x" ?𞊨)
+ ("X" ?𞊩)
+ ("c" ?𞊚)
+ ("b" ?𞊑)
+ ("n" ?𞊗)
+ ("N" ?𞊘)
+ ("m" ?𞊖))
+
(provide 'indian)
;;; indian.el ends here
diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el
index 0c4a0d4ce4..73287ee784 100644
--- a/lisp/leim/quail/misc-lang.el
+++ b/lisp/leim/quail/misc-lang.el
@@ -1180,5 +1180,500 @@
(".||" ?𐩗)
(".=" ?𐩘))
+(quail-define-package
+ "adlam" "Adlam" "𞤀" t "Adlam 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" ?𞥑)
+ ("`!" ?𞥞)
+ ("2" ?𞥒)
+ ("3" ?𞥓)
+ ("4" ?𞥔)
+ ("5" ?𞥕)
+ ("6" ?𞥖)
+ ("7" ?𞥗)
+ ("8" ?𞥘)
+ ("9" ?𞥙)
+ ("0" ?𞥐)
+ ("q" ?𞤹)
+ ("Q" ?𞤗)
+ ("`q" ?𞥆)
+ ("w" ?𞤱)
+ ("W" ?𞤏)
+ ("`w" ?𞥈)
+ ("`W" ?𞥉)
+ ("e" ?𞤫)
+ ("E" ?𞤉)
+ ("`e" ?𞥅)
+ ("r" ?𞤪)
+ ("R" ?𞤈)
+ ("t" ?𞤼)
+ ("T" ?𞤚)
+ ("y" ?𞤴)
+ ("Y" ?𞤒)
+ ("`y" ?𞤰)
+ ("`Y" ?𞤎)
+ ("u" ?𞤵)
+ ("U" ?𞤓)
+ ("i" ?𞤭)
+ ("I" ?𞤋)
+ ("o" ?𞤮)
+ ("O" ?𞤌)
+ ("p" ?𞤨)
+ ("P" ?𞤆)
+ ("a" ?𞤢)
+ ("A" ?𞤀)
+ ("`a" ?𞥄)
+ ("s" ?𞤧)
+ ("S" ?𞤅)
+ ("`s" ?𞥃)
+ ("`S" ?𞤡)
+ ("d" ?𞤣)
+ ("D" ?𞤁)
+ ("`d" ?𞤯)
+ ("`D" ?𞤍)
+ ("f" ?𞤬)
+ ("F" ?𞤊)
+ ("g" ?𞤺)
+ ("G" ?𞤘)
+ ("`g" ?𞥀)
+ ("`G" ?𞤞)
+ ("h" ?𞤸)
+ ("H" ?𞤖)
+ ("`h" ?𞥇)
+ ("j" ?𞤶)
+ ("J" ?𞤔)
+ ("k" ?𞤳)
+ ("K" ?𞤑)
+ ("`k" ?𞤿)
+ ("`K" ?𞤝)
+ ("l" ?𞤤)
+ ("L" ?𞤂)
+ ("z" ?𞥁)
+ ("Z" ?𞤟)
+ ("`z" ?𞥂)
+ ("`Z" ?𞤠)
+ ("x" ?𞤽)
+ ("X" ?𞤛)
+ ("c" ?𞤷)
+ ("C" ?𞤕)
+ ("`c" #x200C) ; ZWNJ
+ ("v" ?𞤾)
+ ("V" ?𞤜)
+ ("`v" ?𞥊)
+ ("b" ?𞤦)
+ ("B" ?𞤄)
+ ("`b" ?𞤩)
+ ("`B" ?𞤇)
+ ("n" ?𞤲)
+ ("N" ?𞤐)
+ ("`n" ?𞤻)
+ ("`N" ?𞤙)
+ ("m" ?𞤥)
+ ("M" ?𞤃)
+ ("`m" ?𞥋)
+ ("`/" ?𞥟))
+
+(quail-define-package
+ "mende-kikakui" "Mende Kikakui" "𞠗" nil
+ "Mende Kikakui input method." nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?𞣇)
+ ("2" ?𞣈)
+ ("3" ?𞣉)
+ ("4" ?𞣊)
+ ("5" ?𞣋)
+ ("6" ?𞣌)
+ ("7" ?𞣍)
+ ("8" ?𞣎)
+ ("9" ?𞣏)
+
+ (".1" ?𞣐)
+ (".2" ?𞣑)
+ (".3" ?𞣒)
+ (".4" ?𞣓)
+ (".5" ?𞣔)
+ (".6" ?𞣕)
+ (".7" ?𞣖)
+
+ ("ki" ?𞠀)
+ ("ka" ?𞠁)
+ ("ku" ?𞠂)
+ ("kee" ?𞠃)
+ ("ke" ?𞠄)
+ ("koo" ?𞠅)
+ ("ko" ?𞠆)
+ ("kua" ?𞠇)
+
+ ("wi" ?𞠈)
+ ("wa" ?𞠉)
+ ("wu" ?𞠊)
+ ("wee" ?𞠋)
+ ("we" ?𞠌)
+ ("woo" ?𞠍)
+ ("wo" ?𞠎)
+ ("wui" ?𞠏)
+ ("wei" ?𞠐)
+
+ ("wvi" ?𞠑)
+ ("wua" ?𞠒)
+ ("wve" ?𞠓)
+
+ ("min" ?𞠔)
+ ("man" ?𞠕)
+ ("mun" ?𞠖)
+ ("men" ?𞠗)
+ ("mon" ?𞠘)
+ ("muan" ?𞠙)
+ ("muen" ?𞠚)
+
+ ("bi" ?𞠛)
+ ("ba" ?𞠜)
+ ("bu" ?𞠝)
+ ("bee" ?𞠞)
+ ("be" ?𞠟)
+ ("boo" ?𞠠)
+ ("bo" ?𞠡)
+
+ ("i" ?𞠢)
+ ("a" ?𞠣)
+ ("u" ?𞠤)
+ ("ee" ?𞠥)
+ ("e" ?𞠦)
+ ("oo" ?𞠧)
+ ("o" ?𞠨)
+ ("ei" ?𞠩)
+ ("in" ?𞠪)
+ ("inn" ?𞠫)
+ ("an" ?𞠬)
+ ("en" ?𞠭)
+
+ ("si" ?𞠮)
+ ("sa" ?𞠯)
+ ("su" ?𞠰)
+ ("see" ?𞠱)
+ ("se" ?𞠲)
+ ("soo" ?𞠳)
+ ("so" ?𞠴)
+ ("sia" ?𞠵)
+
+ ("li" ?𞠶)
+ ("la" ?𞠷)
+ ("lu" ?𞠸)
+ ("lee" ?𞠹)
+ ("le" ?𞠺)
+ ("loo" ?𞠻)
+ ("lo" ?𞠼)
+ ("lle" ?𞠽)
+
+ ("di" ?𞠾)
+ ("da" ?𞠿)
+ ("du" ?𞡀)
+ ("dee" ?𞡁)
+ ("doo" ?𞡂)
+ ("do" ?𞡃)
+
+ ("ti" ?𞡄)
+ ("ta" ?𞡅)
+ ("tu" ?𞡆)
+ ("tee" ?𞡇)
+ ("te" ?𞡈)
+ ("too" ?𞡉)
+ ("to" ?𞡊)
+
+ ("ji" ?𞡋)
+ ("ja" ?𞡌)
+ ("ju" ?𞡍)
+ ("jee" ?𞡎)
+ ("je" ?𞡏)
+ ("joo" ?𞡐)
+ ("jo" ?𞡑)
+ ("jjo" ?𞡒)
+
+ ("yi" ?𞡓)
+ ("ya" ?𞡔)
+ ("yu" ?𞡕)
+ ("yee" ?𞡖)
+ ("ye" ?𞡗)
+ ("yoo" ?𞡘)
+ ("yo" ?𞡙)
+
+ ("fi" ?𞡚)
+ ("fa" ?𞡛)
+ ("fu" ?𞡜)
+ ("fee" ?𞡝)
+ ("fe" ?𞡞)
+ ("foo" ?𞡟)
+ ("fo" ?𞡠)
+ ("fua" ?𞡡)
+ ("fan" ?𞡢)
+
+ ("nin" ?𞡣)
+ ("nan" ?𞡤)
+ ("nun" ?𞡥)
+ ("nen" ?𞡦)
+ ("non" ?𞡧)
+
+ ("hi" ?𞡨)
+ ("ha" ?𞡩)
+ ("hu" ?𞡪)
+ ("hee" ?𞡫)
+ ("he" ?𞡬)
+ ("hoo" ?𞡭)
+ ("ho" ?𞡮)
+ ("heei" ?𞡯)
+ ("hoou" ?𞡰)
+ ("hin" ?𞡱)
+ ("han" ?𞡲)
+ ("hun" ?𞡳)
+ ("hen" ?𞡴)
+ ("hon" ?𞡵)
+ ("huan" ?𞡶)
+
+ ("nggi" ?𞡷)
+ ("ngga" ?𞡸)
+ ("nggu" ?𞡹)
+ ("nggee" ?𞡺)
+ ("ngge" ?𞡻)
+ ("nggoo" ?𞡼)
+ ("nggo" ?𞡽)
+ ("nggaa" ?𞡾)
+ ("nggua" ?𞡿)
+ ("nngge" ?𞢀)
+ ("nnggoo" ?𞢁)
+ ("nnggo" ?𞢂)
+
+ ("gi" ?𞢃)
+ ("ga" ?𞢄)
+ ("gu" ?𞢅)
+ ("gee" ?𞢆)
+ ("guei" ?𞢇)
+ ("guan" ?𞢈)
+
+ ("ngen" ?𞢉)
+ ("ngon" ?𞢊)
+ ("nguan" ?𞢋)
+
+ ("pi" ?𞢌)
+ ("pa" ?𞢍)
+ ("pu" ?𞢎)
+ ("pee" ?𞢏)
+ ("pe" ?𞢐)
+ ("poo" ?𞢑)
+ ("po" ?𞢒)
+
+ ("mbi" ?𞢓)
+ ("mba" ?𞢔)
+ ("mbu" ?𞢕)
+ ("mbee" ?𞢖)
+ ("mmbee" ?𞢗)
+ ("mbe" ?𞢘)
+ ("mboo" ?𞢙)
+ ("mbo" ?𞢚)
+ ("mbuu" ?𞢛)
+ ("mmbe" ?𞢜)
+ ("mmboo" ?𞢝)
+ ("mmbo" ?𞢞)
+
+ ("kpi" ?𞢟)
+ ("kpa" ?𞢠)
+ ("kpu" ?𞢡)
+ ("kpee" ?𞢢)
+ ("kpe" ?𞢣)
+ ("kpoo" ?𞢤)
+ ("kpo" ?𞢥)
+
+ ("gbi" ?𞢦)
+ ("gba" ?𞢧)
+ ("gbu" ?𞢨)
+ ("gbee" ?𞢩)
+ ("gbe" ?𞢪)
+ ("gboo" ?𞢫)
+ ("gbo" ?𞢬)
+
+ ("ra" ?𞢭)
+
+ ("ndi" ?𞢮)
+ ("nda" ?𞢯)
+ ("ndu" ?𞢰)
+ ("ndee" ?𞢱)
+ ("nde" ?𞢲)
+ ("ndoo" ?𞢳)
+ ("ndo" ?𞢴)
+
+ ("nja" ?𞢵)
+ ("nju" ?𞢶)
+ ("njee" ?𞢷)
+ ("njoo" ?𞢸)
+
+ ("vi" ?𞢹)
+ ("va" ?𞢺)
+ ("vu" ?𞢻)
+ ("vee" ?𞢼)
+ ("ve" ?𞢽)
+ ("voo" ?𞢾)
+ ("vo" ?𞢿)
+
+ ("nyin" ?𞣀)
+ ("nyan" ?𞣁)
+ ("nyun" ?𞣂)
+ ("nyen" ?𞣃)
+ ("nyon" ?𞣄))
+
+(quail-define-package
+ "gothic" "Gothic" "𐌰" nil
+ "Input methid for the ancient Gothic script."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?𐌵)
+ ("w" ?𐍅)
+ ("e" ?𐌴)
+ ("r" ?𐍂)
+ ("t" ?𐍄)
+ ("y" ?𐌸)
+ ("u" ?𐌿)
+ ("i" ?𐌹)
+ ("o" ?𐍉)
+ ("p" ?𐍀)
+ ("a" ?𐌰)
+ ("s" ?𐍃)
+ ("d" ?𐌳)
+ ("f" ?𐍆)
+ ("g" ?𐌲)
+ ("h" ?𐌷)
+ ("j" ?𐌾)
+ ("k" ?𐌺)
+ ("l" ?𐌻)
+ ("z" ?𐌶)
+ ("x" ?𐍇)
+ ("c" ?𐍈)
+ ("v" ?𐍁)
+ ("V" ?𐍊)
+ ("b" ?𐌱)
+ ("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/uni-input.el b/lisp/leim/quail/uni-input.el
index 36d8e6a840..3f10b873a3 100644
--- a/lisp/leim/quail/uni-input.el
+++ b/lisp/leim/quail/uni-input.el
@@ -113,10 +113,6 @@ While this input method is active, the variable
(interactive)
(ucs-input-activate -1))
-(define-obsolete-function-alias
- 'ucs-input-inactivate
- #'ucs-input-deactivate "24.3")
-
(defun ucs-input-help ()
(interactive)
(with-output-to-temp-buffer "*Help*"
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index b4ed043246..0cb02f072e 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -171,6 +171,13 @@ unloading."
(cond
((null hist)
(defalias fun nil)
+ ;; FIXME: Arguably these properties should be applied via
+ ;; `define-symbol-prop', but most code still uses just `put'.
+ ;; FIXME: Maybe these properties should be attached to the
+ ;; function itself (as for `advertised-calling-convention')
+ ;; rather than to its symbol.
+ (if (get fun 'compiler-macro) (put fun 'compiler-macro nil))
+ (if (get fun 'gv-expander) (put fun 'gv-expander nil))
;; Override the change that `defalias' just recorded.
(put fun 'function-history nil))
((equal (car hist) loadhist-unload-filename)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 634a331436..2a9aff4c1f 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -244,9 +244,7 @@
(load "language/indonesian")
(load "indent")
-(let ((max-specpdl-size (max max-specpdl-size 1800)))
- ;; A particularly demanding file to load; 1600 does not seem to be enough.
- (load "emacs-lisp/cl-generic"))
+(load "emacs-lisp/cl-generic")
(load "simple")
(load "emacs-lisp/seq")
(load "emacs-lisp/nadvice")
@@ -368,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"))
@@ -503,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/emacsbug.el b/lisp/mail/emacsbug.el
index d72809b186..60f733435a 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -300,7 +300,7 @@ usually do not have translators for other languages.\n\n")))
(let ((txt (delete-and-extract-region (1+ user-point) (point))))
(insert (propertize "\n" 'display txt)))
- (emacs-bug--system-description)
+ (emacs-build-description)
(insert "Configured features:\n" system-configuration-features "\n\n")
(fill-region (line-beginning-position -1) (point))
(when (and (featurep 'native-compile)
@@ -386,7 +386,10 @@ copy text to your preferred mail program.\n"
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
-(defun emacs-bug--system-description ()
+;;;###autoload
+(defun emacs-build-description ()
+ "Insert a description of the current Emacs build in the current buffer."
+ (interactive)
(let ((start (point)))
(insert "\nIn " (emacs-version))
(if emacs-build-system
@@ -414,8 +417,6 @@ copy text to your preferred mail program.\n"
system-configuration-options "'\n\n")
(fill-region (line-beginning-position -1) (point))))
-(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3")
-
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
(goto-char (point-max))
@@ -523,7 +524,7 @@ Message buffer where you can explain more about the patch."
(compose-mail-other-window report-emacs-bug-address subject)
(message-goto-body)
(insert "\n\n\n")
- (emacs-bug--system-description)
+ (emacs-build-description)
(mml-attach-file file "text/patch" nil "attachment")
(message-goto-body)
(message "Write a description of the patch and use %s to send it"
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 989a8b3cd6..2ae916e3ac 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -614,29 +614,12 @@ to arrange for the message to get a From: line."
(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
- "Whether sendmail should issue a warning header if called with \"-f\".
-The sendmail program has a useful feature to let you set the envelope FROM
-address via a command line option, \"-f\". Unfortunately, it also has a widely
-disliked default behavior of selling you out if you do that by inserting
-an unattractive warning in the headers. It looks something like this:
-
- X-Authentication-Warning: u1.example.com: niceguy set
- sender to niceguy@example.com using -f
-
-It is possible to configure sendmail to not do this, but such a
-reconfiguration is not an option for many users. As this is the
-default behavior of most sendmail installations, one can mostly
-only wish it were otherwise. If feedmail believes the sendmail
-program will sell you out this way, it won't use the \"-f\"
-option when calling sendmail. If it doesn't think sendmail will
-sell you out, it will use the \"-f\" \(since it is a handy
-feature). You control what feedmail thinks with this variable.
-The default is nil, meaning that feedmail will believe that
-sendmail will sell you out."
+ "If non-nil, call \"sendmail\" with \"-f\".
+See `message-sendmail-f-is-evil' for an explanation of what the
+\"-f\" parameter does."
:version "24.1"
:group 'feedmail-headers
- :type 'boolean
-)
+ :type 'boolean)
(defcustom feedmail-deduce-envelope-from t
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index eebb140088..5136e11c89 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -57,8 +57,7 @@
"The default number of bits to pay to unknown users.
If this is zero, no payment header will be generated.
See `hashcash-payment-alist'."
- :type 'natnum
- :group 'hashcash)
+ :type 'natnum)
(defcustom hashcash-payment-alist '()
"An association list mapping email addresses to payment amounts.
@@ -72,46 +71,39 @@ present, is the string to be hashed; if not present ADDR
will be used."
(list :tag "Replace hash input"
(string :name "Address")
(string :name "Hash input")
- (integer :name "Amount"))))
- :group 'hashcash)
+ (integer :name "Amount")))))
(defcustom hashcash-default-accept-payment 20
"The default minimum number of bits to accept on incoming payments."
- :type 'natnum
- :group 'hashcash)
+ :type 'natnum)
(defcustom hashcash-accept-resources `((,user-mail-address nil))
"An association list mapping hashcash resources to payment amounts.
Resources named here are to be accepted in incoming payments. If the
corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
is used instead."
- :type 'alist
- :group 'hashcash)
+ :type 'alist)
(define-obsolete-variable-alias 'hashcash-path 'hashcash-program "24.4")
(defcustom hashcash-program "hashcash"
"The name of the hashcash executable.
If this is not in your PATH, specify an absolute file name."
- :type '(choice (const nil) file)
- :group 'hashcash)
+ :type '(choice (const nil) file))
(defcustom hashcash-extra-generate-parameters '("-Z2")
"A list of parameter strings passed to `hashcash-program' when minting.
For example, on very old hardware, you may want to set this
to (\"-Z0\") to disable compression."
:type '(repeat string)
- :version "29.1"
- :group 'hashcash)
+ :version "29.1")
(defcustom hashcash-double-spend-database "hashcash.db"
"The name of the double-spending database file."
- :type 'file
- :group 'hashcash)
+ :type 'file)
(defcustom hashcash-in-news nil
"Specifies whether or not hashcash payments should be made to newsgroups."
- :type 'boolean
- :group 'hashcash)
+ :type 'boolean)
(defvar hashcash-process-alist nil
"Alist of asynchronous hashcash processes and buffers.")
@@ -316,6 +308,7 @@ Set ASYNC to t to start asynchronous calculation. (See
(save-excursion
(save-restriction
(message-narrow-to-headers)
+ (goto-char (point-max))
(let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
(cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
(ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 4bfec22b3a..f095d5e9c0 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -372,11 +372,17 @@ If nil, display all header fields except those matched by
:group 'rmail-headers)
;;;###autoload
-(defcustom rmail-retry-ignored-headers (purecopy
"^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:")
+(defcustom rmail-retry-ignored-headers
+ (concat "^x-authentication-warning:\\|^x-detected-operating-system:\\|"
+ "^x-spam[-a-z]*:\\|^arc-.*:\\|"
+ "^content-type:\\|^content-transfer-encoding:\\|"
+ "^mime-version:\\|^message-id:\\|^x-google-smtp-source:\\|"
+ "^x-received:\\|^received-spf:\\|"
+ "^authentication-results:\\|^dkim-signature:")
"Headers that should be stripped when retrying a failed message."
:type '(choice regexp (const :value nil :tag "None"))
:group 'rmail-headers
- :version "23.2") ; added x-detected-operating-system, x-spam
+ :version "29.1")
;;;###autoload
(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:")
@@ -4614,6 +4620,9 @@ Argument MIME is non-nil if this is a mime message."
"> ")
(push (rmail-epa-decrypt-1 mime) decrypts))))
+ ;; Decode any base64-encoded mime sections.
+ (rmail-epa-decode)
+
(when (and decrypts (rmail-buffers-swapped-p))
(when (y-or-n-p "Replace the original message? ")
(when (eq major-mode 'rmail-mode)
@@ -4678,6 +4687,31 @@ Argument MIME is non-nil if this is a mime message."
(unless decrypts
(error "Nothing to decrypt")))))
+;; Decode all base64-encoded mime sections, so that this change
+;; is made in the Rmail file, not just in the viewing buffer.
+(defun rmail-epa-decode ()
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t)
+ ;; 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))
+ (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)))))))
;;;; Desktop support
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b959f45250..0144a34e5e 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,6 +50,23 @@ Setting this option to nil might speed up the generation of
summaries."
:type 'boolean
:group 'rmail-summary)
+(defcustom rmail-summary-apply-filters-consecutively nil
+ "If non-nil, Rmail summary commands apply filtering on top existing
filtering.
+When this variable is non-nil, `rmail-summary-by-*' commands work on the
+current summary, and so their filtering can be stacked one on top of another.
+This allows gradual narrowing of the selection of the messages."
+ :type 'boolean
+ :version "29.1"
+ :group 'rmail-summary)
+
+(defvar rmail-summary-currently-displayed-msgs nil
+ "String made of `y' and `n'.
+The character at position i tells wether message i is shown in the
+summary or not. First character is ignored.
+Used when applying `rmail-summary-by-*' commands consecutively. Filled
+by `rmail-summary-fill-displayed-messages'.")
+(put 'rmail-summary-currently-displayed-msgs 'permanent-local t)
+
(defvar rmail-summary-font-lock-keywords
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
@@ -267,6 +284,34 @@ 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-fill-displayed-messages ()
+ "Fill the rmail-summary-currently-displayed-msgs string."
+ (with-current-buffer rmail-buffer
+ (with-current-buffer rmail-summary-buffer
+ (setq rmail-summary-currently-displayed-msgs
+ (make-string (1+ rmail-total-messages) ?n))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (aset rmail-summary-currently-displayed-msgs
+ (string-to-number (thing-at-point 'line))
+ ?y)
+ (forward-line 1)))))
+
+(defun rmail-summary-negate ()
+ "Toggle display of messages that match the summary and those which do not."
+ (interactive)
+ (rmail-summary-fill-displayed-messages)
+ (rmail-new-summary "Negate"
+ '(rmail-summary-by-regexp ".*")
+ (lambda (msg)
+ (if
+ (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?n)
+ (progn
+ (aset rmail-summary-currently-displayed-msgs msg
?y) t)
+ (progn
+ (aset rmail-summary-currently-displayed-msgs msg ?n)
nil)))))
+
;;;###autoload
(defun rmail-summary ()
"Display a summary of all messages, one line per message."
@@ -282,9 +327,16 @@ 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 rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary (concat "labels " labels)
(list 'rmail-summary-by-labels labels)
- 'rmail-message-labels-p
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg l)
+ (and (= (aref rmail-summary-currently-displayed-msgs
msg)
+ ?y)
+ (rmail-message-labels-p msg l)))
+ 'rmail-message-labels-p)
(concat " \\("
(mail-comma-list-regexp labels)
"\\)\\(,\\|\\'\\)")))
@@ -297,10 +349,18 @@ 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 rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary
(concat "recipients " recipients)
(list 'rmail-summary-by-recipients recipients primary-only)
- 'rmail-message-recipients-p recipients primary-only))
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg r &optional po)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (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 +388,16 @@ Emacs will list the message in the summary."
(setq regexp (or rmail-last-regexp
(error "No regexp specified"))))
(setq rmail-last-regexp regexp)
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary (concat "regexp " regexp)
(list 'rmail-summary-by-regexp regexp)
- 'rmail-message-regexp-p
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg r)
+ (and (= (aref rmail-summary-currently-displayed-msgs
msg)
+ ?y)
+ (rmail-message-regexp-p msg r)))
+ 'rmail-message-regexp-p)
regexp))
(defun rmail-message-regexp-p (msg regexp)
@@ -365,7 +432,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 +443,18 @@ SUBJECT is a regular expression."
(if subject ", default current subject" "")
"): ")))
(list (read-string prompt nil nil subject) current-prefix-arg)))
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary
(concat "about " subject)
(list 'rmail-summary-by-topic subject whole-message)
- 'rmail-message-subject-p subject whole-message))
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg s &optional wm)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (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 +477,18 @@ sender of the current message."
(if sender ", default this message's sender" "")
"): ")))
(list (read-string prompt nil nil sender))))
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-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 rmail-summary-apply-filters-consecutively
+ (lambda (msg s)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (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/smtpmail.el b/lisp/mail/smtpmail.el
index c2f8f27377..8573532eac 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -577,7 +577,7 @@ for `smtpmail-try-auth-method'.")
(stringp result))
(setq result (catch 'done
(smtpmail-try-auth-method
- process (pop mechs) user password))))
+ process (intern-soft (pop mechs)) user password))))
;; A string result is an error.
(if (stringp result)
(progn
diff --git a/lisp/man.el b/lisp/man.el
index d66f63972a..7ba7bee417 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -168,13 +168,14 @@ pushy -- make the manpage the current buffer in the
current window
bully -- make the manpage the current buffer and only window (sf)
aggressive -- make the manpage the current buffer in the other window (sf)
friendly -- display manpage in the other window but don't make current (sf)
+thrifty -- reuse an existing manpage window if possible (sf)
polite -- don't display manpage, but prints message and beep when ready
quiet -- like `polite', but don't beep
meek -- make no indication that the manpage is ready
Any other value of `Man-notify-method' is equivalent to `meek'."
:type '(radio (const newframe) (const pushy) (const bully)
- (const aggressive) (const friendly)
+ (const aggressive) (const friendly) (const thrifty)
(const polite) (const quiet) (const meek))
:group 'man)
@@ -1229,6 +1230,11 @@ See the variable `Man-notify-method' for the different
notification behaviors."
(and (frame-live-p saved-frame)
(select-frame saved-frame))
(display-buffer man-buffer 'not-this-window))
+ ('thrifty
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (display-buffer man-buffer '(display-buffer-reuse-mode-window
+ (mode . Man-mode))))
('polite
(beep)
(message "Manual buffer %s is ready" (buffer-name man-buffer)))
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/mh-e.el b/lisp/mh-e/mh-e.el
index f6031df9c2..9a04d89097 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -2831,9 +2831,7 @@ removed and entries from `mh-invisible-header-fields' are
added."
(setq mh-invisible-header-fields-compiled
(concat
"^"
- ;; workaround for insufficient default
- (let ((max-specpdl-size 1000))
- (regexp-opt fields t))))
+ (regexp-opt fields t)))
(setq mh-invisible-header-fields-compiled nil))))
;; Compile invisible header fields.
@@ -3183,8 +3181,6 @@ function used to insert the signature with
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
- 'mh-kill-folder-suppress-prompt-functions "24.3")
(defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p)
"Abnormal hook run at the beginning of
\\<mh-folder-mode-map>\\[mh-kill-folder].
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 5b90290237..308660431a 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -583,7 +583,7 @@ perform the operation on all messages in that region.
(make-local-variable 'desktop-save-buffer)
(setq desktop-save-buffer t)
(setq-local
- mh-colors-available-flag (mh-colors-available-p)
+ mh-colors-available-flag (display-color-p)
; Do we have colors available
mh-current-folder (buffer-name) ; Name of folder, a string
mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index ab89ef2a3d..4956d9b59f 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -101,7 +101,7 @@ a non-nil value to suppress the normal prompt when you
remove a
folder. This is useful for folders that are easily regenerated."
(interactive)
(if (or (run-hook-with-args-until-success
- 'mh-kill-folder-suppress-prompt-hooks)
+ 'mh-kill-folder-suppress-prompt-functions)
(yes-or-no-p (format "Remove folder %s (and all included messages)? "
mh-current-folder)))
(let ((folder mh-current-folder)
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-utils.el b/lisp/mh-e/mh-utils.el
index dd662f3552..b2c79350c4 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -59,13 +59,6 @@ used in lieu of `search' in the CL package."
(point))
(set-syntax-table syntax-table))))
-;;;###mh-autoload
-(defun mh-colors-available-p ()
- "Check if colors are available in the Emacs being used."
- ;; FIXME: Can this be replaced with `display-color-p'?
- (let ((color-cells (display-color-cells)))
- (and (numberp color-cells) (>= color-cells 8))))
-
;;;###mh-autoload
(defun mh-colors-in-use-p ()
"Check if colors are being used in the folder buffer."
@@ -1005,6 +998,9 @@ If the current line is too long truncate a part of it as
well."
(goto-char (point-min))
(re-search-forward mh-signature-separator-regexp nil t)))
+;;;###mh-autoload
+(define-obsolete-function-alias 'mh-colors-available-p #'display-color-p
"29.1")
+
(provide 'mh-utils)
;; Local Variables:
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 3f04a3e921..935c9111ee 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -64,6 +64,8 @@
:type 'boolean
:group 'minibuffer
:version "24.3")
+(make-obsolete-variable 'minibuffer-eldef-shorten-default
+ 'minibuffer-default-prompt-format "29.1")
(defvar minibuffer-default-in-prompt-regexps
(minibuffer-default--in-prompt-regexps)
@@ -108,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 3daab8a1e8..4898dfdb98 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -972,10 +972,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 +1245,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))
@@ -4461,6 +4469,11 @@ FORMAT-ARGS is non-nil, PROMPT is used as a format
control
string, and FORMAT-ARGS are the arguments to be substituted into
it. See `format' for details.
+Both PROMPT and `minibuffer-default-prompt-format' are run
+through `substitute-command-keys' (which see). In particular,
+this means that single quotes may be displayed by equivalent
+characters, according to the capabilities of the terminal.
+
If DEFAULT is a list, the first element is used as the default.
If not, the element is used as is.
@@ -4468,12 +4481,12 @@ If DEFAULT is nil or an empty string, no \"default
value\" string
is included in the return value."
(concat
(if (null format-args)
- prompt
- (apply #'format prompt format-args))
+ (substitute-command-keys prompt)
+ (apply #'format (substitute-command-keys prompt) format-args))
(and default
(or (not (stringp default))
(length> default 0))
- (format minibuffer-default-prompt-format
+ (format (substitute-command-keys minibuffer-default-prompt-format)
(if (consp default)
(car default)
default)))
diff --git a/lisp/mpc.el b/lisp/mpc.el
index ba95308bf6..1775e7d5e7 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -182,8 +182,6 @@ numerically rather than lexicographically."
(abs res))
res))))))))
-(define-obsolete-function-alias 'mpc-string-prefix-p #'string-prefix-p "24.3")
-
;; This can speed up mpc--song-search significantly. The table may grow
;; very large, tho. It's only bounded by the fact that it gets flushed
;; whenever the connection is established; which seems to work OK thanks
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 2d528c4862..1597f3651a 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1294,6 +1294,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)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 43dd28ff6d..b8f5018005 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -59,7 +59,7 @@ the existing connection."
(defgroup dictionary nil
"Client for accessing the dictd server based dictionaries."
- :group 'hypermedia)
+ :group 'applications)
(defgroup dictionary-proxy nil
"Proxy configuration options for the dictionary client."
@@ -1173,7 +1173,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.el b/lisp/net/eudc.el
index 40cb25fca2..5f9e78fc7f 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.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 6ed0719eca..414de931c4 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -315,7 +315,8 @@ parameter, and should return the (possibly) transformed
URL."
(defvar-keymap eww-link-keymap
:parent shr-map
- "RET" #'eww-follow-link)
+ "RET" #'eww-follow-link
+ "<mouse-2>" #'eww-follow-link)
(defvar-keymap eww-image-link-keymap
:parent shr-map
@@ -415,13 +416,11 @@ For more information, see Info node `(eww) Top'."
(defun eww-retrieve (url callback cbargs)
(cond
((null eww-retrieve-command)
- (url-retrieve url #'eww-render
- (list url nil (current-buffer))))
+ (url-retrieve url #'eww-render cbargs))
((eq eww-retrieve-command 'sync)
- (let ((orig-buffer (current-buffer))
- (data-buffer (url-retrieve-synchronously url)))
+ (let ((data-buffer (url-retrieve-synchronously url)))
(with-current-buffer data-buffer
- (eww-render nil url nil orig-buffer))))
+ (apply #'eww-render nil url cbargs))))
(t
(let ((buffer (generate-new-buffer " *eww retrieve*"))
(error-buffer (generate-new-buffer " *eww error*")))
@@ -626,7 +625,10 @@ The renaming scheme is performed in accordance with
(setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
- (run-hooks 'eww-after-render-hook)))
+ (run-hooks 'eww-after-render-hook)
+ ;; Enable undo again so that undo works in text input
+ ;; boxes.
+ (setq buffer-undo-list nil)))
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
@@ -928,7 +930,8 @@ The renaming scheme is performed in accordance with
;; May be set later if there's a next/prev link.
(setq-local multi-isearch-next-buffer-function nil)
(unless (eq major-mode 'eww-mode)
- (eww-mode)))
+ (eww-mode))
+ (buffer-disable-undo))
(defun eww-current-url nil
"Return URI of the Web page the current EWW buffer is visiting."
@@ -1176,8 +1179,28 @@ the like."
'((url . eww--url-at-point))))
(setq-local bookmark-make-record-function #'eww-bookmark-make-record)
(buffer-disable-undo)
+ (setq-local shr-url-transformer #'eww--transform-url)
+ ;; Also rescale images when rescaling the text.
+ (add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
(setq buffer-read-only t))
+(defvar text-scale-mode)
+(defvar text-scale-mode-amount)
+(defun eww--rescale-images ()
+ (let ((scaling (if text-scale-mode
+ (+ 1 (* text-scale-mode-amount 0.1))
+ 1)))
+ (save-excursion
+ (goto-char (point-min))
+ (while-let ((match (text-property-search-forward
+ 'display nil (lambda (_ value) (imagep value)))))
+ (let ((image (prop-match-value match)))
+ (unless (image-property image :original-scale)
+ (setf (image-property image :original-scale)
+ (or (image-property image :scale) 1)))
+ (setf (image-property image :scale)
+ (* (image-property image :original-scale) scaling)))))))
+
(defun eww--url-at-point ()
"`thing-at-point' provider function."
(get-text-property (point) 'shr-url))
@@ -1606,7 +1629,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(unless (= start (point))
(put-text-property start (1+ start) 'help-echo "Input field")
;; Mark this as an element we can TAB to.
- (put-text-property start (1+ start) 'shr-url dom))))
+ (put-text-property start (1+ start) 'shr-tab-stop t))))
(defun eww-tag-select (dom)
(shr-ensure-paragraph)
@@ -1878,7 +1901,8 @@ If EXTERNAL is double prefix, browse in new buffer."
eww-mode)
(mouse-set-point mouse-event)
(let* ((orig-url (get-text-property (point) 'shr-url))
- (url (eww--transform-url orig-url)))
+ (url (eww--transform-url orig-url))
+ target)
(cond
((not url)
(message "No link under point"))
@@ -1890,12 +1914,17 @@ If EXTERNAL is double prefix, browse in new buffer."
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
;; This is a #target url in the same page as the current one.
- ((and (url-target (url-generic-parse-url url))
+ ((and (setq target (url-target (url-generic-parse-url url)))
(eww-same-page-p url (plist-get eww-data :url)))
- (let ((dom (plist-get eww-data :dom)))
+ (let ((point (point)))
(eww-save-history)
(plist-put eww-data :url url)
- (eww-display-html 'utf-8 url dom nil (current-buffer))))
+ (goto-char (point-min))
+ (if-let ((match (text-property-search-forward 'shr-target-id target
#'member)))
+ (goto-char (prop-match-beginning match))
+ (goto-char (if (equal target "top")
+ (point-min)
+ point)))))
(t
(eww-browse-url orig-url external)))))
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 5e14589d19..de553468b1 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -72,6 +72,9 @@ HOST is the hostname of an LDAP server (with an optional TCP
port number
appended to it using a colon as a separator).
PROPn and VALn are property/value pairs describing parameters for the server.
Valid properties include:
+ `auth-source' specifies whether or not to look up, via the
+ `auth-source' library, options which are not otherwise provided
+ in this list. See `ldap-search-internal'.
`binddn' is the distinguished name of the user to bind as
(in RFC 1779 syntax).
`passwd' is the password to use for simple authentication.
@@ -90,6 +93,11 @@ Valid properties include:
(string :tag "Host name")
(checklist :inline t
:greedy t
+ (list
+ :tag "Use auth-source"
+ :inline t
+ (const :tag "Use auth-source" auth-source)
+ boolean)
(list
:tag "Search Base"
:inline t
@@ -148,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")))
@@ -601,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"))
@@ -707,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/mailcap.el b/lisp/net/mailcap.el
index 469643dbca..aa0c172655 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -125,7 +125,7 @@ is consulted."
("vnd\\.ms-excel"
(viewer . "gnumeric %s")
(test . (getenv "DISPLAY"))
- (type . "application/vnd.ms-excel"))
+ (type . "application/vnd\\.ms-excel"))
("octet-stream"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
@@ -716,27 +716,43 @@ to supply to the test."
result))))
(defun mailcap-add-mailcap-entry (major minor info &optional storage)
+ "Add handler INFO for mime type MAJOR/MINOR to STORAGE.
+
+MAJOR and MINOR should be strings. MINOR is treated as a regexp
+in later lookups, and, therefore, you may need to escape it
+appropriately.
+
+The format of INFO is described in `mailcap-mime-data'.
+
+STORAGE should be a symbol referring to a variable. The value of
+this variable should have the same format as `mailcap-mime-data'.
+STORAGE defaults to `mailcap--computed-mime-data'.
+
+None of this is enforced."
(let* ((storage (or storage 'mailcap--computed-mime-data))
- (old-major (assoc major (symbol-value storage))))
- (if (null old-major) ; New major area
- (set storage
- (cons (cons major (list (cons minor info)))
- (symbol-value storage)))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assq 'test info)) ; Has a test, insert at beginning
- (setcdr old-major
- (cons (cons minor info) (cdr old-major))))
- ((and (not (assq 'test info)) ; No test info, replace completely
- (not (assq 'test cur-minor))
- (equal (assq 'viewer info) ; Keep alternative viewer
- (assq 'viewer cur-minor)))
- (setcdr cur-minor info))
- (t
- (setcdr old-major
- (setcdr old-major
- (cons (cons minor info) (cdr old-major))))))))))
+ (major-entry (assoc major (symbol-value storage)))
+ (new-minor-entry (cons minor info))
+ minor-entry)
+ (cond
+ ((null major-entry)
+ ;; Add a new major entry containing the new minor entry.
+ (setf major-entry (list major new-minor-entry))
+ (push major-entry (symbol-value storage)))
+ ((and (setf minor-entry (assoc minor major-entry))
+ (not (assq 'test info))
+ (not (assq 'test minor-entry))
+ (equal (assq 'viewer info)
+ (assq 'viewer minor-entry)))
+ ;; Replace a previous MINOR entry if it and the entry to be
+ ;; added both do *not* have a ‘test’ associated in their info
+ ;; alist and both use the same ‘viewer’ command. This ignores
+ ;; other fields in the previous entryʼs info alist: they will be
+ ;; lost when the info alist in the cdr of the previous entry is
+ ;; replaced with the new INFO alist.
+ (setf (cdr minor-entry) info))
+ (t
+ ;; Add the new minor entry to the existing major entry.
+ (push new-minor-entry (cdr major-entry))))))
(defun mailcap-add (type viewer &optional test)
"Add VIEWER as a handler for TYPE.
@@ -963,7 +979,7 @@ If NO-DECODE is non-nil, don't decode STRING."
(".vox" . "audio/basic")
(".vrml" . "x-world/x-vrml")
(".wav" . "audio/x-wav")
- (".xls" . "application/vnd.ms-excel")
+ (".xls" . "application/vnd\\.ms-excel")
(".wrl" . "x-world/x-vrml")
(".xbm" . "image/xbm")
(".xpm" . "image/xpm")
@@ -1035,7 +1051,8 @@ If FORCE, re-parse even if already parsed."
(setq save-pos (point))
(skip-chars-forward "^ \t\n")
(downcase-region save-pos (point))
- (setq type (buffer-substring save-pos (point)))
+ (setq type (mailcap--regexp-quote-type
+ (buffer-substring save-pos (point))))
(while (not (eolp))
(skip-chars-forward " \t")
(setq save-pos (point))
@@ -1048,6 +1065,12 @@ If FORCE, re-parse even if already parsed."
(setq mailcap-mime-extensions (append extns mailcap-mime-extensions)
extns nil)))))
+(defun mailcap--regexp-quote-type (type)
+ (if (not (string-search "/" type))
+ type
+ (pcase-let ((`(,major ,minor) (split-string type "/")))
+ (concat major "/" (regexp-quote minor)))))
+
(defun mailcap-extension-to-mime (extn)
"Return the MIME content type of the file extensions EXTN."
(mailcap-parse-mimetypes)
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/pop3.el b/lisp/net/pop3.el
index 9d59ddf978..1bd52c7a56 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -23,6 +23,8 @@
;;; Commentary:
+;; Post Office Protocol version 3 (RFC 1460) interface.
+;;
;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
;; are implemented. The LIST command has not been implemented due to lack
;; of actual usefulness.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 71505dcaa3..b7eeab1735 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -116,7 +116,7 @@ VALUE must be a string that will be used instead of the
server
name for display purposes. If absent, the real server name will
be displayed instead."
:type '(alist :key-type string
- :value-type (plist :options
+ :value-type (plist :options
((:nick string)
(:port integer)
(:user-name string)
@@ -167,7 +167,7 @@ If a function (e.g., `frame-text-width' or
`window-text-width'),
call it to compute the number of columns."
:risky t ; can get funcalled
:type '(choice (const :tag "Value of `fill-column'" nil)
- (integer :tag "Number of columns")
+ (integer :tag "Number of columns")
(function :tag "Function returning the number of columns")))
(defcustom rcirc-fill-prefix nil
@@ -175,7 +175,7 @@ call it to compute the number of columns."
If nil, calculate the prefix dynamically to line up text
underneath each nick."
:type '(choice (const :tag "Dynamic" nil)
- (string :tag "Prefix text")))
+ (string :tag "Prefix text")))
(defcustom rcirc-url-max-length nil
"Maximum number of characters in displayed URLs.
@@ -273,19 +273,19 @@ Examples:
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\")
(\"oftc\" sasl \"bob\" \"hunter2\"))"
:type '(alist :key-type (regexp :tag "Server")
- :value-type (choice (list :tag "NickServ"
- (const nickserv)
- (string :tag "Nick")
- (string :tag "Password"))
- (list :tag "ChanServ"
- (const chanserv)
- (string :tag "Nick")
- (string :tag "Channel")
- (string :tag "Password"))
- (list :tag "BitlBee"
- (const bitlbee)
- (string :tag "Nick")
- (string :tag "Password"))
+ :value-type (choice (list :tag "NickServ"
+ (const nickserv)
+ (string :tag "Nick")
+ (string :tag "Password"))
+ (list :tag "ChanServ"
+ (const chanserv)
+ (string :tag "Nick")
+ (string :tag "Channel")
+ (string :tag "Password"))
+ (list :tag "BitlBee"
+ (const bitlbee)
+ (string :tag "Nick")
+ (string :tag "Password"))
(list :tag "QuakeNet"
(const quakenet)
(string :tag "Account")
@@ -350,8 +350,6 @@ See `rcirc-bright-nick' face."
See `rcirc-dim-nick' face."
:type '(repeat string))
-(define-obsolete-variable-alias 'rcirc-print-hooks
- 'rcirc-print-functions "24.3")
(defcustom rcirc-print-functions nil
"Hook run after text is printed.
Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
@@ -388,10 +386,10 @@ messages.
If VAL is a cons of coding systems, the car part is used for decoding,
and the cdr part is used for encoding."
:type '(alist :key-type (choice (regexp :tag "Channel Regexp")
- (cons (regexp :tag "Channel Regexp")
- (regexp :tag "Server Regexp")))
- :value-type (choice coding-system
- (cons (coding-system :tag "Decode")
+ (cons (regexp :tag "Channel Regexp")
+ (regexp :tag "Server Regexp")))
+ :value-type (choice coding-system
+ (cons (coding-system :tag "Decode")
(coding-system :tag "Encode")))))
(defcustom rcirc-multiline-major-mode 'fundamental-mode
@@ -520,50 +518,50 @@ If ARG is non-nil, instead prompt for connection
parameters."
(interactive "P")
(if arg
(let* ((server (completing-read "IRC Server: "
- rcirc-server-alist
- nil nil
- (caar rcirc-server-alist)
- 'rcirc-server-name-history))
- (server-plist (cdr (assoc-string server rcirc-server-alist)))
- (port (read-string "IRC Port: "
- (number-to-string
- (or (plist-get server-plist :port)
- rcirc-default-port))
- 'rcirc-server-port-history))
- (nick (read-string "IRC Nick: "
- (or (plist-get server-plist :nick)
- rcirc-default-nick)
- 'rcirc-nick-name-history))
- (user-name (read-string "IRC Username: "
+ rcirc-server-alist
+ nil nil
+ (caar rcirc-server-alist)
+ 'rcirc-server-name-history))
+ (server-plist (cdr (assoc-string server rcirc-server-alist)))
+ (port (read-string "IRC Port: "
+ (number-to-string
+ (or (plist-get server-plist :port)
+ rcirc-default-port))
+ 'rcirc-server-port-history))
+ (nick (read-string "IRC Nick: "
+ (or (plist-get server-plist :nick)
+ rcirc-default-nick)
+ 'rcirc-nick-name-history))
+ (user-name (read-string "IRC Username: "
(or (plist-get server-plist :user-name)
rcirc-default-user-name)
'rcirc-user-name-history))
- (password (read-passwd "IRC Password: " nil
+ (password (read-passwd "IRC Password: " nil
(plist-get server-plist :password)))
- (channels (split-string
- (read-string "IRC Channels: "
- (mapconcat 'identity
- (plist-get server-plist
- :channels)
- " "))
- "[, ]+" t))
+ (channels (split-string
+ (read-string "IRC Channels: "
+ (mapconcat 'identity
+ (plist-get server-plist
+ :channels)
+ " "))
+ "[, ]+" t))
(encryption (rcirc-prompt-for-encryption server-plist))
(process (rcirc-connect server port nick user-name
- rcirc-default-full-name
- channels password encryption)))
- (when rcirc-display-server-buffer
+ rcirc-default-full-name
+ channels password encryption)))
+ (when rcirc-display-server-buffer
(pop-to-buffer-same-window (process-buffer process))))
;; connect to servers in `rcirc-server-alist'
(let (connected-servers)
(dolist (c rcirc-server-alist)
- (let ((server (car c))
- (nick (or (plist-get (cdr c) :nick) rcirc-default-nick))
- (port (or (plist-get (cdr c) :port) rcirc-default-port))
- (user-name (or (plist-get (cdr c) :user-name)
- rcirc-default-user-name))
- (full-name (or (plist-get (cdr c) :full-name)
- rcirc-default-full-name))
- (channels (plist-get (cdr c) :channels))
+ (let ((server (car c))
+ (nick (or (plist-get (cdr c) :nick) rcirc-default-nick))
+ (port (or (plist-get (cdr c) :port) rcirc-default-port))
+ (user-name (or (plist-get (cdr c) :user-name)
+ rcirc-default-user-name))
+ (full-name (or (plist-get (cdr c) :full-name)
+ rcirc-default-full-name))
+ (channels (plist-get (cdr c) :channels))
(password (plist-get (cdr c) :password))
(encryption (plist-get (cdr c) :encryption))
(server-alias (plist-get (cdr c) :server-alias))
@@ -577,21 +575,21 @@ If ARG is non-nil, instead prompt for connection
parameters."
:port port))
(pwd (auth-info-password (car auth))))
(setq password pwd))
- (when server
- (let (connected)
- (dolist (p (rcirc-process-list))
- (when (string= (or server-alias server) (process-name p))
- (setq connected p)))
- (if (not connected)
- (condition-case nil
- (let ((process (rcirc-connect server port nick user-name
+ (when server
+ (let (connected)
+ (dolist (p (rcirc-process-list))
+ (when (string= (or server-alias server) (process-name p))
+ (setq connected p)))
+ (if (not connected)
+ (condition-case nil
+ (let ((process (rcirc-connect server port nick user-name
full-name channels
password encryption
client-cert server-alias)))
(when rcirc-display-server-buffer
(pop-to-buffer-same-window (process-buffer
process))))
- (quit (message "Quit connecting to %s"
+ (quit (message "Quit connecting to %s"
(or server-alias server))))
- (with-current-buffer (process-buffer connected)
+ (with-current-buffer (process-buffer connected)
(setq contact (process-contact
(get-buffer-process (current-buffer)) :name))
(setq connected-servers
@@ -599,12 +597,12 @@ If ARG is non-nil, instead prompt for connection
parameters."
contact (or server-alias server))
connected-servers))))))))
(when connected-servers
- (message "Already connected to %s"
- (if (cdr connected-servers)
- (concat (mapconcat 'identity (butlast connected-servers)
", ")
- ", and "
- (car (last connected-servers)))
- (car connected-servers)))))))
+ (message "Already connected to %s"
+ (if (cdr connected-servers)
+ (concat (mapconcat 'identity (butlast connected-servers)
", ")
+ ", and "
+ (car (last connected-servers)))
+ (car connected-servers)))))))
;;;###autoload
(defalias 'irc 'rcirc)
@@ -732,7 +730,7 @@ that are joined after authentication."
(setq rcirc-nick nick)
(setq rcirc-startup-channels startup-channels)
(setq rcirc-last-connect-time (current-time))
- (setq rcirc-last-server-message-time rcirc-last-connect-time)
+ (setq rcirc-last-server-message-time rcirc-last-connect-time)
;; Check if the immediate process state
(sit-for .1)
@@ -804,8 +802,8 @@ MESSAGE should contain a timestamp, indicating when the
KEEPALIVE
message was generated."
(with-rcirc-process-buffer process
(setq header-line-format
- (format "%f" (float-time
- (time-since (string-to-number message)))))))
+ (format "%f" (float-time
+ (time-since (string-to-number message)))))))
(defvar rcirc-debug-buffer "*rcirc debug*"
"Buffer name for debugging messages.")
@@ -832,8 +830,6 @@ is moved to after the text inserted. Otherwise the point
is not moved."
text))
(goto-char old)))))
-(define-obsolete-variable-alias 'rcirc-sentinel-hooks
- 'rcirc-sentinel-functions "24.3")
(defvar rcirc-sentinel-functions nil
"Hook functions called when the process sentinel is called.
Functions are called with PROCESS and SENTINEL arguments.")
@@ -864,19 +860,19 @@ If QUIET is non-nil, no not emit a message."
(throw 'exit (or quiet (message "Server process is alive")))
(delete-process process))
(let ((conn-info rcirc-connection-info))
- (setf (nth 5 conn-info)
- (cl-remove-if-not #'rcirc-channel-p
- (mapcar #'car rcirc-buffer-alist)))
+ (setf (nth 5 conn-info)
+ (cl-remove-if-not #'rcirc-channel-p
+ (mapcar #'car rcirc-buffer-alist)))
(dolist (buffer (mapcar #'cdr rcirc-buffer-alist))
- (when (buffer-live-p buffer)
+ (when (buffer-live-p buffer)
(with-current-buffer buffer
- (setq mode-line-process ":connecting"))))
- (let ((nprocess (apply #'rcirc-connect conn-info)))
+ (setq mode-line-process ":connecting"))))
+ (let ((nprocess (apply #'rcirc-connect conn-info)))
(when (and (< rcirc-failed-attempts rcirc-reconnect-attempts)
(eq (process-status nprocess) 'failed))
(setq rcirc-failed-attempts (1+ rcirc-failed-attempts))
(rcirc-print nprocess "*rcirc*" "ERROR" nil
- (format "Failed to reconnect (%d/%d)..."
+ (format "Failed to reconnect (%d/%d)..."
rcirc-failed-attempts
rcirc-reconnect-attempts))
(setq rcirc-reconnection-timer
@@ -932,26 +928,26 @@ SENTINEL describes the change in form of a string."
(message "Connecting to %s...done" (or server-alias server))
(dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
- (with-current-buffer (or buffer (current-buffer))
- (setq mode-line-process nil)))))
+ (with-current-buffer (or buffer (current-buffer))
+ (setq mode-line-process nil)))))
((eq status 'closed)
(let ((now (current-time)))
(with-rcirc-process-buffer process
(when (and (< 0 rcirc-reconnect-delay)
(time-less-p rcirc-reconnect-delay
- (time-subtract now
rcirc-last-connect-time)))
+ (time-subtract now
rcirc-last-connect-time)))
(setq rcirc-last-connect-time now)
(rcirc-reconnect process)))))
((eq status 'failed)
(dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
- (with-current-buffer (or buffer (current-buffer))
- (rcirc-print process "*rcirc*" "ERROR" rcirc-target
- (format "%s: %s (%S)"
- (process-name process)
- sentinel
- (process-status process))
+ (with-current-buffer (or buffer (current-buffer))
+ (rcirc-print process "*rcirc*" "ERROR" rcirc-target
+ (format "%s: %s (%S)"
+ (process-name process)
+ sentinel
+ (process-status process))
(not rcirc-target))
- (rcirc-disconnect-buffer)))))
+ (rcirc-disconnect-buffer)))))
(run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
@@ -974,8 +970,6 @@ If BUFFER is nil, default to the current buffer."
(process-list))
ps))
-(define-obsolete-variable-alias 'rcirc-receive-message-hooks
- 'rcirc-receive-message-functions "24.3")
(defvar rcirc-receive-message-functions nil
"Hook functions run when a message is received from server.
Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
@@ -998,10 +992,10 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
(with-rcirc-process-buffer process
(when (not rcirc-connecting)
(with-rcirc-process-buffer process
- (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
- (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
- 'delete-process
- process))))))
+ (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
+ (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
+ 'delete-process
+ process))))))
(defvar rcirc-trap-errors-flag t
"Non-nil means Lisp errors are degraded to error messages.")
@@ -1017,7 +1011,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS
and LINE.")
(defconst rcirc-process-regexp
(rx-let ((message-tag ; message tags as specified in
- ; https://ircv3.net/specs/extensions/message-tags
+ ;
https://ircv3.net/specs/extensions/message-tags
(: (? "+")
(? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/")
(+ (any alnum "-"))
@@ -1055,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.")
@@ -1098,7 +1092,7 @@ Note that the messages are stored in reverse order.")
(split-string tag-data ";"))))
rcirc-message-tags))
(user (match-string 3 text))
- (sender (rcirc-user-nick user))
+ (sender (rcirc-user-nick user))
(cmd (match-string 4 text))
(cmd-end (match-end 4))
(args nil)
@@ -1140,7 +1134,7 @@ found. PROCESS, SENDER and RESPONSE are passed on to
used as the message body."
(rcirc-print process sender response nil
(mapconcat 'identity (cdr args) " ")
- (not (member response rcirc-responses-no-activity))))
+ (not (member response rcirc-responses-no-activity))))
(defun rcirc--connection-open-p (process)
"Check if PROCESS is open or running."
@@ -1186,7 +1180,7 @@ element in PARTS is a list, append it to PARTS."
"Return the process associated with channel BUFFER.
With no argument or nil as argument, use the current buffer."
(let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer)
- rcirc-server-buffer))))
+ rcirc-server-buffer))))
(if buffer
(buffer-local-value 'rcirc-process buffer)
rcirc-process)))
@@ -1195,7 +1189,7 @@ With no argument or nil as argument, use the current
buffer."
"Return PROCESS server name, given by the 001 response."
(with-rcirc-process-buffer process
(or rcirc-server-name
- (warn "server name for process %S unknown" process))))
+ (warn "server name for process %S unknown" process))))
(defun rcirc-nick (process)
"Return PROCESS nick."
@@ -1220,17 +1214,17 @@ With no argument or nil as argument, use the current
buffer."
(insert message)
(goto-char (point-min))
(let (result)
- (while (not (eobp))
- (goto-char (or (byte-to-position rcirc-max-message-length)
- (point-max)))
- ;; max message length is 512 including CRLF
- (while (and (not (bobp))
- (> (length (encode-coding-region
- (point-min) (point) encoding t))
- rcirc-max-message-length))
- (forward-char -1))
- (push (delete-and-extract-region (point-min) (point)) result))
- (nreverse result)))))
+ (while (not (eobp))
+ (goto-char (or (byte-to-position rcirc-max-message-length)
+ (point-max)))
+ ;; max message length is 512 including CRLF
+ (while (and (not (bobp))
+ (> (length (encode-coding-region
+ (point-min) (point) encoding t))
+ rcirc-max-message-length))
+ (forward-char -1))
+ (push (delete-and-extract-region (point-min) (point)) result))
+ (nreverse result)))))
(defun rcirc-send-message (process target message &optional noticep silent)
"Send TARGET associated with PROCESS a privmsg with text MESSAGE.
@@ -1241,7 +1235,7 @@ If SILENT is non-nil, do not print the message in any irc
buffer."
(dolist (msg (rcirc-split-message message))
(rcirc-send-string process response target : msg)
(unless silent
- (rcirc-print process (rcirc-nick process) response target msg)))))
+ (rcirc-print process (rcirc-nick process) response target msg)))))
(defvar-local rcirc-input-ring nil
"Ring object for input.")
@@ -1293,10 +1287,10 @@ The list is updated automatically by
`defun-rcirc-command'.")
;; On some networks it is common to message or
;; mention someone using @nick instead of just
;; nick.
- (if (re-search-backward "[[:space:]@]"
rcirc-prompt-end-marker t)
- (1+ (point))
- rcirc-prompt-end-marker)))
- (table (cond
+ (if (re-search-backward "[[:space:]@]"
rcirc-prompt-end-marker t)
+ (1+ (point))
+ rcirc-prompt-end-marker)))
+ (table (cond
;; No completion before the prompt
((< beg rcirc-prompt-end-marker) nil)
;; Only complete nicks mid-message
@@ -1304,23 +1298,23 @@ The list is updated automatically by
`defun-rcirc-command'.")
(mapcar rcirc-nick-filter
(rcirc-channel-nicks
(rcirc-buffer-process)
- rcirc-target)))
+ rcirc-target)))
;; Complete commands at the beginning of the
;; message, when the first character is a dash
((eq (char-after beg) ?/)
(mapcar
(lambda (cmd) (concat cmd " "))
(nconc (sort (copy-sequence rcirc-client-commands)
- 'string-lessp)
- (sort (copy-sequence rcirc-server-commands)
- 'string-lessp))))
+ 'string-lessp)
+ (sort (copy-sequence rcirc-server-commands)
+ 'string-lessp))))
;; Complete usernames right after the prompt by
;; appending a colon after the name
((mapcar
(lambda (str) (concat (funcall rcirc-nick-filter str)
": "))
(rcirc-channel-nicks (rcirc-buffer-process)
- rcirc-target))))))
- (list beg (point)
+ rcirc-target))))))
+ (list beg (point)
(lambda (str pred action)
(if (eq action 'metadata)
'(metadata (cycle-sort-function . identity))
@@ -1346,12 +1340,91 @@ The list is updated automatically by
`defun-rcirc-command'.")
'set-rcirc-encode-coding-system
"28.1")
+(defun rcirc-format (pre &optional replace)
+ "Insert markup formatting PRE.
+PRE and \"^O\" (ASCII #x0f) will either be inserted around the
+current point respectively or the active region, if present.
+This function an auxiliary function is not meant to be used
+directly, but is invoked by other commands. If the optional
+argument REPLACE is non-nil, first remove any formatting before
+inserting the new one."
+ (when replace (rcirc-unformat))
+ (save-excursion
+ (if (use-region-p)
+ (let ((beg (region-beginning)))
+ (goto-char (region-end))
+ (insert "")
+ (goto-char beg)
+ (insert pre))
+ (insert pre "")))
+ (when (or (not (region-active-p)) (< (point) (mark)))
+ (forward-char (length pre))))
+
+(defun rcirc-unformat ()
+ "Remove the closes formatting found closes to the current point."
+ (interactive)
+ (save-excursion
+ (when (and (search-backward-regexp (rx (or "" " " " " " " ""))
+ rcirc-prompt-end-marker t)
+ (looking-at (rx (group (or "" " " " " " " ""))
+ (*? nonl)
+ (group ""))))
+ (replace-match "" nil nil nil 2)
+ (replace-match "" nil nil nil 1))))
+
+(defun rcirc-format-bold (replace)
+ "Insert bold formatting.
+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))
+
+(defun rcirc-format-italic (replace)
+ "Insert italic formatting.
+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))
+
+(defun rcirc-format-underline (replace)
+ "Insert underlining formatting.
+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))
+
+(defun rcirc-format-strike-trough (replace)
+ "Insert strike-trough formatting.
+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))
+
+(defun rcirc-format-fixed-width (replace)
+ "Insert fixed-width formatting.
+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))
+
(defvar-keymap rcirc-mode-map
:doc "Keymap for rcirc mode."
"RET" #'rcirc-send-input
"M-p" #'rcirc-insert-prev-input
"M-n" #'rcirc-insert-next-input
"TAB" #'completion-at-point
+ "C-c C-f C-b" #'rcirc-format-bold
+ "C-c C-f C-i" #'rcirc-format-italic
+ "C-c C-f C-u" #'rcirc-format-underline
+ "C-c C-f C-s" #'rcirc-format-strike-trough
+ "C-c C-f C-f" #'rcirc-format-fixed-width
+ "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX
+ "C-c C-f C-d" #'rcirc-unformat
"C-c C-b" #'rcirc-browse-url
"C-c C-c" #'rcirc-edit-multiline
"C-c C-j" #'rcirc-cmd-join
@@ -1416,13 +1489,13 @@ PROCESS is the process object used for communication.
(setq mode-line-process nil)
(setq rcirc-input-ring
- ;; If rcirc-input-ring is already a ring with desired
- ;; size do not re-initialize.
- (if (and (ring-p rcirc-input-ring)
- (= (ring-size rcirc-input-ring)
- rcirc-input-ring-size))
- rcirc-input-ring
- (make-ring rcirc-input-ring-size)))
+ ;; If rcirc-input-ring is already a ring with desired
+ ;; size do not re-initialize.
+ (if (and (ring-p rcirc-input-ring)
+ (= (ring-size rcirc-input-ring)
+ rcirc-input-ring-size))
+ rcirc-input-ring
+ (make-ring rcirc-input-ring-size)))
(setq rcirc-server-buffer (process-buffer process))
(setq rcirc-target target)
(setq rcirc-last-post-time (current-time))
@@ -1435,19 +1508,19 @@ PROCESS is the process object used for communication.
(setq buffer-invisibility-spec '())
(setq buffer-display-table (make-display-table))
(set-display-table-slot buffer-display-table 4
- (let ((glyph (make-glyph-code
- ?. 'font-lock-keyword-face)))
- (make-vector 3 glyph)))
+ (let ((glyph (make-glyph-code
+ ?. 'font-lock-keyword-face)))
+ (make-vector 3 glyph)))
(dolist (i rcirc-coding-system-alist)
(let ((chan (if (consp (car i)) (caar i) (car i)))
- (serv (if (consp (car i)) (cdar i) "")))
+ (serv (if (consp (car i)) (cdar i) "")))
(when (and (string-match chan (or target ""))
- (string-match serv (rcirc-server-name process)))
- (setq-local rcirc-decode-coding-system
- (if (consp (cdr i)) (cadr i) (cdr i)))
+ (string-match serv (rcirc-server-name process)))
+ (setq-local rcirc-decode-coding-system
+ (if (consp (cdr i)) (cadr i) (cdr i)))
(setq-local rcirc-encode-coding-system
- (if (consp (cdr i)) (cddr i) (cdr i))))))
+ (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
(setq rcirc-prompt-start-marker (point-max-marker))
@@ -1463,7 +1536,7 @@ PROCESS is the process object used for communication.
(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t)
;; add to buffer list, and update buffer abbrevs
- (when target ; skip server buffer
+ (when target ; skip server buffer
(let ((buffer (current-buffer)))
(with-rcirc-process-buffer process
(push (cons target buffer) rcirc-buffer-alist)))
@@ -1485,41 +1558,41 @@ PROCESS is the process object used for communication.
If ALL is non-nil, update prompts in all IRC buffers."
(if all
(mapc (lambda (process)
- (mapc (lambda (buffer)
- (with-current-buffer buffer
- (rcirc-update-prompt)))
- (with-rcirc-process-buffer process
- (mapcar 'cdr rcirc-buffer-alist))))
- (rcirc-process-list))
+ (mapc (lambda (buffer)
+ (with-current-buffer buffer
+ (rcirc-update-prompt)))
+ (with-rcirc-process-buffer process
+ (mapcar 'cdr rcirc-buffer-alist))))
+ (rcirc-process-list))
(let ((inhibit-read-only t)
- (prompt (or rcirc-prompt "")))
+ (prompt (or rcirc-prompt "")))
(mapc (lambda (rep)
- (setq prompt
- (replace-regexp-in-string (car rep) (cdr rep) prompt)))
- (list (cons "%n" (rcirc-buffer-nick))
- (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
- (cons "%t" (or rcirc-target ""))))
+ (setq prompt
+ (replace-regexp-in-string (car rep) (cdr rep) prompt)))
+ (list (cons "%n" (rcirc-buffer-nick))
+ (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
+ (cons "%t" (or rcirc-target ""))))
(save-excursion
- (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
- (goto-char rcirc-prompt-start-marker)
- (let ((start (point)))
- (insert-before-markers prompt)
- (set-marker rcirc-prompt-start-marker start)
- (when (not (zerop (- rcirc-prompt-end-marker
- rcirc-prompt-start-marker)))
- (add-text-properties rcirc-prompt-start-marker
- rcirc-prompt-end-marker
- (list 'face 'rcirc-prompt
- 'read-only t 'field t
- 'front-sticky t 'rear-nonsticky t))))))))
+ (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
+ (goto-char rcirc-prompt-start-marker)
+ (let ((start (point)))
+ (insert-before-markers prompt)
+ (set-marker rcirc-prompt-start-marker start)
+ (when (not (zerop (- rcirc-prompt-end-marker
+ rcirc-prompt-start-marker)))
+ (add-text-properties rcirc-prompt-start-marker
+ rcirc-prompt-end-marker
+ (list 'face 'rcirc-prompt
+ 'read-only t 'field t
+ 'front-sticky t 'rear-nonsticky
t))))))))
(defun rcirc-set-changed (option value)
"Set OPTION to VALUE and update after a customization change."
(set-default option value)
(cond ((eq option 'rcirc-prompt)
- (rcirc-update-prompt 'all))
- (t
- (error "Bad option %s" option))))
+ (rcirc-update-prompt 'all))
+ (t
+ (error "Bad option %s" option))))
(defun rcirc-channel-p (target)
"Return t if TARGET is a channel name."
@@ -1554,7 +1627,7 @@ with it."
(when (and rcirc-buffer-alist ;; it's a server buffer
rcirc-kill-channel-buffers)
(dolist (channel rcirc-buffer-alist)
- (kill-buffer (cdr channel))))))
+ (kill-buffer (cdr channel))))))
(defun rcirc-change-major-mode-hook ()
"Part the channel when changing the major mode."
@@ -1565,18 +1638,18 @@ with it."
(let ((buffer (current-buffer)))
(rcirc-clear-activity buffer)
(when (and (rcirc-buffer-process)
- (rcirc--connection-open-p (rcirc-buffer-process)))
+ (rcirc--connection-open-p (rcirc-buffer-process)))
(with-rcirc-server-buffer
- (setq rcirc-buffer-alist
- (rassq-delete-all buffer rcirc-buffer-alist)))
+ (setq rcirc-buffer-alist
+ (rassq-delete-all buffer rcirc-buffer-alist)))
(rcirc-update-short-buffer-names)
(if (rcirc-channel-p rcirc-target)
- (rcirc-send-string (rcirc-buffer-process)
+ (rcirc-send-string (rcirc-buffer-process)
"PART" rcirc-target : reason)
- (when rcirc-target
- (rcirc-remove-nick-channel (rcirc-buffer-process)
- (rcirc-buffer-nick)
- rcirc-target))))
+ (when rcirc-target
+ (rcirc-remove-nick-channel (rcirc-buffer-process)
+ (rcirc-buffer-nick)
+ rcirc-target))))
(setq rcirc-target nil)))
(defun rcirc-generate-new-buffer-name (process target)
@@ -1594,30 +1667,30 @@ If optional argument SERVER is non-nil, return the
server buffer
if there is no existing buffer for TARGET, otherwise return nil."
(with-rcirc-process-buffer process
(if (null target)
- (current-buffer)
+ (current-buffer)
(let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
- (or buffer (when server (current-buffer)))))))
+ (or buffer (when server (current-buffer)))))))
(defun rcirc-get-buffer-create (process target)
"Return the buffer associated with the PROCESS and TARGET.
Create the buffer if it doesn't exist."
(let ((buffer (rcirc-get-buffer process target)))
(if (and buffer (buffer-live-p buffer))
- (with-current-buffer buffer
- (when (not rcirc-target)
- (setq rcirc-target target))
- buffer)
+ (with-current-buffer buffer
+ (when (not rcirc-target)
+ (setq rcirc-target target))
+ buffer)
;; create the buffer
(with-rcirc-process-buffer process
- (let ((new-buffer (get-buffer-create
- (rcirc-generate-new-buffer-name process target))))
- (with-current-buffer new-buffer
+ (let ((new-buffer (get-buffer-create
+ (rcirc-generate-new-buffer-name process target))))
+ (with-current-buffer new-buffer
(unless (eq major-mode 'rcirc-mode)
- (rcirc-mode process target))
+ (rcirc-mode process target))
(setq mode-line-process nil))
- (rcirc-put-nick-channel process (rcirc-nick process) target
- rcirc-current-line)
- new-buffer)))))
+ (rcirc-put-nick-channel process (rcirc-nick process) target
+ rcirc-current-line)
+ new-buffer)))))
(defun rcirc-send-input ()
"Send input to target associated with the current buffer."
@@ -1625,31 +1698,31 @@ Create the buffer if it doesn't exist."
(if (< (point) rcirc-prompt-end-marker)
;; copy the line down to the input area
(progn
- (forward-line 0)
- (let ((start (if (eq (point) (point-min))
- (point)
- (if (get-text-property (1- (point)) 'hard)
- (point)
- (previous-single-property-change (point) 'hard))))
- (end (next-single-property-change (1+ (point)) 'hard)))
- (goto-char (point-max))
- (insert (replace-regexp-in-string
- "\n\\s-+" " "
- (buffer-substring-no-properties start end)))))
+ (forward-line 0)
+ (let ((start (if (eq (point) (point-min))
+ (point)
+ (if (get-text-property (1- (point)) 'hard)
+ (point)
+ (previous-single-property-change (point) 'hard))))
+ (end (next-single-property-change (1+ (point)) 'hard)))
+ (goto-char (point-max))
+ (insert (replace-regexp-in-string
+ "\n\\s-+" " "
+ (buffer-substring-no-properties start end)))))
;; process input
(goto-char (point-max))
(when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
;; delete a trailing newline
(when (eq (point) (line-beginning-position))
- (delete-char -1))
+ (delete-char -1))
(let ((input (buffer-substring-no-properties
- rcirc-prompt-end-marker (point))))
- (dolist (line (split-string input "\n"))
- (rcirc-process-input-line line))
- ;; add to input-ring
- (save-excursion
- (ring-insert rcirc-input-ring input)
- (setq rcirc-input-ring-index 0))))))
+ rcirc-prompt-end-marker (point))))
+ (dolist (line (split-string input "\n"))
+ (rcirc-process-input-line line))
+ ;; add to input-ring
+ (save-excursion
+ (ring-insert rcirc-input-ring input)
+ (setq rcirc-input-ring-index 0))))))
(defun rcirc-fill-paragraph (&optional justify)
"Implementation for `fill-paragraph-function'.
@@ -1659,14 +1732,14 @@ The argument JUSTIFY is passed on to `fill-region'."
(save-restriction
(narrow-to-region rcirc-prompt-end-marker (point-max))
(let ((fill-column rcirc-max-message-length))
- (fill-region (point-min) (point-max) justify)))))
+ (fill-region (point-min) (point-max) justify)))))
(defun rcirc-process-input-line (line)
"Process LINE as a message or a command."
(if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line)
(rcirc-process-command (match-string 1 line)
- (match-string 2 line)
- line)
+ (match-string 2 line)
+ line)
(rcirc-process-message line)))
(defun rcirc-process-message (line)
@@ -1687,19 +1760,19 @@ The argument JUSTIFY is passed on to `fill-region'."
LINE is the raw input, from which COMMAND and ARGS was
extracted."
(let ((fun (intern-soft (concat "rcirc-cmd-" command)))
- (process (rcirc-buffer-process)))
+ (process (rcirc-buffer-process)))
(newline)
(with-current-buffer (current-buffer)
(delete-region rcirc-prompt-end-marker (point))
(if (string= command "me")
- (rcirc-print process (rcirc-buffer-nick)
- "ACTION" rcirc-target args)
- (rcirc-print process (rcirc-buffer-nick)
- "COMMAND" rcirc-target line))
+ (rcirc-print process (rcirc-buffer-nick)
+ "ACTION" rcirc-target args)
+ (rcirc-print process (rcirc-buffer-nick)
+ "COMMAND" rcirc-target line))
(set-marker rcirc-prompt-end-marker (point))
(if (fboundp fun)
- (funcall fun args process rcirc-target)
- (rcirc-send-string process command : args)))))
+ (funcall fun args process rcirc-target)
+ (rcirc-send-string process command : args)))))
(defvar-local rcirc-parent-buffer nil
"Message buffer that requested a multiline buffer.")
@@ -1714,7 +1787,7 @@ extracted."
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
(let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
- (point)))
+ (point)))
(parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
(setq rcirc-window-configuration (current-window-configuration))
@@ -1731,6 +1804,13 @@ extracted."
(defvar-keymap rcirc-multiline-minor-mode-map
:doc "Keymap for multiline mode in rcirc."
+ "C-c C-f C-b" #'rcirc-format-bold
+ "C-c C-f C-i" #'rcirc-format-italic
+ "C-c C-f C-u" #'rcirc-format-underline
+ "C-c C-f C-s" #'rcirc-format-strike-trough
+ "C-c C-f C-f" #'rcirc-format-fixed-width
+ "C-c C-f C-t" #'rcirc-format-fixed-width ;as in AucTeX
+ "C-c C-f C-d" #'rcirc-unformat
"C-c C-c" #'rcirc-multiline-minor-submit
"C-x C-s" #'rcirc-multiline-minor-submit
"C-c C-k" #'rcirc-multiline-minor-cancel
@@ -1768,11 +1848,11 @@ extracted."
(process-buffer process)
(let ((buffer (window-buffer)))
(if (and buffer
- (with-current-buffer buffer
- (and (eq major-mode 'rcirc-mode)
- (eq (rcirc-buffer-process) process))))
- buffer
- (process-buffer process)))))
+ (with-current-buffer buffer
+ (and (eq major-mode 'rcirc-mode)
+ (eq (rcirc-buffer-process) process))))
+ buffer
+ (process-buffer process)))))
(defcustom rcirc-response-formats
'(("PRIVMSG" . "<%N> %m")
@@ -1803,7 +1883,7 @@ the of the following escape sequences replaced by the
described values:
%f- Following text uses the default face
%% A literal `%' character"
:type '(alist :key-type (choice (string :tag "Type")
- (const :tag "Default" t))
+ (const :tag "Default" t))
:value-type string))
(defun rcirc-format-response-string (process sender response target text)
@@ -1813,55 +1893,55 @@ The specific formatting used is found by looking up
RESPONSE in
communication."
(with-temp-buffer
(insert (or (cdr (assoc response rcirc-response-formats))
- (cdr (assq t rcirc-response-formats))))
+ (cdr (assq t rcirc-response-formats))))
(goto-char (point-min))
(let ((start (point-min))
- (sender (if (or (not sender)
- (string= (rcirc-server-name process) sender))
- ""
- (funcall rcirc-nick-filter sender)))
- face)
+ (sender (if (or (not sender)
+ (string= (rcirc-server-name process) sender))
+ ""
+ (funcall rcirc-nick-filter sender)))
+ face)
(while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
- (rcirc-add-face start (match-beginning 0) face)
- (setq start (match-beginning 0))
- (replace-match
- (cl-case (aref (match-string 1) 0)
- (?f (setq face
- (cl-case (string-to-char (match-string 3))
- (?w 'font-lock-warning-face)
- (?p 'rcirc-server-prefix)
- (?s 'rcirc-server)
- (t nil)))
- "")
- (?n sender)
- (?N (let ((my-nick (rcirc-nick process)))
- (save-match-data
- (with-syntax-table rcirc-nick-syntax-table
- (rcirc-facify sender
- (cond ((string= sender my-nick)
- 'rcirc-my-nick)
- ((and rcirc-bright-nicks
- (string-match
- (regexp-opt rcirc-bright-nicks
- 'words)
- sender))
- 'rcirc-bright-nick)
- ((and rcirc-dim-nicks
- (string-match
- (regexp-opt rcirc-dim-nicks
- 'words)
- sender))
- 'rcirc-dim-nick)
- (t
- 'rcirc-other-nick)))))))
- (?m (propertize text 'rcirc-text text))
- (?r response)
- (?t (or target ""))
- (t (concat "UNKNOWN CODE:" (match-string 0))))
- t t nil 0)
- (rcirc-add-face (match-beginning 0) (match-end 0) face))
+ (rcirc-add-face start (match-beginning 0) face)
+ (setq start (match-beginning 0))
+ (replace-match
+ (cl-case (aref (match-string 1) 0)
+ (?f (setq face
+ (cl-case (string-to-char (match-string 3))
+ (?w 'font-lock-warning-face)
+ (?p 'rcirc-server-prefix)
+ (?s 'rcirc-server)
+ (t nil)))
+ "")
+ (?n sender)
+ (?N (let ((my-nick (rcirc-nick process)))
+ (save-match-data
+ (with-syntax-table rcirc-nick-syntax-table
+ (rcirc-facify sender
+ (cond ((string= sender my-nick)
+ 'rcirc-my-nick)
+ ((and rcirc-bright-nicks
+ (string-match
+ (regexp-opt rcirc-bright-nicks
+ 'words)
+ sender))
+ 'rcirc-bright-nick)
+ ((and rcirc-dim-nicks
+ (string-match
+ (regexp-opt rcirc-dim-nicks
+ 'words)
+ sender))
+ 'rcirc-dim-nick)
+ (t
+ 'rcirc-other-nick)))))))
+ (?m (propertize text 'rcirc-text text))
+ (?r response)
+ (?t (or target ""))
+ (t (concat "UNKNOWN CODE:" (match-string 0))))
+ t t nil 0)
+ (rcirc-add-face (match-beginning 0) (match-end 0) face))
(rcirc-add-face start (match-beginning 0) face))
- (buffer-substring (point-min) (point-max))))
+ (buffer-substring (point-min) (point-max))))
(defun rcirc-target-buffer (process sender response target _text)
"Return a buffer to print the server response from SENDER.
@@ -1869,17 +1949,17 @@ PROCESS is the process object for the current
connection."
(cl-assert (not (bufferp target)))
(with-rcirc-process-buffer process
(cond ((not target)
- (rcirc-any-buffer process))
- ((not (rcirc-channel-p target))
- ;; message from another user
- (if (or (string= response "PRIVMSG")
- (string= response "ACTION"))
- (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
- target
- sender))
- (rcirc-get-buffer process target t)))
- ((or (rcirc-get-buffer process target)
- (rcirc-any-buffer process))))))
+ (rcirc-any-buffer process))
+ ((not (rcirc-channel-p target))
+ ;; message from another user
+ (if (or (string= response "PRIVMSG")
+ (string= response "ACTION"))
+ (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
+ target
+ sender))
+ (rcirc-get-buffer process target t)))
+ ((or (rcirc-get-buffer process target)
+ (rcirc-any-buffer process))))))
(defvar-local rcirc-last-sender nil)
(defvar-local rcirc-activity-types nil
@@ -1908,11 +1988,11 @@ PROCESS is the process object for the current
connection."
"Return the line from the last activity from NICK in TARGET.
PROCESS is the process object for the current connection."
(let ((line (or (cdr (assoc-string target
- (gethash nick (with-rcirc-server-buffer
- rcirc-nick-table)) t))
- (rcirc-last-quit-line process nick target))))
+ (gethash nick (with-rcirc-server-buffer
+ rcirc-nick-table)) t))
+ (rcirc-last-quit-line process nick target))))
(if line
- line
+ line
;;(message "line is nil for %s in %s" nick target)
nil)))
@@ -1921,7 +2001,7 @@ PROCESS is the process object for the current connection."
PROCESS is the process object for the current connection."
(let ((last-activity-line (rcirc-last-line process nick target)))
(when (and last-activity-line
- (> last-activity-line 0))
+ (> last-activity-line 0))
(- rcirc-current-line last-activity-line))))
(defvar rcirc-markup-text-functions
@@ -1931,7 +2011,8 @@ PROCESS is the process object for the current connection."
rcirc-markup-my-nick
rcirc-markup-urls
rcirc-markup-keywords
- rcirc-markup-bright-nicks)
+ rcirc-markup-bright-nicks
+ rcirc-markup-bridge-bots)
"List of functions used to manipulate text before it is printed.
Each function takes two arguments, SENDER, and RESPONSE. The
@@ -1945,33 +2026,33 @@ record activity. PROCESS is the process object for the
current
connection."
(or text (setq text ""))
(unless (and (or (member sender rcirc-ignore-list)
- (member (with-syntax-table rcirc-nick-syntax-table
- (when (string-match "^\\([^/]\\w*\\)[:,]" text)
- (match-string 1 text)))
- rcirc-ignore-list))
- ;; do not ignore if we sent the message
- (not (string= sender (rcirc-nick process))))
+ (member (with-syntax-table rcirc-nick-syntax-table
+ (when (string-match "^\\([^/]\\w*\\)[:,]" text)
+ (match-string 1 text)))
+ rcirc-ignore-list))
+ ;; do not ignore if we sent the message
+ (not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
(time (if-let ((time (rcirc-get-tag "time")))
(parse-iso8601-time-string time)
(current-time)))
- (inhibit-read-only t))
+ (inhibit-read-only t))
(with-current-buffer buffer
- (let ((moving (= (point) rcirc-prompt-end-marker))
- (old-point (point-marker)))
-
- (setq text (decode-coding-string text rcirc-decode-coding-system))
- (unless (string= sender (rcirc-nick process))
- ;; mark the line with overlay arrow
- (unless (or (marker-position overlay-arrow-position)
- (get-buffer-window (current-buffer))
- (member response rcirc-omit-responses))
- (set-marker overlay-arrow-position
- (marker-position rcirc-prompt-start-marker))))
-
- ;; temporarily set the marker insertion-type because
- ;; insert-before-markers results in hidden text in new buffers
- (goto-char rcirc-prompt-start-marker)
+ (let ((moving (= (point) rcirc-prompt-end-marker))
+ (old-point (point-marker)))
+
+ (setq text (decode-coding-string text rcirc-decode-coding-system))
+ (unless (string= sender (rcirc-nick process))
+ ;; mark the line with overlay arrow
+ (unless (or (marker-position overlay-arrow-position)
+ (get-buffer-window (current-buffer))
+ (member response rcirc-omit-responses))
+ (set-marker overlay-arrow-position
+ (marker-position rcirc-prompt-start-marker))))
+
+ ;; temporarily set the marker insertion-type because
+ ;; insert-before-markers results in hidden text in new buffers
+ (goto-char rcirc-prompt-start-marker)
(catch 'exit
(while (not (bobp))
(goto-char (or (previous-single-property-change (point) 'hard)
@@ -1981,8 +2062,8 @@ connection."
(next-single-property-change (point) 'hard)
(forward-char 1)
(throw 'exit nil))))
- (set-marker-insertion-type rcirc-prompt-start-marker t)
- (set-marker-insertion-type rcirc-prompt-end-marker t)
+ (set-marker-insertion-type rcirc-prompt-start-marker t)
+ (set-marker-insertion-type rcirc-prompt-end-marker t)
;; run markup functions
(cl-assert (bolp))
@@ -1990,32 +2071,29 @@ connection."
(save-restriction
(narrow-to-region (point) (point))
(insert (propertize (rcirc-format-response-string process sender
response
- nil text)
- 'rcirc-msgid (rcirc-get-tag "msgid"))
- (propertize "\n" 'hard t))
-
- ;; squeeze spaces out of text before rcirc-text
- (fill-region (point-min) (point-max))
+ nil text)
+ 'rcirc-msgid (rcirc-get-tag "msgid"))
+ (propertize "\n" 'hard t))
(goto-char (or (next-single-property-change (point-min)
'rcirc-text)
- (point)))
- (when (rcirc-buffer-process)
- (save-excursion (rcirc-markup-timestamp sender response))
- (dolist (fn rcirc-markup-text-functions)
- (save-excursion (funcall fn sender response)))
- (when rcirc-fill-flag
- (save-excursion (rcirc-markup-fill sender response))))
-
- (when rcirc-read-only-flag
- (add-text-properties (point-min) (point-max)
+ (point)))
+ (when (rcirc-buffer-process)
+ (save-excursion (rcirc-markup-timestamp sender response))
+ (dolist (fn rcirc-markup-text-functions)
+ (save-excursion (funcall fn sender response)))
+ (when rcirc-fill-flag
+ (save-excursion (rcirc-markup-fill sender response))))
+
+ (when rcirc-read-only-flag
+ (add-text-properties (point-min) (point-max)
'(read-only t front-sticky t)))
(add-text-properties (point-min) (point-max)
(list 'rcirc-time time))
;; make text omittable
- (let ((last-activity-lines (rcirc-elapsed-lines process sender
target)))
- (if (and (not (string= (rcirc-nick process) sender))
+ (let ((last-activity-lines (rcirc-elapsed-lines process sender
target)))
+ (if (and (not (string= (rcirc-nick process) sender))
(or (member response rcirc-omit-responses)
(and (member response rcirc-omit-unless-requested)
(if (member response rcirc-pending-requests)
@@ -2025,50 +2103,50 @@ connection."
(or (member response rcirc-omit-unless-requested)
(not last-activity-lines)
(< rcirc-omit-threshold last-activity-lines)))
- (put-text-property (point-min) (point-max)
- 'invisible 'rcirc-omit)
- ;; otherwise increment the line count
- (setq rcirc-current-line (1+ rcirc-current-line))))))
-
- (set-marker-insertion-type rcirc-prompt-start-marker nil)
- (set-marker-insertion-type rcirc-prompt-end-marker nil)
-
- ;; truncate buffer if it is very long
- (save-excursion
- (when (and rcirc-buffer-maximum-lines
- (> rcirc-buffer-maximum-lines 0)
- (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
- (delete-region (point-min) (point))))
-
- ;; set the window point for buffers show in windows
- (walk-windows (lambda (w)
- (when (and (not (eq (selected-window) w))
- (eq (current-buffer)
- (window-buffer w))
- (>= (window-point w)
- rcirc-prompt-end-marker))
- (set-window-point w (point-max))))
- nil t)
-
- ;; restore the point
- (goto-char (if moving rcirc-prompt-end-marker old-point)))
-
- ;; keep window on bottom line if it was already there
- (when rcirc-scroll-show-maximum-output
- (let ((window (get-buffer-window)))
- (when window
- (with-selected-window window
- (when (eq major-mode 'rcirc-mode)
- (when (<= (- (window-height)
- (count-screen-lines (window-point)
- (window-start))
- 1)
- 0)
- (recenter -1)))))))
-
- ;; flush undo (can we do something smarter here?)
- (buffer-disable-undo)
- (buffer-enable-undo)
+ (put-text-property (point-min) (point-max)
+ 'invisible 'rcirc-omit)
+ ;; otherwise increment the line count
+ (setq rcirc-current-line (1+ rcirc-current-line))))))
+
+ (set-marker-insertion-type rcirc-prompt-start-marker nil)
+ (set-marker-insertion-type rcirc-prompt-end-marker nil)
+
+ ;; truncate buffer if it is very long
+ (save-excursion
+ (when (and rcirc-buffer-maximum-lines
+ (> rcirc-buffer-maximum-lines 0)
+ (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
+ (delete-region (point-min) (point))))
+
+ ;; set the window point for buffers show in windows
+ (walk-windows (lambda (w)
+ (when (and (not (eq (selected-window) w))
+ (eq (current-buffer)
+ (window-buffer w))
+ (>= (window-point w)
+ rcirc-prompt-end-marker))
+ (set-window-point w (point-max))))
+ nil t)
+
+ ;; restore the point
+ (goto-char (if moving rcirc-prompt-end-marker old-point)))
+
+ ;; keep window on bottom line if it was already there
+ (when rcirc-scroll-show-maximum-output
+ (let ((window (get-buffer-window)))
+ (when window
+ (with-selected-window window
+ (when (eq major-mode 'rcirc-mode)
+ (when (<= (- (window-height)
+ (count-screen-lines (window-point)
+ (window-start))
+ 1)
+ 0)
+ (recenter -1)))))))
+
+ ;; flush undo (can we do something smarter here?)
+ (buffer-disable-undo)
+ (buffer-enable-undo)
;; record mode line activity
(when (and activity
@@ -2076,16 +2154,16 @@ connection."
(not (and rcirc-dim-nicks sender
(string-match (regexp-opt rcirc-dim-nicks) sender)
(rcirc-channel-p target))))
- (rcirc-record-activity (current-buffer)
- (when (not (rcirc-channel-p rcirc-target))
- 'nick)))
+ (rcirc-record-activity (current-buffer)
+ (when (not (rcirc-channel-p rcirc-target))
+ 'nick)))
(when (and rcirc-log-flag
(or target
rcirc-log-process-buffers))
(rcirc-log process sender response target text))
- (sit-for 0) ; displayed text before hook
+ (sit-for 0) ; displayed text before hook
(run-hook-with-args 'rcirc-print-functions
process sender response target text)))))
@@ -2098,9 +2176,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.
@@ -2127,15 +2207,15 @@ disk. PROCESS is the process object for the current
connection."
(parse-iso8601-time-string time))))
(unless (null filename)
(let ((cell (assoc-string filename rcirc-log-alist))
- (line (concat (format-time-string rcirc-time-format time)
- (substring-no-properties
- (rcirc-format-response-string process sender
- response target text))
- "\n")))
- (if cell
- (setcdr cell (concat (cdr cell) line))
- (setq rcirc-log-alist
- (cons (cons filename line) rcirc-log-alist)))))))
+ (line (concat (format-time-string rcirc-time-format time)
+ (substring-no-properties
+ (rcirc-format-response-string process sender
+ response target text))
+ "\n")))
+ (if cell
+ (setcdr cell (concat (cdr cell) line))
+ (setq rcirc-log-alist
+ (cons (cons filename line) rcirc-log-alist)))))))
(defun rcirc-log-write ()
"Flush `rcirc-log-alist' data to disk.
@@ -2146,11 +2226,11 @@ log-files with absolute names (see
`rcirc-log-filename-function')."
(let ((filename (convert-standard-filename
(expand-file-name (car cell)
rcirc-log-directory)))
- (coding-system-for-write 'utf-8))
+ (coding-system-for-write 'utf-8))
(make-directory (file-name-directory filename) t)
(with-temp-buffer
- (insert (cdr cell))
- (write-region (point-min) (point-max) filename t 'quiet))))
+ (insert (cdr cell))
+ (write-region (point-min) (point-max) filename t 'quiet))))
(setq rcirc-log-alist nil))
(defun rcirc-view-log-file ()
@@ -2158,8 +2238,8 @@ log-files with absolute names (see
`rcirc-log-filename-function')."
(interactive)
(find-file-other-window
(expand-file-name (funcall rcirc-log-filename-function
- (rcirc-buffer-process) rcirc-target)
- rcirc-log-directory)))
+ (rcirc-buffer-process) rcirc-target)
+ rcirc-log-directory)))
(defun rcirc-join-channels (process channels)
"Join CHANNELS.
@@ -2167,7 +2247,7 @@ PROCESS is the process object for the current connection."
(save-window-excursion
(dolist (channel channels)
(with-rcirc-process-buffer process
- (rcirc-cmd-join channel process)))))
+ (rcirc-cmd-join channel process)))))
;;; nick management
(defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+)
@@ -2177,9 +2257,9 @@ PROCESS is the process object for the current connection."
"Return the nick from USER. Remove any non-nick junk."
(save-match-data
(if (string-match (concat "^[" rcirc-nick-prefix-chars
- "]*\\([^! ]+\\)!?")
+ "]*\\([^! ]+\\)!?")
(or user ""))
- (match-string 1 user)
+ (match-string 1 user)
user)))
(defun rcirc-nick-channels (process nick)
@@ -2187,7 +2267,7 @@ PROCESS is the process object for the current connection."
PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(mapcar (lambda (x) (car x))
- (gethash nick rcirc-nick-table))))
+ (gethash nick rcirc-nick-table))))
(defun rcirc-put-nick-channel (process nick channel &optional line)
"Add CHANNEL to list associated with NICK.
@@ -2198,12 +2278,12 @@ to zero. PROCESS is the process object for the current
connection."
(let ((nick (rcirc-user-nick nick)))
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
- (record (assoc-string channel chans t)))
- (if record
- (when line (setcdr record line))
- (puthash nick (cons (cons channel (or line 0))
- chans)
- rcirc-nick-table))))))
+ (record (assoc-string channel chans t)))
+ (if record
+ (when line (setcdr record line))
+ (puthash nick (cons (cons channel (or line 0))
+ chans)
+ rcirc-nick-table))))))
(defun rcirc-nick-remove (process nick)
"Remove NICK from table.
@@ -2217,33 +2297,36 @@ PROCESS is the process object for the current
connection."
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
(newchans
- ;; instead of assoc-string-delete-all:
- (let ((record (assoc-string channel chans t)))
- (when record
- (setcar record 'delete)
- (assq-delete-all 'delete chans)))))
+ ;; instead of assoc-string-delete-all:
+ (let ((record (assoc-string channel chans t)))
+ (when record
+ (setcar record 'delete)
+ (assq-delete-all 'delete chans)))))
(if newchans
(puthash nick newchans rcirc-nick-table)
(remhash nick rcirc-nick-table)))))
+(defvar rcirc-pseudo-nicks)
(defun rcirc-channel-nicks (process target)
"Return the list of nicks associated with TARGET sorted by last activity.
PROCESS is the process object for the current connection."
(when target
(if (rcirc-channel-p target)
- (with-rcirc-process-buffer process
- (let (nicks)
- (maphash
- (lambda (k v)
- (let ((record (assoc-string target v t)))
- (if record
- (setq nicks (cons (cons k (cdr record)) nicks)))))
- rcirc-nick-table)
- (mapcar (lambda (x) (car x))
- (sort nicks (lambda (x y)
- (let ((lx (or (cdr x) 0))
- (ly (or (cdr y) 0)))
- (< ly lx)))))))
+ (let ((pseudo-nicks (mapcar #'list rcirc-pseudo-nicks)))
+ (with-rcirc-process-buffer process
+ (let (nicks)
+ (maphash
+ (lambda (k v)
+ (let ((record (assoc-string target v t)))
+ (if record
+ (setq nicks (cons (cons k (cdr record)) nicks)))))
+ rcirc-nick-table)
+ (mapcar (lambda (x) (car x))
+ (sort (nconc pseudo-nicks nicks)
+ (lambda (x y)
+ (let ((lx (or (cdr x) 0))
+ (ly (or (cdr y) 0)))
+ (< ly lx))))))))
(list target))))
(defun rcirc-ignore-update-automatic (nick)
@@ -2251,10 +2334,10 @@ PROCESS is the process object for the current
connection."
If so, remove from `rcirc-ignore-list'. PROCESS is the process
object for the current connection."
(when (member nick rcirc-ignore-list-automatic)
- (setq rcirc-ignore-list-automatic
- (delete nick rcirc-ignore-list-automatic)
- rcirc-ignore-list
- (delete nick rcirc-ignore-list))))
+ (setq rcirc-ignore-list-automatic
+ (delete nick rcirc-ignore-list-automatic)
+ rcirc-ignore-list
+ (delete nick rcirc-ignore-list))))
(defun rcirc-nickname< (s1 s2)
"Return non-nil if IRC nickname S1 is less than S2, and nil otherwise.
@@ -2300,15 +2383,15 @@ This function does not alter the INPUT string."
;; toggle the mode-line channel indicator
(if rcirc-track-minor-mode
(progn
- (and (not (memq 'rcirc-activity-string global-mode-string))
- (setq global-mode-string
- (append global-mode-string '(rcirc-activity-string))))
- (add-hook 'window-configuration-change-hook
- 'rcirc-window-configuration-change))
+ (and (not (memq 'rcirc-activity-string global-mode-string))
+ (setq global-mode-string
+ (append global-mode-string '(rcirc-activity-string))))
+ (add-hook 'window-configuration-change-hook
+ 'rcirc-window-configuration-change))
(setq global-mode-string
- (delete 'rcirc-activity-string global-mode-string))
+ (delete 'rcirc-activity-string global-mode-string))
(remove-hook 'window-configuration-change-hook
- 'rcirc-window-configuration-change)))
+ 'rcirc-window-configuration-change)))
(add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore"))
(add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri"))
@@ -2317,20 +2400,20 @@ This function does not alter the INPUT string."
"Toggle the value of `rcirc-ignore-buffer-activity-flag'."
(interactive)
(setq rcirc-ignore-buffer-activity-flag
- (not rcirc-ignore-buffer-activity-flag))
+ (not rcirc-ignore-buffer-activity-flag))
(message (if rcirc-ignore-buffer-activity-flag
- "Ignore activity in this buffer"
- "Notice activity in this buffer"))
+ "Ignore activity in this buffer"
+ "Notice activity in this buffer"))
(force-mode-line-update))
(defun rcirc-toggle-low-priority ()
"Toggle the value of `rcirc-low-priority-flag'."
(interactive)
(setq rcirc-low-priority-flag
- (not rcirc-low-priority-flag))
+ (not rcirc-low-priority-flag))
(message (if rcirc-low-priority-flag
- "Activity in this buffer is low priority"
- "Activity in this buffer is normal priority"))
+ "Activity in this buffer is low priority"
+ "Activity in this buffer is normal priority"))
(force-mode-line-update))
(defun rcirc-switch-to-server-buffer ()
@@ -2358,14 +2441,14 @@ This function does not alter the INPUT string."
With prefix ARG, go to the next low priority buffer with activity."
(interactive "P")
(let* ((pair (rcirc-split-activity rcirc-activity))
- (lopri (car pair))
- (hipri (cdr pair)))
+ (lopri (car pair))
+ (hipri (cdr pair)))
(if (or (and (not arg) hipri)
- (and arg lopri))
- (progn
- (switch-to-buffer (car (if arg lopri hipri)))
- (when (> (point) rcirc-prompt-start-marker)
- (recenter -1)))
+ (and arg lopri))
+ (progn
+ (switch-to-buffer (car (if arg lopri hipri)))
+ (when (> (point) rcirc-prompt-start-marker)
+ (recenter -1)))
(rcirc-bury-buffers)
(message "No IRC activity.%s"
(if lopri
@@ -2375,8 +2458,6 @@ With prefix ARG, go to the next low priority buffer with
activity."
""))))
(rcirc-update-activity-string))
-(define-obsolete-variable-alias 'rcirc-activity-hooks
- 'rcirc-activity-functions "24.3")
(defvar rcirc-activity-functions nil
"Hook to be run when there is channel activity.
@@ -2388,21 +2469,21 @@ activity. Only run if the buffer is not visible and
"Record BUFFER activity with TYPE."
(with-current-buffer buffer
(let ((old-activity rcirc-activity)
- (old-types rcirc-activity-types))
+ (old-types rcirc-activity-types))
(when (and (not (get-buffer-window (current-buffer) t))
(not (and rcirc-track-ignore-server-buffer-flag
(eq rcirc-server-buffer (current-buffer)))))
- (setq rcirc-activity
- (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity
+ (setq rcirc-activity
+ (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity
(cons (current-buffer) rcirc-activity))
- (lambda (b1 b2)
- (let ((t1 (buffer-local-value 'rcirc-last-post-time b1))
- (t2 (buffer-local-value 'rcirc-last-post-time b2)))
- (time-less-p t2 t1)))))
- (cl-pushnew type rcirc-activity-types)
- (unless (and (equal rcirc-activity old-activity)
- (member type old-types))
- (rcirc-update-activity-string)))))
+ (lambda (b1 b2)
+ (let ((t1 (buffer-local-value 'rcirc-last-post-time b1))
+ (t2 (buffer-local-value 'rcirc-last-post-time b2)))
+ (time-less-p t2 t1)))))
+ (cl-pushnew type rcirc-activity-types)
+ (unless (and (equal rcirc-activity old-activity)
+ (member type old-types))
+ (rcirc-update-activity-string)))))
(run-hook-with-args 'rcirc-activity-functions buffer))
(defun rcirc-clear-activity (buffer)
@@ -2422,10 +2503,10 @@ activity. Only run if the buffer is not visible and
(let (lopri hipri)
(dolist (buf activity)
(with-current-buffer buf
- (if (and rcirc-low-priority-flag
- (not (member 'nick rcirc-activity-types)))
- (push buf lopri)
- (push buf hipri))))
+ (if (and rcirc-low-priority-flag
+ (not (member 'nick rcirc-activity-types)))
+ (push buf lopri)
+ (push buf hipri))))
(cons (nreverse lopri) (nreverse hipri))))
(defvar rcirc-update-activity-string-hook nil
@@ -2434,33 +2515,33 @@ activity. Only run if the buffer is not visible and
(defun rcirc-update-activity-string ()
"Update mode-line string."
(let* ((pair (rcirc-split-activity rcirc-activity))
- (lopri (car pair))
- (hipri (cdr pair)))
+ (lopri (car pair))
+ (hipri (cdr pair)))
(setq rcirc-activity-string
- (cond ((or hipri lopri)
- (concat (and hipri "[")
- (rcirc-activity-string hipri)
- (and hipri lopri ",")
- (and lopri
- (concat "("
- (rcirc-activity-string lopri)
- ")"))
- (and hipri "]")))
- ((not (null (rcirc-process-list)))
- "[]")
- (t "[]")))
+ (cond ((or hipri lopri)
+ (concat (and hipri "[")
+ (rcirc-activity-string hipri)
+ (and hipri lopri ",")
+ (and lopri
+ (concat "("
+ (rcirc-activity-string lopri)
+ ")"))
+ (and hipri "]")))
+ ((not (null (rcirc-process-list)))
+ "[]")
+ (t "[]")))
(run-hooks 'rcirc-update-activity-string-hook)
(force-mode-line-update t)))
(defun rcirc-activity-string (buffers)
"Generate activity string for all BUFFERS."
(mapconcat (lambda (b)
- (let ((s (substring-no-properties (rcirc-short-buffer-name b))))
- (with-current-buffer b
- (dolist (type rcirc-activity-types)
+ (let ((s (substring-no-properties (rcirc-short-buffer-name b))))
+ (with-current-buffer b
+ (dolist (type rcirc-activity-types)
(rcirc-facify s (cl-case type
- (nick 'rcirc-track-nick)
- (keyword 'rcirc-track-keyword)))))
+ (nick 'rcirc-track-nick)
+ (keyword 'rcirc-track-keyword)))))
(let ((map (make-mode-line-mouse-map
'mouse-1
(lambda ()
@@ -2469,7 +2550,7 @@ activity. Only run if the buffer is not visible and
(propertize s
'mouse-face 'mode-line-highlight
'local-map map))))
- buffers ","))
+ buffers ","))
(defun rcirc-short-buffer-name (buffer)
"Return a short name for BUFFER to use in the mode line indicator."
@@ -2485,9 +2566,9 @@ activity. Only run if the buffer is not visible and
"Return a list of the visible buffers that are in `rcirc-mode'."
(let (acc)
(walk-windows (lambda (w)
- (with-current-buffer (window-buffer w)
- (when (eq major-mode 'rcirc-mode)
- (push (current-buffer) acc)))))
+ (with-current-buffer (window-buffer w)
+ (when (eq major-mode 'rcirc-mode)
+ (push (current-buffer) acc)))))
acc))
(defvar rcirc-visible-buffers nil
@@ -2501,7 +2582,7 @@ activity. Only run if the buffer is not visible and
(defun rcirc-window-configuration-change-1 ()
"Clear activity and overlay arrows."
(let* ((old-activity rcirc-activity)
- (hidden-buffers rcirc-visible-buffers))
+ (hidden-buffers rcirc-visible-buffers))
(setq rcirc-visible-buffers (rcirc-visible-buffers))
@@ -2516,8 +2597,8 @@ activity. Only run if the buffer is not visible and
;; remove any killed buffers from list
(setq rcirc-activity
- (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
- rcirc-activity)))
+ (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
+ rcirc-activity)))
;; update the mode-line string
(unless (equal old-activity rcirc-activity)
(rcirc-update-activity-string))))
@@ -2527,14 +2608,14 @@ activity. Only run if the buffer is not visible and
(defun rcirc-update-short-buffer-names ()
"Update variable `rcirc-short-buffer-name' for IRC buffers."
(let ((bufalist
- (apply 'append (mapcar (lambda (process)
- (with-rcirc-process-buffer process
- rcirc-buffer-alist))
- (rcirc-process-list)))))
+ (apply 'append (mapcar (lambda (process)
+ (with-rcirc-process-buffer process
+ rcirc-buffer-alist))
+ (rcirc-process-list)))))
(dolist (i (rcirc-abbreviate bufalist))
(when (buffer-live-p (cdr i))
- (with-current-buffer (cdr i)
- (setq rcirc-short-buffer-name (car i)))))))
+ (with-current-buffer (cdr i)
+ (setq rcirc-short-buffer-name (car i)))))))
(defun rcirc-abbreviate (pairs)
"Generate alist of abbreviated buffer names to buffers.
@@ -2548,12 +2629,12 @@ values, from each process."
acc)
(dolist (x (cdr tree))
(if (listp x)
- (setq acc (append acc
- (mapcar (lambda (y)
- (cons (concat ch (car y))
- (cdr y)))
- (rcirc-rebuild-tree x))))
- (setq acc (cons (cons ch x) acc))))
+ (setq acc (append acc
+ (mapcar (lambda (y)
+ (cons (concat ch (car y))
+ (cdr y)))
+ (rcirc-rebuild-tree x))))
+ (setq acc (cons (cons ch x) acc))))
acc))
(defun rcirc-make-trees (pairs)
@@ -2565,31 +2646,31 @@ prefix could be found or another tree if it shares the
same
prefix with another element in PAIRS."
(let (alist)
(mapc (lambda (pair)
- (if (consp pair)
- (let* ((str (car pair))
- (data (cdr pair))
- (char (unless (zerop (length str))
- (aref str 0)))
- (rest (unless (zerop (length str))
- (substring str 1)))
- (part (if char (assq char alist))))
- (if part
- ;; existing partition
- (setcdr part (cons (cons rest data) (cdr part)))
- ;; new partition
- (setq alist (cons (if char
- (list char (cons rest data))
- data)
- alist))))
- (setq alist (cons pair alist))))
- pairs)
+ (if (consp pair)
+ (let* ((str (car pair))
+ (data (cdr pair))
+ (char (unless (zerop (length str))
+ (aref str 0)))
+ (rest (unless (zerop (length str))
+ (substring str 1)))
+ (part (if char (assq char alist))))
+ (if part
+ ;; existing partition
+ (setcdr part (cons (cons rest data) (cdr part)))
+ ;; new partition
+ (setq alist (cons (if char
+ (list char (cons rest data))
+ data)
+ alist))))
+ (setq alist (cons pair alist))))
+ pairs)
;; recurse into cdrs of alist
(mapc (lambda (x)
- (when (and (listp x) (listp (cadr x)))
- (setcdr x (if (> (length (cdr x)) 1)
- (rcirc-make-trees (cdr x))
- (setcdr x (list (cdadr x)))))))
- alist)))
+ (when (and (listp x) (listp (cadr x)))
+ (setcdr x (if (> (length (cdr x)) 1)
+ (rcirc-make-trees (cdr x))
+ (setcdr x (list (cdadr x)))))))
+ alist)))
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
;; the current buffer/channel/user, and ARGS, which is a string
@@ -2666,7 +2747,7 @@ that, an interactive form can specified."
"Send MESSAGE to CHAN-OR-NICK."
(interactive (list (completing-read "Message nick: "
(with-rcirc-server-buffer
- rcirc-nick-table))
+ rcirc-nick-table))
(read-string "Message: ")))
(rcirc-send-message process chan-or-nick message))
@@ -2677,7 +2758,7 @@ that, an interactive form can specified."
rcirc-nick-table))))
(let ((existing-buffer (rcirc-get-buffer process nick)))
(switch-to-buffer (or existing-buffer
- (rcirc-get-buffer-create process nick)))
+ (rcirc-get-buffer-create process nick)))
(when (not existing-buffer)
(rcirc-cmd-whois nick))))
@@ -2699,7 +2780,7 @@ CHANNELS is a comma- or space-separated string of channel
names."
"Invite NICK to CHANNEL."
(interactive (list
(completing-read "Invite nick: "
- (with-rcirc-server-buffer rcirc-nick-table))
+ (with-rcirc-server-buffer rcirc-nick-table))
(read-string "Channel: ")))
(rcirc-send-string process "INVITE" nick channel))
@@ -2778,8 +2859,8 @@ With a prefix arg, prompt for new topic."
(interactive (list
(completing-read "Kick nick: "
(rcirc-channel-nicks
- (rcirc-buffer-process)
- rcirc-target))
+ (rcirc-buffer-process)
+ rcirc-target))
(read-from-minibuffer "Kick reason: ")))
(rcirc-send-string process "KICK" target nick : reason))
@@ -2811,9 +2892,9 @@ PROCESS is the process object for the current connection."
"Toggle membership of ELEMENTS in SET."
(dolist (elt elements)
(if (and elt (not (string= "" elt)))
- (setq set (if (member-ignore-case elt set)
- (delete elt set)
- (cons elt set)))))
+ (setq set (if (member-ignore-case elt set)
+ (delete elt set)
+ (cons elt set)))))
set)
@@ -2824,33 +2905,33 @@ nicks when no NICK is given. When listing ignored
nicks, the
ones added to the list automatically are marked with an asterisk."
(interactive "sToggle ignoring of nick: ")
(setq rcirc-ignore-list
- (apply #'rcirc-add-or-remove rcirc-ignore-list
- (split-string nick nil t)))
+ (apply #'rcirc-add-or-remove rcirc-ignore-list
+ (split-string nick nil t)))
(rcirc-print process nil "IGNORE" target
- (mapconcat
- (lambda (nick)
- (concat nick
- (if (member nick rcirc-ignore-list-automatic)
- "*" "")))
- rcirc-ignore-list " ")))
+ (mapconcat
+ (lambda (nick)
+ (concat nick
+ (if (member nick rcirc-ignore-list-automatic)
+ "*" "")))
+ rcirc-ignore-list " ")))
(rcirc-define-command bright (nick)
"Manage the bright nick list."
(interactive "sToggle emphasis of nick: ")
(setq rcirc-bright-nicks
- (apply #'rcirc-add-or-remove rcirc-bright-nicks
- (split-string nick nil t)))
+ (apply #'rcirc-add-or-remove rcirc-bright-nicks
+ (split-string nick nil t)))
(rcirc-print process nil "BRIGHT" target
- (mapconcat 'identity rcirc-bright-nicks " ")))
+ (mapconcat 'identity rcirc-bright-nicks " ")))
(rcirc-define-command dim (nick)
"Manage the dim nick list."
(interactive "sToggle deemphasis of nick: ")
(setq rcirc-dim-nicks
- (apply #'rcirc-add-or-remove rcirc-dim-nicks
- (split-string nick nil t)))
+ (apply #'rcirc-add-or-remove rcirc-dim-nicks
+ (split-string nick nil t)))
(rcirc-print process nil "DIM" target
- (mapconcat 'identity rcirc-dim-nicks " ")))
+ (mapconcat 'identity rcirc-dim-nicks " ")))
(rcirc-define-command keyword (keyword)
"Manage the keyword list.
@@ -2858,24 +2939,24 @@ Mark KEYWORD, unmark KEYWORD if already marked, or list
marked
keywords when no KEYWORD is given."
(interactive "sToggle highlighting of keyword: ")
(setq rcirc-keywords
- (apply #'rcirc-add-or-remove rcirc-keywords
- (split-string keyword nil t)))
+ (apply #'rcirc-add-or-remove rcirc-keywords
+ (split-string keyword nil t)))
(rcirc-print process nil "KEYWORD" target
- (mapconcat 'identity rcirc-keywords " ")))
+ (mapconcat 'identity rcirc-keywords " ")))
(defun rcirc-add-face (start end name &optional object)
"Add face NAME to the face text property of the text from START to END."
(when name
(let ((pos start)
- next prop)
+ next prop)
(while (< pos end)
- (setq prop (get-text-property pos 'font-lock-face object)
- next (next-single-property-change pos 'font-lock-face object end))
- (unless (member name (get-text-property pos 'font-lock-face object))
- (add-text-properties pos next
- (list 'font-lock-face (cons name prop)) object))
- (setq pos next)))))
+ (setq prop (get-text-property pos 'font-lock-face object)
+ next (next-single-property-change pos 'font-lock-face object
end))
+ (unless (member name (get-text-property pos 'font-lock-face object))
+ (add-text-properties pos next
+ (list 'font-lock-face (cons name prop)) object))
+ (setq pos next)))))
(defun rcirc-facify (string face)
"Return a copy of STRING with FACE property added."
@@ -2917,7 +2998,75 @@ If ARG is given, opens the URL in a new browser window."
(let ((time (and-let* ((time (rcirc-get-tag "time")))
(parse-iso8601-time-string time))))
(insert (rcirc-facify (format-time-string rcirc-time-format time)
- 'rcirc-timestamp))))
+ 'rcirc-timestamp))))
+
+(defvar-local rcirc-pseudo-nicks '()
+ "List of virtual nicks detected in a channel.
+These are collected by `rcirc-markup-bridge-bots' and don't
+constitute actual users in the current channel. Usually these
+are bridged via a some bot as described in
+`rcirc-bridge-bot-alist'.")
+
+(defcustom rcirc-bridge-bot-alist '()
+ "Alist for handling bouncers by `rcirc-markup-bridge-bots'.
+Each entry has the form (NAME . REGEXP), where NAME is the user
+name of a bouncer and REGEXP is a pattern used to match the
+message. The matching part of the message will be stripped from
+the message, and the first match group will replace the user name
+of the bot. Any matched name will noted and used in some cases
+for nick completion."
+ :type '(alist :key-type (string :tag "Bot name")
+ :value-type regexp)
+ :version "29.1")
+
+(defface rcirc-bridged-nick
+ '((t :inherit highlight))
+ "Face used for pseudo-nick ."
+ :version "29.1")
+
+(defun rcirc-markup-bridge-bots (sender response)
+ "Detect and reformat bridged messages to appear more natural.
+The user option `rcirc-bridge-bot-alist' specified what SENDER to
+handle. This function only operates on direct messages (as
+indicated by RESPONSE)."
+ (catch 'quit
+ (atomic-change-group
+ (save-match-data
+ (when-let* (((string= response "PRIVMSG"))
+ (regexp (alist-get sender rcirc-bridge-bot-alist
+ nil nil #'string=))
+ ((search-forward-regexp regexp nil t))
+ (nick (match-string-no-properties 1)))
+ (replace-match "") ;delete the bot string
+ (unless (member nick rcirc-pseudo-nicks)
+ (push nick rcirc-pseudo-nicks))
+ (goto-char (point-min))
+ (let ((fmt (alist-get "PRIVMSG" rcirc-response-formats
+ nil nil #'string=))
+ (hl-face (cond ((member sender rcirc-bright-nicks)
+ 'rcirc-bright-nick)
+ ((member sender rcirc-dim-nicks)
+ 'rcirc-dim-nick)
+ (t 'rcirc-other-nick)))
+ hl-username-p)
+ (when (string-match (rx (* "%%") "%" (group (or ?N ?n))) fmt)
+ (when (string= (match-string 1 fmt) "N")
+ (setq hl-username-p t))
+ (search-forward-regexp
+ (format-spec
+ (alist-get "PRIVMSG" rcirc-response-formats
+ nil nil #'string=)
+ `((?m . "") (?r . "") (?t . "") (?f . "")
+ (?N . ,(rx (group (+? nonl))))
+ (?n . ,(rx (group (+? nonl))))))
+ nil t)
+ (replace-match
+ (propertize
+ nick
+ 'help-echo (format "Message bridged via %s" sender)
+ 'face `(,@(and hl-username-p (list hl-face))
+ rcirc-bridged-nick))
+ nil t nil 1))))))))
(defun rcirc-markup-attributes (_sender _response)
"Highlight IRC markup, indicated by ASCII control codes."
@@ -2974,10 +3123,8 @@ If ARG is given, opens the URL in a new browser window."
((<= 0 bg (1- (length rcirc-color-codes)))))
(setq background (aref rcirc-color-codes bg)))
(rcirc-add-face (match-beginning 0) (match-end 0)
- `(face (:foreground
- ,foreground
- :background
- ,background))))))
+ `(face (,@(and foreground (list :foreground foreground))
+ ,@(and background (list :background
background))))))))
(defun rcirc-remove-markup-codes (_sender _response)
"Remove ASCII control codes used to designate markup."
@@ -2993,16 +3140,16 @@ If RESPONSE indicates that the nick was mentioned in a
message,
highlight the entire line and record the activity."
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (concat "\\b"
- (regexp-quote (rcirc-nick
- (rcirc-buffer-process)))
- "\\b")
- nil t)
+ (regexp-quote (rcirc-nick
+ (rcirc-buffer-process)))
+ "\\b")
+ nil t)
(rcirc-add-face (match-beginning 0) (match-end 0)
- 'rcirc-nick-in-message)
+ 'rcirc-nick-in-message)
(when (string= response "PRIVMSG")
- (rcirc-add-face (point-min) (point-max)
- 'rcirc-nick-in-message-full-line)
- (rcirc-record-activity (current-buffer) 'nick)))))
+ (rcirc-add-face (point-min) (point-max)
+ 'rcirc-nick-in-message-full-line)
+ (rcirc-record-activity (current-buffer) 'nick)))))
(defun rcirc-markup-urls (_sender _response)
"Highlight and activate URLs."
@@ -3018,11 +3165,11 @@ highlight the entire line and record the activity."
;; rather than `make-button', as text-buttons are much faster in
;; large buffers.
(make-text-button start (point)
- 'face 'rcirc-url
- 'follow-link t
- 'rcirc-url url
- 'action (lambda (button)
- (browse-url-button-open-url
+ 'face 'rcirc-url
+ 'follow-link t
+ 'rcirc-url url
+ 'action (lambda (button)
+ (browse-url-button-open-url
(button-get button 'rcirc-url))))
;; Record the URL if it is not already the latest stored URL.
(unless (string= url (caar rcirc-urls))
@@ -3034,42 +3181,42 @@ Keywords are only highlighted in messages (as indicated
by
RESPONSE) when they were not written by the user (as indicated by
SENDER)."
(when (and (string= response "PRIVMSG")
- (not (string= sender (rcirc-nick (rcirc-buffer-process)))))
+ (not (string= sender (rcirc-nick (rcirc-buffer-process)))))
(let* ((target (or rcirc-target ""))
- (keywords (delq nil (mapcar (lambda (keyword)
- (when (not (string-match keyword
- target))
- keyword))
- rcirc-keywords))))
+ (keywords (delq nil (mapcar (lambda (keyword)
+ (when (not (string-match keyword
+ target))
+ keyword))
+ rcirc-keywords))))
(when keywords
- (while (re-search-forward (regexp-opt keywords 'words) nil t)
- (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
- (rcirc-record-activity (current-buffer) 'keyword))))))
+ (while (re-search-forward (regexp-opt keywords 'words) nil t)
+ (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
+ (rcirc-record-activity (current-buffer) 'keyword))))))
(defun rcirc-markup-bright-nicks (_sender response)
"Highlight nicks brightly as specified by `rcirc-bright-nicks'.
This highlighting only takes place in name lists (as indicated by
RESPONSE)."
(when (and rcirc-bright-nicks
- (string= response "NAMES"))
+ (string= response "NAMES"))
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t)
- (rcirc-add-face (match-beginning 0) (match-end 0)
- 'rcirc-bright-nick)))))
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ 'rcirc-bright-nick)))))
(defun rcirc-markup-fill (_sender response)
"Fill messages as configured by `rcirc-fill-column'.
MOTD messages are not filled (as indicated by RESPONSE)."
- (when (not (string= response "372")) ; /motd
+ (when (not (string= response "372")) ; /motd
(let ((fill-prefix
- (or rcirc-fill-prefix
- (make-string (- (point) (line-beginning-position)) ?\s)))
- (fill-column (- (cond ((null rcirc-fill-column) fill-column)
+ (or rcirc-fill-prefix
+ (make-string (- (point) (line-beginning-position)) ?\s)))
+ (fill-column (- (cond ((null rcirc-fill-column) fill-column)
((functionp rcirc-fill-column)
- (funcall rcirc-fill-column))
- (t rcirc-fill-column))
- ;; make sure ... doesn't cause line wrapping
- 3)))
+ (funcall rcirc-fill-column))
+ (t rcirc-fill-column))
+ ;; make sure ... doesn't cause line wrapping
+ 3)))
(fill-region (point) (point-max) nil t))))
;;; handlers
@@ -3098,7 +3245,7 @@ PROCESS is the process object for the current connection."
(setq auth-required t)))))
(if rcirc-authenticate-before-join
(progn
- (add-hook 'rcirc-authenticated-hook
'rcirc-join-channels-post-auth t t)
+ (add-hook 'rcirc-authenticated-hook
'rcirc-join-channels-post-auth t t)
(rcirc-authenticate))
(rcirc-authenticate)
(rcirc-join-channels process rcirc-startup-channels))
@@ -3137,18 +3284,18 @@ PROCESS is the process object for the current
connection."
(message (cadr args)))
(if (string-match "^\C-a\\(.*\\)\C-a$" message)
(rcirc-handler-CTCP-response process target sender
- (match-string 1 message))
+ (match-string 1 message))
(rcirc-print process sender "NOTICE"
- (cond ((rcirc-channel-p target)
- target)
+ (cond ((rcirc-channel-p target)
+ target)
;; -ChanServ- [#gnu] Welcome...
- ((string-match "\\[\\(#[^] ]+\\)\\]" message)
- (match-string 1 message))
- (sender
- (if (string= sender (rcirc-server-name process))
- nil ; server notice
- sender)))
- message t))))
+ ((string-match "\\[\\(#[^] ]+\\)\\]" message)
+ (match-string 1 message))
+ (sender
+ (if (string= sender (rcirc-server-name process))
+ nil ; server notice
+ sender)))
+ message t))))
(defun rcirc-check-auth-status (process sender args _text)
"Check if the user just authenticated.
@@ -3200,10 +3347,10 @@ connection."
(with-current-buffer (rcirc-get-buffer-create process channel)
;; when recently rejoining, restore the linestamp
(rcirc-put-nick-channel process sender channel
- (let ((last-activity-lines
- (rcirc-elapsed-lines process sender
channel)))
- (when (and last-activity-lines
- (< last-activity-lines
rcirc-omit-threshold))
+ (let ((last-activity-lines
+ (rcirc-elapsed-lines process sender
channel)))
+ (when (and last-activity-lines
+ (< last-activity-lines
rcirc-omit-threshold))
(rcirc-last-line process sender channel))))
;; reset mode-line-process in case joining a channel with an
;; already open buffer (after getting kicked e.g.)
@@ -3223,25 +3370,25 @@ PROCESS is the process object for the current
connection."
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
(progn
- (rcirc-maybe-remember-nick-quit process nick channel)
- (rcirc-remove-nick-channel process nick channel))
+ (rcirc-maybe-remember-nick-quit process nick channel)
+ (rcirc-remove-nick-channel process nick channel))
;; this is us leaving
(mapc (lambda (n)
- (rcirc-remove-nick-channel process n channel))
- (rcirc-channel-nicks process channel))
+ (rcirc-remove-nick-channel process n channel))
+ (rcirc-channel-nicks process channel))
;; if the buffer is still around, make it inactive
(let ((buffer (rcirc-get-buffer process channel)))
(when buffer
- (rcirc-disconnect-buffer buffer)))))
+ (rcirc-disconnect-buffer buffer)))))
(defun rcirc-handler-PART (process sender args _text)
"Handle PART message from SENDER.
ARGS should have the form (CHANNEL REASON).
PROCESS is the process object for the current connection."
(let* ((channel (car args))
- (reason (cadr args))
- (message (concat channel " " reason)))
+ (reason (cadr args))
+ (message (concat channel " " reason)))
(rcirc-print process sender "PART" (funcall rcirc-channel-filter channel)
message)
;; print in private chat buffer if it exists
(when (rcirc-get-buffer (rcirc-buffer-process) sender)
@@ -3254,9 +3401,9 @@ PROCESS is the process object for the current connection."
ARGS should have the form (CHANNEL NICK REASON).
PROCESS is the process object for the current connection."
(let* ((channel (car args))
- (nick (cadr args))
- (reason (nth 2 args))
- (message (concat nick " " channel " " reason)))
+ (nick (cadr args))
+ (reason (nth 2 args))
+ (message (concat nick " " channel " " reason)))
(rcirc-print process sender "KICK" (funcall rcirc-channel-filter channel)
message t)
;; print in private chat buffer if it exists
(when (rcirc-get-buffer (rcirc-buffer-process) nick)
@@ -3269,28 +3416,28 @@ PROCESS is the process object for the current
connection."
PROCESS is the process object for the current connection."
(let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
(when (and elapsed-lines
- (< elapsed-lines rcirc-omit-threshold))
+ (< elapsed-lines rcirc-omit-threshold))
(let ((buffer (rcirc-get-buffer process channel)))
- (when buffer
- (with-current-buffer buffer
- (let ((record (assoc-string nick rcirc-recent-quit-alist t))
- (line (rcirc-last-line process nick channel)))
- (if record
- (setcdr record line)
- (setq rcirc-recent-quit-alist
- (cons (cons nick line)
- rcirc-recent-quit-alist))))))))))
+ (when buffer
+ (with-current-buffer buffer
+ (let ((record (assoc-string nick rcirc-recent-quit-alist t))
+ (line (rcirc-last-line process nick channel)))
+ (if record
+ (setcdr record line)
+ (setq rcirc-recent-quit-alist
+ (cons (cons nick line)
+ rcirc-recent-quit-alist))))))))))
(defun rcirc-handler-QUIT (process sender args _text)
"Handle QUIT message from SENDER.
PROCESS is the process object for the current connection."
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
- ;; broadcast quit message each channel
- (rcirc-print process sender "QUIT" (funcall rcirc-channel-filter
channel) (apply 'concat args))
- ;; record nick in quit table if they recently spoke
- (rcirc-maybe-remember-nick-quit process sender channel))
- (rcirc-nick-channels process sender))
+ ;; broadcast quit message each channel
+ (rcirc-print process sender "QUIT" (funcall rcirc-channel-filter
channel) (apply 'concat args))
+ ;; record nick in quit table if they recently spoke
+ (rcirc-maybe-remember-nick-quit process sender channel))
+ (rcirc-nick-channels process sender))
(rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args _text)
@@ -3311,9 +3458,9 @@ PROCESS is the process object for the current connection."
;; update chat buffer, if it exists
(when-let ((chat-buffer (rcirc-get-buffer process old-nick)))
(with-current-buffer chat-buffer
- (rcirc-print process sender "NICK" old-nick new-nick)
- (setq rcirc-target new-nick)
- (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t))
+ (rcirc-print process sender "NICK" old-nick new-nick)
+ (setq rcirc-target new-nick)
+ (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t))
(setf rcirc-buffer-alist
(cons (cons new-nick chat-buffer)
(delq (assoc-string old-nick rcirc-buffer-alist t)
@@ -3326,7 +3473,7 @@ PROCESS is the process object for the current connection."
;; if this is our nick...
(when (string= old-nick rcirc-nick)
(setq rcirc-nick new-nick)
- (rcirc-update-prompt t)
+ (rcirc-update-prompt t)
;; reauthenticate
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
@@ -3356,16 +3503,16 @@ PROCESS is the process object for the current
connection."
ARGS should have the form (NICK AWAY-MESSAGE).
PROCESS is the process object for the current connection."
(let* ((nick (cadr args))
- (rec (assoc-string nick rcirc-nick-away-alist))
- (away-message (nth 2 args)))
+ (rec (assoc-string nick rcirc-nick-away-alist))
+ (away-message (nth 2 args)))
(when (or (not rec)
- (not (string= (cdr rec) away-message)))
+ (not (string= (cdr rec) away-message)))
;; away message has changed
(rcirc-handler-generic process "AWAY" nick (cdr args) text)
(if rec
- (setcdr rec away-message)
- (setq rcirc-nick-away-alist (cons (cons nick away-message)
- rcirc-nick-away-alist))))))
+ (setcdr rec away-message)
+ (setq rcirc-nick-away-alist (cons (cons nick away-message)
+ rcirc-nick-away-alist))))))
(defun rcirc-handler-317 (process sender args _text)
"Handle idle messages from SENDER (RPL_WHOISIDLE).
@@ -3374,7 +3521,7 @@ PROCESS is the process object for the current connection."
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
(idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs))
- (signon-time (string-to-number (nth 3 args)))
+ (signon-time (string-to-number (nth 3 args)))
(signon-string (format-time-string "%c" signon-time))
(message (format "%s idle for %s, signed on %s"
nick idle-string signon-string)))
@@ -3385,7 +3532,7 @@ PROCESS is the process object for the current connection."
ARGS should have the form (CHANNEL TOPIC).
PROCESS is the process object for the current connection."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
- (rcirc-get-temp-buffer-create process (cadr args)))))
+ (rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
(setq rcirc-topic (nth 2 args)))))
@@ -3396,13 +3543,13 @@ ARGS has the form (CHANNEL SETTER TIME). SENDER is
passed on to
connection. This is a non-standard extension, not specified in
RFC1459."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
- (rcirc-get-temp-buffer-create process (cadr args)))))
+ (rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
(let ((setter (nth 2 args))
- (time (current-time-string
- (string-to-number (cadddr args)))))
- (rcirc-print process sender "TOPIC" (cadr args)
- (format "%s (%s on %s)" rcirc-topic setter time))))))
+ (time (current-time-string
+ (string-to-number (cadddr args)))))
+ (rcirc-print process sender "TOPIC" (cadr args)
+ (format "%s (%s on %s)" rcirc-topic setter time))))))
(defun rcirc-handler-477 (process sender args _text)
"Notify user that CHANNEL does not support modes (ERR_NOCHANMODES).
@@ -3426,9 +3573,9 @@ PROCESS is the process object for the current connection."
;; print in private chat buffers if they exist
(mapc (lambda (nick)
- (when (rcirc-get-buffer process nick)
- (rcirc-print process sender "MODE" nick msg)))
- (cddr args))))
+ (when (rcirc-get-buffer process nick)
+ (rcirc-print process sender "MODE" nick msg)))
+ (cddr args))))
(defun rcirc-get-temp-buffer-create (process channel)
"Return a buffer based on PROCESS and CHANNEL."
@@ -3440,7 +3587,7 @@ PROCESS is the process object for the current connection."
ARGS should have the form (TYPE CHANNEL . NICK-LIST).
PROCESS is the process object for the current connection."
(let ((channel (nth 2 args))
- (names (or (nth 3 args) "")))
+ (names (or (nth 3 args) "")))
(mapc (lambda (nick)
(rcirc-put-nick-channel process nick channel))
(split-string names " " t))
@@ -3459,7 +3606,7 @@ PROCESS is the process object for the current connection."
(with-current-buffer buffer
(rcirc-print process sender "NAMES" channel
(let ((content (buffer-substring (point-min) (point-max))))
- (rcirc-sort-nicknames-join content " "))))
+ (rcirc-sort-nicknames-join content " "))))
(kill-buffer buffer)))
(defun rcirc-handler-433 (process sender args text)
@@ -3507,11 +3654,11 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(with-rcirc-server-buffer
(dolist (i rcirc-authinfo)
(let ((process (rcirc-buffer-process))
- (server (car i))
- (nick (nth 2 i))
- (method (cadr i))
- (args (cdddr i)))
- (when (and (string-match server rcirc-server))
+ (server (car i))
+ (nick (nth 2 i))
+ (method (cadr i))
+ (args (cdddr i)))
+ (when (and (string-match server rcirc-server))
(if (and (memq method '(nickserv chanserv bitlbee))
(string-match nick rcirc-nick))
;; the following methods rely on the user's nickname.
@@ -3581,12 +3728,12 @@ current connection."
(if (not (fboundp handler))
(rcirc-print process sender "ERROR" target
(format "%s sent unsupported ctcp: %s" sender text)
- t)
+ t)
(funcall handler process target sender args)
(unless (or (string= request "ACTION")
- (string= request "KEEPALIVE"))
- (rcirc-print process sender "CTCP" target
- (format "%s" text) t))))))
+ (string= request "KEEPALIVE"))
+ (rcirc-print process sender "CTCP" target
+ (format "%s" text) t))))))
(defun rcirc-handler-ctcp-VERSION (process _target sender _message)
"Handle a CTCP VERSION message from SENDER.
@@ -3733,7 +3880,7 @@ PROCESS is the process object for the current connection."
'((t :family "Monospace"))
"Face used for monospace text in messages.")
-(defface rcirc-my-nick ; font-lock-function-name-face
+(defface rcirc-my-nick ; font-lock-function-name-face
'((((class color) (min-colors 88) (background light)) :foreground "Blue1")
(((class color) (min-colors 88) (background dark)) :foreground
"LightSkyBlue")
(((class color) (min-colors 16) (background light)) :foreground "Blue")
@@ -3742,7 +3889,7 @@ PROCESS is the process object for the current connection."
(t :inverse-video t :weight bold))
"Rcirc face for my messages.")
-(defface rcirc-other-nick ; font-lock-variable-name-face
+(defface rcirc-other-nick ; font-lock-variable-name-face
'((((class grayscale) (background light))
:foreground "Gray90" :weight bold :slant italic)
(((class grayscale) (background dark))
@@ -3772,7 +3919,7 @@ PROCESS is the process object for the current connection."
'((t :inherit default))
"Rcirc face for nicks in `rcirc-dim-nicks'.")
-(defface rcirc-server ; font-lock-comment-face
+(defface rcirc-server ; font-lock-comment-face
'((((class grayscale) (background light))
:foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
@@ -3790,7 +3937,7 @@ PROCESS is the process object for the current connection."
(t :weight bold :slant italic))
"Rcirc face for server messages.")
-(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
+(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
'((default :inherit rcirc-server)
(((class grayscale)))
(((class color) (min-colors 16)))
@@ -3804,7 +3951,7 @@ PROCESS is the process object for the current connection."
'((t :inherit default))
"Rcirc face for timestamps.")
-(defface rcirc-nick-in-message ; font-lock-keyword-face
+(defface rcirc-nick-in-message ; font-lock-keyword-face
'((((class grayscale) (background light)) :foreground "LightGray" :weight
bold)
(((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
(((class color) (min-colors 88) (background light)) :foreground "Purple")
@@ -3818,7 +3965,7 @@ PROCESS is the process object for the current connection."
(defface rcirc-nick-in-message-full-line '((t :weight bold))
"Rcirc face for emphasizing the entire message when your nick is mentioned.")
-(defface rcirc-prompt ; comint-highlight-prompt
+(defface rcirc-prompt ; comint-highlight-prompt
'((((min-colors 88) (background dark)) :foreground "cyan1")
(((background dark)) :foreground "cyan")
(t :foreground "dark blue"))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 248faeb223..75992bc62a 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -295,6 +295,11 @@ and other things:
(make-composed-keymap shr-map image-map)
shr-map))
+(defvar shr-url-transformer #'identity
+ "Function to transform URLs.
+It's called with the URL as the parameter, and should return the
+ URL to use.")
+
;; Public functions and commands.
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
@@ -368,7 +373,6 @@ DOM should be a parse tree as generated by
shr-width
(* shr-width (frame-char-width)))
(shr--window-width)))
- (max-specpdl-size max-specpdl-size)
(shr--link-targets nil)
(hscroll (window-hscroll))
;; `bidi-display-reordering' is supposed to be only used for
@@ -499,7 +503,7 @@ Value is a pair of positions (START . END) if there is a
non-nil
(defun shr-next-link ()
"Skip to the next link."
(interactive)
- (let ((match (text-property-search-forward 'shr-url nil nil t)))
+ (let ((match (text-property-search-forward 'shr-tab-stop nil nil t)))
(if (not match)
(message "No next link")
(goto-char (prop-match-beginning match))
@@ -508,7 +512,7 @@ Value is a pair of positions (START . END) if there is a
non-nil
(defun shr-previous-link ()
"Skip to the previous link."
(interactive)
- (if (not (text-property-search-backward 'shr-url nil nil t))
+ (if (not (text-property-search-backward 'shr-tab-stop nil nil t))
(message "No previous link")
(message "%s" (get-text-property (point) 'help-echo))))
@@ -620,41 +624,34 @@ size, and full-buffer size."
(shr-stylesheet shr-stylesheet)
(shr-depth (1+ shr-depth))
(start (point)))
- ;; shr uses many frames per nested node.
- (if (and (> shr-depth (/ max-specpdl-size 15))
- (not (and shr-offer-extend-specpdl
- (y-or-n-p "Too deeply nested to render properly;
increase `max-specpdl-size'?")
- (setq max-specpdl-size (* max-specpdl-size 2)))))
- (setq shr-warning
- "Not rendering the complete page because of too-deep nesting")
+ (when style
+ (if (string-match-p "color\\|display\\|border-collapse" style)
+ (setq shr-stylesheet (nconc (shr-parse-style style)
+ shr-stylesheet))
+ (setq style nil)))
+ ;; If we have a display:none, then just ignore this part of the DOM.
+ (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none")
+ (and shr-discard-aria-hidden
+ (equal (dom-attr dom 'aria-hidden) "true")))
+ ;; We don't use shr-indirect-call here, since shr-descend is
+ ;; the central bit of shr.el, and should be as fast as
+ ;; possible. Having one more level of indirection with its
+ ;; negative effect on performance is deemed unjustified in
+ ;; this case.
+ (cond (external
+ (funcall external dom))
+ ((fboundp function)
+ (funcall function dom))
+ (t
+ (shr-generic dom)))
+ (when-let ((id (dom-attr dom 'id)))
+ (push (cons id (set-marker (make-marker) start)) shr--link-targets))
+ ;; If style is set, then this node has set the color.
(when style
- (if (string-match-p "color\\|display\\|border-collapse" style)
- (setq shr-stylesheet (nconc (shr-parse-style style)
- shr-stylesheet))
- (setq style nil)))
- ;; If we have a display:none, then just ignore this part of the DOM.
- (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none")
- (and shr-discard-aria-hidden
- (equal (dom-attr dom 'aria-hidden) "true")))
- ;; We don't use shr-indirect-call here, since shr-descend is
- ;; the central bit of shr.el, and should be as fast as
- ;; possible. Having one more level of indirection with its
- ;; negative effect on performance is deemed unjustified in
- ;; this case.
- (cond (external
- (funcall external dom))
- ((fboundp function)
- (funcall function dom))
- (t
- (shr-generic dom)))
- (when-let ((id (dom-attr dom 'id)))
- (push (cons id (set-marker (make-marker) start)) shr--link-targets))
- ;; If style is set, then this node has set the color.
- (when style
- (shr-colorize-region
- start (point)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet))))))))
+ (shr-colorize-region
+ start (point)
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color shr-stylesheet)))))))
(defun shr-fill-text (text)
(if (zerop (length text))
@@ -1019,6 +1016,8 @@ the mouse click event."
(widen)
(let ((alt (buffer-substring start end))
(properties (text-properties-at start))
+ ;; We don't want to record these changes.
+ (buffer-undo-list t)
(inhibit-read-only t))
(delete-region start end)
(goto-char start)
@@ -1216,6 +1215,7 @@ START, and END. Note that START and END should be
markers."
(add-text-properties
start (point)
(list 'shr-url url
+ 'shr-tab-stop t
'button t
'category 'shr ; For button.el button buffers.
'help-echo (let ((parsed (url-generic-parse-url
@@ -1487,7 +1487,9 @@ ones, in case fg and bg are nil."
(dom-attr dom 'name)))) ; Obsolete since HTML5.
(push (cons id (set-marker (make-marker) start)) shr--link-targets))
(when url
- (shr-urlify (or shr-start start) (shr-expand-url url) title)
+ (shr-urlify (or shr-start start)
+ (funcall shr-url-transformer (shr-expand-url url))
+ title)
;; Check whether the URL is suspicious.
(when-let ((warning (or (textsec-suspicious-p
(shr-expand-url url) 'url)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index a39e35a53a..b2caa62e51 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -167,7 +167,52 @@ Valid states are `closed', `initial', `nonauth', and
`auth'.")
(defvar sieve-manage-capability nil)
;; Internal utility functions
-(autoload 'mm-enable-multibyte "mm-util")
+(defun sieve-manage--append-to-log (&rest args)
+ "Append ARGS to sieve-manage log buffer.
+
+ARGS can be a string or a list of strings.
+The buffer to use for logging is specifified via
+`sieve-manage-log'. If it is nil, logging is disabled."
+ (when sieve-manage-log
+ (with-current-buffer (or (get-buffer sieve-manage-log)
+ (with-current-buffer
+ (get-buffer-create sieve-manage-log)
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)))
+ (goto-char (point-max))
+ (apply #'insert args))))
+
+(defun sieve-manage--message (format-string &rest args)
+ "Wrapper around `message' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((ret (apply #'message
+ (concat "sieve-manage: " format-string)
+ args)))
+ (sieve-manage--append-to-log ret "\n")
+ ret))
+
+(defun sieve-manage--error (format-string &rest args)
+ "Wrapper around `error' which also logs to sieve manage log.
+
+See `sieve-manage--append-to-log'."
+ (let ((msg (apply #'format
+ (concat "sieve-manage/ERROR: " format-string)
+ args)))
+ (sieve-manage--append-to-log msg "\n")
+ (error msg)))
+
+(defun sieve-manage-encode (utf8-string)
+ "Convert UTF8-STRING to managesieve protocol octets."
+ (encode-coding-string utf8-string 'raw-text t))
+
+(defun sieve-manage-decode (octets &optional buffer)
+ "Convert managesieve protocol OCTETS to utf-8 string.
+
+If optional BUFFER is non-nil, insert decoded string into BUFFER."
+ (when octets
+ ;; eol type unix is required to preserve "\r\n"
+ (decode-coding-string octets 'utf-8-unix t buffer)))
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
@@ -175,22 +220,19 @@ Valid states are `closed', `initial', `nonauth', and
`auth'.")
sieve-manage-server
sieve-manage-port))
(mapc #'make-local-variable sieve-manage-local-variables)
- (mm-enable-multibyte)
+ (set-buffer-multibyte nil)
+ (setq-local after-change-functions nil)
(buffer-disable-undo)
(current-buffer)))
(defun sieve-manage-erase (&optional p buffer)
- (let ((buffer (or buffer (current-buffer))))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer (with-current-buffer buffer
- (point-min))
- (or p (with-current-buffer buffer
- (point-max)))))))
- (delete-region (point-min) (or p (point-max))))
+ (with-current-buffer (or buffer (current-buffer))
+ (let* ((start (point-min))
+ (end (or p (point-max)))
+ (logdata (buffer-substring-no-properties start end)))
+ (sieve-manage--append-to-log logdata)
+ (delete-region start end)
+ logdata)))
(defun sieve-manage-open-server (server port &optional stream buffer)
"Open network connection to SERVER on PORT.
@@ -202,6 +244,8 @@ Return the buffer associated with the connection."
(open-network-stream
"SIEVE" buffer server port
:type stream
+ ;; eol type unix is required to preserve "\r\n"
+ :coding 'raw-text-unix
:capability-command "CAPABILITY\r\n"
:end-of-command "^\\(OK\\|NO\\).*\n"
:success "^OK.*\n"
@@ -224,7 +268,7 @@ Return the buffer associated with the connection."
;; Authenticators
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
- (message "sieve: Authenticating using %s..." mech)
+ (sieve-manage--message "Authenticating using %s..." mech)
(with-current-buffer buffer
(let* ((auth-info (auth-source-search :host sieve-manage-server
:port "sieve"
@@ -275,11 +319,15 @@ Return the buffer associated with the connection."
(if (and (setq step (sasl-next-step client step))
(setq data (sasl-step-data step)))
;; We got data for server but it's finished
- (error "Server not ready for SASL data: %s" data)
+ (sieve-manage--error
+ "Server not ready for SASL data: %s" data)
;; The authentication process is finished.
+ (sieve-manage--message "Logged in as %s using %s"
+ user-name mech)
(throw 'done t)))
(unless (stringp rsp)
- (error "Server aborted SASL authentication: %s" (caddr rsp)))
+ (sieve-manage--error
+ "Server aborted SASL authentication: %s" (caddr rsp)))
(sasl-step-set-data step (base64-decode-string rsp))
(setq step (sasl-next-step client step))
(sieve-manage-send
@@ -288,8 +336,7 @@ Return the buffer associated with the connection."
(base64-encode-string (sasl-step-data step)
'no-line-break)
"\"")
- ""))))
- (message "sieve: Login using %s...done" mech))))
+ "")))))))
(defun sieve-manage-cram-md5-p (buffer)
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -338,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.
@@ -353,7 +400,7 @@ to work in."
sieve-manage-default-stream)
sieve-manage-auth (or auth
sieve-manage-auth))
- (message "sieve: Connecting to %s..." sieve-manage-server)
+ (sieve-manage--message "Connecting to %s..." sieve-manage-server)
(sieve-manage-open-server sieve-manage-server
sieve-manage-port
sieve-manage-stream
@@ -368,7 +415,8 @@ to work in."
(setq sieve-manage-auth auth)
(cl-return)))
(unless sieve-manage-auth
- (error "Couldn't figure out authenticator for server")))
+ (sieve-manage--error
+ "Couldn't figure out authenticator for server")))
(sieve-manage-erase)
(current-buffer))))
@@ -433,11 +481,7 @@ If NAME is nil, return the full server list of
capabilities."
(defun sieve-manage-putscript (name content &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
- ;; Here we assume that the coding-system will
- ;; replace each char with a single byte.
- ;; This is always the case if `content' is
- ;; a unibyte string.
- (length content)
+ (length (sieve-manage-encode content))
sieve-manage-client-eol content))
(sieve-manage-parse-okno)))
@@ -449,11 +493,10 @@ If NAME is nil, return the full server list of
capabilities."
(defun sieve-manage-getscript (name output-buffer &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
- (let ((script (sieve-manage-parse-string)))
- (sieve-manage-parse-crlf)
- (with-current-buffer output-buffer
- (insert script))
- (sieve-manage-parse-okno))))
+ (sieve-manage-decode (sieve-manage-parse-string)
+ output-buffer)
+ (sieve-manage-parse-crlf)
+ (sieve-manage-parse-okno)))
(defun sieve-manage-setactive (name &optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -478,6 +521,9 @@ If NAME is nil, return the full server list of
capabilities."
(defun sieve-manage-ok-p (rsp)
(string= (downcase (or (car-safe rsp) "")) "ok"))
+(defun sieve-manage-no-p (rsp)
+ (string= (downcase (or (car-safe rsp) "")) "no"))
+
(defun sieve-manage-is-okno ()
(when (looking-at (concat
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
@@ -528,7 +574,11 @@ to local variable `sieve-manage-capability'."
(while (null rsp)
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min))
- (setq rsp (sieve-manage-is-string)))
+ (unless (setq rsp (sieve-manage-is-string))
+ (when (sieve-manage-no-p (sieve-manage-is-okno))
+ ;; simple `error' is enough since `sieve-manage-erase'
+ ;; already adds the server response to the log
+ (error (sieve-manage-erase)))))
(sieve-manage-erase (point))
rsp))
@@ -540,7 +590,8 @@ to local variable `sieve-manage-capability'."
(let (tmp rsp data)
(while (null rsp)
(while (null (or (setq rsp (sieve-manage-is-okno))
- (setq tmp (sieve-manage-is-string))))
+ (setq tmp (sieve-manage-decode
+ (sieve-manage-is-string)))))
(accept-process-output (get-buffer-process (current-buffer)) 1)
(goto-char (point-min)))
(when tmp
@@ -559,13 +610,9 @@ to local variable `sieve-manage-capability'."
rsp)))
(defun sieve-manage-send (cmdstr)
- (setq cmdstr (concat cmdstr sieve-manage-client-eol))
- (and sieve-manage-log
- (with-current-buffer (get-buffer-create sieve-manage-log)
- (mm-enable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (setq cmdstr (sieve-manage-encode
+ (concat cmdstr sieve-manage-client-eol)))
+ (sieve-manage--append-to-log cmdstr)
(process-send-string sieve-manage-process cmdstr))
(provide 'sieve-manage)
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index f62af03534..695a3235a7 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -200,7 +200,13 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(let ((depth (car (syntax-ppss))))
(when (looking-at "[ \t]*}")
(setq depth (1- depth)))
- (indent-line-to (* 2 depth)))))
+ (indent-line-to (* 2 depth))))
+ ;; Skip to the end of the indentation if at the beginning of the
+ ;; line.
+ (when (save-excursion
+ (skip-chars-backward " \t")
+ (bolp))
+ (skip-chars-forward " \t")))
(provide 'sieve-mode)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 3a6067ee10..c2faeaef54 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -152,7 +152,8 @@ require \"fileinto\";
(interactive)
(sieve-manage-close sieve-manage-buffer)
(kill-buffer sieve-manage-buffer)
- (kill-buffer (current-buffer)))
+ (when-let ((buffer (get-buffer sieve-buffer)))
+ (kill-buffer buffer)))
(defun sieve-bury-buffer ()
"Bury the Manage Sieve buffer without closing the connection."
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index be231fcba6..49cbf526ec 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -55,7 +55,7 @@ It is used for TCP/IP devices."
(defconst tramp-adb-method "adb"
"When this method name is used, forward all calls to Android Debug Bridge.")
-(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
+(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank)
"Regexp used as prompt in almquist shell."
:type 'regexp
:version "28.1"
@@ -63,31 +63,30 @@ It is used for TCP/IP devices."
(eval-and-compile
(defconst tramp-adb-ls-date-year-regexp
- "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}"
+ (rx (= 4 digit) "-" (= 2 digit) "-" (= 2 digit))
"Regexp for date year format in ls output."))
(eval-and-compile
- (defconst tramp-adb-ls-date-time-regexp
- "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}"
+ (defconst tramp-adb-ls-date-time-regexp (rx (= 2 digit) ":" (= 2 digit))
"Regexp for date time format in ls output."))
(defconst tramp-adb-ls-date-regexp
- (concat
- "[[:space:]]" tramp-adb-ls-date-year-regexp
- "[[:space:]]" tramp-adb-ls-date-time-regexp
- "[[:space:]]")
+ (tramp-compat-rx
+ blank (regexp tramp-adb-ls-date-year-regexp)
+ blank (regexp tramp-adb-ls-date-time-regexp)
+ blank)
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
- (concat
- "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions
- "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
- "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
- "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
- "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp
- "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date
- "[[:space:]]\\(.*\\)$") ; \6 filename
+ (tramp-compat-rx
+ bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions
+ (? (+ blank) (+ digit)) ; links (Android 7/toybox)
+ (* blank) (group (+ (not blank))) ; \2 username
+ (+ blank) (group (+ (not blank))) ; \3 group
+ (+ blank) (group (+ digit)) ; \4 size
+ (+ blank) (group (regexp tramp-adb-ls-date-year-regexp)
+ blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date
+ blank (group (* nonl)) eol) ; \6 filename
"Regexp for ls output.")
;;;###tramp-autoload
@@ -130,7 +129,7 @@ It is used for TCP/IP devices."
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-adb-handle-file-executable-p)
- (file-exists-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-adb-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
@@ -183,6 +182,7 @@ It is used for TCP/IP devices."
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . ignore)
(tramp-get-remote-gid . tramp-adb-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-adb-handle-get-remote-groups)
(tramp-get-remote-uid . tramp-adb-handle-get-remote-uid)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -220,7 +220,8 @@ arguments to pass to the OPERATION."
(delq nil
(mapcar
(lambda (line)
- (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
+ (when (string-match
+ (rx bol (group (+ (not blank))) (+ blank) "device" eol) line)
;; Replace ":" by "#".
`(nil ,(tramp-compat-string-replace
":" tramp-prefix-port-format (match-string 1 line)))))
@@ -237,10 +238,10 @@ arguments to pass to the OPERATION."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (* blank) (+ (not blank))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
(list (* 1024 (string-to-number (match-string 1)))
@@ -280,10 +281,10 @@ arguments to pass to the OPERATION."
(name (match-string 6))
(symlink-target
(and is-symlink
- (cadr (split-string name "\\( -> \\|\n\\)")))))
+ (cadr (split-string name (rx (| " -> " "\n")))))))
(push (list
(if is-symlink
- (car (split-string name "\\( -> \\|\n\\)"))
+ (car (split-string name (rx (| " -> " "\n"))))
name)
(or is-dir symlink-target)
1 ;link-count
@@ -315,7 +316,7 @@ arguments to pass to the OPERATION."
(tramp-shell-quote-argument localname)))
;; We insert also filename/. and filename/.., because "ls"
;; doesn't on some file systems, like "sdcard".
- (unless (re-search-backward "\\.$" nil t)
+ (unless (re-search-backward (rx "." eol) nil t)
(narrow-to-region (point-max) (point-max))
(tramp-adb-send-command
v (format "%s -d -a -l %s %s | cat"
@@ -325,9 +326,8 @@ arguments to pass to the OPERATION."
(tramp-shell-quote-argument
(tramp-compat-file-name-concat localname ".."))))
(tramp-compat-replace-regexp-in-region
- (regexp-quote
- (tramp-compat-file-name-unquote
- (file-name-as-directory localname)))
+ (tramp-compat-rx (literal (tramp-compat-file-name-unquote
+ (file-name-as-directory localname))))
"" (point-min))
(widen)))
(tramp-adb-sh-fix-ls-output)
@@ -365,16 +365,14 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
- (eval-when-compile
- (concat
- "[[:space:]]"
- "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)"))
+ (tramp-compat-rx
+ blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank))
nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
(when (looking-at-p
- (eval-when-compile
- (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$")))
+ (tramp-compat-rx
+ (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol))
(end-of-line)
(insert "/")))
;; Sort entries.
@@ -472,7 +470,8 @@ Emacs dired can't find files."
(delq
nil
(mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (lambda (l)
+ (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(split-string (buffer-string) "\n")))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
@@ -492,26 +491,52 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
- (tramp-adb-send-command-and-check
- v (format "test -x %s" (tramp-shell-quote-argument localname))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-adb-send-command-and-check
+ v (format "test -x %s" (tramp-shell-quote-argument localname)))))))
+
+(defun tramp-adb-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ ;; `file-exists-p' is used as predicate in file name completion.
+ ;; We don't want to run it when `non-essential' is t, or there is
+ ;; no connection process yet.
+ (when (tramp-connectable-p filename)
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-adb-send-command-and-check
+ v (format "test -e %s" (tramp-shell-quote-argument localname))))))))
(defun tramp-adb-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-adb-send-command-and-check
- v (format "test -r %s" (tramp-shell-quote-argument localname)))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-adb-send-command-and-check
+ v (format "test -r %s" (tramp-shell-quote-argument localname)))))))
(defun tramp-adb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname)))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ ;; If file doesn't exist, check if directory is writable.
(and
(file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
@@ -723,10 +748,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setcar result 0)
(dolist (line signals)
(when (string-match
- (concat
- "^[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\S-+[[:space:]]+"
- "\\([[:alpha:]].*\\)$")
+ (rx bol (* blank) (group (+ digit))
+ (+ blank) (+ (not blank))
+ (+ blank) (group alpha (* nonl)) eol)
line)
(setcar
(nthcdr (string-to-number (match-string 1 line)) result)
@@ -924,7 +948,7 @@ implementation will be used."
(i 0)
p)
- (when (string-match-p "[[:multibyte:]]" command)
+ (when (string-match-p (tramp-compat-rx multibyte) command)
(tramp-error
v 'file-error "Cannot apply multi-byte command `%s'" command))
@@ -997,7 +1021,7 @@ implementation will be used."
(while
(progn
(goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
+ (not (search-forward "\n" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point)))
;; Provide error buffer. This shows only
@@ -1046,32 +1070,23 @@ implementation will be used."
(defun tramp-adb-handle-get-remote-uid (vec id-format)
"Like `tramp-get-remote-uid' for Tramp files.
ID-FORMAT valid values are `string' and `integer'."
- ;; The result is cached in `tramp-get-remote-uid'.
- (tramp-adb-send-command
- vec
- (format "id -u%s %s"
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer))))
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format)))
(defun tramp-adb-handle-get-remote-gid (vec id-format)
"Like `tramp-get-remote-gid' for Tramp files.
ID-FORMAT valid values are `string' and `integer'."
- ;; The result is cached in `tramp-get-remote-gid'.
- (tramp-adb-send-command
- vec
- (format "id -g%s %s"
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer))))
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format)))
+
+(defun tramp-adb-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format)))
(defun tramp-adb-get-device (vec)
"Return full host name from VEC to be used in shell execution.
@@ -1125,7 +1140,7 @@ error and non-nil on success."
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
- (if (string-match-p "[[:multibyte:]]" command)
+ (if (string-match-p (tramp-compat-rx multibyte) command)
;; Multibyte codepoints with four bytes are not supported at
;; least by toybox.
@@ -1149,12 +1164,12 @@ error and non-nil on success."
;; We can't use stty to disable echo of command. stty is said
;; to be added to toybox 0.7.6. busybox shall have it, but this
;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
+ (delete-matching-lines (tramp-compat-rx bol (literal command) eol))
;; When the local machine is W32, there are still trailing ^M.
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
(goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
+ (while (re-search-forward (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
@@ -1170,7 +1185,7 @@ the exit status."
(format "%s; echo tramp_exit_status $?" command)
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -1198,7 +1213,7 @@ FMT and ARGS are passed to `error'."
(let ((inhibit-read-only t))
(goto-char (point-min))
;; ADB terminal sends "^H" sequences.
- (when (re-search-forward "<\b+" (line-end-position) t)
+ (when (re-search-forward (rx "<" (+ "\b")) (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
;; Delete the prompt.
@@ -1232,7 +1247,7 @@ connection if a previous connection has died for some
reason."
;; Maybe we know already that "su" is not supported. We cannot
;; use a connection property, because we have not checked yet
;; whether it is still the same device.
- (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
+ (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t)))
(tramp-error vec 'file-error "Cannot switch to user `%s'" user))
(unless (process-live-p p)
@@ -1272,7 +1287,7 @@ connection if a previous connection has died for some
reason."
;; Change prompt.
(tramp-set-connection-property
- p "prompt" (regexp-quote (format "///%s#$" prompt)))
+ p "prompt" (tramp-compat-rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
@@ -1317,7 +1332,7 @@ connection if a previous connection has died for some
reason."
(unless (tramp-adb-send-command-and-check vec nil)
(delete-process p)
;; Do not flush, we need the nil value.
- (tramp-set-file-property vec "" "su-command-p" nil)
+ (tramp-set-file-property vec "/" "su-command-p" nil)
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 548999ca1d..646ae86452 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -112,8 +112,10 @@
(eval-when-compile (require 'cl-lib))
;; Sometimes, compilation fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
-(eval-and-compile
- (let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
+(with-no-warnings ;; max-specpdl-size
+ (eval-and-compile
+ (let ((max-specpdl-size (* 2 max-specpdl-size)))
+ (require 'tramp-gvfs))))
(autoload 'dired-uncache "dired")
(autoload 'url-tramp-convert-url-to-tramp "url-tramp")
@@ -168,7 +170,8 @@
It must be supported by libarchive(3).")
;; <https://unix-memo.readthedocs.io/en/latest/vfs.html>
-;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar,
mtree, iso9660, compress.
+;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip,
+;; lzma, ar, mtree, iso9660, compress.
;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab.
;;;###autoload
@@ -183,18 +186,22 @@ It must be supported by libarchive(3).")
;;;###autoload
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
- '(concat
- "\\`" "\\(" ".+" "\\."
- ;; Default suffixes ...
- (regexp-opt tramp-archive-suffixes)
- ;; ... with compression.
- "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
- "\\)" ;; \1
- "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
+ `(rx
+ bos
+ ;; This group is used in `tramp-archive-file-name-archive'.
+ (group
+ (+ nonl)
+ ;; Default suffixes ...
+ "." ,(cons '| tramp-archive-suffixes)
+ ;; ... with compression.
+ (? "." ,(cons '| tramp-archive-compression-suffixes)))
+ ;; This group is used in `tramp-archive-file-name-localname'.
+ (group "/" (* nonl))
+ eos)))
(put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t)
-;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
+;; In older Emacs (prior 27.1), `tramp-archive-autoload-file-name-regexp'
;; is not autoloaded. So we cannot expect it to be known in
;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
;;;###tramp-autoload
@@ -293,6 +300,7 @@ It must be supported by libarchive(3).")
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
(tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -324,7 +332,7 @@ arguments to pass to the OPERATION."
;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
;; autoloaded. But it must still be in tramp-loaddefs.el for older
-;; Emacsen.
+;; versions of Emacs.
;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archive")
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
@@ -337,6 +345,7 @@ arguments to pass to the OPERATION."
(tramp-register-file-name-handlers)
(tramp-archive-run-real-handler operation args))
+ (with-no-warnings ;; max-specpdl-size
(let* ((filename (apply #'tramp-archive-file-name-for-operation
operation args))
(archive (tramp-archive-file-name-archive filename))
@@ -370,7 +379,7 @@ arguments to pass to the OPERATION."
(setq args (cons operation args)))
(if fn
(save-match-data (apply (cdr fn) args))
- (tramp-archive-run-real-handler operation args)))))))
+ (tramp-archive-run-real-handler operation args))))))))
;;;###autoload
(progn (defun tramp-archive-autoload-file-name-handler (operation &rest args)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 289df2f9aa..912ea5f8bb 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -28,7 +28,7 @@
;; An implementation of information caching for remote files.
;; Each connection, identified by a `tramp-file-name' structure or by
-;; a process, has a unique cache. We distinguish 4 kind of caches,
+;; a process, has a unique cache. We distinguish 6 kind of caches,
;; depending on the key:
;;
;; - localname is nil. These are reusable properties. Examples:
@@ -37,10 +37,10 @@
;; host when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
-;; - localname is a string. These are temporary properties, which are
-;; related to the file localname is referring to. Examples:
-;; "file-exists-p" is t or nil, depending on the file existence, or
-;; "file-attributes" caches the result of the function
+;; - localname is an absolute file name. These are temporary
+;; properties, which are related to the file localname is referring
+;; to. Examples: "file-exists-p" is t or nil, depending on the file
+;; existence, or "file-attributes" caches the result of the function
;; `file-attributes'. These entries have a timestamp, and they
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
@@ -56,6 +56,10 @@
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
;; "locale" is the used shell locale.
;;
+;; - The key is `tramp-cache-version'. It keeps the Tramp version the
+;; cache data was produced with. If the cache is read by another
+;; Tramp version, it is flushed.
+;;
;; - The key is `tramp-cache-undefined'. All functions return the
;; expected values, but nothing is cached.
@@ -105,6 +109,10 @@ details see the info pages."
:group 'tramp
:type 'file)
+;;;###tramp-autoload
+(defconst tramp-cache-version (make-tramp-file-name :method "cache")
+"Virtual connection vector for Tramp version.")
+
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
@@ -135,39 +143,41 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
- (let* ((hash (tramp-get-hash-table key))
- (cached (and (hash-table-p hash) (gethash property hash)))
- (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
- (value default)
- cache-used)
-
- (when ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is
- ;; still valid. Otherwise, DEFAULT is set.
- (and (consp cached)
- (or (null remote-file-name-inhibit-cache)
- (and (integerp remote-file-name-inhibit-cache)
- (time-less-p
- nil
- (time-add (car cached) remote-file-name-inhibit-cache)))
- (and (consp remote-file-name-inhibit-cache)
- (time-less-p
- remote-file-name-inhibit-cache (car cached)))))
- (setq value (cdr cached)
- cache-used t))
-
- (tramp-message
- key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
- (tramp-file-name-localname key)
- property value remote-file-name-inhibit-cache cache-used cached-at)
- ;; For analysis purposes, count the number of getting this file attribute.
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (and (boundp var) (numberp (symbol-value var))
- (symbol-value var))
- 0)))
- (set var (1+ val))))
- value))
+ (if (eq key tramp-cache-undefined) default
+ (let* ((hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at
+ (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ cache-used)
+
+ (when ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is
+ ;; still valid. Otherwise, DEFAULT is set.
+ (and (consp cached)
+ (or (null remote-file-name-inhibit-cache)
+ (and (integerp remote-file-name-inhibit-cache)
+ (time-less-p
+ nil
+ (time-add (car cached)
remote-file-name-inhibit-cache)))
+ (and (consp remote-file-name-inhibit-cache)
+ (time-less-p
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ cache-used t))
+
+ (tramp-message
+ key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
+ (tramp-file-name-localname key)
+ property value remote-file-name-inhibit-cache cache-used cached-at)
+ ;; For analysis purposes, count the number of getting this file
attribute.
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-get-count-" property)))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
+ (set var (1+ val))))
+ value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
@@ -180,19 +190,20 @@ Return DEFAULT if not set."
Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
- (let ((hash (tramp-get-hash-table key)))
- ;; We put the timestamp there.
- (puthash property (cons (current-time) value) hash)
- (tramp-message
- key 8 "%s %s %s" (tramp-file-name-localname key) property value)
- ;; For analysis purposes, count the number of setting this file attribute.
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (and (boundp var) (numberp (symbol-value var))
- (symbol-value var))
- 0)))
- (set var (1+ val))))
- value))
+ (if (eq key tramp-cache-undefined) value
+ (let ((hash (tramp-get-hash-table key)))
+ ;; We put the timestamp there.
+ (puthash property (cons (current-time) value) hash)
+ (tramp-message
+ key 8 "%s %s %s" (tramp-file-name-localname key) property value)
+ ;; For analysis purposes, count the number of setting this file
attribute.
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-set-count-" property)))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
+ (set var (1+ val))))
+ value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
@@ -202,19 +213,22 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-file-property-p (key file property)
"Check whether PROPERTY of FILE is defined in the cache context of KEY."
- (not (eq (tramp-get-file-property key file property tramp-cache-undefined)
- tramp-cache-undefined)))
+ (and
+ (not (eq key tramp-cache-undefined))
+ (not (eq (tramp-get-file-property key file property tramp-cache-undefined)
+ tramp-cache-undefined))))
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
- (remhash property (tramp-get-hash-table key))
- (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
- (when (>= tramp-verbose 10)
- (let ((var (intern (concat "tramp-cache-set-count-" property))))
- (makunbound var))))
+ (unless (eq key tramp-cache-undefined)
+ (remhash property (tramp-get-hash-table key))
+ (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
+ (when (>= tramp-verbose 10)
+ (let ((var (intern (concat "tramp-cache-set-count-" property))))
+ (makunbound var)))))
(defun tramp-flush-file-upper-properties (key file)
"Remove some properties of FILE's upper directory."
@@ -224,11 +238,14 @@ Return VALUE."
(file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
- (dolist (property (hash-table-keys (tramp-get-hash-table key)))
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property))))))
+ (unless (eq key tramp-cache-undefined)
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ (rx
+ bos (| "directory-" "file-name-all-completions"
+ "file-entries"))
+ property)
+ (tramp-flush-file-property key file property)))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
@@ -236,14 +253,15 @@ Return VALUE."
(let ((truename (tramp-get-file-property key file "file-truename")))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
- (tramp-message key 8 "%s" (tramp-file-name-localname key))
- (remhash key tramp-cache-data)
- ;; Remove file properties of symlinks.
- (when (and (stringp truename)
- (not (string-equal file (directory-file-name truename))))
- (tramp-flush-file-properties key truename))
- ;; Remove selected properties of upper directory.
- (tramp-flush-file-upper-properties key file)))
+ (unless (eq key tramp-cache-undefined)
+ (tramp-message key 8 "%s" (tramp-file-name-localname key))
+ (remhash key tramp-cache-data)
+ ;; Remove file properties of symlinks.
+ (when (and (stringp truename)
+ (not (string-equal file (directory-file-name truename))))
+ (tramp-flush-file-properties key truename))
+ ;; Remove selected properties of upper directory.
+ (tramp-flush-file-upper-properties key file))))
;;;###tramp-autoload
(defun tramp-flush-directory-properties (key directory)
@@ -277,7 +295,7 @@ Remove also properties of all files in subdirectories."
This is suppressed for temporary buffers."
(save-match-data
(unless (or (null (buffer-name))
- (string-match-p "^\\( \\|\\*\\)" (buffer-name)))
+ (string-match-p (rx bos (| blank "*")) (buffer-name)))
(let ((bfn (if (stringp (buffer-file-name))
(buffer-file-name)
default-directory))
@@ -583,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.
@@ -622,9 +651,16 @@ for all methods. Resulting data are derived from
connection history."
;; initialized properly by side effect.
(unless (tramp-connection-property-p key (car item))
(tramp-set-connection-property key (pop item) (car item)))))))
+ ;; Check Tramp version. Clear cache in case of mismatch.
+ (unless (string-equal
+ (tramp-get-connection-property
+ tramp-cache-version "tramp-version" "")
+ tramp-version)
+ (signal 'file-error nil))
(setq tramp-cache-data-changed nil))
(file-error
- ;; Most likely because the file doesn't exist yet. No message.
+ ;; Most likely because the file doesn't exist yet, or the Tramp
+ ;; version doesn't match. No message.
(clrhash tramp-cache-data))
(error
;; File is corrupted.
@@ -632,6 +668,9 @@ for all methods. Resulting data are derived from
connection history."
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
+;; Initialize the cache version.
+(tramp-set-connection-property tramp-cache-version "tramp-version"
tramp-version)
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-cache 'force)))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index b2a68fc5eb..0442fa7409 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -34,6 +34,7 @@
(declare-function mml-mode "mml")
(declare-function mml-insert-empty-tag "mml")
(declare-function reporter-dump-variable "reporter")
+(defvar mm-7bit-chars)
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
@@ -178,6 +179,10 @@ This includes password cache, file cache, connection
cache, buffers."
;; Flush file and connection cache.
(clrhash tramp-cache-data)
+ ;; Initialize the cache version.
+ (tramp-set-connection-property
+ tramp-cache-version "tramp-version" tramp-version)
+
;; Remove ad-hoc proxies.
(let ((proxies tramp-default-proxies-alist))
(while proxies
@@ -354,7 +359,7 @@ The remote connection identified by SOURCE is flushed by
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
- (regexp-quote (file-remote-p source))))
+ (tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
"Enter new Tramp connection: "
dir default 'confirm init #'file-directory-p)))))
@@ -465,7 +470,7 @@ For details, see `tramp-rename-files'."
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
- (regexp-quote (file-remote-p source))))
+ (tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
(format "Change Tramp connection `%s': " source)
dir default 'confirm init #'file-directory-p)))))
@@ -502,7 +507,7 @@ This is needed if there are compatibility problems."
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
- (dolist (elc (directory-files dir 'full "\\.elc\\'"))
+ (dolist (elc (directory-files dir 'full (rx ".elc" eos)))
(delete-file elc))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)
(let ((inhibit-read-only t))
@@ -604,7 +609,7 @@ buffer in your bug report.
;; There are non-7bit characters to be masked.
(when (and (stringp val)
(string-match-p
- (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
+ (rx-to-string `(not (any ,mm-7bit-chars))) val))
(with-current-buffer reporter-eval-buffer
(set varsym
`(decode-coding-string
@@ -613,20 +618,22 @@ buffer in your bug report.
'raw-text)))))
;; Dump variable.
- (reporter-dump-variable varsym mailbuf)
+ (goto-char (point-max))
+ (save-excursion
+ (reporter-dump-variable varsym mailbuf))
(unless (hash-table-p val)
;; Remove string quotation.
- (forward-line -1)
(when (looking-at
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$")) ;; \4 "
+ (tramp-compat-rx
+ bol (group (* anychar)) "\"" ;; \1 "
+ (group "(base64-decode-string ") "\\" ;; \2 \
+ (group "\"" (* anychar)) "\\" ;; \3 \
+ (group "\")") "\"" eol)) ;; \4 "
(replace-match "\\1\\2\\3\\4")
(beginning-of-line)
- (insert " ;; Variable encoded due to non-printable characters.\n"))
- (forward-line 1))
+ (insert " ;; Variable encoded due to non-printable characters.\n")))
+ (goto-char (point-max))
;; Reset VARSYM to old value.
(with-current-buffer reporter-eval-buffer
@@ -656,21 +663,27 @@ buffer in your bug report.
(erase-buffer)
(insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
(lisp-indent-line)
- (dolist
- (varsym
- (sort
- (append
- (mapcar
- #'intern
- (all-completions "tramp-" (buffer-local-variables buffer)))
- ;; Non-tramp variables of interest.
- '(connection-local-variables-alist default-directory))
- #'string<))
- (reporter-dump-variable varsym elbuf))
+ (dolist (varsym
+ (sort
+ (append
+ (mapcar
+ #'intern
+ (all-completions "tramp-" (buffer-local-variables buffer)))
+ ;; Non-tramp variables of interest.
+ '(connection-local-variables-alist default-directory))
+ #'string<))
+ (reporter-dump-variable varsym elbuf))
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf)))
+ ;; Beautify encoded values.
+ (goto-char (point-min))
+ (while (re-search-forward
+ (rx "'" (group "(decode-coding-string")) nil 'noerror)
+ (replace-match "\\1"))
+ (goto-char (point-max))
+
;; Dump load-path shadows.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
@@ -683,7 +696,7 @@ buffer in your bug report.
(eq major-mode 'message-mode)
(bound-and-true-p mml-mode))
- (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
+ (let ((tramp-buf-regexp (rx "*" (? "debug ") "tramp/"))
(buffer-list (tramp-list-tramp-buffers))
(curbuf (current-buffer)))
@@ -694,7 +707,7 @@ buffer in your bug report.
(setq buffer-read-only nil)
(goto-char (point-min))
(while (not (eobp))
- (if (re-search-forward tramp-buf-regexp (line-end-position) t)
+ (if (re-search-forward tramp-buf-regexp (line-end-position) t)
(forward-line 1)
(forward-line 0)
(let ((start (point)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 203d3ede98..a1d1d284ed 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -36,6 +36,7 @@
(require 'shell)
(require 'subr-x)
+(declare-function tramp-compat-rx "tramp")
(declare-function tramp-error "tramp")
(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
@@ -49,6 +50,13 @@
(warn "Tramp has been compiled with Emacs %s, this is Emacs %s"
tramp-compat-emacs-compiled-version emacs-version))
+(with-eval-after-load 'docker-tramp
+ (warn (concat "Package `docker-tramp' has been obsoleted, "
+ "please use integrated package `tramp-container'")))
+(with-eval-after-load 'kubernetes-tramp
+ (warn (concat "Package `kubernetes-tramp' has been obsoleted, "
+ "please use integrated package `tramp-container'")))
+
;; For not existing functions, obsolete functions, or functions with a
;; changed argument list, there are compiler warnings. We want to
;; avoid them in cases we know what we do.
@@ -180,6 +188,50 @@ CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
+;; `rx' in Emacs 26 doesn't know the `literal', `anychar' and
+;; `multibyte' constructs. The `not' construct requires an `any'
+;; construct as argument. The `regexp' construct requires a literal
+;; string.
+(defvar tramp-compat-rx--runtime-params)
+
+(defun tramp-compat-rx--transform-items (items)
+ (mapcar #'tramp-compat-rx--transform-item items))
+
+;; There is an error in Emacs 26. `(rx "a" (? ""))' => "a?".
+;; We must protect the string in regexp and literal, therefore.
+(defun tramp-compat-rx--transform-item (item)
+ (pcase item
+ ('anychar 'anything)
+ ('multibyte 'nonascii)
+ (`(not ,expr)
+ (if (consp expr) item (list 'not (list 'any expr))))
+ (`(regexp ,expr)
+ (setq tramp-compat-rx--runtime-params t)
+ `(regexp ,(list '\, `(concat "\\(?:" ,expr "\\)"))))
+ (`(literal ,expr)
+ (setq tramp-compat-rx--runtime-params t)
+ `(regexp ,(list '\, `(concat "\\(?:" (regexp-quote ,expr) "\\)"))))
+ (`(eval . ,_) item)
+ (`(,head . ,rest) (cons head (tramp-compat-rx--transform-items rest)))
+ (_ item)))
+
+(defun tramp-compat-rx--transform (items)
+ (let* ((tramp-compat-rx--runtime-params nil)
+ (new-rx (cons ': (tramp-compat-rx--transform-items items))))
+ (if tramp-compat-rx--runtime-params
+ `(rx-to-string ,(list '\` new-rx) t)
+ (rx-to-string new-rx t))))
+
+(if (ignore-errors (rx-to-string '(literal "a"))) ;; Emacs 27+.
+ (defalias 'tramp-compat-rx #'rx)
+ (defmacro tramp-compat-rx (&rest items)
+ (tramp-compat-rx--transform items)))
+
+;; This is needed for compilation in the Emacs source tree.
+;;;###autoload (defalias 'tramp-compat-rx #'rx)
+
+(put #'tramp-compat-rx 'tramp-autoload t)
+
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
new file mode 100644
index 0000000000..328625b776
--- /dev/null
+++ b/lisp/net/tramp-container.el
@@ -0,0 +1,211 @@
+;;; tramp-container.el --- Tramp integration for Docker-like containers -*-
lexical-binding: t; -*-
+
+;; Copyright © 2022 Free Software Foundation, Inc.
+
+;; Author: Brian Cully <bjc@kublai.com>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; 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:
+
+;; Allows Tramp access to environments provided by Docker and similar
+;; programs.
+;;
+;; ## Usage
+;;
+;; Open a file on a running Docker container:
+;;
+;; C-x C-f /docker:USER@CONTAINER:/path/to/file
+;;
+;; or Podman:
+;;
+;; C-x C-f /podman:USER@CONTAINER:/path/to/file
+;;
+;; Where:
+;; USER is the user on the container to connect as (optional)
+;; CONTAINER is the container to connect to
+;;
+;;
+;; Open file in a Kubernetes container:
+;;
+;; C-x C-f /kubernetes:POD:/path/to/file
+;;
+;; Where:
+;; POD is the pod to connect to.
+;; By default, the first container in that pod will be
+;; used.
+;;
+;; Completion for POD and accessing it operate in the current
+;; namespace, use this command to change it:
+;;
+;; "kubectl config set-context --current --namespace=<name>"
+
+;;; Code:
+
+(require 'tramp)
+
+;;;###tramp-autoload
+(defcustom tramp-docker-program "docker"
+ "Name of the Docker client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "docker")
+ (string)))
+
+;;;###tramp-autoload
+(defcustom tramp-podman-program "podman"
+ "Name of the Podman client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "podman")
+ (string)))
+
+;;;###tramp-autoload
+(defcustom tramp-kubernetes-program "kubectl"
+ "Name of the Kubernetes client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "kubectl")
+ (string)))
+
+;;;###tramp-autoload
+(defconst tramp-docker-method "docker"
+ "Tramp method name to use to connect to Docker containers.")
+
+;;;###tramp-autoload
+(defconst tramp-podman-method "podman"
+ "Tramp method name to use to connect to Podman containers.")
+
+;;;###tramp-autoload
+(defconst tramp-kubernetes-method "kubernetes"
+ "Tramp method name to use to connect to Kubernetes containers.")
+
+;;;###tramp-autoload
+(defun tramp-docker--completion-function (&rest _args)
+ "List Docker-like containers available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (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))
+ (names (mapcar
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (1+ nonl))
+ "\t" (? (group (1+ nonl))) eol)
+ line)
+ (or (match-string 2 line) (match-string 1 line))))
+ lines)))
+ (mapcar (lambda (m) (list nil m)) (delq nil names))))
+
+;;;###tramp-autoload
+(defun tramp-kubernetes--completion-function (&rest _args)
+ "List Kubernetes pods available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (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")))
+ (names (split-string raw-list "\n" 'omit)))
+ (mapcar (lambda (name)
+ (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.
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-docker-method
+ (tramp-login-program ,tramp-docker-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-podman-method
+ (tramp-login-program ,tramp-podman-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-kubernetes-method
+ (tramp-login-program ,tramp-kubernetes-program)
+ (tramp-login-args (("exec")
+ ("%h")
+ ("-it")
+ ("--")
+ ("%l")))
+ (tramp-config-check tramp-kubernetes--current-context-data)
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+
+ (tramp-set-completion-function
+ tramp-docker-method
+ '((tramp-docker--completion-function "")))
+
+ (tramp-set-completion-function
+ tramp-podman-method
+ '((tramp-docker--completion-function "")))
+
+ (tramp-set-completion-function
+ tramp-kubernetes-method
+ '((tramp-kubernetes--completion-function ""))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-container 'force)))
+
+(provide 'tramp-container)
+
+;;; tramp-container.el ends here
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 657437b283..16c4049a68 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -233,6 +233,7 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
(temporary-file-directory . tramp-handle-temporary-file-directory)
;; `tramp-get-home-directory' performed by default-handler.
;; `tramp-get-remote-gid' performed by default handler.
+ ;; `tramp-get-remote-groups' performed by default handler.
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -426,7 +427,7 @@ Otherwise, return NAME."
(if (directory-name-p name) #'file-name-as-directory #'identity)
(concat
dir
- (unless (string-match-p (rx (seq bos (opt "/") eos)) localname)
+ (unless (string-match-p (rx bos (? "/") eos) localname)
(with-tramp-file-property
crypt-vec localname (concat (symbol-name op) "-file-name")
(unless (tramp-crypt-send-command
@@ -437,7 +438,7 @@ Otherwise, return NAME."
(if (eq op 'encrypt) "Encoding" "Decoding") name))
(with-current-buffer (tramp-get-connection-buffer crypt-vec)
(goto-char (point-min))
- (buffer-substring (point-min) (line-end-position)))))))
+ (buffer-substring (point-min) (line-end-position)))))))
;; Nothing to do.
name))
@@ -554,7 +555,7 @@ localname."
(defun tramp-crypt-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
- (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+ (encrypt-regexp (tramp-compat-rx (literal encrypt-filename) eos))
tramp-crypt-enabled)
(condition-case err
(access-file encrypt-filename string)
@@ -583,6 +584,7 @@ This function is invoked by `tramp-crypt-handle-copy-file'
and
`tramp-crypt-handle-rename-file'. It is an error if OP is
neither of `copy' and `rename'. FILENAME and NEWNAME must be
absolute file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -706,7 +708,7 @@ absolute file names."
(mapcar
(lambda (x)
(replace-regexp-in-string
- (concat "^" (regexp-quote directory)) ""
+ (tramp-compat-rx bos (literal directory)) ""
(tramp-crypt-decrypt-file-name x)))
(directory-files (tramp-crypt-encrypt-file-name directory) 'full)))))
@@ -850,6 +852,14 @@ WILDCARD is not supported."
(tramp-compat-funcall
'unlock-file (tramp-crypt-encrypt-file-name filename))))
+(with-eval-after-load 'bookmark
+ (add-hook 'bookmark-inhibit-context-functions
+ #'tramp-crypt-file-name-p)
+ (add-hook 'tramp-crypt-unload-hook
+ (lambda ()
+ (remove-hook 'bookmark-inhibit-context-functions
+ #'tramp-crypt-file-name-p))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-crypt 'force)))
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index dd7e0f9f34..ad736256ca 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -97,9 +97,9 @@ present for backward compatibility."
;; Add some defaults for `tramp-default-method-alist'.
(add-to-list 'tramp-default-method-alist
- (list "\\`ftp\\." nil tramp-ftp-method))
+ (list (rx bos "ftp.") nil tramp-ftp-method))
(add-to-list 'tramp-default-method-alist
- (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
+ (list nil (rx bos (| "anonymous" "ftp") eos) tramp-ftp-method))
;; Add completion function for FTP method.
(tramp-set-completion-function
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index 486a3cc57b..ea6b5a0622 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -51,7 +51,7 @@
"Remove hidden files from FILES."
(if tramp-fuse-remove-hidden-files
(cl-remove-if
- (lambda (x) (and (stringp x) (string-match-p "\\.fuse_hidden" x)))
+ (lambda (x) (and (stringp x) (string-match-p (rx ".fuse_hidden") x)))
files)
files))
@@ -69,10 +69,11 @@
(tramp-fuse-local-file-name directory))))))))
(if full
;; Massage the result.
- (let ((local (concat
- "^" (regexp-quote
- (tramp-fuse-mount-point
- (tramp-dissect-file-name directory)))))
+ (let ((local (tramp-compat-rx
+ bol
+ (literal
+ (tramp-fuse-mount-point
+ (tramp-dissect-file-name directory)))))
(remote (directory-file-name
(funcall
(if (tramp-compat-file-name-quoted-p directory)
@@ -179,8 +180,8 @@ It has the same meaning as
`remote-file-name-inhibit-cache'.")
(tramp-set-file-property
vec "/" "mounted"
(when (string-match
- (format
- "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec)))
+ (tramp-compat-rx
+ bol (group (literal (tramp-fuse-mount-spec vec))) blank)
mount)
(match-string 1 mount)))))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index ca5e959bea..477f8fb3fd 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -316,6 +316,10 @@ It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-password-anonymous-supported 16
"Operation supports anonymous users.")
+;; Since: 2.58
+(defconst tramp-gvfs-password-tcrypt 32
+ "Operation takes TCRYPT parameters.")
+
;; For the time being, we just need org.goa.Account and org.goa.Files
;; interfaces. We document the other ones, just in case.
@@ -410,9 +414,10 @@ It has been changed in GVFS 1.14.")
;; </interface>
(defconst tramp-goa-identity-regexp
- (concat "^" "\\(" tramp-user-regexp "\\)?"
- "@" "\\(" tramp-host-regexp "\\)?"
- "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?")
+ (tramp-compat-rx
+ bol (? (group (regexp tramp-user-regexp)))
+ "@" (? (group (regexp tramp-host-regexp)))
+ (? ":" (group (regexp tramp-port-regexp))))
"Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.")
(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail"
@@ -710,15 +715,16 @@ It has been changed in GVFS 1.14.")
"unix::device")
"GVFS file attributes."))
-(eval-and-compile
- (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t)
"=\\(.+?\\)")
- "Regexp to parse GVFS file attributes with `gvfs-ls'."))
+(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ (tramp-compat-rx
+ blank (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
+ "=" (group (+? nonl)))
+ "Regexp to parse GVFS file attributes with `gvfs-ls'.")
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
+ (tramp-compat-rx
+ bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
+ ":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file attributes with `gvfs-info'.")
(defconst tramp-gvfs-file-system-attributes
@@ -728,16 +734,17 @@ It has been changed in GVFS 1.14.")
"GVFS file system attributes.")
(defconst tramp-gvfs-file-system-attributes-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-system-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
+ (tramp-compat-rx
+ bol (* blank)
+ (group (regexp (regexp-opt tramp-gvfs-file-system-attributes)))
+ ":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file system attributes with `gvfs-info'.")
(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
"Default prefix for owncloud / nextcloud methods.")
(defconst tramp-gvfs-nextcloud-default-prefix-regexp
- (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$")
+ (tramp-compat-rx (literal tramp-gvfs-nextcloud-default-prefix) eol)
"Regexp of default prefix for owncloud / nextcloud methods.")
@@ -820,6 +827,7 @@ It has been changed in GVFS 1.14.")
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . tramp-gvfs-handle-get-home-directory)
(tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -868,7 +876,7 @@ arguments to pass to the OPERATION."
(defun tramp-gvfs-dbus-string-to-byte-array (string)
"Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
(dbus-string-to-byte-array
- (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature)
(concat string (string 0)) string)))
(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
@@ -902,7 +910,7 @@ The call will be traced by Tramp with trace level 6."
(let (result)
(tramp-message vec 6 "%s" (cons func args))
(setq result (apply func args))
- (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
+ (tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result))
result))
(put #'tramp-dbus-function 'tramp-suppress-trace t)
@@ -963,7 +971,7 @@ The global value will always be nil; it is bound where
needed.")
(defun tramp-gvfs-info (filename &optional arg)
"Check FILENAME via `gvfs-info'.
Set file property \"file-exists-p\" with the result."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-set-file-property
v localname "file-exists-p"
(tramp-gvfs-send-command
@@ -986,6 +994,7 @@ This function is invoked by `tramp-gvfs-handle-copy-file'
and
`tramp-gvfs-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -1129,7 +1138,7 @@ file names."
(defun tramp-gvfs-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
@@ -1157,7 +1166,9 @@ file names."
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
;; If there is a default location, expand tilde.
- (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" 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)
@@ -1167,26 +1178,28 @@ file names."
(setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
- (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; We do not pass "/..".
- (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname)
+ (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos)
method)
+ (when (string-match
+ (tramp-compat-rx bos "/" (+ (not "/")) (group "/.." (? "/")))
+ localname)
(setq localname (replace-match "/" t t localname 1)))
- (when (string-match "^/\\.\\./?" localname)
+ (when (string-match (rx bol "/.." (? "/")) localname)
(setq localname (replace-match "/" t t localname))))
;; There might be a double slash. Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../"),
;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ v (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
@@ -1195,7 +1208,7 @@ file names."
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
- (with-parsed-tramp-file-name directory nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "directory-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
@@ -1208,20 +1221,22 @@ file names."
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (looking-at
- (eval-when-compile
- (concat "^\\(.+\\)[[:blank:]]"
- "\\([[:digit:]]+\\)[[:blank:]]"
- "(\\(.+?\\))"
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
+ (tramp-compat-rx
+ bol (group (+ nonl)) blank
+ (group (+ digit)) blank
+ "(" (group (+? nonl)) ")"
+ (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(let ((item (list (cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(cons "name" (match-string 1)))))
(goto-char (1+ (match-end 3)))
(while (looking-at
- (concat
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\|" "$" "\\)"))
+ (tramp-compat-rx
+ (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
+ (group
+ (| (regexp
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
+ eol))))
(push (cons (match-string 1) (match-string 2)) item)
(goto-char (match-end 2)))
;; Add display name as head.
@@ -1239,7 +1254,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property
v localname
(if file-system "file-system-attributes" "file-attributes")
@@ -1266,8 +1281,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(setq localname (tramp-compat-file-name-unquote localname))
- (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (string-match-p "^/?\\([^/]+\\)$" localname))
+ (if (or (and (string-match-p
+ (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method)
+ (string-match-p
+ (tramp-compat-rx bol (? "/") (+ (not "/")) eol) localname))
(string-equal localname "/"))
(tramp-gvfs-get-root-attributes filename)
(assoc
@@ -1297,7 +1314,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; Convert them to multibyte.
(decode-coding-string
(replace-regexp-in-string
- "\\\\x\\([[:xdigit:]]\\{2\\}\\)"
+ (rx "\\x" (group (= 2 xdigit)))
(lambda (x)
(unibyte-string (string-to-number (match-string 1 x) 16)))
res-symlink-target)
@@ -1311,7 +1328,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
+ (number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@@ -1319,7 +1336,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
+ (number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@@ -1396,7 +1413,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
(or (tramp-check-cached-permissions v ?x)
(tramp-check-cached-permissions v ?s)))))
@@ -1467,7 +1484,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(let* ((events (process-get proc 'events))
(rest-string (process-get proc 'rest-string))
(dd (tramp-get-default-directory (process-buffer proc)))
- (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
+ (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd)))))
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
(tramp-message proc 6 "%S\n%s" proc string)
@@ -1481,15 +1498,16 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
- (string-match-p "Monitoring not supported\\|No locations given" string)
+ (string-match-p
+ (rx (| "Monitoring not supported" "No locations given")) string)
(delete-process proc))
(while (string-match
- (eval-when-compile
- (concat "^.+:"
- "[[:space:]]\\(.+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\(.+\\)\\)?$"))
+ (tramp-compat-rx
+ bol (+ nonl) ":"
+ blank (group (+ nonl)) ":"
+ blank (group (regexp (regexp-opt tramp-gio-events)))
+ (? (group blank (group (+ nonl)))) eol)
string)
(let ((file (match-string 1 string))
@@ -1499,11 +1517,11 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
(setq file (replace-match dd nil nil file)))
- (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file)
+ (while (string-match-p (rx "%" (= 2 xdigit)) file)
(setq file (url-unhex-string file)))
(when (string-match ddu (or file1 ""))
(setq file1 (replace-match dd nil nil file1)))
- (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 ""))
+ (while (string-match-p (rx "%" (= 2 xdigit)) (or file1 ""))
(setq file1 (url-unhex-string file1)))
;; Remove watch when file or directory to be watched is deleted.
(when (and (member action '(moved deleted))
@@ -1719,14 +1737,16 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+ (replace-regexp-in-string
+ (tramp-compat-rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1"
+ object-path)))
(defun tramp-gvfs-url-host (url)
"Return the host name part of URL, a string.
We cannot use `url-host', because `url-generic-parse-url' returns
a downcased host name only."
(and (stringp url)
- (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url)
+ (string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url)
(match-string 1 url)))
@@ -1739,7 +1759,8 @@ a downcased host name only."
(pw-prompt
(format
"%s for %s "
- (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message)
+ (if (string-match
+ (rx (group (any "Pp") (| "assword" "assphrase"))) message)
(capitalize (match-string 1 message))
"Password")
filename))
@@ -1861,7 +1882,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(cadr (assoc "ssl" (cadr mount-spec)))))
(uri (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "uri" (cadr mount-spec))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
+ (when (string-match (rx bol (group (| "afp" "smb"))) method)
(setq method (match-string 1 method)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
(setq method "davs"))
@@ -1961,7 +1982,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(or
(cadr (assoc "share" (cadr mount-spec)))
(cadr (assoc "volume" (cadr mount-spec)))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
+ (when (string-match (rx bol (group (| "afp" "smb"))) method)
(setq method (match-string 1 method)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
(setq method "davs"))
@@ -1993,8 +2014,9 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(string-equal domain (tramp-file-name-domain vec))
(string-equal host (tramp-file-name-host vec))
(string-equal port (tramp-file-name-port vec))
- (string-match-p (concat "^/" (regexp-quote (or share "")))
- (tramp-file-name-unquote-localname vec)))
+ (string-match-p
+ (tramp-compat-rx bol "/" (literal (or share "")))
+ (tramp-file-name-unquote-localname vec)))
;; Set mountpoint and location.
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
@@ -2019,7 +2041,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
It was \"a(say)\", but has changed to \"a{sv})\"."
- (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature)
(list :dict-entry key
(list :variant (tramp-gvfs-dbus-string-to-byte-array value)))
(list :struct key (tramp-gvfs-dbus-string-to-byte-array value))))
@@ -2037,9 +2059,12 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(port (if media
(tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
- (share (when (string-match "^/?\\([^/]+\\)" localname)
+ (share (when (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))))
+ localname)
(match-string 1 localname)))
- (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false"))
+ (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method)
+ "true" "false"))
(mount-spec
`(:array
,@(cond
@@ -2047,7 +2072,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(list (tramp-gvfs-mount-spec-entry "type" "smb-share")
(tramp-gvfs-mount-spec-entry "server" host)
(tramp-gvfs-mount-spec-entry "share" share)))
- ((string-match-p "^dav\\|^nextcloud" method)
+ ((string-match-p (rx bol (| "davs" "nextcloud")) method)
(list (tramp-gvfs-mount-spec-entry "type" "dav")
(tramp-gvfs-mount-spec-entry "host" host)
(tramp-gvfs-mount-spec-entry "ssl" ssl)))
@@ -2061,7 +2086,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
((string-equal "nextcloud" method)
(list (tramp-gvfs-mount-spec-entry "type" "owncloud")
(tramp-gvfs-mount-spec-entry "host" host)))
- ((string-match-p "^http" method)
+ ((string-match-p (rx bol "http") method)
(list (tramp-gvfs-mount-spec-entry "type" "http")
(tramp-gvfs-mount-spec-entry
"uri"
@@ -2078,8 +2103,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
,@(when port
(list (tramp-gvfs-mount-spec-entry "port" port)))))
(mount-pref
- (if (and (string-match-p "^dav" method)
- (string-match "^/?[^/]+" localname))
+ (if (and (string-match-p (rx bol "dav") method)
+ (string-match
+ (tramp-compat-rx bol (? "/") (+ (not "/"))) localname))
(match-string 0 localname)
(tramp-gvfs-get-remote-prefix vec))))
@@ -2166,7 +2192,7 @@ connection if a previous connection has died for some
reason."
(string-equal localname "/"))
(tramp-user-error vec "Filename must contain an AFP volume"))
- (when (and (string-match-p "davs?" method)
+ (when (and (string-match-p (rx "dav" (? "s")) method)
(string-equal localname "/"))
(tramp-user-error vec "Filename must contain a WebDAV share"))
@@ -2216,7 +2242,7 @@ connection if a previous connection has died for some
reason."
;; The call must be asynchronously, because of the "askPassword"
;; or "askQuestion" callbacks.
- (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature)
(with-tramp-dbus-call-method vec nil
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
@@ -2446,7 +2472,7 @@ It checks for mounted media devices."
(text (zeroconf-service-txt x))
user)
(when port
- (setq host (format "%s%s%d" host tramp-prefix-port-regexp port)))
+ (setq host (format "%s%s%d" host tramp-prefix-port-format port)))
;; A user is marked in a TXT field like "u=guest".
(while text
(when (string-match "u=\\(.+\\)$" (car text))
@@ -2462,7 +2488,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(ignore-errors
(split-string
(shell-command-to-string (format "avahi-browse -trkp %s" service))
- "[\n\r]+" 'omit "^\\+;.*$"))))
+ (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol)))))
(delete-dups
(mapcar
(lambda (x)
@@ -2472,13 +2498,14 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
user)
;; A user is marked in a TXT field like "u=guest".
(while text
- (when (string-match "u=\\(.+\\)$" (car text))
+ (when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
(setq user (match-string 1 (car text))))
(setq text (cdr text)))
(list user host)))
result))))
(when tramp-gvfs-enabled
+ (with-no-warnings ;; max-specpdl-size
;; Suppress D-Bus error messages and Tramp traces.
(let (;; Sometimes, it fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
@@ -2536,7 +2563,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
"mtp"
(mapcar
(lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
- tramp-media-methods))))
+ tramp-media-methods)))))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 226113d880..78107e1a03 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -85,7 +85,8 @@ special handling of `substitute-in-file-name'."
(defun tramp-rfn-eshadow-update-overlay-regexp ()
"An overlay covering the shadowed part of the filename."
- (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
+ (rx-to-string
+ `(: (* (not (any ,tramp-postfix-host-format "/~"))) (| "/" "~"))))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
@@ -124,25 +125,30 @@ 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'.
;; Use `path-separator' as it does eshell.
(setq eshell-path-env
- (mapconcat
- #'identity (butlast (tramp-compat-exec-path)) path-separator)))
+ (if (file-remote-p default-directory)
+ (mapconcat
+ #'identity (butlast (tramp-compat-exec-path)) path-separator)
+ (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:
@@ -215,9 +221,13 @@ NAME must be equal to `tramp-current-connection'."
;; Create a pseudo mode `tramp-info-lookup-mode' for Tramp symbol lookup.
(info-lookup-maybe-add-help
:mode 'tramp-info-lookup-mode :topic 'symbol
- :regexp "[^][()`'‘’,\" \t\n]+"
- :doc-spec '(("(tramp)Function Index" nil "^ -+ .*: " "\\( \\|$\\)")
- ("(tramp)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)")))
+ :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’"))))
+ :doc-spec `(("(tramp)Function Index" nil
+ ,(rx bol blank (+ "-") blank (* nonl) ":" blank)
+ ,(rx (| blank eol)))
+ ("(tramp)Variable Index" nil
+ ,(rx bol blank (+ "-") blank (* nonl) ":" blank)
+ ,(rx (| blank eol)))))
(add-hook
'tramp-integration-unload-hook
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 5bee5641bb..9e379da8c1 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -147,6 +147,7 @@
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -186,7 +187,7 @@ arguments to pass to the OPERATION."
(delq nil
(mapcar
(lambda (line)
- (when (string-match "^\\(\\S-+\\):$" line)
+ (when (string-match (rx bol (group (+ (not blank))) ":" eol) line)
`(nil ,(match-string 1 line))))
(tramp-process-lines nil tramp-rclone-program "listremotes")))))
@@ -210,6 +211,7 @@ This function is invoked by `tramp-rclone-handle-copy-file'
and
`tramp-rclone-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -300,11 +302,11 @@ file names."
(let (total used free)
(goto-char (point-min))
(while (not (eobp))
- (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Total: " (+ blank) (group (+ digit))))
(setq total (string-to-number (match-string 1))))
- (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Used: " (+ blank) (group (+ digit))))
(setq used (string-to-number (match-string 1))))
- (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Free: " (+ blank) (group (+ digit))))
(setq free (string-to-number (match-string 1))))
(forward-line))
(when used
@@ -343,7 +345,7 @@ file names."
(tramp-rclone-maybe-open-connection v)
;; TODO: This shall be handled by `expand-file-name'.
(setq localname
- (replace-regexp-in-string "^\\." "" (or localname "")))
+ (replace-regexp-in-string (rx bol ".") "" (or localname "")))
(format "%s%s" (tramp-fuse-mounted-p v) localname)))
;; It is a local file name.
filename))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ca08c6f0b3..cfecd32aba 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -81,10 +81,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m"
+(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit))
"m")
"Terminal control escape sequences for display attributes.")
-(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n"
+(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n")
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
@@ -411,19 +411,17 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-default-method-alist
`(,tramp-local-host-regexp
- ,(format "\\`%s\\'" tramp-root-id-string) "su"))
+ ,(tramp-compat-rx bos (literal tramp-root-id-string) eos) "su"))
(add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'")
+ `(,(rx bos (| "su" "sudo" "doas" "ksu") eos)
nil ,tramp-root-id-string))
;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
;; Do not add "plink" based methods, they ask interactively for the user.
(add-to-list 'tramp-default-user-alist
- `(,(concat
- "\\`"
- (regexp-opt
- '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
- "\\'")
+ `(,(rx bos
+ (| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")
+ eos)
nil ,(user-login-name))))
;;;###tramp-autoload
@@ -518,8 +516,8 @@ The string is used in `tramp-methods'.")
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
(defcustom tramp-sh-extra-args
- '(("/bash\\'" . "-noediting -norc -noprofile")
- ("/zsh\\'" . "-f +Z -V"))
+ `((,(rx "/bash" eos) . "-noediting -norc -noprofile")
+ (,(rx "/zsh" eos) . "-f +Z -V"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
@@ -785,6 +783,41 @@ characters need to be doubled.")
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-perl-id
+ "%p -e '
+use strict;
+use warnings;
+use POSIX qw(getgroups);
+
+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\",
+ $uid, $user, $gid, $group, join \",\", @groups;' %n"
+ "Perl script printing `id' output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
+(defconst tramp-python-id
+ "%y -c '
+import os, pwd, grp;
+
+def idform(id):
+ return \"{:d}({:s})\".format(id, grp.getgrgid(id)[0]);
+
+uid = os.getuid();
+user = pwd.getpwuid(uid)[0];
+gid = os.getgid();
+group = grp.getgrgid(gid)[0]
+groups = map(idform, os.getgrouplist(user, gid));
+
+print(\"uid={:d}({:s}) gid={:d}({:s}) groups={:s}\"
+ .format(uid, user, gid, group, \",\".join(groups)));' %n"
+ "Python script printing `id' output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
"%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
@@ -1084,6 +1117,7 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . tramp-sh-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sh-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-sh-handle-get-remote-groups)
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -1102,66 +1136,63 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target))))
- ;; There could be a cyclic link.
- (tramp-flush-file-properties
- v (expand-file-name target (tramp-file-local-name default-directory))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
-
- (let ((ln (tramp-get-remote-ln v))
- (cwd (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless ln
- (tramp-error
- v 'file-error
- (concat "Making a symbolic link. "
- "ln(1) does not exist on the remote host.")))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Right, they are on the same host, regardless of user,
- ;; method, etc. We now make the link on the remote
- ;; machine. This will occur as the user that TARGET belongs to.
- (and (tramp-send-command-and-check
- v (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- v (format
- "%s -sf %s %s" ln
- (tramp-shell-quote-argument target)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file
- ;; names could start with "-".
- ;; `tramp-shell-quote-argument' does not handle
- ;; this, we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory localname)))))))))))
+ (with-parsed-tramp-file-name (expand-file-name linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target))))
+ ;; There could be a cyclic link.
+ (tramp-flush-file-properties
+ v (expand-file-name target (tramp-file-local-name default-directory))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
+
+ (let ((ln (tramp-get-remote-ln v))
+ (cwd (tramp-run-real-handler
+ #'file-name-directory (list localname))))
+ (unless ln
+ (tramp-error
+ v 'file-error
+ (concat "Making a symbolic link. "
+ "ln(1) does not exist on the remote host.")))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (tramp-flush-file-properties v localname)
+
+ ;; Right, they are on the same host, regardless of user,
+ ;; method, etc. We now make the link on the remote machine.
+ ;; This will occur as the user that TARGET belongs to.
+ (and (tramp-send-command-and-check
+ v (format "cd %s" (tramp-shell-quote-argument cwd)))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" ln
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use
+ ;; relative file names. However, relative file names
+ ;; could start with "-".
+ ;; `tramp-shell-quote-argument' does not handle this,
+ ;; we must do it ourselves.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname))))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
@@ -1188,7 +1219,7 @@ component is used as the target of the symlink."
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (buffer-substring (point-min) (line-end-position))))
+ (buffer-substring (point-min) (line-end-position))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
@@ -1225,7 +1256,7 @@ component is used as the target of the symlink."
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-exists-p"
(if (tramp-file-property-p v localname "file-attributes")
(not (null (tramp-get-file-property v localname "file-attributes")))
@@ -1250,7 +1281,7 @@ component is used as the target of the symlink."
(tramp-do-file-attributes-with-perl v localname))
(t (tramp-do-file-attributes-with-ls v localname)))))))
-(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+(defconst tramp-sunos-unames (rx (| "SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
(defun tramp-sh--quoting-style-options (vec)
@@ -1400,7 +1431,7 @@ component is used as the target of the symlink."
(buffer-name)))
(if time-list
(tramp-run-real-handler #'set-visited-file-modtime (list time-list))
- (let ((f (buffer-file-name))
+ (let ((f (expand-file-name (buffer-file-name)))
coding-system-used)
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
@@ -1416,7 +1447,7 @@ component is used as the target of the symlink."
(format "%s -ild %s"
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point) (line-end-position))))
+ (setq attr (buffer-substring (point) (line-end-position))))
(tramp-set-file-property
v localname "visited-file-modtime-ild" attr))
(setq last-coding-system-used coding-system-used)
@@ -1460,7 +1491,7 @@ of."
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring (point) (line-end-position))))
+ (setq attr (buffer-substring (point) (line-end-position))))
(equal
attr
(tramp-get-file-property
@@ -1497,7 +1528,7 @@ of."
time)))
(tramp-send-command-and-check
v (format
- "env TZ=UTC %s %s %s %s"
+ "env TZ=UTC0 %s %s %s %s"
(tramp-get-remote-touch v)
(if (tramp-get-connection-property v "touch-t")
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
@@ -1525,10 +1556,16 @@ ID-FORMAT valid values are `string' and `integer'."
;; The result is cached in `tramp-get-remote-uid'.
(ignore-errors
(cond
- ((tramp-get-remote-id vec) (tramp-get-remote-uid-with-id vec id-format))
- ((tramp-get-remote-perl vec) (tramp-get-remote-uid-with-perl vec
id-format))
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
((tramp-get-remote-python vec)
- (tramp-get-remote-uid-with-python vec id-format)))))
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format))))
(defun tramp-sh-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
@@ -1536,10 +1573,33 @@ ID-FORMAT valid values are `string' and `integer'."
;; The result is cached in `tramp-get-remote-gid'.
(ignore-errors
(cond
- ((tramp-get-remote-id vec) (tramp-get-remote-gid-with-id vec id-format))
- ((tramp-get-remote-perl vec) (tramp-get-remote-gid-with-perl vec
id-format))
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
((tramp-get-remote-python vec)
- (tramp-get-remote-gid-with-python vec id-format)))))
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format))))
+
+(defun tramp-sh-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-groups'.
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
+ ((tramp-get-remote-python vec)
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format))))
(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@@ -1569,11 +1629,14 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
- "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
+ (regexp (tramp-compat-rx
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))))))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@@ -1582,7 +1645,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname))))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (re-search-forward regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -1590,7 +1653,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-set-file-selinux-context (filename context)
"Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(when (and (consp context)
(tramp-remote-selinux-p v))
(let ((user (and (stringp (nth 0 context)) (nth 0 context)))
@@ -1617,7 +1680,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-acl"
(when (and (tramp-remote-acl-p v)
(tramp-send-command-and-check
@@ -1654,7 +1717,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
@@ -1665,8 +1728,10 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
(if (tramp-file-property-p v localname "file-attributes")
(tramp-handle-file-readable-p filename)
(tramp-run-test "-r" filename)))))
@@ -1675,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
;; `file-directory-p' is used as predicate for file name completion.
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
@@ -1694,7 +1759,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
(if (tramp-file-property-p v localname "file-attributes")
@@ -1703,12 +1768,13 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-check-cached-permissions v ?w)
(tramp-run-test "-w" filename))
;; If file doesn't exist, check if directory is writable.
- (and (file-exists-p (file-name-directory filename))
- (tramp-run-test "-w" (file-name-directory filename)))))))
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property
v localname
(format "file-ownership-preserved-p%s" (if group "-group" ""))
@@ -1723,7 +1789,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; On BSD-derived systems files always inherit the
;; parent directory's group, so skip the group-gid
;; test.
- (tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin")
+ (tramp-check-remote-uname v (rx (| "BSD" "DragonFly"
"Darwin")))
(= (file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
@@ -1809,7 +1875,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Check result code, found in last line of output.
(forward-line -1)
- (if (looking-at-p "^fail$")
+ (if (looking-at-p (rx bol "fail" eol))
(progn
;; Grab error message from line before last line
;; (it was put there by `cd 2>&1').
@@ -1817,12 +1883,12 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-error
v 'file-error
"tramp-sh-handle-file-name-all-completions: %s"
- (buffer-substring (point) (line-end-position))))
+ (buffer-substring (point) (line-end-position))))
;; For peace of mind, if buffer doesn't end in `fail'
;; then it should end in `ok'. If neither are in the
;; buffer something went seriously wrong on the remote
;; side.
- (unless (looking-at-p "^ok$")
+ (unless (looking-at-p (rx bol "ok" eol))
(tramp-error
v 'file-error
(concat "tramp-sh-handle-file-name-all-completions: "
@@ -1830,7 +1896,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
- (push (buffer-substring (point) (line-end-position)) result)))
+ (push (buffer-substring (point) (line-end-position)) result)))
result))))))
;; cp, mv and ln
@@ -1845,8 +1911,8 @@ ID-FORMAT valid values are `string' and `integer'."
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
+ (with-parsed-tramp-file-name (expand-file-name filename) v1
+ (with-parsed-tramp-file-name (expand-file-name newname) v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
;; Do the 'confirm if exists' thing.
@@ -1942,7 +2008,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; When newname did exist, we have wrong cached values.
(when t2
- (with-parsed-tramp-file-name newname nil
+ (with-parsed-tramp-file-name (expand-file-name newname) nil
(tramp-flush-file-properties v localname)))))))
(defun tramp-sh-handle-rename-file
@@ -1978,6 +2044,7 @@ This function is invoked by `tramp-sh-handle-copy-file'
and
`tramp-sh-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -2090,6 +2157,7 @@ file names."
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
+ ;; FILENAME and NEWNAME are already expanded.
;; Check, whether file is too large. Emacs checks in `insert-file-1'
;; and `find-file-noselect', but that's not called here.
(abort-if-file-too-large
@@ -2132,6 +2200,7 @@ the file (for rename). Both files must reside on the
same host.
KEEP-DATE means to make sure that NEWNAME has the same timestamp
as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid from FILENAME."
+ ;; FILENAME and NEWNAME are already expanded.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(file-times (file-attribute-modification-time
@@ -2280,6 +2349,7 @@ the uid and gid from FILENAME."
(op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
The method used must be an out-of-band method."
+ ;; FILENAME and NEWNAME are already expanded.
(let* ((v1 (and (tramp-tramp-file-p filename)
(tramp-dissect-file-name filename)))
(v2 (and (tramp-tramp-file-p newname)
@@ -2515,7 +2585,7 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
@@ -2533,7 +2603,7 @@ The method used must be an out-of-band method."
(if (>= emacs-major-version 29)
(tramp-run-real-handler #'dired-compress-file (list file))
;; Code stolen mainly from dired-aux.el.
- (with-parsed-tramp-file-name file nil
+ (with-parsed-tramp-file-name (expand-file-name file) nil
(tramp-flush-file-properties v localname)
(let ((suffixes dired-compress-file-suffixes)
suffix)
@@ -2550,7 +2620,7 @@ The method used must be an out-of-band method."
(with-tramp-progress-reporter
v 0 (format "Uncompressing %s" file)
(when (tramp-send-command-and-check
- v (if (string-match-p "%[io]" (nth 2 suffix))
+ v (if (string-match-p (rx "%" (any "io")) (nth 2
suffix))
(replace-regexp-in-string
"%i" (tramp-shell-quote-argument localname)
(nth 2 suffix))
@@ -2659,7 +2729,9 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
- (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror)
+ (when (re-search-backward
+ (rx bol "//DIRED//" (+ blank) (group (+ nonl)) eol)
+ nil 'noerror)
(let ((beg (match-beginning 1))
(end (match-end 0)))
;; Now read the numeric positions of file names.
@@ -2731,7 +2803,7 @@ The method used must be an out-of-band method."
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
- (when (and (re-search-forward "^\\([[:space:]]*total\\)" nil t)
+ (when (and (re-search-forward (rx bol (group (* blank) "total")) nil
t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let ((available (get-free-disk-space ".")))
@@ -2755,10 +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
- (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") 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)
@@ -2774,7 +2850,10 @@ the result will be a local, non-Tramp, file name."
;; groks tilde expansion! The function `tramp-find-shell' is
;; supposed to find such a shell on the remote host. Please
;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" 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)
@@ -2785,7 +2864,7 @@ the result will be a local, non-Tramp, file name."
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
(when (and (zerop (length uname))
- (string-match-p "\\`su\\(do\\)?\\'" method))
+ (string-match-p (rx bos "su" (? "do") eos) method))
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -2794,7 +2873,7 @@ the result will be a local, non-Tramp, file name."
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../"),
;; unless there are tilde characters in file name.
@@ -2802,9 +2881,9 @@ the result will be a local, non-Tramp, file name."
;; would be problems with UNC shares or Cygwin mounts.
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
- v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- localname
- (tramp-drop-volume-letter
+ v (tramp-drop-volume-letter
+ (if (string-prefix-p "~" localname)
+ localname
(tramp-run-real-handler
#'expand-file-name (list localname))))))))))
@@ -2884,11 +2963,12 @@ implementation will be used."
;; command.
(heredoc (and (not (bufferp stderr))
(stringp program)
- (string-match-p "sh$" program)
+ (string-match-p (rx "sh" eol) program)
(= (length args) 2)
(string-equal "-c" (car args))
;; Don't if there is a quoted string.
- (not (string-match-p "'\\|\"" (cadr args)))
+ (not
+ (string-match-p (rx (any "'\"")) (cadr args)))
;; Check, that /dev/tty is usable.
(tramp-get-remote-dev-tty v)))
;; When PROGRAM is nil, we just provide a tty.
@@ -3093,7 +3173,7 @@ implementation will be used."
(let (signal-hook-function)
(condition-case nil
(dolist (sig (cdr signals))
- (unless (string-match-p "^[[:alnum:]+-]+$" sig)
+ (unless (string-match-p (rx bol (+ (any "+-" alnum)) eol) sig)
(error nil)))
(error (setq signals '(0)))))
(dotimes (i 128)
@@ -3124,8 +3204,8 @@ implementation will be used."
(tramp-shell-quote-argument (format "kill -%d $$" i))))
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (buffer-substring (line-beginning-position)
- (line-end-position)))))
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))))
(if (string-empty-p res)
(format "Signal %d" i)
res)))
@@ -3737,6 +3817,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(concat "create,modify,move,moved_from,moved_to,move_self,"
"delete,delete_self,ignored"))
((memq 'attribute-change flags) "attrib,ignored"))
+ ;; "-P" has been added to version 3.21, so we cannot assume it
yet.
sequence `(,command "-mq" "-e" ,events ,localname)
;; Make events a list of symbols.
events
@@ -3810,8 +3891,8 @@ Fall back to normal file name handler if no Tramp handler
exists."
(catch 'doesnt-work
;; https://bugs.launchpad.net/bugs/1742946
- (when
- (string-match-p "Monitoring not supported\\|No locations given"
string)
+ (when (string-match-p
+ (rx (| "Monitoring not supported" "No locations given")) string)
(delete-process proc)
(throw 'doesnt-work nil))
@@ -3829,9 +3910,11 @@ Fall back to normal file name handler if no Tramp
handler exists."
((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor)
((eq system-type 'cygwin) 'GPollFileMonitor)))
;; TODO: What happens, if several monitor names are reported?
- ((string-match "\
-Supported arguments for GIO_USE_FILE_MONITOR environment variable:
-\\s-*\\([[:alpha:]]+\\) - 20" string)
+ ((string-match
+ (rx "Supported arguments for "
+ "GIO_USE_FILE_MONITOR environment variable:\n"
+ (* blank) (group (+ alpha)) " - 20")
+ string)
(setq pos (match-end 0))
(intern
(format "G%sFileMonitor" (capitalize (match-string 1 string)))))
@@ -3842,15 +3925,15 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
- (eval-when-compile
- (concat "^[^:]+:"
- "[[:space:]]\\([^:]+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\([^:]+\\)\\)?$"))
+ (tramp-compat-rx
+ bol (+ (not ":")) ":" blank
+ (group (+ (not ":"))) ":" blank
+ (group (regexp (regexp-opt tramp-gio-events)))
+ (? blank (group (+ (not ":")))) eol)
string)
(let* ((file (match-string 1 string))
- (file1 (match-string 4 string))
+ (file1 (match-string 3 string))
(object
(list
proc
@@ -3870,7 +3953,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
`(file-notify ,object file-notify-callback))))))
;; Save rest of the string.
- (while (string-match "^\n" string)
+ (while (string-match (rx bol "\n") string)
(setq string (replace-match "" nil nil string)))
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
@@ -3883,9 +3966,8 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
(dolist (line (split-string string "[\n\r]+" 'omit))
;; Check, whether there is a problem.
(unless (string-match
- (concat "^[^[:blank:]]+"
- "[[:blank:]]+\\([^[:blank:]]+\\)"
- "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
+ (rx bol (+ (not blank)) (+ blank) (group (+ (not blank)))
+ (? (+ blank) (group (+ (not (any "\r\n"))))))
line)
(tramp-error proc 'file-notify-error line))
@@ -3897,7 +3979,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
(intern-soft
(tramp-compat-string-replace "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
- (or (match-string 3 line)
+ (or (match-string 2 line)
(file-name-nondirectory (process-get proc 'watch-name))))))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
@@ -3921,10 +4003,10 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (? bol "/" (* (not blank)) blank) (* blank)
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) (+ blank)
+ (group (+ digit))))
(mapcar
(lambda (d)
(* d (tramp-get-connection-property v "df-blocksize" 0)))
@@ -3939,56 +4021,73 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(defun tramp-expand-script (vec script)
"Expand SCRIPT with remote files or commands.
-\"%a\", \"%h\", \"%l\", \"%o\", \"%p\", \"%r\" and \"%s\" format
-specifiers are replaced by the respective `awk', `hexdump', `ls',
-`od', `perl', `readlink' and `stat' commands. \"%n\" is replaced
-by \"2>/dev/null\", and \"%t\" is replaced by a temporary file
-name. If VEC is nil, the respective local commands are used. If
-there is a format specifier which cannot be expanded, this
-function returns nil."
- (if (not (string-match-p "\\(^\\|[^%]\\)%[ahlnoprst]" script))
+\"%a\", \"%h\", \"%l\", \"%o\", \"%p\", \"%r\", \"%s\" and \"%y\"
+format specifiers are replaced by the respective `awk',
+`hexdump', `ls', `od', `perl', `readlink', `stat' and `python'
+commands. \"%n\" is replaced by \"2>/dev/null\", and \"%t\" is
+replaced by a temporary file name. If VEC is nil, the respective
+local commands are used. If there is a format specifier which
+cannot be expanded, this function returns nil."
+ (if (not (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%" (any "ahlnoprsty")) script))
script
(catch 'wont-work
- (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
+ (let ((awk (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%a") script)
(or
(if vec (tramp-get-remote-awk vec) (executable-find "awk"))
(throw 'wont-work nil))))
- (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script)
+ (hdmp (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%h") script)
(or
(if vec (tramp-get-remote-hexdump vec)
(executable-find "hexdump"))
(throw 'wont-work nil))))
- (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script)
+ (dev (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%n") script)
(or
(if vec (concat "2>" (tramp-get-remote-null-device vec))
(if (eq system-type 'windows-nt) ""
(concat "2>" null-device)))
(throw 'wont-work nil))))
- (ls (when (string-match-p "\\(^\\|[^%]\\)%l" script)
+ (ls (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%l") script)
(format "%s %s"
(or (tramp-get-ls-command vec)
(throw 'wont-work nil))
(tramp-sh--quoting-style-options vec))))
- (od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
+ (od (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%o") script)
(or (if vec (tramp-get-remote-od vec) (executable-find "od"))
(throw 'wont-work nil))))
- (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script)
+ (perl (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%p") script)
(or
(if vec
(tramp-get-remote-perl vec) (executable-find "perl"))
(throw 'wont-work nil))))
- (readlink (when (string-match-p "\\(^\\|[^%]\\)%r" script)
+ (python (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%y") script)
(or
(if vec
+ (tramp-get-remote-python vec)
+ (executable-find "python"))
+ (throw 'wont-work nil))))
+ (readlink (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%r") script)
+ (or
+ (if vec
(tramp-get-remote-readlink vec)
(executable-find "readlink"))
(throw 'wont-work nil))))
- (stat (when (string-match-p "\\(^\\|[^%]\\)%s" script)
+ (stat (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%s") script)
(or
(if vec
(tramp-get-remote-stat vec) (executable-find "stat"))
(throw 'wont-work nil))))
- (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
+ (tmp (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%t") script)
(or
(if vec
(tramp-file-local-name (tramp-make-tramp-temp-name vec))
@@ -3998,7 +4097,7 @@ function returns nil."
script
(format-spec-make
?a awk ?h hdmp ?l ls ?n dev ?o od ?p perl
- ?r readlink ?s stat ?t tmp))))))
+ ?r readlink ?s stat ?t tmp ?y python))))))
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
@@ -4061,7 +4160,7 @@ This function expects to be in the right *tramp* buffer."
(unless (or ignore-path (tramp-check-remote-uname vec
tramp-sunos-unames))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
- (if (looking-at-p "^\\s-*1$")
+ (if (looking-at-p (rx bol (* blank) "1" eol))
(setq result (concat "\\" progname))))
(unless result
(when ignore-tilde
@@ -4088,8 +4187,8 @@ This function expects to be in the right *tramp* buffer."
(when (search-backward "tramp_executable " nil t)
(skip-chars-forward "^ ")
(skip-chars-forward " ")
- (setq result (buffer-substring (point) (line-end-position)))))
- result)))
+ (setq result (buffer-substring (point) (line-end-position)))))
+ result)))
;; On hydra.nixos.org, the $PATH environment variable is too long to
;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We
@@ -4101,7 +4200,8 @@ whether it exists and if so, it is added to the
environment
variable PATH."
(let ((command
(format
- "PATH=%s && export PATH" (string-join (tramp-get-remote-path vec)
":")))
+ "PATH=%s && export PATH"
+ (string-join (tramp-get-remote-path vec) ":")))
(pipe-buf
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
@@ -4244,16 +4344,22 @@ file exists and nonzero exit status otherwise."
;; Sanity check.
(tramp-barf-if-no-shell-prompt
- (tramp-get-connection-process vec) 10
+ (tramp-get-connection-process vec) 60
"Couldn't find remote shell prompt for %s" shell)
(unless
(tramp-check-for-regexp
- (tramp-get-connection-process vec) (regexp-quote tramp-end-of-output))
+ (tramp-get-connection-process vec)
+ (tramp-compat-rx (literal tramp-end-of-output)))
+ (tramp-wait-for-output (tramp-get-connection-process vec))
(tramp-message vec 5 "Setting shell prompt")
(tramp-send-command
vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
(tramp-shell-quote-argument tramp-end-of-output))
- t))
+ t t)
+ (tramp-barf-if-no-shell-prompt
+ (tramp-get-connection-process vec) 60
+ "Couldn't find remote shell prompt for %s" shell))
+ (tramp-wait-for-output (tramp-get-connection-process vec))
;; Check proper HISTFILE setting. We give up when not working.
(when (and (stringp tramp-histfile-override)
@@ -4284,7 +4390,9 @@ file exists and nonzero exit status otherwise."
(tramp-send-command
vec (format "echo ~%s" tramp-root-id-string) t)
(if (or (string-match-p
- (format "^~%s$" tramp-root-id-string) (buffer-string))
+ (tramp-compat-rx
+ bol "~" (literal tramp-root-id-string) eol)
+ (buffer-string))
;; The default shell (ksh93) of OpenSolaris
;; and Solaris is buggy. We've got reports
;; for "SunOS 5.10" and "SunOS 5.11" so far.
@@ -4322,8 +4430,9 @@ seconds. If not, it produces an error message with the
given ERROR-ARGS."
(condition-case nil
(tramp-wait-for-regexp
proc timeout
- (format
- "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
+ (tramp-compat-rx
+ (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern))
+ eos))
(error
(delete-process proc)
(apply #'tramp-error-with-buffer
@@ -4363,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
@@ -4372,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'"
@@ -4381,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.
@@ -4392,7 +4526,8 @@ process to set up. VEC specifies the connection."
(string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
- (string-match-p "utf-?8" (tramp-get-remote-locale vec))
+ (string-match-p
+ (rx "utf" (? "-") "8") (tramp-get-remote-locale vec))
(cons 'utf-8 'utf-8))
(process-coding-system proc)
(cons 'undecided 'undecided)))
@@ -4424,7 +4559,7 @@ process to set up. VEC specifies the connection."
(t
(tramp-message
vec 5 "Checking remote host type for `send-process-string' bug")
- (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0))))
+ (if (string-match-p (rx (| "FreeBSD" "DragonFly")) uname) 500 0))))
;; Set remote PATH variable.
(tramp-set-remote-path vec)
@@ -4456,7 +4591,7 @@ process to set up. VEC specifies the connection."
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
- (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname)
+ (if (string-match-p (rx (| "BSD" "DragonFly" "Darwin")) uname)
(tramp-send-command vec "stty tabs" t)
(tramp-send-command vec "stty tab0" t))
@@ -4682,7 +4817,7 @@ Goes through the list `tramp-local-coding-commands' and
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'wont-work-remote nil)))
;; `rem-enc' and `rem-dec' could be a string meanwhile.
@@ -4768,7 +4903,7 @@ Goes through the list `tramp-inline-compress-commands'."
nil t))
(throw 'next nil))
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(tramp-message
vec 5
@@ -4779,7 +4914,7 @@ Goes through the list `tramp-inline-compress-commands'."
(throw 'next nil))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(setq found t)))
@@ -4868,7 +5003,7 @@ Goes through the list `tramp-inline-compress-commands'."
(goto-char (point-min))
(unless
(search-forward-regexp
- "\\(illegal\\|unknown\\) option -- T" nil t)
+ (rx (| "illegal" "unknown") " option -- T") nil t)
(setq tramp-scp-strict-file-name-checking "-T")))))))
tramp-scp-strict-file-name-checking)))
@@ -4895,7 +5030,7 @@ Goes through the list `tramp-inline-compress-commands'."
(goto-char (point-min))
(unless
(search-forward-regexp
- "\\(illegal\\|unknown\\) option -- O" nil t)
+ (rx (| "illegal" "unknown") " option -- O") nil t)
(setq tramp-scp-force-scp-protocol "-O")))))))
tramp-scp-force-scp-protocol)))
@@ -4918,7 +5053,7 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-call-process vec1 "scp" nil t nil "-R")
(goto-char (point-min))
(not (search-forward-regexp
- "\\(illegal\\|unknown\\) option -- R" nil 'noerror)))))
+ (rx (| "illegal" "unknown") " option -- R") nil 'noerror)))))
;; Check, that RemoteCommand is not used.
(with-tramp-connection-property
@@ -4959,7 +5094,11 @@ Goes through the list `tramp-inline-compress-commands'."
(line-beginning-position) (line-end-position))
string
(and
- (string-match "^[^# ]+ \\S-+ \\(\\S-+\\)$" string)
+ (string-match
+ (rx bol (+ (not (any blank "#"))) blank
+ (+ (not blank)) blank
+ (group (+ (not blank))) eol)
+ string)
(match-string 1 string))
found
(and string
@@ -5264,20 +5403,23 @@ function waits for output unless NOOUTPUT is set."
;; Busyboxes built with the EDITING_ASK_TERMINAL config
;; option send also escape sequences, which must be
;; ignored.
- (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
- (regexp-quote tramp-end-of-output)
- tramp-device-escape-sequence-regexp))
+ (regexp (tramp-compat-rx
+ (* (not (any "#$\n")))
+ (literal tramp-end-of-output)
+ (? (regexp tramp-device-escape-sequence-regexp))
+ (? "\r") eol))
;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
- (regexp1 (format "\\(^\\|\000\\)%s" regexp))
+ (regexp1 (tramp-compat-rx (| bol "\000") (regexp regexp)))
(found (tramp-wait-for-regexp proc timeout regexp1)))
(if found
(let ((inhibit-read-only t))
;; A simple-minded busybox has sent " ^H" sequences.
;; Delete them.
(goto-char (point-min))
- (when (re-search-forward "^\\(.\b\\)+$" (line-end-position) t)
+ (when (re-search-forward
+ (rx bol (+ nonl "\b") eol) (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
;; Delete the prompt.
@@ -5308,7 +5450,10 @@ Optional argument EXIT-STATUS, if non-nil, triggers the
return of
the exit status."
(let (cmd data)
(if (and (stringp command)
- (string-match (format ".*<<'%s'.*" tramp-end-of-heredoc) command))
+ (string-match
+ (tramp-compat-rx
+ (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl))
+ command))
(setq cmd (match-string 0 command)
data (substring command (match-end 0)))
(setq cmd command))
@@ -5324,7 +5469,7 @@ the exit status."
(if subshell " )" "")
data)))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -5369,7 +5514,7 @@ raises an error."
(unless noerror signal-hook-function)))
(read (current-buffer)))
;; Error handling.
- (when (re-search-forward "\\S-" (line-end-position) t)
+ (when (re-search-forward (rx (not blank)) (line-end-position) t)
(error nil)))
(error (unless noerror
(tramp-error
@@ -5399,7 +5544,7 @@ raises an error."
;; This does not work for MS Windows scp, if there are characters
;; to be quoted. OpenSSH 8 supports disabling of strict file name
;; checking in scp, we use it when available.
- (unless (string-match-p "ftp$" method)
+ (unless (string-match-p (rx "ftp" eos) method)
(setq localname (tramp-unquote-shell-quote-argument localname)))
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
@@ -5477,7 +5622,7 @@ Nonexistent directories are removed from spec."
(tramp-get-method-parameter vec 'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument tramp-end-of-heredoc))
- 'noerror (regexp-quote tramp-end-of-heredoc))
+ 'noerror (tramp-compat-rx (literal tramp-end-of-heredoc)))
(progn
(tramp-message
vec 2 "Could not retrieve `tramp-own-remote-path'")
@@ -5526,8 +5671,9 @@ Nonexistent directories are removed from spec."
(with-current-buffer (tramp-get-connection-buffer vec)
(while candidates
(goto-char (point-min))
- (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates)))
- (buffer-string))
+ (if (string-match-p
+ (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
+ (buffer-string))
(setq locale (car candidates)
candidates nil)
(setq candidates (cdr candidates)))))
@@ -5557,7 +5703,7 @@ Nonexistent directories are removed from spec."
"%s --color=never -al %s"
result (tramp-get-remote-null-device vec)))
(not (string-match-p
- (regexp-quote "\e")
+ "\e"
(tramp-get-buffer-string
(tramp-get-buffer vec)))))
(setq result (concat result " --color=never")))
@@ -5605,7 +5751,7 @@ Nonexistent directories are removed from spec."
vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (when (looking-at-p (regexp-quote tramp-end-of-output))
+ (when (looking-at-p (tramp-compat-rx (literal tramp-end-of-output)))
(format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
(progn
(tramp-send-command
@@ -5670,7 +5816,9 @@ Nonexistent directories are removed from spec."
tmp (tramp-send-command-and-read
vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
(unless (and (listp tmp) (stringp (car tmp))
- (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp))
+ (string-match-p
+ (rx bol (any "\"`'‘„”«「") "/" (any "\"'’“”»」") eol)
+ (car tmp))
(integerp (cadr tmp)))
(setq result nil)))
result))))
@@ -5762,36 +5910,9 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
;; Check POSIX parameter.
(when (tramp-send-command-and-check vec (format "%s -u" result))
- (tramp-set-connection-property
- vec "uid-integer"
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (read (current-buffer))))
(throw 'id-found result))
(setq dl (cdr dl))))))))
-(defun tramp-get-remote-uid-with-id (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `id'."
- ;; `tramp-get-remote-id' sets already connection property "uid-integer".
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (tramp-send-command-and-read
- vec
- (format "%s -u%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))))
-
-(defun tramp-get-remote-uid-with-perl (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print $>"
- "print \"\\\"\", scalar getpwuid($>), \"\\\"\""))))
-
(defun tramp-get-remote-python (vec)
"Determine remote `python' command."
(with-tramp-connection-property vec "python"
@@ -5799,46 +5920,6 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
(tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
-(defun tramp-get-remote-uid-with-python (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getuid())"
- "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] +
'\\\"')"))))
-
-(defun tramp-get-remote-gid-with-id (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -g%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
-
-(defun tramp-get-remote-gid-with-perl (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print ($)=~/(\\d+)/)"
- "print \"\\\"\", scalar getgrgid($)), \"\\\"\""))))
-
-(defun tramp-get-remote-gid-with-python (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getgid())"
- "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] +
'\\\"')"))))
-
(defun tramp-get-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index ba0a1d3598..e55f6bb6ee 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -53,7 +53,7 @@
;;;###tramp-autoload
(tramp--with-startup
(add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
+ `(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil))
;; Add completion function for SMB method.
(tramp-set-completion-function
@@ -92,79 +92,79 @@ this variable \"client min protocol=NT1\"."
"Version string of the SMB client.")
(defconst tramp-smb-server-version
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ (tramp-compat-rx "Domain=[" (* (not "]")) "] "
+ "OS=[" (* (not "]")) "] "
+ "Server=[" (* (not "]")) "]")
"Regexp of SMB server identification.")
-(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+(defconst tramp-smb-prompt
+ (rx bol (| (: (| "smb:" "PS") blank (+ nonl) "> ")
+ (: (+ blank) "Server"
+ (+ blank) "Comment" eol)))
"Regexp used as prompt in smbclient or powershell.")
(defconst tramp-smb-wrong-passwd-regexp
- (regexp-opt
- '("NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_WRONG_PASSWORD"))
+ (rx (| "NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
"Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
- (mapconcat
- #'identity
- `(;; Connection error / timeout / unknown command.
- "Connection\\( to \\S-+\\)? failed"
- "Read from server failed, maybe it closed the connection"
- "Call timed out: server did not respond"
- "\\S-+: command not found"
- "Server doesn't support UNIX CIFS calls"
- ,(regexp-opt
- '(;; Samba.
- "ERRDOS"
- "ERRHRD"
- "ERRSRV"
- "ERRbadfile"
- "ERRbadpw"
- "ERRfilexists"
- "ERRnoaccess"
- "ERRnomem"
- "ERRnosuchshare"
- ;; See /usr/include/samba-4.0/core/ntstatus.h.
- ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
- ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
- ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
- ;; Windows 6.3 (Windows Server 2012, Windows 10).
- "NT_STATUS_ACCESS_DENIED"
- "NT_STATUS_ACCOUNT_LOCKED_OUT"
- "NT_STATUS_BAD_NETWORK_NAME"
- "NT_STATUS_CANNOT_DELETE"
- "NT_STATUS_CONNECTION_DISCONNECTED"
- "NT_STATUS_CONNECTION_REFUSED"
- "NT_STATUS_CONNECTION_RESET"
- "NT_STATUS_DIRECTORY_NOT_EMPTY"
- "NT_STATUS_DUPLICATE_NAME"
- "NT_STATUS_FILE_IS_A_DIRECTORY"
- "NT_STATUS_HOST_UNREACHABLE"
- "NT_STATUS_IMAGE_ALREADY_LOADED"
- "NT_STATUS_INVALID_LEVEL"
- "NT_STATUS_INVALID_PARAMETER"
- "NT_STATUS_INVALID_PARAMETER_MIX"
- "NT_STATUS_IO_TIMEOUT"
- "NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_NETWORK_ACCESS_DENIED"
- "NT_STATUS_NOT_IMPLEMENTED"
- "NT_STATUS_NO_LOGON_SERVERS"
- "NT_STATUS_NO_SUCH_FILE"
- "NT_STATUS_NO_SUCH_USER"
- "NT_STATUS_NOT_A_DIRECTORY"
- "NT_STATUS_NOT_SUPPORTED"
- "NT_STATUS_OBJECT_NAME_COLLISION"
- "NT_STATUS_OBJECT_NAME_INVALID"
- "NT_STATUS_OBJECT_NAME_NOT_FOUND"
- "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
- "NT_STATUS_PASSWORD_MUST_CHANGE"
- "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
- "NT_STATUS_REVISION_MISMATCH"
- "NT_STATUS_SHARING_VIOLATION"
- "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
- "NT_STATUS_UNSUCCESSFUL"
- "NT_STATUS_WRONG_PASSWORD")))
- "\\|")
+ (rx (| ;; Connection error / timeout / unknown command.
+ (: "Connection" (? " to " (+ (not blank))) " failed")
+ "Read from server failed, maybe it closed the connection"
+ "Call timed out: server did not respond"
+ (: (+ (not blank)) ": command not found")
+ "Server doesn't support UNIX CIFS calls"
+ (| ;; Samba.
+ "ERRDOS"
+ "ERRHRD"
+ "ERRSRV"
+ "ERRbadfile"
+ "ERRbadpw"
+ "ERRfilexists"
+ "ERRnoaccess"
+ "ERRnomem"
+ "ERRnosuchshare"
+ ;; See /usr/include/samba-4.0/core/ntstatus.h.
+ ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
+ ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
+ ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
+ ;; Windows 6.3 (Windows Server 2012, Windows 10).
+ "NT_STATUS_ACCESS_DENIED"
+ "NT_STATUS_ACCOUNT_LOCKED_OUT"
+ "NT_STATUS_BAD_NETWORK_NAME"
+ "NT_STATUS_CANNOT_DELETE"
+ "NT_STATUS_CONNECTION_DISCONNECTED"
+ "NT_STATUS_CONNECTION_REFUSED"
+ "NT_STATUS_CONNECTION_RESET"
+ "NT_STATUS_DIRECTORY_NOT_EMPTY"
+ "NT_STATUS_DUPLICATE_NAME"
+ "NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
+ "NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
+ "NT_STATUS_INVALID_PARAMETER"
+ "NT_STATUS_INVALID_PARAMETER_MIX"
+ "NT_STATUS_IO_TIMEOUT"
+ "NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_NETWORK_ACCESS_DENIED"
+ "NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
+ "NT_STATUS_NO_SUCH_FILE"
+ "NT_STATUS_NO_SUCH_USER"
+ "NT_STATUS_NOT_A_DIRECTORY"
+ "NT_STATUS_NOT_SUPPORTED"
+ "NT_STATUS_OBJECT_NAME_COLLISION"
+ "NT_STATUS_OBJECT_NAME_INVALID"
+ "NT_STATUS_OBJECT_NAME_NOT_FOUND"
+ "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
+ "NT_STATUS_PASSWORD_MUST_CHANGE"
+ "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
+ "NT_STATUS_REVISION_MISMATCH"
+ "NT_STATUS_SHARING_VIOLATION"
+ "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
+ "NT_STATUS_UNSUCCESSFUL"
+ "NT_STATUS_WRONG_PASSWORD")))
"Regexp for possible error strings of SMB servers.
Used instead of analyzing error codes of commands.")
@@ -298,6 +298,7 @@ See `tramp-actions-before-shell' for more info.")
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . tramp-smb-handle-get-home-directory)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -727,7 +728,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary.
- (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" 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)
@@ -737,17 +740,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
- (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../"),
;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ v (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
@@ -765,10 +768,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(widen)
(tramp-message vec 10 "\n%s" (buffer-string))
(goto-char (point-min))
- (while (and (not (eobp)) (not (looking-at-p "^REVISION:")))
+ (while (and (not (eobp)) (not (looking-at-p (rx bol "REVISION:"))))
(forward-line)
(delete-region (point-min) (point)))
- (while (and (not (eobp)) (looking-at-p "^.+:.+"))
+ (while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl))))
(forward-line))
(delete-region (point) (point-max))
(throw 'tramp-action 'ok))))
@@ -882,29 +885,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(while (not (eobp))
(cond
((looking-at
- (concat
- "Size:\\s-+\\([[:digit:]]+\\)\\s-+"
- "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)"))
+ (rx "Size:" (+ blank) (group (+ digit)) (+ blank)
+ "Blocks:" (+ blank) (+ digit) (+ blank) (group (+
wordchar))))
(setq size (string-to-number (match-string 1))
id (if (string-equal "directory" (match-string 2)) t
(if (string-equal "symbolic" (match-string 2)) ""))))
((looking-at
-
"Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)")
+ (rx "Inode:" (+ blank) (group (+ digit)) (+ blank)
+ "Links:" (+ blank) (group (+ digit))))
(setq inode (string-to-number (match-string 1))
link (string-to-number (match-string 2))))
((looking-at
- (concat
- "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+"
- "Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
- "Gid:\\s-+\\([[:digit:]]+\\)"))
+ (rx "Access:" (+ blank)
+ "(" (+ digit) "/" (group (+ (not blank))) ")" (+ blank)
+ "Uid:" (+ blank) (group (+ digit)) (+ blank)
+ "Gid:" (+ blank) (group (+ digit))))
(setq mode (match-string 1)
uid (match-string 2)
gid (match-string 3)))
((looking-at
- (concat
- "Access:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Access:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq atime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -914,10 +918,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- (concat
- "Modify:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Modify:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq mtime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -927,10 +932,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- (concat
- "Change:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Change:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq ctime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -948,7 +954,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(format
"readlink %s" (tramp-smb-shell-quote-localname vec))))
(goto-char (point-min))
- (and (looking-at ".+ -> \\(.+\\)")
+ (and (looking-at (rx (+ nonl) " -> " (group (+ nonl))))
(setq id (match-string 1))))
;; Return the result.
@@ -1003,14 +1009,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available"))
+ (rx (* blank) (group (+ digit))
+ " blocks of size " (group (+ digit))
+ ". " (group (+ digit)) " blocks available"))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
- (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
+ (when (looking-at (rx "Total number of bytes: " (group (+ digit))))
;; The used number of bytes is not part of the result.
;; As side effect, we store it as file property.
(tramp-set-file-property
@@ -1061,11 +1067,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
(when wildcard
- (string-match "\\." base)
+ (string-match (rx ".") base)
(setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
+ (string-match (rx "*") base)
(setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
+ (string-match (rx "?") base)
(setq base (replace-match ".?" nil nil base)))
;; Filter entries.
@@ -1076,7 +1082,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p (format "^%s" base) (nth 0 x)) x))
+ (when (string-match-p
+ (tramp-compat-rx bol (literal base)) (nth 0 x))
+ x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1205,50 +1213,47 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
- (unless (tramp-smb-send-command
- v (format "symlink %s %s"
- (tramp-smb-shell-quote-argument target)
- (tramp-smb-shell-quote-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (tramp-get-connection-buffer v)))))))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported"))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ (unless (tramp-smb-send-command
+ v (format "symlink %s %s"
+ (tramp-smb-shell-quote-argument target)
+ (tramp-smb-shell-quote-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (tramp-get-connection-buffer v))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
@@ -1486,7 +1491,7 @@ component is used as the target of the symlink."
;; the function. No error is propagated outside,
;; due to the `ignore-errors' closure.
(unless
- (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (tramp-search-regexp (rx "tramp_exit_status " (+
digit)))
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'"
@@ -1577,7 +1582,8 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
filename
(with-parsed-tramp-file-name filename nil
;; Ignore in LOCALNAME everything before "//".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)"
localname))
+ (when (and (stringp localname)
+ (string-match (rx (+? nonl) "/" (group (| "/" "~")))
localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))))
@@ -1623,7 +1629,8 @@ VEC or USER, or if there is no home directory, return
nil."
"Return the share name of LOCALNAME."
(save-match-data
(let ((localname (tramp-file-name-unquote-localname vec)))
- (when (string-match "^/?\\([^/]+\\)/" localname)
+ (when (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname)
(match-string 1 localname)))))
(defun tramp-smb-get-localname (vec)
@@ -1633,7 +1640,9 @@ If VEC has no cifs capabilities, exchange \"/\" by
\"\\\\\"."
(let ((localname (tramp-file-name-unquote-localname vec)))
(setq
localname
- (if (string-match "^/?[^/]+\\(/.*\\)" localname)
+ (if (string-match
+ (tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl)))
+ localname)
;; There is a share, separated by "/".
(if (not (tramp-smb-get-cifs-capabilities vec))
(mapconcat
@@ -1641,16 +1650,17 @@ If VEC has no cifs capabilities, exchange \"/\" by
\"\\\\\"."
(match-string 1 localname) "")
(match-string 1 localname))
;; There is just a share.
- (if (string-match "^/?\\([^/]+\\)$" localname)
+ (if (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname)
(match-string 1 localname)
"")))
;; Sometimes we have discarded `substitute-in-file-name'.
- (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
+ (when (string-match (rx (group "$$") (| "/" eol)) localname)
(setq localname (replace-match "$" nil nil localname 1)))
;; A trailing space is not supported.
- (when (string-match-p " $" localname)
+ (when (string-match-p (rx blank eol) localname)
(tramp-error
vec 'file-error
"Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
@@ -1751,7 +1761,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
;;
;; Problems:
;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
-;; available in older Emacsen.
+;; available in older versions of Emacs.
;; * The length of constructs (file name, size) might exceed the default.
;; * File names might contain spaces.
;; * Permissions might be empty.
@@ -1769,7 +1779,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(if (not share)
;; Read share entries.
- (when (string-match "^Disk|\\([^|]+\\)|" line)
+ (when (string-match
+ (tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line)
(setq localname (match-string 1 line)
mode "dr-xr-xr-x"
size 0))
@@ -1778,14 +1789,17 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-block nil
;; year.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(setq year (string-to-number (match-string 1 line))
line (substring line 0 -5))
(cl-return))
;; time.
(if (string-match
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line)
+ (rx (group (+ digit)) ":"
+ (group (+ digit)) ":"
+ (group (+ digit)) eol)
+ line)
(setq hour (string-to-number (match-string 1 line))
min (string-to-number (match-string 2 line))
sec (string-to-number (match-string 3 line))
@@ -1793,28 +1807,28 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; day.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
;; month.
- (if (string-match "\\(\\w+\\)$" line)
+ (if (string-match (rx (group (+ wordchar)) eol) line)
(setq month (match-string 1 line)
line (substring line 0 -4))
(cl-return))
;; weekday.
- (if (string-match-p "\\(\\w+\\)$" line)
+ (if (string-match-p (rx (+ wordchar) eol) line)
(setq line (substring line 0 -5))
(cl-return))
;; size.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
- "\\([ACDEHNORrsSTV]+\\)" (substring line length))
+ (rx (+ (any "ACDEHNORSTVrs"))) (substring line length))
(setq length (+ length (match-end 0))))
(setq line (substring line 0 length)))
(cl-return))
@@ -1823,7 +1837,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
;; NONINDEXED, NORMAL, OFFLINE, READONLY,
;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
- (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
+ (if (string-match (rx (? (group (+ (any "ACDEHNORSTVrs")))) eol) line)
(setq
mode (or (match-string 1 line) "")
mode (format
@@ -1838,7 +1852,11 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; localname.
- (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
+ (if (string-match
+ (rx bol (+ blank)
+ (group (not blank) (? (* nonl) (not blank)))
+ (* blank) eol)
+ line)
(setq localname (match-string 1 line))
(cl-return))))
@@ -1877,7 +1895,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(member
"pathnames"
(split-string
- (buffer-substring (point) (line-end-position)) nil
'omit)))))))))
+ (buffer-substring (point) (line-end-position))
+ nil 'omit)))))))))
(defun tramp-smb-get-stat-capability (vec)
"Check whether the SMB server supports the `stat' command."
@@ -1927,7 +1946,7 @@ If ARGUMENT is non-nil, use it as argument for
(setq tramp-smb-version (shell-command-to-string command))
(tramp-message vec 6 command)
(tramp-message vec 6 "\n%s" tramp-smb-version)
- (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
+ (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version)
(setq tramp-smb-version
(replace-match "" nil nil tramp-smb-version))))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 4e3b94277b..3c67fa6ea2 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -46,6 +46,9 @@
:version "28.1"
:type 'string)
+;;;###tramp-autoload
+(defvar tramp-default-remote-shell) ;; Silence byte compiler.
+
;;;###tramp-autoload
(tramp--with-startup
(add-to-list 'tramp-methods
@@ -150,6 +153,7 @@
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -215,7 +219,7 @@ arguments to pass to the OPERATION."
(progn
;; Read the expression.
(goto-char (point-min))
- (buffer-substring (point) (line-end-position)))
+ (buffer-substring (point) (line-end-position)))
":" 'omit))))
;; The equivalent to `exec-directory'.
`(,(tramp-file-local-name (expand-file-name default-directory)))))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 643b5f35c0..bc8739c4d6 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -49,7 +49,8 @@
(tramp-password-previous-hop t)))
(add-to-list 'tramp-default-user-alist
- `("\\`sudoedit\\'" nil ,tramp-root-id-string))
+ `(,(tramp-compat-rx bos (literal tramp-sudoedit-method) eos)
+ nil ,tramp-root-id-string))
(tramp-set-completion-function
tramp-sudoedit-method tramp-completion-function-alist-su))
@@ -142,6 +143,7 @@ See `tramp-actions-before-shell' for more info.")
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-sudoedit-handle-get-remote-groups)
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -192,8 +194,8 @@ arguments to pass to the OPERATION."
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
+ (with-parsed-tramp-file-name (expand-file-name filename) v1
+ (with-parsed-tramp-file-name (expand-file-name newname) v2
;; Do the 'confirm if exists' thing.
(when (file-exists-p newname)
;; What to do?
@@ -233,6 +235,7 @@ This function is invoked by
`tramp-sudoedit-handle-copy-file' and
`tramp-sudoedit-handle-rename-file'. It is an error if OP is
neither of `copy' and `rename'. FILENAME and NEWNAME must be
absolute file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -343,7 +346,7 @@ absolute file names."
(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
@@ -366,31 +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 "\\`~\\([^/]*\\)\\(.*\\)\\'" 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 "^/\\.\\.?$" localname)
- (setq localname "/"))
- ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name
- v (if (string-match-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."
@@ -399,7 +407,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-acl"
(let ((result (and (tramp-sudoedit-remote-acl-p v)
(tramp-sudoedit-send-command-string
@@ -436,10 +444,15 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
- (tramp-sudoedit-send-command
- v "test" "-x" (tramp-compat-file-name-unquote localname)))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-sudoedit-send-command
+ v "test" "-x" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
@@ -447,10 +460,12 @@ the result will be a local, non-Tramp, file name."
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-exists-p"
- (tramp-sudoedit-send-command
- v "test" "-e" (tramp-compat-file-name-unquote localname))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-sudoedit-send-command
+ v "test" "-e" (tramp-compat-file-name-unquote localname)))))))
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -470,18 +485,21 @@ the result will be a local, non-Tramp, file name."
(delq
nil
(mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(split-string
(tramp-get-buffer-string (tramp-get-connection-buffer v))
"\n" 'omit))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-sudoedit-send-command
- v "test" "-r" (tramp-compat-file-name-unquote localname))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-sudoedit-send-command
+ v "test" "-r" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
@@ -501,18 +519,21 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
- "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
+ (regexp (tramp-compat-rx
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))))))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"
(tramp-compat-file-name-unquote localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (re-search-forward regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -530,9 +551,9 @@ the result will be a local, non-Tramp, file name."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (* blank) (group (+ digit))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))))
(list (string-to-number (match-string 1))
;; The second value is the used size. We need the
;; free size.
@@ -550,7 +571,7 @@ the result will be a local, non-Tramp, file name."
nil
time)))
(tramp-sudoedit-send-command
- v "env" "TZ=UTC" "touch" "-t"
+ v "env" "TZ=UTC0" "touch" "-t"
(format-time-string "%Y%m%d%H%M.%S" time t)
(if (eq flag 'nofollow) "-h" "")
(tramp-compat-file-name-unquote localname)))))
@@ -588,14 +609,19 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- (tramp-sudoedit-send-command
- v "test" "-w" (tramp-compat-file-name-unquote localname))
- (let ((dir (file-name-directory filename)))
- (and (file-exists-p dir)
- (file-writable-p dir)))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-sudoedit-send-command
+ v "test" "-w" (tramp-compat-file-name-unquote localname)))
+ ;; If file doesn't exist, check if directory is writable.
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
(defun tramp-sudoedit-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -620,41 +646,38 @@ the result will be a local, non-Tramp, file name."
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
- (tramp-sudoedit-send-command
- v "ln" "-sf"
- (tramp-compat-file-name-unquote target)
- (tramp-compat-file-name-unquote localname))))))
+ (with-parsed-tramp-file-name (expand-file-name linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (tramp-flush-file-properties v localname)
+ (tramp-sudoedit-send-command
+ v "ln" "-sf"
+ (tramp-compat-file-name-unquote target)
+ (tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -684,7 +707,7 @@ component is used as the target of the symlink."
(defun tramp-sudoedit-handle-set-file-selinux-context (filename context)
"Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(when (and (consp context)
(tramp-sudoedit-remote-selinux-p v))
(let ((user (and (stringp (nth 0 context)) (nth 0 context)))
@@ -714,18 +737,23 @@ VEC or USER, or if there is no home directory, return
nil."
(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- ;; The result is cached in `tramp-get-remote-uid'.
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-u")
- (tramp-sudoedit-send-command-string vec "id" "-un")))
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format)))
(defun tramp-sudoedit-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- ;; The result is cached in `tramp-get-remote-gid'.
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-g")
- (tramp-sudoedit-send-command-string vec "id" "-gn")))
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format)))
+
+(defun tramp-sudoedit-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format)))
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@@ -841,7 +869,7 @@ In case there is no valid Lisp expression, it raises an
error."
(condition-case nil
(prog1 (read (current-buffer))
;; Error handling.
- (when (re-search-forward "\\S-" (line-end-position) t)
+ (when (re-search-forward (rx (not blank)) (line-end-position) t)
(error nil)))
(error (tramp-error
vec 'file-error
@@ -855,7 +883,7 @@ In case there is no valid Lisp expression, it raises an
error."
(tramp-message vec 6 "\n%s" (buffer-string))
(goto-char (point-max))
;(delete-blank-lines)
- (while (looking-back "[ \t\n]+" nil 'greedy)
+ (while (looking-back (rx (+ (any " \t\n"))) nil 'greedy)
(delete-region (match-beginning 0) (point)))
(when (> (point-max) (point-min))
(substring-no-properties (buffer-string))))))
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index e849c36d13..2bbdb299a6 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; An implementation of "uuencode" in Lisp. Uses the function
-;; base64-encode-region which is built-in to modern Emacsen.
+;; base64-encode-region which is built-in to modern Emacs.
;;; Code:
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 238ec50c40..63f313dc50 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -64,7 +64,8 @@
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
-;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA
package.
+;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU
+;; ELPA package.
;;;###autoload (when (featurep 'tramp-compat)
;;;###autoload (load "tramp-compat" 'noerror 'nomessage))
@@ -204,9 +205,9 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
MUST be a Bourne-like shell. It is normally not necessary to
set this to any value other than \"/bin/sh\": Tramp wants to
use a shell which groks tilde expansion, but it can search
- for it. Also note that \"/bin/sh\" exists on all Unixen,
- this might not be true for the value that you decide to use.
- You Have Been Warned.
+ for it. Also note that \"/bin/sh\" exists on all Unixen
+ except Andtoid, this might not be true for the value that you
+ decide to use. You Have Been Warned.
* `tramp-remote-shell-login'
This specifies the arguments to let `tramp-remote-shell' run
@@ -277,7 +278,15 @@ 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 and \"adb\"-based methods do.
+ Until now, just \"ssh\"-based, \"sshfs\"-based and
+ \"adb\"-based methods do.
+
+ * `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
@@ -514,10 +523,11 @@ interpreted as a regular expression which always matches."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
(when (and (eq system-type 'windows-nt)
- (not (string-match-p "sh$" tramp-encoding-shell)))
- (list (format "\\`\\(%s\\|%s\\)\\'"
- (regexp-quote (downcase tramp-system-name))
- (regexp-quote (upcase tramp-system-name)))))
+ (not (string-match-p (rx "sh" eol) tramp-encoding-shell)))
+ (list (tramp-compat-rx
+ bos (| (literal (downcase tramp-system-name))
+ (literal (upcase tramp-system-name)))
+ eos)))
"List of hosts, which run a restricted shell.
This is a list of regular expressions, which denote hosts running
a restricted shell like \"rbash\". Those hosts can be used as
@@ -528,12 +538,11 @@ host runs a restricted shell, it shall be added to this
list, too."
;;;###tramp-autoload
(defcustom tramp-local-host-regexp
- (concat
- "\\`"
- (regexp-opt
- `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1"
"::1")
- t)
- "\\'")
+ (tramp-compat-rx
+ bos
+ (| (literal tramp-system-name)
+ (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1"))
+ eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
:version "29.1"
@@ -580,8 +589,9 @@ followed by an equal number of backspaces to erase them will
usually suffice.")
(defconst tramp-echoed-echo-mark-regexp
- (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
- tramp-echo-mark-marker tramp-echo-mark-marker-length)
+ (rx-to-string
+ `(: ,tramp-echo-mark-marker
+ (= ,tramp-echo-mark-marker-length "\b" (? " \b"))))
"Regexp which matches `tramp-echo-mark' as it gets echoed by \
the remote shell.")
@@ -598,7 +608,7 @@ if you need to change this."
:type 'string)
(defcustom tramp-login-prompt-regexp
- ".*\\(user\\|login\\)\\( .*\\)?: *"
+ (rx (* nonl) (| "user" "login") (? blank (* nonl)) ":" (* blank))
"Regexp matching login-like prompts.
The regexp should match at end of buffer.
@@ -610,8 +620,11 @@ Sometimes the prompt is reported to look like \"login
as:\"."
;; displayed at the beginning of the line (and Zsh uses it).
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
- (concat "\\(?:^\\|\r\\)"
- "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*")
+ (rx (| bol "\r")
+ (* (not (any "\n#$%>]")))
+ (? "#") (any "#$%>]") (* blank)
+ ;; Escape characters.
+ (* "[" (* (any ";" digit)) alpha (* blank)))
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -626,7 +639,10 @@ This regexp must match both `tramp-initial-end-of-output'
and
:type 'regexp)
(defcustom tramp-password-prompt-regexp
- (format "^.*\\(%s\\).*:\^@? *" (regexp-opt password-word-equivalents))
+ (tramp-compat-rx
+ bol (* nonl)
+ (group (regexp (regexp-opt password-word-equivalents)))
+ (* nonl) ":" (? "\^@") (* blank))
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
@@ -640,36 +656,26 @@ The `sudo' program appears to insert a `^@' character
into the prompt."
:type 'regexp)
(defcustom tramp-wrong-passwd-regexp
- (concat "^.*"
- ;; These strings should be on the last line
- (regexp-opt '("Permission denied"
- "Login incorrect"
- "Login Incorrect"
- "Connection refused"
- "Connection closed"
- "Timeout, server not responding."
- "Sorry, try again."
- "Name or service not known"
- "Host key verification failed."
- "No supported authentication methods left to try!")
- t)
- ".*"
- "\\|"
- "^.*\\("
- ;; Here comes a list of regexes, separated by \\|
- "Received signal [[:digit:]]+"
- "\\).*")
+ (rx bol (* nonl)
+ (| "Permission denied"
+ "Login [Ii]ncorrect"
+ "Connection refused"
+ "Connection closed"
+ "Timeout, server not responding."
+ "Sorry, try again."
+ "Name or service not known"
+ "Host key verification failed."
+ "No supported authentication methods left to try!"
+ (: "Received signal " (+ digit)))
+ (* nonl))
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
:type 'regexp)
(defcustom tramp-yesno-prompt-regexp
- (concat
- (regexp-opt
- '("Are you sure you want to continue connecting (yes/no)?"
- "Are you sure you want to continue connecting (yes/no/[fingerprint])?")
- t)
- "\\s-*")
+ (rx "Are you sure you want to continue connecting (yes/no"
+ (? "/[fingerprint]") ")?"
+ (* blank))
"Regular expression matching all yes/no queries which need to be confirmed.
The confirmation should be done with yes or no.
The regexp should match at end of buffer.
@@ -677,11 +683,9 @@ See also `tramp-yn-prompt-regexp'."
:type 'regexp)
(defcustom tramp-yn-prompt-regexp
- (concat
- (regexp-opt '("Store key in cache? (y/n)"
- "Update cached key? (y/n, Return cancels connection)")
- t)
- "\\s-*")
+ (rx (| "Store key in cache? (y/n)"
+ "Update cached key? (y/n, Return cancels connection)")
+ (* blank))
"Regular expression matching all y/n queries which need to be confirmed.
The confirmation should be done with y or n.
The regexp should match at end of buffer.
@@ -698,11 +702,9 @@ files conditionalize this setup based on the TERM
environment variable."
:type 'string)
(defcustom tramp-terminal-prompt-regexp
- (concat "\\("
- "TERM = (.*)"
- "\\|"
- "Terminal type\\? \\[.*\\]"
- "\\)\\s-*")
+ (rx (| (: "TERM = (" (* nonl) ")")
+ (: "Terminal type? [" (* nonl) "]"))
+ (* blank))
"Regular expression matching all terminal setting prompts.
The regexp should match at end of buffer.
The answer will be provided by `tramp-action-terminal', which see."
@@ -713,7 +715,7 @@ The answer will be provided by `tramp-action-terminal',
which see."
;; "-no-antispoof". However, since we don't know which PuTTY
;; version is installed, we must react interactively.
(defcustom tramp-antispoof-regexp
- (regexp-quote "Access granted. Press Return to begin session. ")
+ (rx "Access granted. Press Return to begin session. ")
"Regular expression matching plink's anti-spoofing message.
The regexp should match at end of buffer."
:version "27.1"
@@ -723,42 +725,42 @@ The regexp should match at end of buffer."
;; with their finger. We must tell it to the user.
;; Added in OpenSSH 8.2. I've tested it with yubikey.
(defcustom tramp-security-key-confirm-regexp
- "^\r*Confirm user presence for key .*[\r\n]*"
+ (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-security-key-confirmed-regexp
- "^\r*User presence confirmed[\r\n]*"
+ (rx bol (* "\r") "User presence confirmed" (* (any "\r\n")))
"Regular expression matching security key confirmation message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-security-key-timeout-regexp
- "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*"
+ (rx bol (* "\r") "sign_and_send_pubkey: signing failed for "
+ (* nonl) (* (any "\r\n")))
"Regular expression matching security key timeout message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-operation-not-permitted-regexp
- (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
- (regexp-opt '("Operation not permitted") t))
+ (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank)
+ "Operation not permitted")
"Regular expression matching keep-date problems in (s)cp operations.
Copying has been performed successfully already, so this message can
be ignored safely."
:type 'regexp)
(defcustom tramp-copy-failed-regexp
- (concat "\\(.+: "
- (regexp-opt '("Permission denied"
- "not a regular file"
- "is a directory"
- "No such file or directory")
- t)
- "\\)\\s-*")
+ (rx (+ nonl) ": "
+ (| "No such file or directory"
+ "Permission denied"
+ "is a directory"
+ "not a regular file")
+ (* blank))
"Regular expression matching copy problems in (s)cp operations."
:type 'regexp)
@@ -809,6 +811,23 @@ Customize. See also `tramp-change-syntax'."
:initialize #'custom-initialize-default
:set #'tramp-set-syntax)
+(defvar tramp-prefix-format)
+(defvar tramp-prefix-regexp)
+(defvar tramp-method-regexp)
+(defvar tramp-postfix-method-format)
+(defvar tramp-postfix-method-regexp)
+(defvar tramp-prefix-ipv6-format)
+(defvar tramp-prefix-ipv6-regexp)
+(defvar tramp-postfix-ipv6-format)
+(defvar tramp-postfix-ipv6-regexp)
+(defvar tramp-postfix-host-format)
+(defvar tramp-postfix-host-regexp)
+(defvar tramp-remote-file-name-spec-regexp)
+(defvar tramp-file-name-structure)
+(defvar tramp-file-name-regexp)
+(defvar tramp-completion-method-regexp)
+(defvar tramp-completion-file-name-regexp)
+
(defun tramp-set-syntax (symbol value)
"Set SYMBOL to value VALUE.
Used in user option `tramp-syntax'. There are further variables
@@ -822,24 +841,25 @@ to be set, depending on VALUE."
;; Set the value:
(set-default symbol value)
;; Reset the depending variables.
- (with-no-warnings
- (setq tramp-prefix-format (tramp-build-prefix-format)
- tramp-prefix-regexp (tramp-build-prefix-regexp)
- tramp-method-regexp (tramp-build-method-regexp)
- tramp-postfix-method-format (tramp-build-postfix-method-format)
- tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
- tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
- tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
- tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
- tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
- tramp-postfix-host-format (tramp-build-postfix-host-format)
- tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
- tramp-remote-file-name-spec-regexp
- (tramp-build-remote-file-name-spec-regexp)
- tramp-file-name-structure (tramp-build-file-name-structure)
- tramp-file-name-regexp (tramp-build-file-name-regexp)
- tramp-completion-file-name-regexp
- (tramp-build-completion-file-name-regexp)))
+ (setq tramp-prefix-format (tramp-build-prefix-format)
+ tramp-prefix-regexp (tramp-build-prefix-regexp)
+ tramp-method-regexp (tramp-build-method-regexp)
+ tramp-postfix-method-format (tramp-build-postfix-method-format)
+ tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
+ tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
+ tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
+ tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
+ tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
+ tramp-postfix-host-format (tramp-build-postfix-host-format)
+ tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
+ tramp-remote-file-name-spec-regexp
+ (tramp-build-remote-file-name-spec-regexp)
+ tramp-file-name-structure (tramp-build-file-name-structure)
+ tramp-file-name-regexp (tramp-build-file-name-regexp)
+ tramp-completion-method-regexp
+ (tramp-build-completion-method-regexp)
+ tramp-completion-file-name-regexp
+ (tramp-build-completion-file-name-regexp))
;; Rearrange file name handlers.
(tramp-register-file-name-handlers))
@@ -872,30 +892,32 @@ Raise an error if it is invalid."
"Return `tramp-prefix-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-prefix-format-alist))
-(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-format nil ; Initialized when defining `tramp-syntax'!
"String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-regexp ()
"Return `tramp-prefix-regexp'."
- (concat "^" (regexp-quote tramp-prefix-format)))
+ (tramp-compat-rx bol (literal (tramp-build-prefix-format))))
-(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
- '((default . "[[:alnum:]-]+")
+ `((default . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (>= 2 alnum))))
(simplified . "")
- (separate . "[[:alnum:]-]*"))
+ (separate . ,(tramp-compat-rx
+ (? (| (literal tramp-default-method-marker) (>= 2 alnum))))))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
"Return `tramp-method-regexp' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-method-regexp-alist))
-(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'!
- "Regexp matching methods identifiers.
+(defvar tramp-method-regexp nil ; Initialized when defining `tramp-syntax'!
+ "Regexp matching method identifiers.
The `ftp' syntax does not support methods.")
(defconst tramp-postfix-method-format-alist
@@ -908,47 +930,50 @@ The `ftp' syntax does not support methods.")
"Return `tramp-postfix-method-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-method-format-alist))
-(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'!
+(defvar tramp-postfix-method-format nil ; Init'd when defining `tramp-syntax'!
"String matching delimiter between method and user or host names.
The `ftp' syntax does not support methods.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-method-regexp ()
"Return `tramp-postfix-method-regexp'."
- (regexp-quote tramp-postfix-method-format))
+ (tramp-compat-rx (literal (tramp-build-postfix-method-format))))
-(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'!
+(defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'!
"Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp "[^/|: \t]+"
+(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank))))
"Regexp matching user names.")
(defconst tramp-prefix-domain-format "%"
"String matching delimiter between user and domain names.")
-(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format)
+(defconst tramp-prefix-domain-regexp
+ (tramp-compat-rx (literal tramp-prefix-domain-format))
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
-(defconst tramp-domain-regexp "[[:alnum:]_.-]+"
+(defconst tramp-domain-regexp (rx (+ (any "._-" alnum)))
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
- (concat "\\(" tramp-user-regexp "\\)"
- tramp-prefix-domain-regexp
- "\\(" tramp-domain-regexp "\\)")
+ (tramp-compat-rx
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-prefix-domain-regexp)
+ (group (regexp tramp-domain-regexp)))
"Regexp matching user names with domain names.")
(defconst tramp-postfix-user-format "@"
"String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
-(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format)
+(defconst tramp-postfix-user-regexp
+ (tramp-compat-rx (literal tramp-postfix-user-format))
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[[:alnum:]_.%-]+"
+(defconst tramp-host-regexp (rx (+ (any "%._-" alnum)))
"Regexp matching host names.")
(defconst tramp-prefix-ipv6-format-alist
@@ -961,22 +986,22 @@ Derived from `tramp-postfix-user-format'.")
"Return `tramp-prefix-ipv6-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
-(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-ipv6-format nil ; Initialized when defining
`tramp-syntax'!
"String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-ipv6-regexp ()
"Return `tramp-prefix-ipv6-regexp'."
- (regexp-quote tramp-prefix-ipv6-format))
+ (tramp-compat-rx (literal tramp-prefix-ipv6-format)))
-(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching left hand side of IPv6 addresses.
Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+"
+(defconst tramp-ipv6-regexp (rx (+ (* alnum) ":") (* (any "." alnum)))
"Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format-alist
@@ -989,38 +1014,41 @@ Derived from `tramp-prefix-ipv6-format'.")
"Return `tramp-postfix-ipv6-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
-(defvar tramp-postfix-ipv6-format nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-ipv6-format nil ; Initialized when defining
`tramp-syntax'!
"String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-ipv6-regexp ()
"Return `tramp-postfix-ipv6-regexp'."
- (regexp-quote tramp-postfix-ipv6-format))
+ (tramp-compat-rx (literal tramp-postfix-ipv6-format)))
-(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching right hand side of IPv6 addresses.
Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format "#"
"String matching delimiter between host names and port numbers.")
-(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format)
+(defconst tramp-prefix-port-regexp
+ (tramp-compat-rx (literal tramp-prefix-port-format))
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
-(defconst tramp-port-regexp "[[:digit:]]+"
+(defconst tramp-port-regexp (rx (+ digit))
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
- (concat "\\(" tramp-host-regexp "\\)"
- tramp-prefix-port-regexp
- "\\(" tramp-port-regexp "\\)")
+ (tramp-compat-rx
+ (group (regexp tramp-host-regexp))
+ (regexp tramp-prefix-port-regexp)
+ (group (regexp tramp-port-regexp)))
"Regexp matching host names with port numbers.")
(defconst tramp-postfix-hop-format "|"
"String matching delimiter after ad-hoc hop definitions.")
-(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format)
+(defconst tramp-postfix-hop-regexp
+ (tramp-compat-rx (literal tramp-postfix-hop-format))
"Regexp matching delimiter after ad-hoc hop definitions.
Derived from `tramp-postfix-hop-format'.")
@@ -1034,19 +1062,19 @@ Derived from `tramp-postfix-hop-format'.")
"Return `tramp-postfix-host-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-host-format-alist))
-(defvar tramp-postfix-host-format nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-host-format nil ; Initialized when defining
`tramp-syntax'!
"String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-host-regexp ()
"Return `tramp-postfix-host-regexp'."
- (regexp-quote tramp-postfix-host-format))
+ (tramp-compat-rx (literal tramp-postfix-host-format)))
-(defvar tramp-postfix-host-regexp nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-host-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching delimiter between host names and localnames.
Derived from `tramp-postfix-host-format'.")
-(defconst tramp-localname-regexp "[^\n\r]*\\'"
+(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos)
"Regexp matching localnames.")
(defconst tramp-unknown-id-string "UNKNOWN"
@@ -1067,16 +1095,21 @@ 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."
- (concat
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(?:" tramp-host-regexp "\\|"
- tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
- tramp-postfix-ipv6-regexp "\\)"
- "\\(?:" tramp-prefix-port-regexp tramp-port-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'!
+ nil ; Initialized when defining `tramp-syntax'!
"Regular expression matching a Tramp file name between prefix and postfix.")
(defun tramp-build-file-name-structure ()
@@ -1084,15 +1117,16 @@ It is expected, that `tramp-syntax' has the proper
value."
It is expected, that `tramp-syntax' has the proper value.
See `tramp-file-name-structure'."
(list
- (concat
- tramp-prefix-regexp
- "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp "\\)+" "\\)?"
- tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
- "\\(" tramp-localname-regexp "\\)")
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (? (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-host-regexp)
+ (group (regexp tramp-localname-regexp)))
5 6 7 8 1))
-(defvar tramp-file-name-structure nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-file-name-structure nil ; Initialized when defining
`tramp-syntax'!
"List detailing the Tramp file name structure.
This is a list of six elements (REGEXP METHOD USER HOST FILE HOP).
@@ -1117,7 +1151,8 @@ See also `tramp-file-name-regexp'.")
(car tramp-file-name-structure))
;;;###autoload
-(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:"
+(defconst tramp-initial-file-name-regexp
+ (rx bos "/" (+ (not (any "/:"))) ":" (* (not (any "/:"))) ":")
"Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
@@ -1134,78 +1169,60 @@ initial value is overwritten by the car of
`tramp-file-name-structure'.")
:version "27.1"
:type '(choice (const nil) regexp))
-(defconst tramp-completion-file-name-regexp-default
- (concat
- "\\`"
- ;; `file-name-completion' uses absolute paths for matching. This
- ;; means that on W32 systems, something like "/ssh:host:~/path"
- ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\("
- ;; Optional multi hop.
- "\\([^/|:]+:[^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ;; Method separator, user name and host name.
- "\\(:[^/|:]*\\)?"
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for default remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-simplified
- (concat
- "\\`"
- ;; Allow the volume letter at the beginning of the path. See the
- ;; comment in `tramp-completion-file-name-regexp-default' for more
- ;; details.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\("
- ;; Optional multi hop.
- "\\([^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; At least two characters.
- "[^/|:]\\{2,\\}"
- ;; At least one character.
- "[^/|:]+")
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for simplified style remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-separate
- (concat
- "\\`"
- ;; Allow the volume letter at the beginning of the path. See the
- ;; comment in `tramp-completion-file-name-regexp-default' for more
- ;; details.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\(\\[[^]]*\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for separate remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-(defconst tramp-completion-file-name-regexp-alist
- `((default . ,tramp-completion-file-name-regexp-default)
- (simplified . ,tramp-completion-file-name-regexp-simplified)
- (separate . ,tramp-completion-file-name-regexp-separate))
- "Alist mapping incomplete Tramp file names.")
+(defconst tramp-volume-letter-regexp
+ (if (eq system-type 'windows-nt)
+ (rx bos alpha ":") "")
+ "Volume letter on MS Windows.")
+
+;; `tramp-method-regexp' needs at least two characters, in order to
+;; distinguish from volume letter. This is in the way when completing.
+(defconst tramp-completion-method-regexp-alist
+ `((default . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (+ alnum))))
+ (simplified . "")
+ (separate . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (* alnum)))))
+ "Alist mapping Tramp syntax to regexps matching completion methods.")
+
+(defun tramp-build-completion-method-regexp ()
+ "Return `tramp-completion-method-regexp' according to `tramp-syntax'."
+ (tramp-lookup-syntax tramp-completion-method-regexp-alist))
+
+(defvar tramp-completion-method-regexp
+ nil ; Initialized when defining `tramp-syntax'!
+ "Regexp matching completion method identifiers.
+The `ftp' syntax does not support methods.")
(defun tramp-build-completion-file-name-regexp ()
"Return `tramp-completion-file-name-regexp' according to `tramp-syntax'."
- (tramp-lookup-syntax tramp-completion-file-name-regexp-alist))
+ (if (eq tramp-syntax 'separate)
+ ;; FIXME: This shouldn't be necessary.
+ (tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos)
+ (tramp-compat-rx
+ bos
+ ;; `file-name-completion' uses absolute paths for matching.
+ ;; This means that on W32 systems, something like
+ ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
+ ;; `tramp-drop-volume-letter'.
+ (? (regexp tramp-volume-letter-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)
+ (regexp tramp-postfix-hop-regexp))
+
+ ;; Last hop.
+ (? (regexp tramp-completion-method-regexp)
+ ;; Method separator, user name and host name.
+ (? (regexp tramp-postfix-method-regexp)
+ ;; This is a little bit lax, but it serves.
+ (? (regexp tramp-host-regexp))))
+
+ eos)))
(defvar tramp-completion-file-name-regexp
- nil ;Initialized when defining `tramp-syntax'!
+ nil ; Initialized when defining `tramp-syntax'!
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
@@ -1218,14 +1235,8 @@ Also see `tramp-file-name-structure'.")
;;;###autoload
(defconst tramp-autoload-file-name-regexp
- (concat
- "\\`/"
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ":")
+ ;; The method is either "-", or at least two characters.
+ (rx bos "/" (| "-" (>= 2 (not (any "/:|")))) ":")
"Regular expression matching file names handled by Tramp autoload.
It must match the initial `tramp-syntax' settings. It should not
match file names at root of the underlying local file system,
@@ -1444,9 +1455,14 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal
;; data structure.
-;; The basic structure for remote file names. We must autoload it in
-;; tramp-loaddefs.el, because some functions, which need it, wouldn't
-;; work otherwise when unloading / reloading Tramp. (Bug#50869)
+;; The basic structure for remote file names.
+
+;; Note: We started autoloading it in tramp-loaddefs.el, because some
+;; functions, which needed it, wouldn't work otherwise when unloading
+;; / reloading Tramp (Bug#50869).
+;; This bug is fixed in Emacs 29, but other parts of Tramp have grown
+;; dependencies on having this in tramp-loaddefs.el in the mean time,
+;; so .... here we are.
;;;###tramp-autoload(require 'cl-lib)
;;;###tramp-autoload
(progn
@@ -1497,27 +1513,28 @@ If nil, return `tramp-default-port'."
;;;###tramp-autoload
(defun tramp-file-name-unify (vec &optional localname)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
-If LOCALNAME is a string, set it as localname.
+If LOCALNAME is an absolute file name, set it as localname. If
+LOCALNAME is a relative file name, return `tramp-cache-undefined'.
Objects returned by this function compare `equal' if they refer to the
same connection. Make a copy in order to avoid side effects."
- (when (tramp-file-name-p vec)
- (setq vec (copy-tramp-file-name vec))
- (setf (tramp-file-name-localname vec)
- (and (stringp localname)
- ;; FIXME: This is a sanity check. When this error
- ;; doesn't happen for a while, it can be removed.
- (or (file-name-absolute-p localname)
- (tramp-error
- vec 'file-error "File `%s' must be absolute" localname))
- (tramp-compat-file-name-unquote (directory-file-name localname)))
- (tramp-file-name-hop vec) nil))
- vec)
+ (if (and (stringp localname)
+ (not (file-name-absolute-p localname)))
+ (setq vec tramp-cache-undefined)
+ (when (tramp-file-name-p vec)
+ (setq vec (copy-tramp-file-name vec))
+ (setf (tramp-file-name-localname vec)
+ (and (stringp localname)
+ (tramp-compat-file-name-unquote
+ (directory-file-name localname)))
+ (tramp-file-name-hop vec) nil))
+ vec))
(put #'tramp-file-name-unify 'tramp-suppress-trace t)
;; 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))))
@@ -1528,7 +1545,7 @@ If VEC is a vector, check first in connection properties.
Afterwards, check in `tramp-methods'. If the `tramp-methods'
entry does not exist, return nil."
(let ((hash-entry
- (replace-regexp-in-string "^tramp-" "" (symbol-name param))))
+ (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param))))
(if (tramp-connection-property-p vec hash-entry)
;; We use the cached property.
(tramp-get-connection-property vec hash-entry)
@@ -1548,10 +1565,7 @@ entry does not exist, return nil."
"Return t if NAME is a string with Tramp file name syntax."
(and tramp-mode (stringp name)
;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
- (not (string-match-p
- (if (memq system-type '(cygwin windows-nt))
- "^/[[:alpha:]]?:" "^/:")
- name))
+ (not (string-match-p (rx bos "/" (? alpha) ":") name))
;; Excluded file names.
(or (null tramp-ignored-file-name-regexp)
(not (string-match-p tramp-ignored-file-name-regexp name)))
@@ -1744,7 +1758,7 @@ See `tramp-dissect-file-name' for details."
(let ((v (tramp-dissect-file-name
(concat tramp-prefix-format
(replace-regexp-in-string
- (concat tramp-postfix-hop-regexp "$")
+ (tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos)
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
@@ -1797,7 +1811,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
;; Assure that the hops are in `tramp-default-proxies-alist'.
;; In tramp-archive.el, the slot `hop' is used for the archive
;; file name.
- (unless (string-equal method "archive")
+ (unless (string-equal method tramp-archive-method)
(tramp-add-hops (car args)))))
(t (setq method (nth 0 args)
@@ -1840,7 +1854,9 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
(replace-regexp-in-string
tramp-prefix-regexp ""
(replace-regexp-in-string
- (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
+ (tramp-compat-rx
+ (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)
@@ -1955,10 +1971,12 @@ of `current-buffer'."
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
(defconst tramp-debug-outline-regexp
- (concat
- "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
+ (rx ;; Timestamp.
+ (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
+ ;; Thread.
+ (? (group "#<thread " (+ nonl) ">") blank)
+ ;; Function name, verbosity.
+ (+ (any "-" alnum)) " (" (group (+ digit)) ") #")
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@@ -1967,7 +1985,7 @@ of `current-buffer'."
;; Also, in `font-lock-defaults' you can specify a function name for
;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
- (concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
+ (tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
'(1 font-lock-warning-face t t)
'(0 (outline-font-lock-face) keep t))
"Used for highlighting Tramp debug buffers in `outline-mode'.")
@@ -2421,13 +2439,16 @@ letter into the file name. This function removes it."
(save-match-data
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
- (setq result (if (string-match "\\`[[:alpha:]]:/" result)
- (replace-match "/" nil t result) result))
+ (setq result
+ (replace-regexp-in-string
+ (tramp-compat-rx (regexp tramp-volume-letter-regexp) "/")
+ "/" result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
-(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$"
+(defconst tramp-dns-sd-service-regexp
+ (rx bol "_" (+ (any "-" alnum)) "._tcp" eol)
"DNS-SD service regexp.")
;;;###tramp-autoload
@@ -2530,7 +2551,7 @@ coding system might not be determined. This function
repairs it."
;; We found a matching entry in `file-coding-system-alist'.
;; So we add a similar entry, but with the temporary file name
;; as regexp.
- (push (cons (regexp-quote tmpname) (cdr elt)) result)))))
+ (push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result)))))
(defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
@@ -2642,8 +2663,8 @@ Must be handled by the callers."
(tramp-get-default-directory (process-buffer (nth 0 args)))))
;; VEC.
((member operation
- '(tramp-get-home-directory
- tramp-get-remote-gid tramp-get-remote-uid))
+ '(tramp-get-home-directory tramp-get-remote-gid
+ tramp-get-remote-groups tramp-get-remote-uid))
(tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
@@ -2808,14 +2829,12 @@ This avoids problems during autoload, when `load-path'
contains
remote file names."
;; We expect all other Tramp files in the same directory as tramp.el.
(let* ((dir (expand-file-name (file-name-directory (locate-library
"tramp"))))
- (files-regexp
- (format
- "^%s$"
- (regexp-opt
- (mapcar
- #'file-name-sans-extension
- (directory-files dir nil "\\`tramp.+\\.elc?\\'"))
- 'paren))))
+ (files (delete-dups
+ (mapcar
+ #'file-name-sans-extension
+ (directory-files
+ dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos)))))
+ (files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol)))
(mapatoms
(lambda (atom)
(when (and (functionp atom)
@@ -2852,6 +2871,7 @@ remote file names."
(put #'tramp-completion-file-name-handler 'operations
(mapcar #'car tramp-completion-file-name-handler-alist))
+ ;; Integrated in Emacs 27.
(when (bound-and-true-p tramp-archive-enabled)
(add-to-list 'file-name-handler-alist
(cons tramp-archive-file-name-regexp
@@ -2960,11 +2980,10 @@ not in completion mode."
;; Suppress hop from completion.
(when (string-match
- (concat
- tramp-prefix-regexp
- "\\(" "\\(" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp
- "\\)+" "\\)")
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
fullname)
(setq hop (match-string 1 fullname)
fullname (replace-match "" nil nil fullname 1)))
@@ -3046,69 +3065,69 @@ not in completion mode."
;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""]
;; ["x" "" nil nil] ["x" "y" nil nil]
-;; "/x:y@""/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]"
-;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
+;; "/x:y@" "/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]"
+;; ["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
(defun tramp-completion-dissect-file-name (name)
"Return a list of `tramp-file-name' structures for NAME.
They are collected by `tramp-completion-dissect-file-name1'."
- (let* ((x-nil "\\|\\(\\)")
- (tramp-completion-ipv6-regexp
- (format
- "[^%s]*"
- (if (zerop (length tramp-postfix-ipv6-format))
- tramp-postfix-host-format
- tramp-postfix-ipv6-format)))
- ;; "/method" "/[method"
- (tramp-completion-file-name-structure1
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp x-nil "\\)$")
- 1 nil nil nil))
- ;; "/method:user" "/[method/user"
- (tramp-completion-file-name-structure2
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp x-nil "\\)$")
- 1 2 nil nil))
- ;; "/method:host" "/[method/host"
- (tramp-completion-file-name-structure3
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:[ipv6" "/[method/ipv6"
- (tramp-completion-file-name-structure4
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:user@host" "/[method/user@host"
- (tramp-completion-file-name-structure5
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 2 3 nil))
- ;; "/method:user@[ipv6" "/[method/user@ipv6"
- (tramp-completion-file-name-structure6
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 2 3 nil)))
+ (let (;; "/method" "/[method"
+ (tramp-completion-file-name-structure1
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (? (regexp tramp-completion-method-regexp))) eol)
+ 1 nil nil nil))
+ ;; "/method:user" "/[method/user"
+ (tramp-completion-file-name-structure2
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (? (regexp tramp-user-regexp))) eol)
+ 1 2 nil nil))
+ ;; "/method:host" "/[method/host"
+ (tramp-completion-file-name-structure3
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (? (regexp tramp-host-regexp))) eol)
+ 1 nil 2 nil))
+ ;; "/method:[ipv6" "/[method/ipv6"
+ (tramp-completion-file-name-structure4
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 nil 2 nil))
+ ;; "/method:user@host" "/[method/user@host"
+ (tramp-completion-file-name-structure5
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (group (? (regexp tramp-host-regexp))) eol)
+ 1 2 3 nil))
+ ;; "/method:user@[ipv6" "/[method/user@ipv6"
+ (tramp-completion-file-name-structure6
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 2 3 nil)))
(delq
nil
(mapcar
@@ -3233,11 +3252,11 @@ Either user or host may be nil."
Either user or host may be nil."
(let (result
(regexp
- (concat
- "^\\(" tramp-host-regexp "\\)"
- "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
+ (tramp-compat-rx
+ bol (group (regexp tramp-host-regexp))
+ (? (+ blank) (group (regexp tramp-user-regexp))))))
(when (re-search-forward regexp (line-end-position) t)
- (setq result (append (list (match-string 3) (match-string 1)))))
+ (setq result (append (list (match-string 2) (match-string 1)))))
(forward-line 1)
result))
@@ -3249,7 +3268,8 @@ User is always nil."
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
+ (tramp-parse-group
+ (tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ","))
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3260,9 +3280,11 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
- (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)"
- "\\|" "\\(" tramp-host-regexp "\\)")
- 1 " \t"))
+ (tramp-compat-rx
+ (| (: bol (* blank) "Host")
+ (: bol (+ nonl)) ;; ???
+ (group (regexp tramp-host-regexp))))
+ 1 (rx blank)))
;; Generic function.
(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
@@ -3274,21 +3296,25 @@ User is always nil."
(files (and (file-directory-p dirname) (directory-files dirname))))
(cl-loop
for f in files
- when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ when (and (not (string-match-p (rx bol (** 1 2 ".") eol) f))
+ (string-match regexp f))
collect (list nil (match-string 1 f)))))
(defun tramp-parse-shostkeys (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
- dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+ dirname
+ (tramp-compat-rx
+ bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol)))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
dirname
- (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
+ (tramp-compat-rx
+ bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub"
eol)))
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3299,7 +3325,9 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
+ (tramp-compat-rx
+ bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
+ 1 (rx blank)))
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3317,7 +3345,7 @@ Host is always \"localhost\"."
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let (result
- (regexp (concat "^\\(" tramp-user-regexp "\\):")))
+ (regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":")))
(when (re-search-forward regexp (line-end-position) t)
(setq result (list (match-string 1) "localhost")))
(forward-line 1)
@@ -3339,7 +3367,8 @@ Host is always \"localhost\"."
"Return a (group host) tuple allowed to access.
Host is always \"localhost\"."
(let (result
- (split (split-string (buffer-substring (point) (line-end-position))
":")))
+ (split
+ (split-string (buffer-substring (point) (line-end-position)) ":")))
(when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
(setq result (list (nth 0 split) "localhost")))
(forward-line 1)
@@ -3367,17 +3396,18 @@ User is always nil."
(tramp-parse-putty-group registry-or-dirname)))))
;; UNIX case.
(tramp-parse-shostkeys-sknownhosts
- registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
+ registry-or-dirname
+ (tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol))))
(defun tramp-parse-putty-group (registry)
- "Return a (user host) tuple allowed to access.
+ "Return a (user host) tuple allowed to access.
User is always nil."
- (let (result
- (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (when (re-search-forward regexp (line-end-position) t)
- (setq result (list nil (match-string 1))))
- (forward-line 1)
- result))
+ (let (result
+ (regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl)))))
+ (when (re-search-forward regexp (line-end-position) t)
+ (setq result (list nil (match-string 1))))
+ (forward-line 1)
+ result))
;;; Skeleton macros for file name handler functions.
@@ -3416,7 +3446,7 @@ BODY is the backend specific code."
BODY is the backend specific code."
(declare (indent 5) (debug t))
`(or
- (with-parsed-tramp-file-name ,directory nil
+ (with-parsed-tramp-file-name (expand-file-name ,directory) nil
(tramp-barf-if-file-missing v ,directory
(when (file-directory-p ,directory)
(setq ,directory
@@ -3447,7 +3477,7 @@ BODY is the backend specific code."
BODY is the backend specific code."
(declare (indent 6) (debug t))
`(or
- (with-parsed-tramp-file-name ,directory nil
+ (with-parsed-tramp-file-name (expand-file-name ,directory) nil
(tramp-barf-if-file-missing v ,directory
(when (file-directory-p ,directory)
(let ((temp
@@ -3509,7 +3539,7 @@ BODY is the backend specific code."
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
BODY is the backend specific code."
(declare (indent 1) (debug t))
- `(with-parsed-tramp-file-name ,filename nil
+ `(with-parsed-tramp-file-name (expand-file-name ,filename) nil
(when (not (file-exists-p ,filename))
(tramp-error v 'file-missing ,filename))
(with-tramp-saved-file-properties
@@ -3640,7 +3670,7 @@ Let-bind it when necessary.")
;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists
;; since Emacs 29.1. Since this handler isn't called for older
-;; Emacsen, it is save to invoke them via `tramp-compat-funcall'.
+;; Emacs, it is save to invoke them via `tramp-compat-funcall'.
(defun tramp-handle-abbreviate-file-name (filename)
"Like `abbreviate-file-name' for Tramp files."
(let* ((case-fold-search (file-name-case-insensitive-p filename))
@@ -3690,7 +3720,7 @@ Let-bind it when necessary.")
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
(with-parsed-tramp-file-name
- (if (tramp-tramp-file-p newname) newname filename) nil
+ (expand-file-name (if (tramp-tramp-file-p newname) newname filename)) nil
(unless (tramp-equal-remote filename newname)
(tramp-error
v 'file-error
@@ -3773,7 +3803,9 @@ Let-bind it when necessary.")
;; Expand tilde. Usually, the methods applying this handler do
;; not support tilde expansion. But users could declare a
;; respective connection property. (Bug#53847)
- (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" 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)
@@ -3783,10 +3815,10 @@ Let-bind it when necessary.")
(setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
- (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
@@ -3794,7 +3826,7 @@ Let-bind it when necessary.")
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
v (tramp-drop-volume-letter
- (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list
localname)))))))))
@@ -3805,7 +3837,10 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (eq (file-attribute-type (file-attributes (file-truename filename))) t))
+ ;; `file-truename' could raise an error, for example due to a cyclic
+ ;; symlink.
+ (ignore-errors
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equalp-p' for Tramp files."
@@ -3822,7 +3857,7 @@ Let-bind it when necessary.")
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-exists-p"
(not (null (file-attributes filename)))))))
@@ -3881,16 +3916,14 @@ Let-bind it when necessary.")
(with-tramp-progress-reporter v 5 "Checking case-insensitive"
;; The idea is to compare a file with lower case
;; letters with the same file with upper case letters.
- (let ((candidate
- (tramp-compat-file-name-unquote
- (directory-file-name filename)))
+ (let ((candidate (directory-file-name filename))
case-fold-search
tmpfile)
;; Check, whether we find an existing file with
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
- "[[:lower:]]" (tramp-file-local-name candidate))
+ (rx lower) (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@@ -3898,7 +3931,7 @@ Let-bind it when necessary.")
;; Nothing found, so we must use a temporary file
;; for comparison.
(unless (string-match-p
- "[[:lower:]]" (tramp-file-local-name candidate))
+ (rx lower) (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@@ -3933,7 +3966,9 @@ Let-bind it when necessary.")
(and
completion-ignored-extensions
(string-match-p
- (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
+ (tramp-compat-rx
+ (regexp (regexp-opt completion-ignored-extensions)) eos)
+ x)
;; We remember the hit.
(push x hits-ignored-extensions))))))
;; No match. So we try again for ignored files.
@@ -3968,14 +4003,15 @@ Let-bind it when necessary.")
(defun tramp-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
(or (tramp-check-cached-permissions v ?r)
;; `tramp-check-cached-permissions' doesn't handle symbolic
;; links.
(when-let ((symlink (file-symlink-p filename)))
(and (stringp symlink)
- (file-readable-p (concat (file-remote-p filename)
symlink))))))))
+ (file-readable-p
+ (concat (file-remote-p filename) symlink))))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
@@ -4066,7 +4102,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
(tramp-check-cached-permissions v ?w)
@@ -4142,12 +4178,13 @@ Let-bind it when necessary.")
(goto-char (point-min))
(while (setq start
(text-property-not-all
- (point) (line-end-position) 'dired-filename t))
+ (point) (line-end-position) 'dired-filename t))
(delete-region
start
- (or (text-property-any start (line-end-position)
'dired-filename t)
- (line-end-position)))
- (if (= (line-beginning-position) (line-end-position))
+ (or (text-property-any
+ start (line-end-position) 'dired-filename t)
+ (line-end-position)))
+ (if (= (line-beginning-position) (line-end-position))
;; Empty line.
(delete-region (point) (progn (forward-line) (point)))
(forward-line)))))))))
@@ -4269,15 +4306,13 @@ Let-bind it when necessary.")
(defun tramp-ps-time ()
"Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\".
Return it as number of seconds. Used in `tramp-process-attributes-ps-format'."
- (search-forward-regexp "\\s-+")
- (search-forward-regexp
- (concat
- "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?"
- "\\([0-9]+\\):" "\\)?"
- "\\([0-9]+\\):"
- ;; Seconds can also be a floating point number.
- "\\([0-9.]+\\)")
- (line-end-position) 'noerror)
+ (search-forward-regexp (rx (+ blank)))
+ (search-forward-regexp (rx (? (? (group (+ digit)) "-")
+ (group (+ digit)) ":")
+ (group (+ digit)) ":"
+ ;; Seconds can also be a floating point num.
+ (group (+ (any "." digit))))
+ (line-end-position) 'noerror)
(+ (* 24 60 60 (string-to-number (or (match-string 1) "0")))
(* 60 60 (string-to-number (or (match-string 2) "0")))
(* 60 (string-to-number (or (match-string 3) "0")))
@@ -4382,7 +4417,7 @@ It is not guaranteed, that all process attributes as
described in
;; "%s" (buffer-substring (point) (line-end-position)))
(when (save-excursion
(search-forward-regexp
- "[[:digit:]]" (line-end-position) 'noerror))
+ (rx digit) (line-end-position) 'noerror))
(setq res nil)
(dolist (elt tramp-process-attributes-ps-format)
(push
@@ -4391,16 +4426,17 @@ It is not guaranteed, that all process attributes as
described in
(cond
((eq (cdr elt) 'number) (read (current-buffer)))
((eq (cdr elt) 'string)
- (search-forward-regexp "\\S-+")
+ (search-forward-regexp (rx (+ (not blank))))
(match-string 0))
((numberp (cdr elt))
- (search-forward-regexp "\\s-+")
- (search-forward-regexp ".+" (+ (point) (cdr elt)))
+ (search-forward-regexp (rx (+ blank)))
+ (search-forward-regexp
+ (rx (+ nonl)) (+ (point) (cdr elt)))
(string-trim (match-string 0)))
((fboundp (cdr elt))
(funcall (cdr elt)))
((null (cdr elt))
- (search-forward-regexp "\\s-+")
+ (search-forward-regexp (rx (+ blank)))
(buffer-substring (point) (line-end-position)))))
res))
;; `nice' could be `-'.
@@ -4442,7 +4478,10 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(defconst tramp-lock-file-info-regexp
;; USER@HOST.PID[:BOOT_TIME]
- "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
+ (rx bos (group (+ nonl))
+ "@" (group (+ nonl))
+ "." (group (+ digit))
+ (? ":" (+ digit)) eos)
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
@@ -4538,7 +4577,7 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
;; The first condition is always true for absolute file names.
;; Included for safety's sake.
(unless (or (file-name-directory file)
- (string-match-p "\\.elc?\\'" 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)))
@@ -4571,9 +4610,9 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
tramp-prefix-format proxy tramp-postfix-host-format))
(entry
(list (and (stringp host-port)
- (concat "^" (regexp-quote host-port) "$"))
+ (tramp-compat-rx bol (literal host-port) eol))
(and (stringp user-domain)
- (concat "^" (regexp-quote user-domain) "$"))
+ (tramp-compat-rx bol (literal user-domain) eol))
(propertize proxy 'tramp-ad-hoc t))))
(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
;; Add the hop.
@@ -4652,7 +4691,7 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (concat "^" (regexp-quote host) "$")))))
+ (setq previous-host (tramp-compat-rx bol (literal host) eol)))))
;; Result.
target-alist))
@@ -4841,7 +4880,7 @@ support symbolic links."
(defun tramp-handle-shell-command (command &optional output-buffer
error-buffer)
"Like `shell-command' for Tramp files."
- (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
+ (let* ((asynchronous (string-match-p (rx (* blank) "&" (* blank) eos)
command))
(command (substring command 0 asynchronous))
current-buffer-p
(output-buffer-p output-buffer)
@@ -5024,14 +5063,14 @@ BUFFER might be a list, in this case STDERR is
separated."
(let (process-environment)
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (stringp localname)
- (if (string-match "//\\(/\\|~\\)" localname)
+ (if (string-match-p (rx "//" (| "/" "~")) localname)
(setq filename
(replace-regexp-in-string
- "\\`/+" "/" (substitute-in-file-name localname)))
+ (rx bos (+ "/")) "/" (substitute-in-file-name localname)))
(setq filename
(concat (file-remote-p filename)
(replace-regexp-in-string
- "\\`/+" "/"
+ (rx bos (+ "/")) "/"
;; We must disable cygwin-mount file name
;; handlers and alike.
(tramp-run-real-handler
@@ -5144,8 +5183,10 @@ of."
;; The descriptor must be a process object.
(unless (processp proc)
(tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
- ;; There might be pending output.
- (while (tramp-accept-process-output proc 0))
+ ;; There might be pending output. Avoid problems with reentrant
+ ;; call of Tramp.
+ (ignore-errors
+ (while (tramp-accept-process-output proc 0)))
(tramp-message proc 6 "Kill %S" proc)
(delete-process proc))
@@ -5278,7 +5319,8 @@ Wait, until the connection buffer changes."
(ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
+ (with-temp-message
+ (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
@@ -5439,7 +5481,7 @@ performed successfully. Any other value means an error."
Mostly useful to protect BODY from being interrupted by timers."
(declare (indent 1) (debug t))
`(if (tramp-get-connection-property ,proc "locked")
- ;; Be kind for older Emacsen.
+ ;; Be kind for old versions of Emacs.
(if (member 'remote-file-error debug-ignored-errors)
(throw 'non-essential 'non-essential)
(tramp-error
@@ -5614,7 +5656,8 @@ the remote host use line-endings as defined in the
variable
(tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
- (when (and prompt (tramp-search-regexp (regexp-quote prompt)))
+ (when (and prompt
+ (tramp-search-regexp (tramp-compat-rx (literal prompt))))
(delete-region (point) (point-max))))))))
(defun tramp-get-inode (vec)
@@ -5818,7 +5861,7 @@ VEC is used for tracing."
(while candidates
(goto-char (point-min))
(if (string-match-p
- (format "^%s\r?$" (regexp-quote (car candidates)))
+ (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
(buffer-string))
(setq locale (car candidates)
candidates nil)
@@ -5861,7 +5904,13 @@ be granted."
(equal remote-gid tramp-unknown-id-integer)
(equal remote-gid (file-attribute-group-id file-attr))
(equal tramp-unknown-id-integer
- (file-attribute-group-id file-attr)))))))
+ (file-attribute-group-id file-attr))))
+ ;; Group accessible and owned by user's secondary group.
+ (and
+ (eq access
+ (aref (file-attribute-modes file-attr) (+ offset 3)))
+ (member (file-attribute-group-id file-attr)
+ (tramp-get-remote-groups vec 'integer))))))
(defmacro tramp-convert-file-attributes (vec localname id-format attr)
"Convert `file-attributes' ATTR generated Tramp backend functions.
@@ -5926,7 +5975,9 @@ to cache the result. Return the modified ATTR."
(when (consp (car attr))
(setcar attr
(and (stringp (caar attr))
- (string-match ".+ -> .\\(.+\\)." (caar attr))
+ (string-match
+ (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl)
+ (caar attr))
(decode-coding-string
(match-string 1 (caar attr)) 'utf-8))))
;; Set file's gid change bit.
@@ -5997,6 +6048,52 @@ ID-FORMAT valid values are `string' and `integer'."
(and (equal id-format 'integer) tramp-unknown-id-integer)
(and (equal id-format 'string) tramp-unknown-id-string)))
+(defun tramp-get-remote-groups (vec id-format)
+ "The list of groups of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "groups-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-groups vec id-format))))
+
+(defun tramp-read-id-output (vec)
+ "Read in connection buffer the output of the `id' command.
+Set connection properties \"{uid,gid.groups}-{integer,string}\"."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let (uid-integer uid-string
+ gid-integer gid-string
+ groups-integer groups-string)
+ (goto-char (point-min))
+ ;; Read uid.
+ (when (re-search-forward
+ (rx "uid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
+ nil 'noerror)
+ (setq uid-integer (string-to-number (match-string 1))
+ uid-string (match-string 2)))
+ ;; Read gid.
+ (when (re-search-forward
+ (rx "gid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
+ nil 'noerror)
+ (setq gid-integer (string-to-number (match-string 1))
+ gid-string (match-string 2)))
+ ;; Read groups.
+ (when (re-search-forward (rx "groups=") nil 'noerror)
+ (while (looking-at
+ (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")"))
+ (setq groups-integer (cons (string-to-number (match-string 1))
+ groups-integer)
+ groups-string (cons (match-string 2) groups-string))
+ (goto-char (match-end 0))
+ (skip-chars-forward ",")))
+ ;; Set connection properties.
+ (tramp-set-connection-property vec "uid-integer" uid-integer)
+ (tramp-set-connection-property vec "uid-string" uid-string)
+ (tramp-set-connection-property vec "gid-integer" gid-integer)
+ (tramp-set-connection-property vec "gid-string" gid-string)
+ (tramp-set-connection-property
+ vec "groups-integer" (nreverse groups-integer))
+ (tramp-set-connection-property
+ vec "groups-string" (nreverse groups-string)))))
+
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise.
This handles also chrooted environments, which are not regarded as local."
@@ -6124,7 +6221,7 @@ ALIST is of the form ((FROM . TO) ...)."
(let* ((pr (car alist))
(from (car pr))
(to (cdr pr)))
- (while (string-match (regexp-quote from) string)
+ (while (string-match (tramp-compat-rx (literal from)) string)
(setq string (replace-match to t t string)))
(setq alist (cdr alist))))
string))
@@ -6226,7 +6323,7 @@ verbosity of 6."
(apply #'process-lines program args)
(error
(tramp-error vec (car err) (cdr err)))))
- (tramp-message vec 6 "%s" result)
+ (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n"))
result))
(defun tramp-process-running-p (process-name)
@@ -6387,15 +6484,13 @@ would use a wrong quoting for local file names. See
`w32-shell-name'."
Only works for Bourne-like shells."
(let ((system-type 'not-windows))
(save-match-data
- (let ((result (tramp-unquote-shell-quote-argument s))
- (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
+ (let ((result (tramp-unquote-shell-quote-argument s)))
(when (and (>= (length result) 2)
(string= (substring result 0 2) "\\~"))
(setq result (substring result 1)))
- (while (string-match nl result)
- (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
- t t result)))
- result))))
+ (replace-regexp-in-string
+ (tramp-compat-rx "\\" (literal tramp-rsh-end-of-line))
+ (format "'%s'" tramp-rsh-end-of-line) result)))))
;;; Signal handling. This works for remote processes, which have set
;;; the process property `remote-pid'.
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index dfe5c369e2..9cbab29504 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -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-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/crisp.el b/lisp/obsolete/crisp.el
index 8424c42b69..5e1a278a2c 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -174,9 +174,6 @@
All the bindings are done here instead of globally to try and be
nice to the world.")
-(define-obsolete-variable-alias 'crisp-mode-modeline-string
- 'crisp-mode-mode-line-string "24.3")
-
(defcustom crisp-mode-mode-line-string " *CRiSP*"
"String to display in the mode line when CRiSP emulation mode is enabled."
:type 'string)
diff --git a/lisp/linum.el b/lisp/obsolete/linum.el
similarity index 93%
rename from lisp/linum.el
rename to lisp/obsolete/linum.el
index d491da5206..e94cf5086c 100644
--- a/lisp/linum.el
+++ b/lisp/obsolete/linum.el
@@ -6,6 +6,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; Old-Version: 0.9x
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -24,6 +25,13 @@
;;; Commentary:
+;; NOTE: This library was made obsolete in Emacs 29.1. We recommend
+;; using either the built-in `display-line-numbers-mode', or the
+;; `nlinum' package from GNU ELPA instead. The former has better
+;; performance, but the latter is closer to a drop-in replacement.
+;;
+;; --------------------
+;;
;; Display line numbers for the current buffer.
;;
;; Toggle display of line numbers with M-x linum-mode. To enable
@@ -89,9 +97,6 @@ Linum mode is a buffer-local minor mode."
'linum-update-current) nil t)
(add-hook 'after-change-functions 'linum-after-change nil t))
(add-hook 'window-scroll-functions 'linum-after-scroll nil t)
- ;; Using both window-size-change-functions and
- ;; window-configuration-change-hook seems redundant. --Stef
- ;; (add-hook 'window-size-change-functions 'linum-after-size nil t)
(add-hook 'change-major-mode-hook 'linum-delete-overlays nil t)
(add-hook 'window-configuration-change-hook
;; FIXME: If the buffer is shown in N windows, this
@@ -101,7 +106,6 @@ Linum mode is a buffer-local minor mode."
(linum-update-current))
(remove-hook 'post-command-hook 'linum-update-current t)
(remove-hook 'post-command-hook 'linum-schedule t)
- ;; (remove-hook 'window-size-change-functions 'linum-after-size t)
(remove-hook 'window-scroll-functions 'linum-after-scroll t)
(remove-hook 'after-change-functions 'linum-after-change t)
(remove-hook 'window-configuration-change-hook 'linum-update-current t)
@@ -205,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
@@ -231,16 +232,10 @@ Linum mode is a buffer-local minor mode."
(defun linum-after-scroll (win _start)
(linum-update (window-buffer win)))
-;; (defun linum-after-size (frame)
-;; (linum-after-config))
-
(defun linum-schedule ()
;; schedule an update; the delay gives Emacs a chance for display changes
(run-with-idle-timer 0 nil #'linum-update-current))
-;; (defun linum-after-config ()
-;; (walk-windows (lambda (w) (linum-update (window-buffer w))) nil 'visible))
-
(defun linum-unload-function ()
"Unload the Linum library."
(global-linum-mode -1)
@@ -250,6 +245,9 @@ Linum mode is a buffer-local minor mode."
(defconst linum-version "0.9x")
(make-obsolete-variable 'linum-version 'emacs-version "28.1")
+(make-obsolete 'linum-mode #'display-line-numbers-mode "29.1")
+(make-obsolete 'global-linum-mode #'global-display-line-numbers-mode "29.1")
+
(provide 'linum)
;;; linum.el ends here
diff --git a/lisp/thumbs.el b/lisp/obsolete/thumbs.el
similarity index 97%
rename from lisp/thumbs.el
rename to lisp/obsolete/thumbs.el
index 0b3d36d6e3..a98b339b47 100644
--- a/lisp/thumbs.el
+++ b/lisp/obsolete/thumbs.el
@@ -5,6 +5,7 @@
;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: Multimedia
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -23,6 +24,11 @@
;;; Commentary:
+;; NOTE: This library was made obsolete in Emacs 29.1.
+;; We recommend using `M-x image-dired' instead.
+;;
+;; --------------------
+;;
;; This package create two new modes: `thumbs-mode' and
`thumbs-view-image-mode'.
;; It is used for basic browsing and viewing of images from within Emacs.
;; Minimal image manipulation functions are also available via external
@@ -99,6 +105,8 @@ This must be the ImageMagick \"convert\" utility."
:type 'string
:version "28.1")
+(make-obsolete-variable 'thumbs-setroot-command
+ 'wallpaper-commands-alist "29.1")
(defcustom thumbs-setroot-command
"xloadimage -onroot -fullscreen *"
"Command to set the root window."
@@ -385,6 +393,7 @@ and SAME-WINDOW to show thumbs in the same window."
;;;###autoload
(defalias 'thumbs 'thumbs-show-from-dir)
+(make-obsolete 'thumbs 'image-dired "29.1")
(defun thumbs-find-image (img &optional num otherwin)
(let ((buffer (current-buffer)))
@@ -425,6 +434,7 @@ Open another window."
(defun thumbs-call-setroot-command (img)
"Call the setroot program for IMG."
+ (declare (obsolete wallpaper-set "29.1"))
(run-hooks 'thumbs-before-setroot-hook)
(shell-command (string-replace
"*"
@@ -435,15 +445,13 @@ Open another window."
(defun thumbs-set-image-at-point-to-root-window ()
"Set the image at point as the desktop wallpaper."
(interactive)
- (thumbs-call-setroot-command
- (thumbs-current-image)))
+ (wallpaper-set (thumbs-current-image)))
(defun thumbs-set-root ()
"Set the current image as root."
(interactive)
- (thumbs-call-setroot-command
- (or thumbs-current-tmp-filename
- thumbs-current-image-filename)))
+ (wallpaper-set (or thumbs-current-tmp-filename
+ thumbs-current-image-filename)))
(defun thumbs-file-alist ()
"Make an alist of elements (POS . FILENAME) for all images in thumb buffer."
@@ -756,13 +764,16 @@ ACTION and ARG should be a valid convert command."
(defun thumbs-dired-setroot ()
"In dired, call the setroot program on the image at point."
(interactive)
- (thumbs-call-setroot-command (dired-get-filename)))
+ (wallpaper-set (dired-get-filename)))
;; Modif to dired mode map
(define-key dired-mode-map "\C-ta" 'thumbs-dired-show)
(define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked)
(define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot)
+(make-obsolete-variable 'thumbs-before-setroot-hook nil "29.1")
+(make-obsolete-variable 'thumbs-after-setroot-hook nil "29.1")
+
(define-obsolete-function-alias 'thumbs-image-type
#'image-supported-file-p "29.1")
diff --git a/lisp/obsolete/url-about.el b/lisp/obsolete/url-about.el
index 608df3f2a5..b9f8732b28 100644
--- a/lisp/obsolete/url-about.el
+++ b/lisp/obsolete/url-about.el
@@ -32,7 +32,7 @@
(or (get 'url-extension-protocols 'probed)
(mapc (lambda (s) (url-scheme-get-property s 'name))
(or (get 'url-extension-protocols 'schemes)
- (let ((schemes '("info" "man" "rlogin" "telnet"
+ (let ((schemes '("info" "man" "telnet"
"tn3270" "data" "snews")))
(mapc (lambda (d)
(mapc (lambda (f)
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 537d65c658..20835a09d0 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -311,7 +311,7 @@ Only the value `maybe' can be trusted :-(."
;; dir-status-files called from vc-dir, which loads vc,
;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(defun vc-arch-dir-status-files (dir _files callback)
"Run `tla inventory' for DIR and pass results to CALLBACK.
diff --git a/lisp/obsolete/vc-mtn.el b/lisp/obsolete/vc-mtn.el
index cd56b29007..4fc496d509 100644
--- a/lisp/obsolete/vc-mtn.el
+++ b/lisp/obsolete/vc-mtn.el
@@ -141,7 +141,7 @@ switches."
;; dir-status-files called from vc-dir, which loads vc,
;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(defun vc-mtn-dir-status-files (dir _files update-function)
(vc-mtn-command (current-buffer) 'async dir "status")
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/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-ctags.el b/lisp/org/org-ctags.el
index 6fc97ca399..67db49e9a6 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -47,7 +47,7 @@
;;
;; 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-macro.el b/lisp/org/org-macro.el
index 0921f3aa27..b58c51f3fb 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -66,7 +66,7 @@
(declare-function org-mode "org" ())
(declare-function vc-backend "vc-hooks" (f))
(declare-function vc-call "vc-hooks" (fun file &rest args) t)
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(defvar org-link-search-must-match-exact-headline)
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 7c4de03bc2..7a91a33b74 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -66,7 +66,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/
;;
;;
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 353d533c06..3273d8707d 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.5.4"))
+ (let ((org-release "9.5.5"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.5.4-19-g4dff42"))
+ (let ((org-git-version "release_9.5.5"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 9facbed04d..7de907590e 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -9,7 +9,7 @@
;; Homepage: https://orgmode.org
;; Package-Requires: ((emacs "25.1"))
-;; Version: 9.5.4
+;; Version: 9.5.5
;; This file is part of GNU Emacs.
;;
@@ -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.el b/lisp/org/ox.el
index 9a2a69b2c1..56bb4b74df 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -4642,7 +4642,7 @@ from the export back-end."
;; a given element, excluded. Note: "-n" switches reset that count.
;;
;; `org-export-unravel-code' extracts source code (along with a code
-;; references alist) from an `element-block' or `src-block' type
+;; references alist) from an `example-block' or `src-block' type
;; element.
;;
;; `org-export-format-code' applies a formatting function to each line
diff --git a/lisp/outline.el b/lisp/outline.el
index 3250b62f1e..ef5249a146 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -281,33 +281,79 @@ 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."
- ;; FIXME -- is there a `buffer-match-p' defcustom type somewhere?
- :type 'sexp
- :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")
-(define-icon outline-open button
- '((emoji "🔽")
+(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.")
+
+(define-icon outline-open nil
+ '((image "outline-open.svg" "outline-open.pbm" :height (0.8 . em))
+ (emoji "🔽")
(symbol " ▼ ")
(text " open "))
- "Icon used for buttons for opening a section in outline buffers."
+ "Icon used for buttons for opened sections in outline buffers."
:version "29.1"
- :help-echo "Open this section")
+ :help-echo "Close this section")
-(define-icon outline-close button
- '((emoji "▶️")
+(define-icon outline-close nil
+ '((image "outline-close.svg" "outline-close.pbm" :height (0.8 . em))
+ (emoji "▶️")
(symbol " ▶ ")
(text " close "))
- "Icon used for buttons for closing a section in outline buffers."
+ "Icon used for buttons for closed sections in outline buffers."
:version "29.1"
- :help-echo "Close this section")
+ :help-echo "Open this section")
+
+(define-icon outline-close-rtl outline-close
+ '((image "outline-close.svg" "outline-close.pbm" :height (0.8 . em)
+ :rotation 180)
+ (emoji "◀️")
+ (symbol " ◀ "))
+ "Right-to-left icon used for buttons in closed outline sections."
+ :version "29.1")
+
+(define-icon outline-open-in-margins outline-open
+ '((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)
+ (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)
+ (emoji "◀️")
+ (symbol "◀")
+ (text "<"))
+ "Right-to-left icon used for closed sections in margins."
+ :version "29.1")
(defvar outline-level #'outline-level
@@ -338,6 +384,10 @@ data reflects the `outline-regexp'.")
:safe #'booleanp
:version "22.1")
+(defvar outline-imenu-generic-expression
+ (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))
+ "Value for `imenu-generic-expression' in Outline mode.")
+
;;;###autoload
(define-derived-mode outline-mode text-mode "Outline"
"Set major mode for editing outlines with selective display.
@@ -372,8 +422,7 @@ Turning on outline mode calls the value of `text-mode-hook'
and then of
(concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
(setq-local font-lock-defaults
'(outline-font-lock-keywords t nil nil backward-paragraph))
- (setq-local imenu-generic-expression
- (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
+ (setq-local imenu-generic-expression outline-imenu-generic-expression)
(add-hook 'change-major-mode-hook #'outline-show-all nil t)
(add-hook 'hack-local-variables-hook #'outline-apply-default-state nil t))
@@ -427,16 +476,13 @@ outline font-lock faces to those of major mode."
(goto-char (point-min))
(let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
(while (re-search-forward regexp nil t)
- (let ((overlay (make-overlay (match-beginning 0)
- (match-end 0))))
- (overlay-put overlay 'outline-overlay t)
- (when (or (eq outline-minor-mode-highlight 'override)
+ (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
+ (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)
- (goto-char (match-beginning 0))
- (not (get-text-property (point) 'face))))
- (overlay-put overlay 'face (outline-font-lock-face)))
- (when (and (outline--use-buttons-p) (outline-on-heading-p))
- (outline--insert-open-button)))
+ (not (get-text-property (match-beginning 0) 'face))))
+ (overlay-put overlay 'face (outline-font-lock-face))))
(goto-char (match-end 0))))))
;;;###autoload
@@ -445,17 +491,37 @@ outline font-lock faces to those of major mode."
See the command `outline-mode' for more information on this mode."
:lighter " Outl"
- :keymap (easy-mmode-define-keymap
- `(([menu-bar] . ,outline-minor-mode-menu-bar-map)
- (,outline-minor-mode-prefix . ,outline-mode-prefix-map))
- :inherit outline-minor-mode-cycle-map)
+ :keymap (define-keymap
+ :parent outline-minor-mode-cycle-map
+ "<menu-bar>" outline-minor-mode-menu-bar-map
+ "<left-margin> <mouse-1>" 'outline-cycle
+ "<right-margin> <mouse-1>" 'outline-cycle
+ "<left-margin> S-<mouse-1>" 'outline-cycle-buffer
+ "<right-margin> S-<mouse-1>" 'outline-cycle-buffer
+ (key-description outline-minor-mode-prefix)
outline-mode-prefix-map)
(if outline-minor-mode
(progn
+ (when outline-minor-mode-use-buttons
+ (add-hook 'after-change-functions
+ #'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 (eq outline-minor-mode-use-buttons 'in-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
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-buffer nil (window-buffer)))))
(when outline-minor-mode-highlight
- (when (and global-font-lock-mode (font-lock-specified-p major-mode))
- (font-lock-add-keywords nil outline-font-lock-keywords t)
- (font-lock-flush))
- (outline-minor-mode-highlight-buffer))
+ (if (and global-font-lock-mode (font-lock-specified-p major-mode))
+ (progn
+ (font-lock-add-keywords nil outline-font-lock-keywords t)
+ (font-lock-flush))
+ (outline-minor-mode-highlight-buffer)))
+ (outline--fix-up-all-buttons)
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
(lambda () (outline-minor-mode -1))
@@ -464,20 +530,26 @@ See the command `outline-mode' for more information on
this mode."
;; Cause use of ellipses for invisible text.
(add-to-invisibility-spec '(outline . t))
(outline-apply-default-state))
- (when outline-minor-mode-highlight
- (if font-lock-fontified
- (font-lock-remove-keywords nil outline-font-lock-keywords))
- (remove-overlays nil nil 'outline-overlay t)
- (font-lock-flush))
(setq line-move-ignore-invisible nil)
;; Cause use of ellipses for invisible text.
(remove-from-invisibility-spec '(outline . t))
;; When turning off outline mode, get rid of any outline hiding.
- (outline-show-all)))
-
-(defun outline--use-buttons-p ()
- (and outline-minor-mode
- (buffer-match-p outline-minor-mode-use-buttons (current-buffer))))
+ (outline-show-all)
+ (when outline-minor-mode-highlight
+ (if font-lock-fontified
+ (font-lock-remove-keywords nil outline-font-lock-keywords))
+ (font-lock-flush)
+ (remove-overlays nil nil 'outline-highlight t))
+ (when outline-minor-mode-use-buttons
+ (remove-overlays nil nil 'outline-button t)
+ (when (eq outline-minor-mode-use-buttons 'in-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 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.
@@ -980,80 +1052,10 @@ Note that this does not hide the lines preceding the
first heading line."
"Hide everything after this heading at deeper levels.
If non-nil, EVENT should be a mouse event."
(interactive (list last-nonmenu-event))
- (when (mouse-event-p event)
- (mouse-set-point event))
- (when (outline--use-buttons-p)
- (outline--insert-close-button))
- (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 'follow-link 'mouse-face)
- (overlay-put o 'mouse-face 'highlight)
- (overlay-put o 'outline-button t))
- (let ((icon
- (icon-elements (if (eq type 'close) '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)))
- (when-let ((image (plist-get icon 'image)))
- (overlay-put o 'display image))
- (overlay-put o 'display (plist-get icon 'string))
- (overlay-put o 'face (plist-get icon 'face)))
- o))
-
-(defun outline--insert-open-button ()
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (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 ()
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (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 from
- (save-excursion
- (goto-char from)
- (setq from (line-beginning-position))))
- (when (outline--use-buttons-p)
- (outline-map-region
- (lambda ()
- ;; `outline--cycle-state' will fail if we're in a totally
- ;; collapsed buffer -- but in that case, we're not in a
- ;; `show-all' situation.
- (if (eq (ignore-errors (outline--cycle-state)) 'show-all)
- (outline--insert-open-button)
- (outline--insert-close-button)))
- (or from (point-min)) (or to (point-max)))))
+ (save-excursion
+ (when (mouse-event-p event)
+ (mouse-set-point event))
+ (outline-flag-subtree t)))
(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
@@ -1071,13 +1073,13 @@ If non-nil, EVENT should be a mouse event."
(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1")
(defun outline-show-subtree (&optional event)
- "Show everything after this heading at deeper levels."
+ "Show everything after this heading at deeper levels.
+If non-nil, EVENT should be a mouse event."
(interactive (list last-nonmenu-event))
- (when (mouse-event-p event)
- (mouse-set-point event))
- (when (outline--use-buttons-p)
- (outline--insert-open-button))
- (outline-flag-subtree nil))
+ (save-excursion
+ (when (mouse-event-p event)
+ (mouse-set-point event))
+ (outline-flag-subtree nil)))
(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1")
@@ -1340,6 +1342,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.
@@ -1518,6 +1523,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'."
@@ -1552,7 +1560,7 @@ Return either `hide-all', `headings-only', or `show-all'."
(< (save-excursion (outline-next-heading) (point))
(save-excursion (outline-end-of-subtree) (point)))))
-(defun outline-cycle ()
+(defun outline-cycle (&optional event)
"Cycle visibility state of the current heading line's body.
This cycles the visibility of the current heading line's subheadings
@@ -1560,28 +1568,33 @@ and body between `hide all', `headings only' and `show
all'.
`Hide all' means hide all the subheadings and their bodies.
`Headings only' means show the subheadings, but not their bodies.
-`Show all' means show all the subheadings and their bodies."
- (interactive)
- (condition-case nil
- (pcase (outline--cycle-state)
- ('hide-all
- (if (outline-has-subheading-p)
- (progn (outline-show-children)
- (message "Only headings"))
+`Show all' means show all the subheadings and their bodies.
+
+If non-nil, EVENT should be a mouse event."
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (when (mouse-event-p event)
+ (mouse-set-point event))
+ (condition-case nil
+ (pcase (outline--cycle-state)
+ ('hide-all
+ (if (outline-has-subheading-p)
+ (progn (outline-show-children)
+ (message "Only headings"))
+ (outline-show-subtree)
+ (message "Show all")))
+ ('headings-only
(outline-show-subtree)
- (message "Show all")))
- ('headings-only
- (outline-show-subtree)
- (message "Show all"))
- ('show-all
- (outline-hide-subtree)
- (message "Hide all")))
- (outline-before-first-heading nil)))
+ (message "Show all"))
+ ('show-all
+ (outline-hide-subtree)
+ (message "Hide all")))
+ (outline-before-first-heading nil))))
(defvar-local outline--cycle-buffer-state 'show-all
"Internal variable used for tracking buffer cycle state.")
-(defun outline-cycle-buffer ()
+(defun outline-cycle-buffer (&optional level)
"Cycle visibility state of the body lines of the whole buffer.
This cycles the visibility of all the subheadings and bodies of all
@@ -1590,20 +1603,28 @@ the heading lines in the buffer. It cycles them
between `hide all',
`Hide all' means hide all the buffer's subheadings and their bodies.
`Headings only' means show all the subheadings, but not their bodies.
-`Show all' means show all the buffer's subheadings and their bodies."
- (interactive)
- (let (has-top-level)
+`Show all' means show all the buffer's subheadings and their bodies.
+
+With a prefix argument, show headings up to that LEVEL."
+ (interactive (list (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))
+ (let (top-level)
(save-excursion
(goto-char (point-min))
- (while (not (or has-top-level (eobp)))
- (when (outline-on-heading-p t)
- (when (= (funcall outline-level) 1)
- (setq has-top-level t)))
+ (while (not (or (eq top-level 1) (eobp)))
+ (when-let ((level (and (outline-on-heading-p t)
+ (funcall outline-level))))
+ (when (< level (or top-level most-positive-fixnum))
+ (setq top-level (max level 1))))
(outline-next-heading)))
(cond
+ (level
+ (outline-hide-sublevels level)
+ (setq outline--cycle-buffer-state 'all-heading)
+ (message "All headings up to level %s" level))
((and (eq outline--cycle-buffer-state 'show-all)
- has-top-level)
- (outline-hide-sublevels 1)
+ top-level)
+ (outline-hide-sublevels top-level)
(setq outline--cycle-buffer-state 'top-level)
(message "Top level headings"))
((or (eq outline--cycle-buffer-state 'show-all)
@@ -1615,22 +1636,117 @@ the heading lines in the buffer. It cycles them
between `hide all',
(t
(outline-show-all)
(setq outline--cycle-buffer-state 'show-all)
- (message "Show all")))
- (outline--fix-up-all-buttons)))
+ (message "Show all")))))
-(defvar outline-navigation-repeat-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-b") #'outline-backward-same-level)
- (define-key map (kbd "b") #'outline-backward-same-level)
- (define-key map (kbd "C-f") #'outline-forward-same-level)
- (define-key map (kbd "f") #'outline-forward-same-level)
- (define-key map (kbd "C-n") #'outline-next-visible-heading)
- (define-key map (kbd "n") #'outline-next-visible-heading)
- (define-key map (kbd "C-p") #'outline-previous-visible-heading)
- (define-key map (kbd "p") #'outline-previous-visible-heading)
- (define-key map (kbd "C-u") #'outline-up-heading)
- (define-key map (kbd "u") #'outline-up-heading)
- map))
+
+;;; 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
+ "C-f" #'outline-forward-same-level
+ "f" #'outline-forward-same-level
+ "C-n" #'outline-next-visible-heading
+ "n" #'outline-next-visible-heading
+ "C-p" #'outline-previous-visible-heading
+ "p" #'outline-previous-visible-heading
+ "C-u" #'outline-up-heading
+ "u" #'outline-up-heading)
(dolist (command '(outline-backward-same-level
outline-forward-same-level
@@ -1639,17 +1755,15 @@ the heading lines in the buffer. It cycles them
between `hide all',
outline-up-heading))
(put command 'repeat-map 'outline-navigation-repeat-map))
-(defvar outline-editing-repeat-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-v") #'outline-move-subtree-down)
- (define-key map (kbd "v") #'outline-move-subtree-down)
- (define-key map (kbd "C-^") #'outline-move-subtree-up)
- (define-key map (kbd "^") #'outline-move-subtree-up)
- (define-key map (kbd "C->") #'outline-demote)
- (define-key map (kbd ">") #'outline-demote)
- (define-key map (kbd "C-<") #'outline-promote)
- (define-key map (kbd "<") #'outline-promote)
- map))
+(defvar-keymap outline-editing-repeat-map
+ "C-v" #'outline-move-subtree-down
+ "v" #'outline-move-subtree-down
+ "C-^" #'outline-move-subtree-up
+ "^" #'outline-move-subtree-up
+ "C->" #'outline-demote
+ ">" #'outline-demote
+ "C-<" #'outline-promote
+ "<" #'outline-promote)
(dolist (command '(outline-move-subtree-down
outline-move-subtree-up
@@ -1657,6 +1771,7 @@ the heading lines in the buffer. It cycles them between
`hide all',
outline-promote))
(put command 'repeat-map 'outline-editing-repeat-map))
+
(provide 'outline)
(provide 'noutline)
diff --git a/lisp/paren.el b/lisp/paren.el
index d7580de9a9..e2c060ceb9 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -118,6 +118,14 @@ On non-graphical frames, the context is shown in the echo
area."
(let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol)
"Overlay used to highlight the paren at point.")
+(defcustom show-paren-predicate '(not (derived-mode . special-mode))
+ "Whether to use `show-paren-mode' in a buffer.
+The default is to enable the mode in all buffers that have don't
+derive from `special-mode', which means that it's on (by default)
+in all editing buffers."
+ :type 'buffer-predicate
+ :safe #'booleanp
+ :version "29.1")
;;;###autoload
(define-minor-mode show-paren-mode
@@ -126,6 +134,9 @@ On non-graphical frames, the context is shown in the echo
area."
When enabled, any matching parenthesis is highlighted in `show-paren-style'
after `show-paren-delay' seconds of Emacs idle time.
+Also see `show-paren-predicate', which controls which buffers
+this mode is enabled in.
+
This is a global minor mode. To toggle the mode in a single buffer,
use `show-paren-local-mode'."
:global t :group 'paren-showing
@@ -414,7 +425,13 @@ It is the default value of `show-paren-data-function'."
(defun show-paren-function ()
"Highlight the parentheses until the next input arrives."
- (let ((data (and show-paren-mode (funcall show-paren-data-function))))
+ (let ((data (and show-paren-mode
+ ;; If we're using `show-paren-local-mode', then
+ ;; always heed the value.
+ (or (local-variable-p 'show-paren-mode)
+ ;; If not, check that the predicate matches.
+ (buffer-match-p show-paren-predicate (current-buffer)))
+ (funcall show-paren-data-function))))
(if (not data)
(progn
;; If show-paren-mode is nil in this buffer or if not at a paren that
diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el
new file mode 100644
index 0000000000..3584fa0673
--- /dev/null
+++ b/lisp/pcmpl-git.el
@@ -0,0 +1,110 @@
+;;; pcmpl-git.el --- Completions for Git -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Package: pcomplete
+
+;; 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 completion rules for the Git program.
+
+;;; Code:
+
+(require 'pcomplete)
+(require 'vc-git)
+
+(defun pcmpl-git--expand-flags (args)
+ "In the list of ARGS, expand arguments of the form --[no-]flag."
+ (mapcan (lambda (arg) (if (string-search "[no-]" arg)
+ (list (string-replace "[no-]" "" arg)
+ (string-replace "[no-]" "no-" arg))
+ (list arg)))
+ args))
+
+(defun pcmpl-git--tracked-file-predicate (&rest args)
+ "Return a predicate function determining the Git status of a file.
+Files listed by `git ls-files ARGS' satisfy the predicate."
+ (when-let ((files (mapcar #'expand-file-name
+ (ignore-errors
+ (apply #'process-lines
+ vc-git-program "ls-files" args)))))
+ (lambda (file)
+ (setq file (expand-file-name file))
+ (if (string-suffix-p "/" file)
+ (seq-some (lambda (f) (string-prefix-p file f))
+ files)
+ (member file files)))))
+
+(defun pcmpl-git--remote-refs (remote)
+ "List the locally known Git revisions from REMOTE."
+ (delq nil
+ (mapcar
+ (let ((re (concat "\\`" (regexp-quote remote) "/\\(.*\\)")))
+ (lambda (s) (when (string-match re s) (match-string 1 s))))
+ (vc-git-revision-table nil))))
+
+;;;###autoload
+(defun pcomplete/git ()
+ "Completion for the `git' command."
+ (let ((subcommands (pcomplete-from-help `(,vc-git-program "help" "-a")
+ :margin "^\\( +\\)[a-z]"
+ :argument "[[:alnum:]-]+")))
+ (while (not (member (pcomplete-arg 1) subcommands))
+ (if (string-prefix-p "-" (pcomplete-arg))
+ (pcomplete-here (pcomplete-from-help `(,vc-git-program "help")
+ :margin "\\(\\[\\)-"
+ :separator " | "
+ :description "\\`"))
+ (pcomplete-here (completion-table-merge
+ subcommands
+ (when (string-prefix-p "-" (pcomplete-arg 1))
+ (pcomplete-entries))))))
+ (let ((subcmd (pcomplete-arg 1)))
+ (while (pcase subcmd
+ ((guard (string-prefix-p "-" (pcomplete-arg)))
+ (pcomplete-here
+ (pcmpl-git--expand-flags
+ (pcomplete-from-help `(,vc-git-program "help" ,subcmd)
+ :argument
+ "-+\\(?:\\[no-\\]\\)?[a-z-]+=?"))))
+ ;; Complete modified tracked files
+ ((or "add" "commit" "restore")
+ (pcomplete-here
+ (pcomplete-entries
+ nil (pcmpl-git--tracked-file-predicate "-m"))))
+ ;; Complete all tracked files
+ ((or "mv" "rm" "grep" "status")
+ (pcomplete-here
+ (pcomplete-entries nil (pcmpl-git--tracked-file-predicate))))
+ ;; Complete revisions
+ ((or "branch" "merge" "rebase" "switch")
+ (pcomplete-here (vc-git-revision-table nil)))
+ ;; Complete revisions and tracked files
+ ;; TODO: diff and log accept revision ranges
+ ((or "checkout" "reset" "show" "diff" "log")
+ (pcomplete-here
+ (completion-table-in-turn
+ (vc-git-revision-table nil)
+ (pcomplete-entries nil
(pcmpl-git--tracked-file-predicate)))))
+ ;; Complete remotes and their revisions
+ ((or "fetch" "pull" "push")
+ (pcomplete-here (process-lines vc-git-program "remote"))
+ (pcomplete-here (pcmpl-git--remote-refs (pcomplete-arg
1)))))))))
+
+(provide 'pcmpl-git)
+;;; pcmpl-git.el ends here
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 3c9bf1ec9d..cdfde5640a 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -394,6 +394,40 @@ Return the new list."
(while (pcomplete-here (pcomplete-dirs) nil #'identity))))
;;;###autoload
-(defalias 'pcomplete/gdb 'pcomplete/xargs)
+(defun pcomplete/awk ()
+ "Completion for the `awk' command."
+ (pcomplete-here-using-help "awk --help"
+ :margin "\t"
+ :separator " +"
+ :description "\0"
+ :metavar "[=a-z]+"))
+
+;;;###autoload
+(defun pcomplete/gpg ()
+ "Completion for the `gpg` command."
+ (pcomplete-here-using-help "gpg --help" :narrow-end "^ -se"))
+
+;;;###autoload
+(defun pcomplete/gdb ()
+ "Completion for the `gdb' command."
+ (while
+ (cond
+ ((string= "--args" (pcomplete-arg 1))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+ ((string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "gdb --help")))
+ (t (pcomplete-here (pcomplete-entries))))))
+
+;;;###autoload
+(defun pcomplete/emacs ()
+ "Completion for the `emacs' command."
+ (pcomplete-here-using-help "emacs --help" :margin "^\\(\\)-"))
+
+;;;###autoload
+(defun pcomplete/emacsclient ()
+ "Completion for the `emacsclient' command."
+ (pcomplete-here-using-help "emacsclient --help" :margin "^\\(\\)-"))
;;; pcmpl-gnu.el ends here
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 7c072f3d40..023c655a2a 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -30,6 +30,7 @@
(provide 'pcmpl-linux)
(require 'pcomplete)
+(eval-when-compile (require 'rx))
;; Functions:
@@ -111,4 +112,71 @@ Test is done using `equal'."
(pcomplete-uniquify-list points)
(cons "swap" (pcmpl-linux-mounted-directories))))))
+;;; systemd
+
+(defun pcmpl-linux--systemd-units (&rest args)
+ "Run `systemd list-units ARGS' and return the output as a list."
+ (with-temp-buffer
+ (apply #'call-process
+ "systemctl" nil '(t nil) nil
+ "list-units" "--full" "--legend=no" "--plain" args)
+ (goto-char (point-min))
+ (let (result)
+ (while (re-search-forward (rx bol (group (+ (not space)))
+ (+ space) (+ (not space))
+ (+ space) (group (+ (not space)))
+ (+ space) (+ (not space))
+ (+ space) (group (* nonl)))
+ nil t)
+ (push (match-string 1) result)
+ (put-text-property 0 1 'pcomplete-annotation
+ (concat " " (match-string 2))
+ (car result))
+ (put-text-property 0 1 'pcomplete-description
+ (match-string 3)
+ (car result)))
+ (nreverse result))))
+
+;;;###autoload
+(defun pcomplete/systemctl ()
+ "Completion for the `systemctl' command."
+ (let ((subcmds (pcomplete-from-help
+ "systemctl --help"
+ :margin (rx bol " " (group) alpha)
+ :argument (rx (+ (any alpha ?-)))
+ :metavar (rx (group (+ " " (>= 2 (any upper "[]|."))))))))
+ (while (not (member (pcomplete-arg 1) subcmds))
+ (if (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "systemctl --help"
+ :metavar "[^ ]+"
+ :separator " \\(\\)-"))
+ (pcomplete-here subcmds)))
+ (let ((subcmd (pcomplete-arg 1))
+ (context (if (member "--user" pcomplete-args) "--user" "--system")))
+ (while (pcase subcmd
+ ((guard (string-prefix-p "-" (pcomplete-arg 0)))
+ (pcomplete-here
+ (pcomplete-from-help "systemctl --help")))
+ ;; TODO: suggest only relevant units to each subcommand
+ ("start"
+ (pcomplete-here
+ (pcmpl-linux--systemd-units context "--state"
"inactive,failed")))
+ ((or "restart" "stop")
+ (pcomplete-here
+ (pcmpl-linux--systemd-units context "--state" "active")))
+ (_ (pcomplete-here
+ (completion-table-in-turn
+ (pcmpl-linux--systemd-units context "--all")
+ (pcomplete-entries)))))))))
+
+;;;###autoload
+(defun pcomplete/journalctl ()
+ "Completion for the `journalctl' command."
+ (while (if (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "journalctl --help"
+ :metavar "[^ ]+"
+ :separator " \\(\\)-"))
+ (pcomplete-here (mapcar (lambda (s) (concat s "="))
+ (process-lines "journalctl" "--fields"))))))
+
;;; pcmpl-linux.el ends here
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index f7925d9d9e..ebb6b72600 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -21,7 +21,8 @@
;;; Commentary:
-;; These functions provide completion rules for the `rpm' command.
+;; These functions provide completion rules for the `rpm' command and
+;; related tools.
;;; Code:
@@ -378,6 +379,46 @@
(t
(error "You must select a mode: -q, -i, -U, --verify, etc"))))))
+;;; DNF
+
+(defvar pcmpl-rpm-dnf-cache-file "/var/cache/dnf/packages.db"
+ "Location of the DNF cache.")
+
+(defun pcmpl-rpm--dnf-packages (status)
+ (when (and (file-exists-p pcmpl-rpm-dnf-cache-file)
+ (executable-find "sqlite3"))
+ (with-temp-message
+ "Getting list of packages..."
+ (process-lines "sqlite3" "-batch" "-init" "/dev/null"
+ pcmpl-rpm-dnf-cache-file
+ (pcase-exhaustive status
+ ('available "select pkg from available")
+ ('installed "select pkg from installed")
+ ('not-installed "\
+select pkg from available where pkg not in (select pkg from installed)"))))))
+
+;;;###autoload
+(defun pcomplete/dnf ()
+ "Completion for the `dnf' command."
+ (let ((subcmds (pcomplete-from-help "dnf help"
+ :margin "^\\(\\)[a-z-]+ "
+ :argument "[a-z-]+")))
+ (while (not (member (pcomplete-arg 1) subcmds))
+ (pcomplete-here (completion-table-merge
+ subcmds
+ (pcomplete-from-help "dnf help"))))
+ (let ((subcmd (pcomplete-arg 1)))
+ (while (pcase subcmd
+ ((guard (pcomplete-match "\\`-" 0))
+ (pcomplete-here
+ (pcomplete-from-help `("dnf" "help" ,subcmd))))
+ ((or "downgrade" "reinstall" "remove")
+ (pcomplete-here (pcmpl-rpm--dnf-packages 'installed)))
+ ((or "install" "mark" "reinstall" "upgrade")
+ (pcomplete-here (pcmpl-rpm--dnf-packages 'not-installed)))
+ ((or "builddep" "changelog" "info" "list" "repoquery"
"updateinfo")
+ (pcomplete-here (pcmpl-rpm--dnf-packages 'available))))))))
+
(provide 'pcmpl-rpm)
;;; pcmpl-rpm.el ends here
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 8774f091c8..0c32f814d0 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -25,7 +25,7 @@
(require 'pcomplete)
-;; User Variables:
+;;; User Variables
(defcustom pcmpl-unix-group-file "/etc/group"
"If non-nil, a string naming the group file on your system."
@@ -56,7 +56,7 @@ being via `pcmpl-ssh-known-hosts-file'."
:group 'pcmpl-unix
:version "24.1")
-;; Functions:
+;;; Shell builtins and core utilities
;;;###autoload
(defun pcomplete/cd ()
@@ -69,34 +69,38 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/rmdir ()
"Completion for `rmdir'."
- (while (pcomplete-here (pcomplete-dirs))))
+ (while (if (string-prefix-p "-" (pcomplete-arg))
+ (pcomplete-here (pcomplete-from-help "rmdir --help"))
+ (pcomplete-here (pcomplete-dirs)))))
;;;###autoload
(defun pcomplete/rm ()
- "Completion for `rm'."
- (let ((pcomplete-help "(fileutils)rm invocation"))
- (pcomplete-opt "dfirRv")
- (while (pcomplete-here (pcomplete-all-entries) nil
- #'expand-file-name))))
+ "Completion for the `rm' command."
+ (pcomplete-here-using-help "rm --help"))
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
(while (string-prefix-p "-" (pcomplete-arg 0))
- (pcomplete-here (funcall pcomplete-default-completion-function)))
+ (pcomplete-here (pcomplete-from-help "xargs --help"))
+ (when (pcomplete-match "\\`-[adEIiLnPs]\\'") (pcomplete-here)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
-;; FIXME: Add completion of sudo-specific arguments.
-(defalias 'pcomplete/sudo #'pcomplete/xargs)
-
;;;###autoload
-(defalias 'pcomplete/time 'pcomplete/xargs)
+(defun pcomplete/time ()
+ "Completion for the `time' command."
+ (pcomplete-opt "p")
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
;;;###autoload
(defun pcomplete/which ()
"Completion for `which'."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "which --help")))
(while (pcomplete-here (funcall pcomplete-command-completion-function))))
(defun pcmpl-unix-read-passwd-file (file)
@@ -128,25 +132,455 @@ documentation), this function returns nil."
(if pcmpl-unix-passwd-file
(pcmpl-unix-read-passwd-file pcmpl-unix-passwd-file)))
+;;;###autoload
+(defun pcomplete/cat ()
+ "Completion for the `cat' command."
+ (pcomplete-here-using-help "cat --help"))
+
+;;;###autoload
+(defun pcomplete/tac ()
+ "Completion for the `tac' command."
+ (pcomplete-here-using-help "tac --help"))
+
+;;;###autoload
+(defun pcomplete/nl ()
+ "Completion for the `nl' command."
+ (pcomplete-here-using-help "nl --help"))
+
+;;;###autoload
+(defun pcomplete/od ()
+ "Completion for the `od' command."
+ (pcomplete-here-using-help "od --help"))
+
+;;;###autoload
+(defun pcomplete/base32 ()
+ "Completion for the `base32' and `base64' commands."
+ (pcomplete-here-using-help "base32 --help"))
+;;;###autoload
+(defalias 'pcomplete/base64 'pcomplete/base32)
+
+;;;###autoload
+(defun pcomplete/basenc ()
+ "Completion for the `basenc' command."
+ (pcomplete-here-using-help "basenc --help"))
+
+;;;###autoload
+(defun pcomplete/fmt ()
+ "Completion for the `fmt' command."
+ (pcomplete-here-using-help "fmt --help"))
+
+;;;###autoload
+(defun pcomplete/pr ()
+ "Completion for the `pr' command."
+ (pcomplete-here-using-help "pr --help"))
+
+;;;###autoload
+(defun pcomplete/fold ()
+ "Completion for the `fold' command."
+ (pcomplete-here-using-help "fold --help"))
+
+;;;###autoload
+(defun pcomplete/head ()
+ "Completion for the `head' command."
+ (pcomplete-here-using-help "head --help"))
+
+;;;###autoload
+(defun pcomplete/tail ()
+ "Completion for the `tail' command."
+ (pcomplete-here-using-help "tail --help"))
+
+;;;###autoload
+(defun pcomplete/split ()
+ "Completion for the `split' command."
+ (pcomplete-here-using-help "split --help"))
+
+;;;###autoload
+(defun pcomplete/csplit ()
+ "Completion for the `csplit' command."
+ (pcomplete-here-using-help "csplit --help"))
+
+;;;###autoload
+(defun pcomplete/wc ()
+ "Completion for the `wc' command."
+ (pcomplete-here-using-help "wc --help"))
+
+;;;###autoload
+(defun pcomplete/sum ()
+ "Completion for the `sum' command."
+ (pcomplete-here-using-help "sum --help"))
+
+;;;###autoload
+(defun pcomplete/cksum ()
+ "Completion for the `cksum' command."
+ (pcomplete-here-using-help "cksum --help"))
+
+;;;###autoload
+(defun pcomplete/b2sum ()
+ "Completion for the `b2sum' command."
+ (pcomplete-here-using-help "b2sum --help"))
+
+;;;###autoload
+(defun pcomplete/md5sum ()
+ "Completion for checksum commands."
+ (pcomplete-here-using-help "md5sum --help"))
+;;;###autoload(defalias 'pcomplete/sha1sum 'pcomplete/md5sum)
+;;;###autoload(defalias 'pcomplete/sha224sum 'pcomplete/md5sum)
+;;;###autoload(defalias 'pcomplete/sha256sum 'pcomplete/md5sum)
+;;;###autoload(defalias 'pcomplete/sha384sum 'pcomplete/md5sum)
+;;;###autoload(defalias 'pcomplete/sha521sum 'pcomplete/md5sum)
+
+;;;###autoload
+(defun pcomplete/sort ()
+ "Completion for the `sort' command."
+ (pcomplete-here-using-help "sort --help"))
+
+;;;###autoload
+(defun pcomplete/shuf ()
+ "Completion for the `shuf' command."
+ (pcomplete-here-using-help "shuf --help"))
+
+;;;###autoload
+(defun pcomplete/uniq ()
+ "Completion for the `uniq' command."
+ (pcomplete-here-using-help "uniq --help"))
+
+;;;###autoload
+(defun pcomplete/comm ()
+ "Completion for the `comm' command."
+ (pcomplete-here-using-help "comm --help"))
+
+;;;###autoload
+(defun pcomplete/ptx ()
+ "Completion for the `ptx' command."
+ (pcomplete-here-using-help "ptx --help"))
+
+;;;###autoload
+(defun pcomplete/tsort ()
+ "Completion for the `tsort' command."
+ (pcomplete-here-using-help "tsort --help"))
+
+;;;###autoload
+(defun pcomplete/cut ()
+ "Completion for the `cut' command."
+ (pcomplete-here-using-help "cut --help"))
+
+;;;###autoload
+(defun pcomplete/paste ()
+ "Completion for the `paste' command."
+ (pcomplete-here-using-help "paste --help"))
+
+;;;###autoload
+(defun pcomplete/join ()
+ "Completion for the `join' command."
+ (pcomplete-here-using-help "join --help"))
+
+;;;###autoload
+(defun pcomplete/tr ()
+ "Completion for the `tr' command."
+ (pcomplete-here-using-help "tr --help"))
+
+;;;###autoload
+(defun pcomplete/expand ()
+ "Completion for the `expand' command."
+ (pcomplete-here-using-help "expand --help"))
+
+;;;###autoload
+(defun pcomplete/unexpand ()
+ "Completion for the `unexpand' command."
+ (pcomplete-here-using-help "unexpand --help"))
+
+;;;###autoload
+(defun pcomplete/ls ()
+ "Completion for the `ls' command."
+ (pcomplete-here-using-help "ls --help"))
+;;;###autoload(defalias 'pcomplete/dir 'pcomplete/ls)
+;;;###autoload(defalias 'pcomplete/vdir 'pcomplete/ls)
+
+;;;###autoload
+(defun pcomplete/cp ()
+ "Completion for the `cp' command."
+ (pcomplete-here-using-help "cp --help"))
+
+;;;###autoload
+(defun pcomplete/dd ()
+ "Completion for the `dd' command."
+ (let ((operands (pcomplete-from-help "dd --help"
+ :argument "[a-z]+="
+ :narrow-start "\n\n"
+ :narrow-end "\n\n")))
+ (while
+ (cond ((pcomplete-match "\\`[io]f=\\(.*\\)" 0)
+ (pcomplete-here (pcomplete-entries)
+ (pcomplete-match-string 1 0)))
+ (t (pcomplete-here operands))))))
+
+;;;###autoload
+(defun pcomplete/install ()
+ "Completion for the `install' command."
+ (pcomplete-here-using-help "install --help"))
+
+;;;###autoload
+(defun pcomplete/mv ()
+ "Completion for the `mv' command."
+ (pcomplete-here-using-help "mv --help"))
+
+;;;###autoload
+(defun pcomplete/shred ()
+ "Completion for the `shred' command."
+ (pcomplete-here-using-help "shred --help"))
+
+;;;###autoload
+(defun pcomplete/ln ()
+ "Completion for the `ln' command."
+ (pcomplete-here-using-help "ln --help"))
+
+;;;###autoload
+(defun pcomplete/mkdir ()
+ "Completion for the `mkdir' command."
+ (pcomplete-here-using-help "mkdir --help"))
+
+;;;###autoload
+(defun pcomplete/mkfifo ()
+ "Completion for the `mkfifo' command."
+ (pcomplete-here-using-help "mkfifo --help"))
+
+;;;###autoload
+(defun pcomplete/mknod ()
+ "Completion for the `mknod' command."
+ (pcomplete-here-using-help "mknod --help"))
+
+;;;###autoload
+(defun pcomplete/readlink ()
+ "Completion for the `readlink' command."
+ (pcomplete-here-using-help "readlink --help"))
+
;;;###autoload
(defun pcomplete/chown ()
"Completion for the `chown' command."
- (unless (pcomplete-match "\\`-")
- (if (pcomplete-match "\\`[^.]*\\'" 0)
- (pcomplete-here* (pcmpl-unix-user-names))
- (if (pcomplete-match "\\.\\([^.]*\\)\\'" 0)
- (pcomplete-here* (pcmpl-unix-group-names)
- (pcomplete-match-string 1 0))
- (pcomplete-here*))))
+ (while (pcomplete-match "\\`-" 0)
+ (pcomplete-here (pcomplete-from-help "chown --help")))
+ (if (pcomplete-match "\\`[^.]*\\'" 0)
+ (pcomplete-here* (pcmpl-unix-user-names))
+ (if (pcomplete-match "\\.\\([^.]*\\)\\'" 0)
+ (pcomplete-here* (pcmpl-unix-group-names)
+ (pcomplete-match-string 1 0))
+ (pcomplete-here*)))
(while (pcomplete-here (pcomplete-entries))))
;;;###autoload
(defun pcomplete/chgrp ()
"Completion for the `chgrp' command."
- (unless (pcomplete-match "\\`-")
- (pcomplete-here* (pcmpl-unix-group-names)))
+ (while (pcomplete-match "\\`-" 0)
+ (pcomplete-here (pcomplete-from-help "chgrp --help")))
+ (pcomplete-here* (pcmpl-unix-group-names))
(while (pcomplete-here (pcomplete-entries))))
+;;;###autoload
+(defun pcomplete/chmod ()
+ "Completion for the `chmod' command."
+ (pcomplete-here-using-help "chmod --help"))
+
+;;;###autoload
+(defun pcomplete/touch ()
+ "Completion for the `touch' command."
+ (pcomplete-here-using-help "touch --help"))
+
+;;;###autoload
+(defun pcomplete/df ()
+ "Completion for the `df' command."
+ (pcomplete-here-using-help "df --help"))
+
+;;;###autoload
+(defun pcomplete/du ()
+ "Completion for the `du' command."
+ (pcomplete-here-using-help "du --help"))
+
+;;;###autoload
+(defun pcomplete/stat ()
+ "Completion for the `stat' command."
+ (pcomplete-here-using-help "stat --help"))
+
+;;;###autoload
+(defun pcomplete/sync ()
+ "Completion for the `sync' command."
+ (pcomplete-here-using-help "sync --help"))
+
+;;;###autoload
+(defun pcomplete/truncate ()
+ "Completion for the `truncate' command."
+ (pcomplete-here-using-help "truncate --help"))
+
+;;;###autoload
+(defun pcomplete/echo ()
+ "Completion for the `echo' command."
+ (pcomplete-here-using-help '("echo" "--help")))
+
+;;;###autoload
+(defun pcomplete/test ()
+ "Completion for the `test' command."
+ (pcomplete-here-using-help '("[" "--help")
+ :margin "^ +\\([A-Z]+1 \\)?"))
+;;;###autoload(defalias (intern "pcomplete/[") 'pcomplete/test)
+
+;;;###autoload
+(defun pcomplete/tee ()
+ "Completion for the `tee' command."
+ (pcomplete-here-using-help "tee --help"))
+
+;;;###autoload
+(defun pcomplete/basename ()
+ "Completion for the `basename' command."
+ (pcomplete-here-using-help "basename --help"))
+
+;;;###autoload
+(defun pcomplete/dirname ()
+ "Completion for the `dirname' command."
+ (pcomplete-here-using-help "dirname --help"))
+
+;;;###autoload
+(defun pcomplete/pathchk ()
+ "Completion for the `pathchk' command."
+ (pcomplete-here-using-help "pathchk --help"))
+
+;;;###autoload
+(defun pcomplete/mktemp ()
+ "Completion for the `mktemp' command."
+ (pcomplete-here-using-help "mktemp --help"))
+
+;;;###autoload
+(defun pcomplete/realpath ()
+ "Completion for the `realpath' command."
+ (pcomplete-here-using-help "realpath --help"))
+
+;;;###autoload
+(defun pcomplete/id ()
+ "Completion for the `id' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "id --help")))
+ (while (pcomplete-here (pcmpl-unix-user-names))))
+
+;;;###autoload
+(defun pcomplete/groups ()
+ "Completion for the `groups' command."
+ (while (pcomplete-here (pcmpl-unix-user-names))))
+
+;;;###autoload
+(defun pcomplete/who ()
+ "Completion for the `who' command."
+ (pcomplete-here-using-help "who --help"))
+
+;;;###autoload
+(defun pcomplete/date ()
+ "Completion for the `date' command."
+ (pcomplete-here-using-help "date --help"))
+
+;;;###autoload
+(defun pcomplete/nproc ()
+ "Completion for the `nproc' command."
+ (pcomplete-here-using-help "nproc --help"))
+
+;;;###autoload
+(defun pcomplete/uname ()
+ "Completion for the `uname' command."
+ (pcomplete-here-using-help "uname --help"))
+
+;;;###autoload
+(defun pcomplete/hostname ()
+ "Completion for the `hostname' command."
+ (pcomplete-here-using-help "hostname --help"))
+
+;;;###autoload
+(defun pcomplete/uptime ()
+ "Completion for the `uptime' command."
+ (pcomplete-here-using-help "uptime --help"))
+
+;;;###autoload
+(defun pcomplete/chcon ()
+ "Completion for the `chcon' command."
+ (pcomplete-here-using-help "chcon --help"))
+
+;;;###autoload
+(defun pcomplete/runcon ()
+ "Completion for the `runcon' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "runcon --help"))
+ (when (pcomplete-match "\\`-[turl]\\'" 0) (pcomplete-here)))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/chroot ()
+ "Completion for the `chroot' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "chroot --help")))
+ (pcomplete-here (pcomplete-dirs))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/env ()
+ "Completion for the `env' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "env --help"))
+ (when (pcomplete-match "\\`-[uCS]\\'") (pcomplete-here)))
+ (while (pcomplete-match "=" 0) (pcomplete-here)) ; FIXME: Complete env vars
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/nice ()
+ "Completion for the `nice' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "nice --help"))
+ (pcomplete-here))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/nohup ()
+ "Completion for the `nohup' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "nohup --help")))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/stdbuf ()
+ "Completion for the `stdbuf' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "stdbuf --help"))
+ (when (pcomplete-match "\\`-[ioe]\\'") (pcomplete-here)))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/timeout ()
+ "Completion for the `timeout' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "timeout --help"))
+ (when (pcomplete-match "\\`-[ks]\\'") (pcomplete-here)))
+ (pcomplete-here) ; eat DURATION argument
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
+;;;###autoload
+(defun pcomplete/numfmt ()
+ "Completion for the `numfmt' command."
+ (pcomplete-here-using-help "numfmt --help"))
+
+;;;###autoload
+(defun pcomplete/seq ()
+ "Completion for the `seq' command."
+ (pcomplete-here-using-help "seq --help"))
+
+;;; Network commands
;; ssh support by Phil Hagelberg.
;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
@@ -239,6 +673,18 @@ Includes files as well as host names followed by a colon."
(pcomplete-opt "xl(pcmpl-unix-user-names)")
(pcmpl-unix-complete-hostname))
+;;; Miscellaneous
+
+;;;###autoload
+(defun pcomplete/sudo ()
+ "Completion for the `sudo' command."
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (pcomplete-from-help "sudo --help"))
+ (when (pcomplete-match "\\`-[CDghpRtTUu]\\'") (pcomplete-here)))
+ (funcall pcomplete-command-completion-function)
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
(provide 'pcmpl-unix)
;;; pcmpl-unix.el ends here
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 261a3d4e27..1ede867c5f 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -28,6 +28,22 @@
(eval-when-compile (require 'cl-lib))
(require 'pcomplete)
+;;; TeX
+
+;;;###autoload
+(defun pcomplete/tex ()
+ "Completion for the `tex' command."
+ (pcomplete-here-using-help "tex --help"
+ :margin "^\\(?:\\[-no\\]\\)?\\(\\)-"))
+;;;###autoload(defalias 'pcomplete/pdftex 'pcomplete/tex)
+;;;###autoload(defalias 'pcomplete/latex 'pcomplete/tex)
+;;;###autoload(defalias 'pcomplete/pdflatex 'pcomplete/tex)
+
+;;;###autoload
+(defun pcomplete/luatex ()
+ "Completion for the `luatex' command."
+ (pcomplete-here-using-help "luatex --help"))
+;;;###autoload(defalias 'pcomplete/lualatex 'pcomplete/luatex)
;;;; tlmgr - https://www.tug.org/texlive/tlmgr.html
@@ -142,6 +158,12 @@
(unless (pcomplete-match "^--" 0)
(pcomplete-here* (pcomplete-dirs-or-entries)))))))
+;;; Grep-like tools
+
+;;;###autoload
+(defun pcomplete/rg ()
+ "Completion for the `rg' command."
+ (pcomplete-here-using-help "rg --help"))
;;;; ack - https://betterthangrep.com
@@ -288,6 +310,8 @@ long options."
(pcmpl-x-ag-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
+;;; Borland
+
;;;###autoload
(defun pcomplete/bcc32 ()
"Completion function for Borland's C++ compiler."
@@ -321,5 +345,24 @@ long options."
;;;###autoload
(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+;;; Network tools
+
+;;;###autoload
+(defun pcomplete/rclone ()
+ "Completion for the `rclone' command."
+ (let ((subcmds (pcomplete-from-help "rclone help"
+ :margin "^ "
+ :argument "[a-z]+"
+ :narrow-start "\n\n")))
+ (while (not (member (pcomplete-arg 1) subcmds))
+ (pcomplete-here (completion-table-merge
+ subcmds
+ (pcomplete-from-help "rclone help flags"))))
+ (let ((subcmd (pcomplete-arg 1)))
+ (while (if (pcomplete-match "\\`-" 0)
+ (pcomplete-here (pcomplete-from-help
+ `("rclone" ,subcmd "--help")))
+ (pcomplete-here (pcomplete-entries)))))))
+
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 15b9880df8..8cb0aa3b7a 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -119,6 +119,9 @@
;;; Code:
(require 'comint)
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'rx))
(defgroup pcomplete nil
"Programmable completion."
@@ -155,9 +158,6 @@ This mirrors the optional behavior of tcsh.
A non-nil value is useful if `pcomplete-autolist' is non-nil too."
:type 'boolean)
-(define-obsolete-variable-alias
- 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
-
(defcustom pcomplete-man-function #'man
"A function to that will be called to display a manual page.
It will be passed the name of the command to document."
@@ -364,11 +364,10 @@ modified to be an empty string, or the desired separation
string."
;;; Alternative front-end using the standard completion facilities.
-;; The way pcomplete-parse-arguments, pcomplete-stub, and
-;; pcomplete-quote-argument work only works because of some deep
-;; hypothesis about the way the completion work. Basically, it makes
-;; it pretty much impossible to have completion other than
-;; prefix-completion.
+;; The way pcomplete-parse-arguments and pcomplete-stub work only
+;; works because of some deep hypothesis about the way the completion
+;; work. Basically, it makes it pretty much impossible to have
+;; completion other than prefix-completion.
;;
;; pcomplete--common-suffix and completion-table-subvert try to work around
;; this difficulty with heuristics, but it's really a hack.
@@ -485,6 +484,14 @@ Same as `pcomplete' but using the standard completion UI."
(when completion-ignore-case
(setq table (completion-table-case-fold table)))
(list beg (point) table
+ :annotation-function
+ (lambda (cand)
+ (when (stringp cand)
+ (get-text-property 0 'pcomplete-annotation cand)))
+ :company-docsig
+ (lambda (cand)
+ (when (stringp cand)
+ (get-text-property 0 'pcomplete-help cand)))
:predicate pred
:exit-function
;; If completion is finished, add a terminating space.
@@ -639,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.
@@ -841,9 +845,6 @@ this is `comint-dynamic-complete-functions'."
(throw 'pcompleted t)
pcomplete-args))))))
-(define-obsolete-function-alias
- 'pcomplete-quote-argument #'comint-quote-filename "24.3")
-
;; file-system completion lists
(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
@@ -1332,6 +1333,133 @@ If specific documentation can't be given, be generic."
(pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
'pcomplete--host-name-cache-timestamp)))
+;;; Parsing help messages
+
+(defvar pcomplete-from-help (make-hash-table :test #'equal)
+ "Memoization table for function `pcomplete-from-help'.")
+
+(cl-defun pcomplete-from-help (command
+ &rest args
+ &key
+ (margin (rx bol (+ " ")))
+ (argument (rx "-" (+ (any "-" alnum)) (? "=")))
+ (metavar (rx (? " ")
+ (or (+ (any alnum "_-"))
+ (seq "[" (+? nonl) "]")
+ (seq "<" (+? nonl) ">")
+ (seq "{" (+? nonl) "}"))))
+ (separator (rx ", " symbol-start))
+ (description (rx (* nonl)
+ (* "\n" (>= 9 " ") (* nonl))))
+ narrow-start
+ narrow-end)
+ "Parse output of COMMAND into a list of completion candidates.
+
+COMMAND can be a string to be executed in a shell or a list of
+strings (program name and arguments). It should print a help
+message.
+
+A list of arguments is collected after each match of MARGIN.
+Each argument should match ARGUMENT, possibly followed by a match
+of METAVAR. If a match of SEPARATOR follows, then more
+argument-metavar pairs are collected. Finally, a match of
+DESCRIPTION is collected.
+
+Keyword ARGS:
+
+MARGIN: regular expression after which argument descriptions are
+ to be found. Parsing continues at the end of the first match
+ group or, failing that, the entire match.
+
+ARGUMENT: regular expression matching an argument name. The
+ first match group (failing that, the entire match) is collected
+ as the argument name. Parsing continues at the end of the
+ second matching group (failing that, the first group or entire
+ match).
+
+METAVAR: regular expression matching an argument parameter name.
+ The first match group (failing that, the entire match) is
+ collected as the parameter name and used as completion
+ annotation. Parsing continues at the end of the second
+ matching group (failing that, the first group or entire match).
+
+SEPARATOR: regular expression matching the separator between
+ arguments. Parsing continues at the end of the first match
+ group (failing that, the entire match).
+
+DESCRIPTION: regular expression matching the description of an
+ argument. The first match group (failing that, the entire
+ match) is collected as the parameter name and used as
+ completion help. Parsing continues at the end of the first
+ matching group (failing that, the entire match).
+
+NARROW-START, NARROW-END: if non-nil, parsing of the help message
+ is narrowed to the region between the end of the first match
+ group (failing that, the entire match) of these regular
+ expressions."
+ (with-memoization (gethash (cons command args) pcomplete-from-help)
+ (with-temp-buffer
+ (let ((case-fold-search nil)
+ (default-directory (expand-file-name "~/"))
+ (command (if (stringp command)
+ (list shell-file-name
+ shell-command-switch
+ command)
+ command))
+ i result)
+ (apply #'call-process (car command) nil t nil (cdr command))
+ (goto-char (point-min))
+ (narrow-to-region (or (and narrow-start
+ (re-search-forward narrow-start nil t)
+ (or (match-beginning 1) (match-beginning
0)))
+ (point-min))
+ (or (and narrow-end
+ (re-search-forward narrow-end nil t)
+ (or (match-beginning 1) (match-beginning
0)))
+ (point-max)))
+ (goto-char (point-min))
+ (while (re-search-forward margin nil t)
+ (goto-char (or (match-end 1) (match-end 0)))
+ (setq i 0)
+ (while (and (or (zerop i)
+ (and (looking-at separator)
+ (goto-char (or (match-end 1)
+ (match-end 0)))))
+ (looking-at argument))
+ (setq i (1+ i))
+ (goto-char (seq-some #'match-end '(2 1 0)))
+ (push (or (match-string 1) (match-string 0)) result)
+ (when (looking-at metavar)
+ (goto-char (seq-some #'match-end '(2 1 0)))
+ (put-text-property 0 1
+ 'pcomplete-annotation
+ (or (match-string 1) (match-string 0))
+ (car result))))
+ (when (looking-at description)
+ (goto-char (seq-some #'match-end '(2 1 0)))
+ (let ((help (string-clean-whitespace
+ (or (match-string 1) (match-string 0))))
+ (items (take i result)))
+ (while items
+ (put-text-property 0 1 'pcomplete-help help
+ (pop items))))))
+ (nreverse result)))))
+
+(defun pcomplete-here-using-help (command &rest args)
+ "Perform completion for a simple command.
+Offer switches and directory entries as completion candidates.
+The switches are obtained by calling `pcomplete-from-help' with
+COMMAND and ARGS as arguments."
+ (while (cond
+ ((string= "--" (pcomplete-arg 1))
+ (while (pcomplete-here (pcomplete-entries))))
+ ((pcomplete-match "\\`--[^=]+=\\(.*\\)" 0)
+ (pcomplete-here (pcomplete-entries)
+ (pcomplete-match-string 1 0)))
+ ((string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (apply #'pcomplete-from-help command args)))
+ (t (pcomplete-here (pcomplete-entries))))))
+
(provide 'pcomplete)
;;; pcomplete.el ends here
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 167cb4fabe..10da9cb9ab 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -116,39 +116,37 @@ is always with pixel resolution.")
(defvar mwheel-coalesce-scroll-events)
-(defvar pixel-scroll-precision-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [wheel-down] 'pixel-scroll-precision)
- (define-key map [wheel-up] 'pixel-scroll-precision)
- (define-key map [touch-end] 'pixel-scroll-start-momentum)
- (define-key map [mode-line wheel-down] 'pixel-scroll-precision)
- (define-key map [mode-line wheel-up] 'pixel-scroll-precision)
- (define-key map [mode-line touch-end] 'pixel-scroll-start-momentum)
- (define-key map [header-line wheel-down] 'pixel-scroll-precision)
- (define-key map [header-line wheel-up] 'pixel-scroll-precision)
- (define-key map [header-line touch-end] 'pixel-scroll-start-momentum)
- (define-key map [vertical-scroll-bar wheel-down] 'pixel-scroll-precision)
- (define-key map [vertical-scroll-bar wheel-up] 'pixel-scroll-precision)
- (define-key map [vertical-scroll-bar touch-end]
'pixel-scroll-start-momentum)
- (define-key map [tool-bar wheel-down] 'pixel-scroll-precision)
- (define-key map [tool-bar wheel-up] 'pixel-scroll-precision)
- (define-key map [tool-bar touch-end] 'pixel-scroll-start-momentum)
- (define-key map [left-margin wheel-down] 'pixel-scroll-precision)
- (define-key map [left-margin wheel-up] 'pixel-scroll-precision)
- (define-key map [left-margin touch-end] 'pixel-scroll-start-momentum)
- (define-key map [right-margin wheel-down] 'pixel-scroll-precision)
- (define-key map [right-margin wheel-up] 'pixel-scroll-precision)
- (define-key map [right-margin touch-end] 'pixel-scroll-start-momentum)
- (define-key map [left-fringe wheel-down] 'pixel-scroll-precision)
- (define-key map [left-fringe wheel-up] 'pixel-scroll-precision)
- (define-key map [left-fringe touch-end] 'pixel-scroll-start-momentum)
- (define-key map [right-fringe wheel-down] 'pixel-scroll-precision)
- (define-key map [right-fringe wheel-up] 'pixel-scroll-precision)
- (define-key map [right-fringe touch-end] 'pixel-scroll-start-momentum)
- (define-key map [next] 'pixel-scroll-interpolate-down)
- (define-key map [prior] 'pixel-scroll-interpolate-up)
- map)
- "The key map used by `pixel-scroll-precision-mode'.")
+(defvar-keymap pixel-scroll-precision-mode-map
+ :doc "The key map used by `pixel-scroll-precision-mode'."
+ "<wheel-down>" #'pixel-scroll-precision
+ "<wheel-up>" #'pixel-scroll-precision
+ "<touch-end>" #'pixel-scroll-start-momentum
+ "<mode-line> <wheel-down>" #'pixel-scroll-precision
+ "<mode-line> <wheel-up>" #'pixel-scroll-precision
+ "<mode-line> <touch-end>" #'pixel-scroll-start-momentum
+ "<header-line> <wheel-down>" #'pixel-scroll-precision
+ "<header-line> <wheel-up>" #'pixel-scroll-precision
+ "<header-line> <touch-end>" #'pixel-scroll-start-momentum
+ "<vertical-scroll-bar> <wheel-down>" #'pixel-scroll-precision
+ "<vertical-scroll-bar> <wheel-up>" #'pixel-scroll-precision
+ "<vertical-scroll-bar> <touch-end>" #'pixel-scroll-start-momentum
+ "<tool-bar> <wheel-down>" #'pixel-scroll-precision
+ "<tool-bar> <wheel-up>" #'pixel-scroll-precision
+ "<tool-bar> <touch-end>" #'pixel-scroll-start-momentum
+ "<left-margin> <wheel-down>" #'pixel-scroll-precision
+ "<left-margin> <wheel-up>" #'pixel-scroll-precision
+ "<left-margin> <touch-end>" #'pixel-scroll-start-momentum
+ "<right-margin> <wheel-down>" #'pixel-scroll-precision
+ "<right-margin> <wheel-up>" #'pixel-scroll-precision
+ "<right-margin> <touch-end>" #'pixel-scroll-start-momentum
+ "<left-fringe> <wheel-down>" #'pixel-scroll-precision
+ "<left-fringe> <wheel-up>" #'pixel-scroll-precision
+ "<left-fringe> <touch-end>" #'pixel-scroll-start-momentum
+ "<right-fringe> <wheel-down>" #'pixel-scroll-precision
+ "<right-fringe> <wheel-up>" #'pixel-scroll-precision
+ "<right-fringe> <touch-end>" #'pixel-scroll-start-momentum
+ "<next>" #'pixel-scroll-interpolate-down
+ "<prior>" #'pixel-scroll-interpolate-up)
(defcustom pixel-scroll-precision-use-momentum nil
"If non-nil, continue to scroll the display after wheel movement stops.
@@ -195,7 +193,7 @@ Nil means to not interpolate such scrolls."
:type 'float
:version "29.1")
-(defcustom pixel-scroll-precision-interpolation-factor 4.0
+(defcustom pixel-scroll-precision-interpolation-factor 2.0
"A factor to apply to the distance of an interpolated scroll."
:group 'mouse
:type 'float
@@ -605,19 +603,25 @@ the height of the current window."
(when (< delta 0)
(set-window-vscroll nil (- delta) t t)))))
-(defun pixel-scroll-precision-interpolate (delta &optional old-window)
+(defun pixel-scroll-precision-interpolate (delta &optional old-window factor)
"Interpolate a scroll of DELTA pixels.
OLD-WINDOW is the window which will be selected when redisplay
takes place, or nil for the current window. This results in the
-window being scrolled by DELTA pixels with an animation."
+window being scrolled by DELTA pixels with an animation. FACTOR
+is a scale by which DELTA will be modified. If nil, it defaults
+to `pixel-scroll-precision-interpolation-factor'."
(let ((percentage 0)
(total-time pixel-scroll-precision-interpolation-total-time)
- (factor pixel-scroll-precision-interpolation-factor)
+ (factor (or factor pixel-scroll-precision-interpolation-factor))
(last-time (float-time))
- (time-elapsed 0.0)
+ (time-elapsed 0)
(between-scroll pixel-scroll-precision-interpolation-between-scroll)
(rem (window-parameter nil 'interpolated-scroll-remainder))
- (time (window-parameter nil 'interpolated-scroll-remainder-time)))
+ (time (window-parameter nil 'interpolated-scroll-remainder-time))
+ (last-delta 0))
+ (unless (or (not rem) (eq (< delta 0) (< rem 0)))
+ ;; The direction changed. Clear the remainder.
+ (setq rem nil))
(when (and rem time
(< (- (float-time) time) 1.0)
(eq (< delta 0) (< rem 0)))
@@ -631,18 +635,19 @@ window being scrolled by DELTA pixels with an animation."
(selected-window))
(redisplay t))
(sleep-for between-scroll)
- (setq time-elapsed (+ time-elapsed
- (- (float-time) last-time))
- percentage (/ time-elapsed total-time))
- (let ((throw-on-input nil))
- (if (< delta 0)
- (pixel-scroll-precision-scroll-down
- (ceiling (abs (* (* delta factor)
- (/ between-scroll total-time)))))
- (pixel-scroll-precision-scroll-up
- (ceiling (* (* delta factor)
- (/ between-scroll total-time))))))
- (setq last-time (float-time)))
+ (let ((time (float-time)))
+ (setq time-elapsed (+ time-elapsed
+ (- time last-time))
+ percentage (/ time-elapsed total-time))
+ (let* ((throw-on-input nil)
+ (absolute-delta (* (min 1 percentage) delta factor))
+ (relative-delta (abs
+ (round (- absolute-delta
last-delta)))))
+ (setq last-delta absolute-delta)
+ (if (< delta 0)
+ (pixel-scroll-precision-scroll-down relative-delta)
+ (pixel-scroll-precision-scroll-up relative-delta)))
+ (setq last-time time)))
(if (< percentage 1)
(progn
(set-window-parameter nil 'interpolated-scroll-remainder
@@ -821,14 +826,20 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
"Interpolate a scroll downwards by one page."
(interactive)
(if pixel-scroll-precision-interpolate-page
- (pixel-scroll-precision-interpolate (- (window-text-height nil t)))
+ (pixel-scroll-precision-interpolate (- (window-text-height nil t))
+ ;; Don't use an
+ ;; interpolation factor,
+ ;; since we want exactly 1
+ ;; page to be scrolled.
+ nil 1)
(cua-scroll-up)))
(defun pixel-scroll-interpolate-up ()
"Interpolate a scroll upwards by one page."
(interactive)
(if pixel-scroll-precision-interpolate-page
- (pixel-scroll-precision-interpolate (window-text-height nil t))
+ (pixel-scroll-precision-interpolate (window-text-height nil t)
+ nil 1)
(cua-scroll-down)))
;;;###autoload
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 8da4205af5..4e4982e7b0 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -80,12 +80,8 @@ directory will be used.")
(defun gamegrid-calculate-glyph-size ()
"Calculate appropriate glyph size in pixels based on display resolution.
Return a multiple of 8 no less than 16."
- (let (atts
+ (let ((atts (frame-monitor-attributes))
y-pitch)
- (dolist (mon (display-monitor-attributes-list))
- (when-let ((frames (alist-get 'frames mon))
- (match (memq (selected-frame) frames)))
- (setq atts mon)))
(setq y-pitch (cond
(atts
(/ (nth 4 (assq 'geometry atts))
@@ -347,6 +343,8 @@ format."
(gamegrid-match-spec-list (cdr spec-list)))))
(defun gamegrid-make-glyph (data-spec-list color-spec-list)
+ ;; image.el is not preloaded in --without-x builds.
+ (defvar image-scaling-factor)
(let ((data (gamegrid-match-spec-list data-spec-list))
(color (gamegrid-match-spec-list color-spec-list))
(image-scaling-factor 1.0))
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 58fb82b6ed..1a4b6dbeb1 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -149,10 +149,9 @@ BITS must be of length nrings. Start at START-TIME."
(setq show-trailing-whitespace nil)
(unwind-protect
(let*
- (;; These lines can cause Emacs to crash if you ask for too
- ;; many rings. If you uncomment them, on most systems you
+ (;; This line can cause Emacs to crash if you ask for too
+ ;; many rings. If you uncomment it, on most systems you
;; can get 10,000+ rings.
- ;;(max-specpdl-size (max max-specpdl-size (* nrings 15)))
;;(max-lisp-eval-depth (max max-lisp-eval-depth (+ nrings 20)))
(vert (not hanoi-horizontal-flag))
(pole-width (length (format "%d" (max 0 (1- nrings)))))
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 534b45c772..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'
@@ -3040,7 +3040,7 @@ A. Interface:
I. PostScript printing:
- 1. You can generate a PostScript file (if you type C-u before activating
+ 1. You can generate a PostScript file (if you type \\[universal-argument]
before activating
menu) or PostScript temporary file for a directory, a buffer, a region
or a major mode, choosing 1-up, 2-up, 4-up or any other n-up printing;
after file generation, ghostview is activated using the file generated
@@ -3080,7 +3080,7 @@ I. PostScript printing:
`pr-ps-utility-alist'.
2. Operate the same way as option 1, but it sends directly the PostScript
- code (or put in a file, if you've typed C-u) or it uses ghostscript to
+ code (or put in a file, if you've typed \\[universal-argument]) or it
uses ghostscript to
print the PostScript file generated. It depends on option 18, if it's
turned on, it uses ghostscript; otherwise, it sends directly to
printer. If spooling is on (option 16), the PostScript code is saved
@@ -3089,7 +3089,7 @@ I. PostScript printing:
Instead of printing each buffer, region or major mode at once, you can
save temporarily the PostScript code generated in a buffer and print it
later. The option `Despool...' despools the PostScript spooling buffer
- directly on a printer. If you type C-u before choosing this option,
+ directly on a printer. If you type \\[universal-argument] before
choosing this option,
the PostScript code generated is saved in a file instead of sending it to
the printer. To spool the PostScript code generated you need to turn on
option 16. This option is enabled if spooling is on (option 16).
@@ -4183,7 +4183,8 @@ bottom."
(defun pr-help (&rest _ignore)
"Help for the printing package."
(interactive)
- (pr-show-setup pr-help-message "*Printing Help*"))
+ (pr-show-setup (substitute-command-keys pr-help-message)
+ "*Printing Help*"))
;;;###autoload
@@ -5036,7 +5037,8 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-show-setup (settings buffer-name)
(with-output-to-temp-buffer buffer-name
- (princ settings)
+ (with-current-buffer buffer-name
+ (insert settings))
(help-print-return-message)))
@@ -5544,13 +5546,11 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defvar pr-i-ps-send 'printer)
-(defvar pr-interface-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "q" 'pr-interface-quit)
- (define-key map "?" 'pr-interface-help)
- map)
- "Keymap for `pr-interface'.")
+(defvar-keymap pr-interface-map
+ :doc "Keymap for `pr-interface'."
+ :parent widget-keymap
+ "q" #'pr-interface-quit
+ "?" #'pr-interface-help)
(defmacro pr-interface-save (&rest body)
`(with-current-buffer pr-i-buffer
diff --git a/lisp/proced.el b/lisp/proced.el
index a27638d367..a774f2dd1e 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -426,7 +426,14 @@ Important: the match ends just after the marker.")
"Name of Proced Log buffer.")
(defconst proced-help-string
- "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
+ (concat "\\<proced-mode-map> "
+ "\\[next-line] next, "
+ "\\[previous-line] previous, "
+ "\\[proced-mark] mark, "
+ "\\[proced-unmark] unmark, "
+ "\\[proced-send-signal] kill, "
+ "\\[quit-window] quit "
+ "(type \\[proced-help] for more help)")
"Help string for Proced.")
(defconst proced-header-help-echo
@@ -445,60 +452,58 @@ Important: the match ends just after the marker.")
(,(concat "^[" (char-to-string proced-marker-char) "]")
".+" (proced-move-to-goal-column) nil (0 'proced-marked))))
-(defvar proced-mode-map
- (let ((km (make-sparse-keymap)))
- ;; moving
- (define-key km " " 'next-line)
- (define-key km "n" 'next-line)
- (define-key km "p" 'previous-line)
- (define-key km "\C-n" 'next-line)
- (define-key km "\C-p" 'previous-line)
- (define-key km "\C-?" 'previous-line)
- (define-key km [?\S-\ ] 'previous-line)
- (define-key km [down] 'next-line)
- (define-key km [up] 'previous-line)
- ;; marking
- (define-key km "d" 'proced-mark) ; Dired compatibility ("delete")
- (define-key km "m" 'proced-mark)
- (put 'proced-mark :advertised-binding "m")
- (define-key km "u" 'proced-unmark)
- (define-key km "\177" 'proced-unmark-backward)
- (define-key km "M" 'proced-mark-all)
- (define-key km "U" 'proced-unmark-all)
- (define-key km "t" 'proced-toggle-marks)
- (define-key km "C" 'proced-mark-children)
- (define-key km "P" 'proced-mark-parents)
- ;; filtering
- (define-key km "f" 'proced-filter-interactive)
- (define-key km [mouse-2] 'proced-refine)
- (define-key km "\C-m" 'proced-refine)
- ;; sorting
- (define-key km "sc" 'proced-sort-pcpu)
- (define-key km "sm" 'proced-sort-pmem)
- (define-key km "sp" 'proced-sort-pid)
- (define-key km "ss" 'proced-sort-start)
- (define-key km "sS" 'proced-sort-interactive)
- (define-key km "st" 'proced-sort-time)
- (define-key km "su" 'proced-sort-user)
- ;; similar to `Buffer-menu-sort-by-column'
- (define-key km [header-line mouse-1] 'proced-sort-header)
- (define-key km [header-line mouse-2] 'proced-sort-header)
- (define-key km "T" 'proced-toggle-tree)
- ;; formatting
- (define-key km "F" 'proced-format-interactive)
- ;; operate
- (define-key km "o" 'proced-omit-processes)
- (define-key km "x" 'proced-send-signal) ; Dired compatibility
- (define-key km "k" 'proced-send-signal) ; kill processes
- (define-key km "r" 'proced-renice) ; renice processes
- ;; misc
- (define-key km "h" 'describe-mode)
- (define-key km "?" 'proced-help)
- (define-key km [remap undo] 'proced-undo)
- (define-key km [remap advertised-undo] 'proced-undo)
- ;; Additional keybindings are inherited from `special-mode-map'
- km)
- "Keymap for Proced commands.")
+(defvar-keymap proced-mode-map
+ :doc "Keymap for Proced commands."
+ ;; moving
+ "SPC" #'next-line
+ "n" #'next-line
+ "p" #'previous-line
+ "C-n" #'next-line
+ "C-p" #'previous-line
+ "S-SPC" #'previous-line
+ "<down>" #'next-line
+ "<up>" #'previous-line
+ ;; marking
+ "d" #'proced-mark ; Dired compatibility ("delete")
+ "m" #'proced-mark
+ "u" #'proced-unmark
+ "DEL" #'proced-unmark-backward
+ "M" #'proced-mark-all
+ "U" #'proced-unmark-all
+ "t" #'proced-toggle-marks
+ "C" #'proced-mark-children
+ "P" #'proced-mark-parents
+ ;; filtering
+ "f" #'proced-filter-interactive
+ "<mouse-2>" #'proced-refine
+ "RET" #'proced-refine
+ ;; sorting
+ "s c" #'proced-sort-pcpu
+ "s m" #'proced-sort-pmem
+ "s p" #'proced-sort-pid
+ "s s" #'proced-sort-start
+ "s S" #'proced-sort-interactive
+ "s t" #'proced-sort-time
+ "s u" #'proced-sort-user
+ ;; similar to `Buffer-menu-sort-by-column'
+ "<header-line> <mouse-1>" #'proced-sort-header
+ "<header-line> <mouse-2>" #'proced-sort-header
+ "T" #'proced-toggle-tree
+ ;; formatting
+ "F" #'proced-format-interactive
+ ;; operate
+ "o" #'proced-omit-processes
+ "x" #'proced-send-signal ; Dired compatibility
+ "k" #'proced-send-signal ; kill processes
+ "r" #'proced-renice ; renice processes
+ ;; misc
+ "h" #'describe-mode
+ "?" #'proced-help
+ "<remap> <undo>" #'proced-undo
+ "<remap> <advertised-undo>" #'proced-undo
+ ;; Additional keybindings are inherited from `special-mode-map'
+ )
+(put 'proced-mark :advertised-binding "m")
(easy-menu-define proced-menu proced-mode-map
"Proced Menu."
@@ -637,22 +642,27 @@ type \\<proced-mode-map>\\[proced-mark] to mark a process
for later commands.
Type \\[proced-send-signal] to send signals to marked processes.
Type \\[proced-renice] to renice marked processes.
-The initial content of a listing is defined by the variable `proced-filter'
-and the variable `proced-format'.
-The variable `proced-filter' specifies which system processes are displayed.
-The variable `proced-format' specifies which attributes are displayed for
-each process. Type \\[proced-filter-interactive] and
\\[proced-format-interactive]
-to change the values of `proced-filter' and `proced-format'.
-The current value of the variable `proced-filter' is indicated in the
-mode line.
+The initial content of a listing is defined by the variable
+`proced-filter' and the variable `proced-format'.
+
+The variable `proced-filter' specifies which system processes are
+displayed.
+
+The variable `proced-format' specifies which attributes are
+displayed for each process.
+
+Type \\[proced-filter-interactive] and \\[proced-format-interactive] to \
+change the values of `proced-filter' and
+`proced-format'. The current value of the variable
+`proced-filter' is indicated in the mode line.
The sort order of Proced listings is defined by the variable `proced-sort'.
-Type \\[proced-sort-interactive] or click on a header in the header line
-to change the sort scheme. The current sort scheme is indicated in the
-mode line, using \"+\" or \"-\" for ascending or descending sort order.
+Type \\[proced-sort-interactive] or click on a header in the header \
+line to change the sort scheme.
+The current sort scheme is indicated in the mode line, using
+\"+\" or \"-\" for ascending or descending sort order.
-Type \\[proced-toggle-tree] to toggle whether the listing is
-displayed as process tree.
+Type \\[proced-toggle-tree] to toggle whether the listing is displayed as
process tree.
Type \\[proced-toggle-auto-update] to automatically update the
process list. The time interval for updates can be configured
@@ -661,11 +671,11 @@ via `proced-auto-update-interval'.
An existing Proced listing can be refined by typing \\[proced-refine].
Refining an existing listing does not update the variable `proced-filter'.
-The attribute-specific rules for formatting, filtering, sorting, and refining
-are defined in `proced-grammar-alist'.
+The attribute-specific rules for formatting, filtering, sorting,
+and refining are defined in `proced-grammar-alist'.
-After displaying or updating a Proced buffer, Proced runs the normal hook
-`proced-post-display-hook'.
+After displaying or updating a Proced buffer, Proced runs the
+normal hook `proced-post-display-hook'.
\\{proced-mode-map}"
:interactive nil
@@ -1768,6 +1778,9 @@ The value returned is the value of the last form in BODY."
(save-window-excursion
;; Analogous to `dired-pop-to-buffer'
;; Don't split window horizontally. (Bug#1806)
+ ;; FIXME: `dired-pop-to-buffer' was removed and replaced with
+ ;; `dired-mark-pop-up'. Should we just use
+ ;; `pop-to-buffer' here also?
(display-buffer (current-buffer)
'(display-buffer-in-direction
(direction . bottom)
@@ -1977,7 +1990,7 @@ STRING is an overall summary of the failures."
(proced-why)
(if (eq last-command 'proced-help)
(describe-mode)
- (message proced-help-string)))
+ (message (substitute-command-keys proced-help-string))))
(defun proced-undo ()
"Undo in a Proced buffer.
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-align.el b/lisp/progmodes/cc-align.el
index e14f5b9058..7b45be3c5c 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -85,11 +85,14 @@ statement-cont.)
Works with: topmost-intro-cont."
(save-excursion
(beginning-of-line)
- (c-backward-syntactic-ws (c-langelem-pos langelem))
- (if (and (memq (char-before) '(?} ?,))
- (not (and c-overloadable-operators-regexp
- (c-after-special-operator-id))))
- c-basic-offset)))
+ (unless (re-search-forward c-fun-name-substitute-key
+ (c-point 'eol) t)
+ (beginning-of-line)
+ (c-backward-syntactic-ws (c-langelem-pos langelem))
+ (if (and (memq (char-before) '(?} ?,))
+ (not (and c-overloadable-operators-regexp
+ (c-after-special-operator-id))))
+ c-basic-offset))))
(defun c-lineup-gnu-DEFUN-intro-cont (langelem)
"Line up the continuation lines of a DEFUN macro in the Emacs C source.
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 57750a2b39..089fa9ffe4 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -56,6 +56,7 @@
;; Silence the byte compiler.
(cc-bytecomp-defvar c-new-BEG)
(cc-bytecomp-defvar c-new-END)
+(cc-bytecomp-defvar c-open-string-opener)
(cc-bytecomp-defun c-restore-string-fences)
(cc-bytecomp-defun c-clear-string-fences)
@@ -777,16 +778,20 @@
;; opener, t if it would be a division sign.
;;
;; This function does hidden buffer changes.
- (search-forward-regexp c-awk-string-without-end-here-re nil t) ; a (possibly
unterminated) string
- (c-awk-set-string-regexp-syntax-table-properties
- (match-beginning 0) (match-end 0))
- (cond ((looking-at "\"")
- (forward-char)
- t) ; In AWK, ("15" / 5) gives 3 ;-)
- ((looking-at "[\n\r]") ; Unterminated string with EOL.
- (forward-char)
- nil) ; / on next line would start a regexp
- (t nil))) ; Unterminated string at EOB
+ (let ((string-start (if (eq (char-after) ?_) (1+ (point)) (point))))
+ (search-forward-regexp c-awk-string-without-end-here-re nil t) ; a
(possibly unterminated) string
+ (c-awk-set-string-regexp-syntax-table-properties
+ (match-beginning 0) (match-end 0))
+ (cond ((looking-at "\"")
+ (forward-char)
+ t) ; In AWK, ("15" / 5) gives 3 ;-)
+ ((looking-at "[\n\r]") ; Unterminated string with EOL.
+ (setq c-open-string-opener string-start)
+ (forward-char)
+ nil) ; / on next line would start a regexp
+ (t ; Unterminated string at EOB
+ (setq c-open-string-opener string-start)
+ nil))))
(defun c-awk-syntax-tablify-/ (anchor anchor-state-/div)
;; Point is at a /. Determine whether this is a division sign or a regexp
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index f867625480..81aac2ec27 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
@@ -125,7 +124,7 @@ The result of the body appears to the compiler as a quoted
constant.
This variant works around bugs in `eval-when-compile' in various
\(X)Emacs versions. See cc-defs.el for details."
- (declare (indent 0) (debug t))
+ (declare (indent 0) (debug (&rest def-form)))
(if c-inside-eval-when-compile
;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
;; evaluates its body at macro expansion time if it's nested
@@ -2629,6 +2628,20 @@ fallback definition for all modes, to break the cycle).")
(defconst c-lang--novalue "novalue")
+(defmacro c-let*-maybe-max-specpdl-size (varlist &rest body)
+ ;; Like let*, but doesn't bind `max-specpdl-size' if that variable
+ ;; is in the bindings list and either doesn't exist or is obsolete.
+ (declare (debug let*) (indent 1))
+ (let ((-varlist- (copy-sequence varlist)) msp-binding)
+ (if (or (not (boundp 'max-specpdl-size))
+ (get 'max-specpdl-size 'byte-obsolete-variable))
+ (cond
+ ((memq 'max-specpdl-size -varlist-)
+ (setq -varlist- (delq 'max-specpdl-size -varlist-)))
+ ((setq msp-binding (assq 'max-specpdl-size -varlist-))
+ (setq -varlist- (delq msp-binding -varlist-)))))
+ `(let* ,-varlist- ,@body)))
+
(defun c-get-lang-constant (name &optional source-files mode)
;; Used by `c-lang-const'.
@@ -2669,21 +2682,22 @@ fallback definition for all modes, to break the
cycle).")
;; In that case we just continue with the "assignment" before
;; the one currently being evaluated, thereby creating the
;; illusion if a `setq'-like sequence of assignments.
- (let* ((c-buffer-is-cc-mode mode)
- (source-pos
- (or (assq sym c-lang-constants-under-evaluation)
- (cons sym (vector source nil))))
- ;; Append `c-lang-constants-under-evaluation' even if an
- ;; earlier entry is found. It's only necessary to get
- ;; the recording of dependencies above correct.
- (c-lang-constants-under-evaluation
- (cons source-pos c-lang-constants-under-evaluation))
- (fallback (get mode 'c-fallback-mode))
- value
- ;; Make sure the recursion limits aren't very low
- ;; since the `c-lang-const' dependencies can go deep.
- (max-specpdl-size (max max-specpdl-size 3000))
- (max-lisp-eval-depth (max max-lisp-eval-depth 1000)))
+ (c-let*-maybe-max-specpdl-size
+ ((c-buffer-is-cc-mode mode)
+ (source-pos
+ (or (assq sym c-lang-constants-under-evaluation)
+ (cons sym (vector source nil))))
+ ;; Append `c-lang-constants-under-evaluation' even if an
+ ;; earlier entry is found. It's only necessary to get
+ ;; the recording of dependencies above correct.
+ (c-lang-constants-under-evaluation
+ (cons source-pos c-lang-constants-under-evaluation))
+ (fallback (get mode 'c-fallback-mode))
+ value
+ ;; Make sure the recursion limits aren't very low
+ ;; since the `c-lang-const' dependencies can go deep.
+ (max-specpdl-size (max max-specpdl-size 3000))
+ (max-lisp-eval-depth (max max-lisp-eval-depth 1000)))
(if (if fallback
(let ((backup-source-pos (copy-sequence (cdr source-pos))))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index bc6155dd66..d730fddeb0 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -142,6 +142,11 @@
;; Put on the brace which introduces a brace list and on the commas
;; which separate the elements within it.
;;
+;; 'c-<>-c-types-set
+;; This property is set on an opening angle bracket, and indicates that
+;; any "," separators within the template/generic expression have been
+;; marked with a 'c-type property value 'c-<>-arg-sep (see above).
+;;
;; 'c-awk-NL-prop
;; Used in AWK mode to mark the various kinds of newlines. See
;; cc-awk.el.
@@ -6137,7 +6142,7 @@ comment at the start of cc-engine.el for more info."
(forward-char))))
(backward-char)
(if (let ((c-parse-and-markup-<>-arglists t)
- (c-restricted-<>-arglists t))
+ c-restricted-<>-arglists)
(c-forward-<>-arglist nil)) ; Should always work.
(when (> (point) to)
(setq bound-<> (point)))
@@ -6688,8 +6693,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))))
@@ -6730,8 +6734,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
@@ -8151,13 +8154,48 @@ multi-line strings (but not C++, for example)."
(c-truncate-lit-pos-cache c-neutralize-pos)))
+(defun c-before-after-change-check-c++-modules (beg end &optional _old_len)
+ ;; Extend the region (c-new-BEG c-new-END) as needed to enclose complete
+ ;; C++20 module statements. This function is called solely from
+ ;; `c-get-state-before-change-functions' and `c-before-font-lock-functions'
+ ;; as part of the before-change and after-change processing for C++.
+ ;;
+ ;; Point is undefined both on entry and exit, and the return value has no
+ ;; significance.
+ (c-save-buffer-state (res bos lit-start)
+ (goto-char end)
+ (if (setq lit-start (c-literal-start))
+ (goto-char lit-start))
+ (when (>= (point) beg)
+ (setq res (c-beginning-of-statement-1 nil t)) ; t is IGNORE-LABELS
+ (setq bos (point))
+ (when (and (memq res '(same previous))
+ (looking-at c-module-key))
+ (setq c-new-BEG (min c-new-BEG (point)))
+ (if (c-syntactic-re-search-forward
+ ";" (min (+ (point) 500) (point-max)) t)
+ (setq c-new-END (max c-new-END (point))))))
+ (when (or (not bos) (< beg bos))
+ (goto-char beg)
+ (when (not (c-literal-start))
+ (setq res (c-beginning-of-statement-1 nil t))
+ (setq bos (point))
+ (when (and (memq res '(same previous))
+ (looking-at c-module-key))
+ (setq c-new-BEG (min c-new-BEG (point)))
+ (if (c-syntactic-re-search-forward
+ ";" (min (+ (point) 500) (point-max)) t)
+ (setq c-new-END (max c-new-END (point)))))))))
+
+
;; Handling of small scale constructs like types and names.
;; Dynamically bound variable that instructs `c-forward-type' to also
;; 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
@@ -8317,6 +8355,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
@@ -8424,12 +8479,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
@@ -8469,25 +8523,40 @@ multi-line strings (but not C++, for example)."
;; recording of any found types that constitute an argument in
;; the arglist.
(c-record-found-types (if c-record-type-identifiers t)))
- (if (catch 'angle-bracket-arglist-escape
- (setq c-record-found-types
- (c-forward-<>-arglist-recur all-types)))
- (progn
- (when (consp c-record-found-types)
- (let ((cur c-record-found-types))
- (while (consp (car-safe cur))
- (c-fontify-new-found-type
- (buffer-substring-no-properties (caar cur) (cdar cur)))
- (setq cur (cdr cur))))
- (setq c-record-type-identifiers
- ;; `nconc' doesn't mind that the tail of
- ;; `c-record-found-types' is t.
- (nconc c-record-found-types c-record-type-identifiers)))
- t)
-
- (setq c-found-types old-found-types)
- (goto-char start)
- nil)))
+ ;; Special handling for C++20's "import <...>" operator.
+ (if (and (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (and (zerop (c-backward-token-2))
+ (looking-at "import\\>\\(?:[^_$]\\|$\\)"))))
+ (when (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?")
+ (if (match-beginning 1) ; A terminated <..>
+ (progn
+ (when c-parse-and-markup-<>-arglists
+ (c-mark-<-as-paren (point))
+ (c-mark->-as-paren (match-beginning 1))
+ (c-truncate-lit-pos-cache (point)))
+ (goto-char (match-end 1))
+ t)
+ nil))
+ (if (catch 'angle-bracket-arglist-escape
+ (setq c-record-found-types
+ (c-forward-<>-arglist-recur all-types)))
+ (progn
+ (when (consp c-record-found-types)
+ (let ((cur c-record-found-types))
+ (while (consp (car-safe cur))
+ (c-fontify-new-found-type
+ (buffer-substring-no-properties (caar cur) (cdar cur)))
+ (setq cur (cdr cur))))
+ (setq c-record-type-identifiers
+ ;; `nconc' doesn't mind that the tail of
+ ;; `c-record-found-types' is t.
+ (nconc c-record-found-types c-record-type-identifiers)))
+ t)
+
+ (setq c-found-types old-found-types)
+ (goto-char start)
+ nil))))
(defun c-forward-<>-arglist-recur (all-types)
;; Recursive part of `c-forward-<>-arglist'.
@@ -8505,9 +8574,9 @@ multi-line strings (but not C++, for example)."
arg-start-pos)
;; If the '<' has paren open syntax then we've marked it as an angle
;; bracket arglist before, so skip to the end.
- (if (and (not c-parse-and-markup-<>-arglists)
- syntax-table-prop-on-<)
-
+ (if (and syntax-table-prop-on-<
+ (or (not c-parse-and-markup-<>-arglists)
+ (c-get-char-property (point) 'c-<>-c-types-set)))
(progn
(forward-char)
(if (and (c-go-up-list-forward)
@@ -8604,6 +8673,7 @@ multi-line strings (but not C++, for example)."
(c-unmark-<->-as-paren (point)))))
(c-mark-<-as-paren start)
(c-mark->-as-paren (1- (point)))
+ (c-put-char-property start 'c-<>-c-types-set t)
(c-truncate-lit-pos-cache start))
(setq res t)
nil)) ; Exit the loop.
@@ -8866,8 +8936,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)))
@@ -8976,7 +9054,8 @@ 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.
@@ -8988,6 +9067,7 @@ multi-line strings (but not C++, for example)."
(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".
@@ -9020,9 +9100,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)))
@@ -9107,7 +9192,11 @@ multi-line strings (but not C++, for example)."
(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
@@ -9457,16 +9546,151 @@ point unchanged and return nil."
;; Handling of large scale constructs like statements and declarations.
-(defun c-forward-declarator (&optional limit accept-anon)
- ;; Assuming point is at the start of a declarator, move forward over it,
- ;; leaving point at the next token after it (e.g. a ) or a ; or a ,).
+(defun c-forward-primary-expression (&optional limit)
+ ;; Go over the primary expression (if any) at point, moving to the next
+ ;; token and return non-nil. If we're not at a primary expression leave
+ ;; point unchanged and return nil.
;;
- ;; Return a list (ID-START ID-END BRACKETS-AFTER-ID GOT-INIT DECORATED),
- ;; where ID-START and ID-END are the bounds of the declarator's identifier,
- ;; and BRACKETS-AFTER-ID is non-nil if a [...] pair is present after the id.
- ;; GOT-INIT is non-nil when the declarator is followed by "=" or "(",
- ;; DECORATED is non-nil when the identifier is embellished by an operator,
- ;; like "*x", or "(*x)".
+ ;; Note that this function is incomplete, handling only those cases expected
+ ;; to be common in a C++20 requires clause.
+ (let ((here (point))
+ (c-restricted-<>-arglists t)
+ (c-parse-and-markup-<>-arglists nil)
+ )
+ (if (cond
+ ((looking-at c-constant-key)
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws limit)
+ t)
+ ((eq (char-after) ?\()
+ (and (c-go-list-forward (point) limit)
+ (eq (char-before) ?\))
+ (progn (c-forward-syntactic-ws limit)
+ t)))
+ ((c-forward-over-compound-identifier)
+ (c-forward-syntactic-ws limit)
+ (while (cond
+ ((looking-at "<")
+ (prog1
+ (c-forward-<>-arglist nil)
+ (c-forward-syntactic-ws limit)))
+ ((looking-at c-opt-identifier-concat-key)
+ (and
+ (zerop (c-forward-token-2 1 nil limit))
+ (prog1
+ (c-forward-over-compound-identifier)
+ (c-forward-syntactic-ws limit))))))
+ t)
+ ((looking-at c-fun-name-substitute-key) ; "requires"
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws limit)
+ (and
+ (or (not (eq (char-after) ?\())
+ (prog1
+ (and (c-go-list-forward (point) limit)
+ (eq (char-before) ?\)))
+ (c-forward-syntactic-ws)))
+ (eq (char-after) ?{)
+ (and (c-go-list-forward (point) limit)
+ (eq (char-before) ?}))
+ (progn
+ (c-forward-syntactic-ws limit)
+ t))))
+ t
+ (goto-char here)
+ nil)))
+
+(defun c-forward-c++-requires-clause (&optional limit)
+ ;; Point is at the keyword "requires". Move forward over the requires
+ ;; clause to the next token after it and return non-nil. If there is no
+ ;; valid requires clause at point, leave point unmoved and return nil.
+ (let ((here (point))
+ final-point)
+ (or limit (setq limit (point-max)))
+ (if (and
+ (zerop (c-forward-token-2 1 nil limit)) ; over "requires".
+ (prog1
+ (c-forward-primary-expression limit)
+ (setq final-point (point))
+ (while
+ (and (looking-at "\\(?:&&\\|||\\)")
+ (progn (goto-char (match-end 0))
+ (c-forward-syntactic-ws limit)
+ (and (< (point) limit)
+ (c-forward-primary-expression limit))))
+ (setq final-point (point)))))
+ (progn (goto-char final-point)
+ t)
+ (goto-char here)
+ nil)))
+
+(defun c-forward-decl-arglist (not-top id-in-parens &optional limit)
+ ;; Point is at an open parenthesis, assumed to be the arglist of a function
+ ;; declaration. Move over this arglist and following syntactic whitespace,
+ ;; and return non-nil. If the construct isn't such an arglist, leave point
+ ;; unmoved and return nil.
+ ;;
+ ;; Note that point is assumed to be at a place where an arglist is expected.
+ ;; Only for C++, where there are other possibilities, is any actual
+ ;; processing done. Otherwise, t is simply returned.
+ (let ((here (point)) got-type)
+ (if (or
+ (not (c-major-mode-is 'c++-mode))
+ (and
+ (or (not not-top)
+ id-in-parens ; Id is in parens, etc.
+ (save-excursion
+ (forward-char)
+ (c-forward-syntactic-ws limit)
+ (looking-at "[*&]")))
+ (save-excursion
+ (let (c-last-identifier-range)
+ (forward-char)
+ (c-forward-syntactic-ws limit)
+ (catch 'is-function
+ (while
+ ;; Go forward one argument at each iteration.
+ (progn
+ (while
+ (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((looking-at
+ c-noise-macro-with-parens-name-re)
+ (c-forward-noise-clause))))
+ (when (eq (char-after) ?\))
+ (forward-char)
+ (c-forward-syntactic-ws limit)
+ (throw 'is-function t))
+ (setq got-type (c-forward-type))
+ (cond
+ ((null got-type)
+ (throw 'is-function nil))
+ ((not (eq got-type 'maybe))
+ (throw 'is-function t)))
+ (c-forward-declarator limit t t)
+ (eq (char-after) ?,))
+ (forward-char)
+ (c-forward-syntactic-ws))
+ t)))))
+ (and (c-go-list-forward (point) limit)
+ (progn (c-forward-syntactic-ws limit) t))
+ (goto-char here)
+ nil)))
+
+(defun c-forward-declarator (&optional limit accept-anon not-top)
+ ;; Assuming point is at the start of a declarator, move forward over it,
+ ;; leaving point at the next token after it (e.g. a ) or a ; or a ,), or at
+ ;; end of buffer if there is no such token.
+ ;;
+ ;; Return a list (ID-START ID-END BRACKETS-AFTER-ID GOT-INIT DECORATED
+ ;; ARGLIST), where ID-START and ID-END are the bounds of the declarator's
+ ;; identifier, BRACKETS-AFTER-ID is non-nil if a [...] pair is present after
+ ;; the id, and ARGLIST is non-nil either when an arglist has been moved
+ ;; over, or when we have stopped at an unbalanced open-paren. GOT-INIT is
+ ;; non-nil when the declarator is followed by "=" or "(", DECORATED is
+ ;; non-nil when the identifier is embellished by an operator, like "*x", or
+ ;; "(*x)".
;;
;; If ACCEPT-ANON is non-nil, move forward over any "anonymous declarator",
;; i.e. something like the (*) in int (*), such as might be found in a
@@ -9485,7 +9709,8 @@ point unchanged and return nil."
;; array/struct initialization) or "=" or terminating delimiter
;; (e.g. "," or ";" or "}").
(let ((here (point))
- id-start id-end brackets-after-id paren-depth decorated)
+ id-start id-end brackets-after-id paren-depth decorated
+ got-init arglist double-double-quote)
(or limit (setq limit (point-max)))
(if (and
(< (point) limit)
@@ -9499,44 +9724,61 @@ point unchanged and return nil."
;; of the while. These are, e.g. "*" in "int *foo" or "(" and
;; "*" in "int (*foo) (void)" (Note similar code in
;; `c-forward-decl-or-cast-1'.)
- (while
- (cond
- ((looking-at c-decl-hangon-key)
- (c-forward-keyword-clause 1))
- ((and c-opt-cpp-prefix
- (looking-at c-noise-macro-with-parens-name-re))
- (c-forward-noise-clause))
- ((and (looking-at c-type-decl-prefix-key)
- (if (and (c-major-mode-is 'c++-mode)
- (match-beginning 4)) ; Was 3 - 2021-01-01
- ;; If the third submatch matches in C++ then
- ;; we're looking at an identifier that's a
- ;; prefix only if it specifies a member pointer.
- (progn
- (setq id-start (point))
- (c-forward-name)
- (if (save-match-data
- (looking-at "\\(::\\)"))
- ;; We only check for a trailing "::" and
- ;; let the "*" that should follow be
- ;; matched in the next round.
- t
- ;; It turned out to be the real identifier,
- ;; so flag that and stop.
- (setq got-identifier t)
- nil))
- t))
- (if (save-match-data
- (looking-at c-type-decl-operator-prefix-key))
- (setq decorated t))
- (if (eq (char-after) ?\()
- (progn
- (setq paren-depth (1+ paren-depth))
- (forward-char))
- (goto-char (or (match-end 1)
- (match-end 2))))
- (c-forward-syntactic-ws)
- t)))
+ (while
+ (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((and c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
+ ;; Special handling for operator<op>.
+ ((and c-opt-op-identifier-prefix
+ (looking-at c-opt-op-identifier-prefix))
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws limit)
+ (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)
+ nil)
+ t))
+ ((and (looking-at c-type-decl-prefix-key)
+ (if (and (c-major-mode-is 'c++-mode)
+ (match-beginning 4)) ; Was 3 - 2021-01-01
+ ;; If the fourth submatch matches in C++ then
+ ;; we're looking at an identifier that's a
+ ;; prefix only if it specifies a member pointer.
+ (progn
+ (setq id-start (point))
+ (when (c-forward-name)
+ (if (save-match-data
+ (looking-at "\\(::\\)"))
+ ;; We only check for a trailing "::" and
+ ;; let the "*" that should follow be
+ ;; matched in the next round.
+ t
+ ;; It turned out to be the real identifier,
+ ;; so flag that and stop.
+ (setq got-identifier t)
+ nil)))
+ t))
+ (if (save-match-data
+ (looking-at c-type-decl-operator-prefix-key))
+ (setq decorated t))
+ (if (eq (char-after) ?\()
+ (progn
+ (setq paren-depth (1+ paren-depth))
+ (forward-char))
+ (goto-char (or (match-end 1)
+ (match-end 2))))
+ (c-forward-syntactic-ws)
+ t)))
;; If we haven't passed the identifier already, do it now.
(unless got-identifier
@@ -9550,24 +9792,49 @@ point unchanged and return nil."
(accept-anon
(setq id-start nil id-end nil)
t)
- (t (/= (point) here))))
+ (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)
- (c-safe (goto-char (scan-lists (point) 1 paren-depth))))
+ (prog1
+ (c-safe (goto-char (scan-lists (point) 1 paren-depth)))
+ (c-forward-syntactic-ws)))
- (<= (point) limit)
+ (or (eq (point) (point-max)) ; No token after identifier.
+ (< (point) limit))
;; Skip over any trailing bit, such as "__attribute__".
(progn
- (while (cond
- ((looking-at c-decl-hangon-key)
- (c-forward-keyword-clause 1))
- ((and c-opt-cpp-prefix
- (looking-at c-noise-macro-with-parens-name-re))
- (c-forward-noise-clause))))
- (<= (point) limit))
+ (while (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((looking-at c-type-decl-suffix-key)
+ (cond
+ ((save-match-data
+ (looking-at c-fun-name-substitute-key))
+ (c-forward-c++-requires-clause))
+ ((eq (char-after) ?\()
+ (if (c-forward-decl-arglist not-top decorated limit)
+ (progn (setq arglist t
+ got-init nil)
+ t)
+ (if (c-go-list-forward (point) limit)
+ t
+ (setq arglist t) ; For unbalanced (.
+ nil)))
+ (t (c-forward-keyword-clause 1))))
+ ((and c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))))
+ (<= (point) limit))
;; Search syntactically to the end of the declarator (";",
;; ",", a closing paren, eob etc) or to the beginning of an
@@ -9575,45 +9842,56 @@ point unchanged and return nil."
;; Note that square brackets are now not also treated as
;; initializers, since this broke when there were also
;; initializing brace lists.
- (let (found)
- (while
- (and (< (point) limit)
- (progn
- ;; In the next loop, we keep searching forward whilst
- ;; we find ":"s which aren't single colons inside C++
- ;; "for" statements.
- (while
- (and
- (< (point) limit)
- (setq found
- (c-syntactic-re-search-forward
- "[;:,]\\|\\s)\\|\\(=\\|\\s(\\)"
- limit t t))
- (eq (char-before) ?:)
- (if (looking-at c-:-op-cont-regexp)
- (progn (goto-char (match-end 0)) t)
- (not
- (and (c-major-mode-is '(c++-mode java-mode))
- (save-excursion
- (and
- (c-go-up-list-backward)
- (eq (char-after) ?\()
- (progn (c-backward-syntactic-ws)
- (c-simple-skip-symbol-backward))
- (looking-at c-paren-stmt-key))))))))
- found)
- (eq (char-before) ?\[)
- (c-go-up-list-forward))
- (setq brackets-after-id t))
- (when found (backward-char))
- (<= (point) limit)))
- (list id-start id-end brackets-after-id (match-beginning 1) decorated)
+ (or (eq (char-after) ?\() ; Not an arglist.
+ (let (found)
+ (while
+ (and (< (point) limit)
+ (progn
+ ;; In the next loop, we keep searching forward
+ ;; whilst we find ":"s which aren't single colons
+ ;; inside C++ "for" statements.
+ (while
+ (and
+ (< (point) limit)
+ (prog1
+ (setq found
+ (c-syntactic-re-search-forward
+ "[;:,]\\|\\(=\\|\\s(\\)"
+ limit 'limit t))
+ (setq got-init
+ (and found (match-beginning 1))))
+ (eq (char-before) ?:)
+ (not
+ (and (c-major-mode-is '(c++-mode java-mode))
+ (save-excursion
+ (and
+ (c-go-up-list-backward)
+ (eq (char-after) ?\()
+ (progn (c-backward-syntactic-ws)
+ (c-simple-skip-symbol-backward))
+ (looking-at c-paren-stmt-key)))))
+ (if (looking-at c-:-op-cont-regexp)
+ (progn (goto-char (match-end 0)) t)
+ ;; Does this : introduce the class
+ ;; initialization list, or a bitfield?
+ (not arglist)))) ; Carry on for a bitfield
+ found)
+ (when (eq (char-before) ?\[)
+ (setq brackets-after-id t)
+ (prog1 (c-go-up-list-forward)
+ (c-forward-syntactic-ws)))))
+ (when (and found
+ (memq (char-before) '(?\; ?\: ?, ?= ?\( ?\[ ?{)))
+ (backward-char))
+ (<= (point) limit))))
+ (list id-start id-end brackets-after-id got-init decorated arglist)
(goto-char here)
nil)))
(defun c-do-declarators
- (cdd-limit cdd-list cdd-not-top cdd-comma-prop cdd-function)
+ (cdd-limit cdd-list cdd-not-top cdd-comma-prop cdd-function
+ &optional cdd-accept-anon)
"Assuming point is at the start of a comma separated list of declarators,
apply CDD-FUNCTION to each declarator (when CDD-LIST is non-nil) or just the
first declarator (when CDD-LIST is nil). When CDD-FUNCTION is nil, no
@@ -9638,6 +9916,9 @@ Stop at or before CDD-LIMIT (which may NOT be nil).
If CDD-NOT-TOP is non-nil, we are not at the top-level (\"top-level\" includes
being directly inside a class or namespace, etc.).
+If CDD-ACCEPT-ANON is non-nil, we also process declarators without names,
+e.g. \"int (*)(int)\" in a function prototype.
+
Return non-nil if we've reached the token after the last declarator (often a
semicolon, or a comma when CDD-LIST is nil); otherwise (when we hit CDD-LIMIT,
or fail otherwise) return nil, leaving point at the beginning of the putative
@@ -9649,67 +9930,25 @@ This function might do hidden buffer changes."
;; CDD-FUNCTION.
(let
((cdd-pos (point)) cdd-next-pos cdd-id-start cdd-id-end
- cdd-decl-res cdd-got-func cdd-got-type cdd-got-init
+ cdd-decl-res cdd-got-func cdd-got-init
c-last-identifier-range cdd-exhausted cdd-after-block)
;; The following `while' applies `cdd-function' to a single declarator id
;; each time round. It loops only when CDD-LIST is non-nil.
(while
(and (not cdd-exhausted)
- (setq cdd-decl-res (c-forward-declarator cdd-limit)))
+ (setq cdd-decl-res (c-forward-declarator
+ cdd-limit cdd-accept-anon cdd-not-top)))
+
(setq cdd-next-pos (point)
cdd-id-start (car cdd-decl-res)
cdd-id-end (cadr cdd-decl-res)
- cdd-got-func (and (eq (char-after) ?\()
- (or (not (c-major-mode-is 'c++-mode))
- (not cdd-not-top)
- (car (cddr (cddr cdd-decl-res))) ; Id is in
- ; parens, etc.
- (save-excursion
- (forward-char)
- (c-forward-syntactic-ws)
- (looking-at "[*&]")))
- (not (car (cddr cdd-decl-res)))
- (or (not (c-major-mode-is 'c++-mode))
- (save-excursion
- (let (c-last-identifier-range)
- (forward-char)
- (c-forward-syntactic-ws)
- (catch 'is-function
- (while
- (progn
- (while
- (cond
- ((looking-at c-decl-hangon-key)
- (c-forward-keyword-clause 1))
- ((looking-at
c-noise-macro-with-parens-name-re)
- (c-forward-noise-clause))))
- (if (eq (char-after) ?\))
- (throw 'is-function t))
- (setq cdd-got-type (c-forward-type))
- (cond
- ((null cdd-got-type)
- (throw 'is-function nil))
- ((not (eq cdd-got-type 'maybe))
- (throw 'is-function t)))
- (c-forward-declarator nil t)
- (eq (char-after) ?,))
- (forward-char)
- (c-forward-syntactic-ws))
- t)))))
- cdd-got-init (and (cadr (cddr cdd-decl-res))
- (char-after)))
+ cdd-got-func (cadr (cddr (cddr cdd-decl-res)))
+ cdd-got-init (and (cadr (cddr cdd-decl-res)) (char-after)))
;; Jump past any initializer or function prototype to see if
;; there's a ',' to continue at.
- (cond (cdd-got-func
- ;; Skip a parenthesized initializer (C++) or a function
- ;; prototype.
- (if (c-go-list-forward (point) cdd-limit) ; over the parameter
list.
- (c-forward-syntactic-ws cdd-limit)
- (setq cdd-exhausted t))) ; unbalanced parens
-
- (cdd-got-init ; "=" sign OR opening "(", "[", or "("
+ (cond (cdd-got-init ; "=" sign OR opening "(", "[", or "("
;; Skip an initializer expression in braces, whether or not (in
;; C++ Mode) preceded by an "=". Be careful that the brace list
;; isn't a code block or a struct (etc.) block.
@@ -9732,8 +9971,9 @@ This function might do hidden buffer changes."
(t (c-forward-syntactic-ws cdd-limit)))
(if cdd-function
- (funcall cdd-function cdd-id-start cdd-id-end cdd-next-pos
- cdd-not-top cdd-got-func cdd-got-init))
+ (save-excursion
+ (funcall cdd-function cdd-id-start cdd-id-end cdd-next-pos
+ cdd-not-top cdd-got-func cdd-got-init)))
;; If a ',' is found we set cdd-pos to the next declarator and iterate.
(if (and cdd-list (< (point) cdd-limit) (looking-at ","))
@@ -9791,7 +10031,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
@@ -9833,13 +10074,13 @@ This function might do hidden buffer changes."
;;
;;
;;
- ;; The second element of the return value is non-nil when a
- ;; `c-typedef-decl-kwds' specifier is found in the declaration.
- ;; Specifically it is a dotted pair (A . B) where B is t when a
- ;; `c-typedef-kwds' ("typedef") is present, and A is t when some
- ;; other `c-typedef-decl-kwds' (e.g. class, struct, enum)
- ;; specifier is present. I.e., (some of) the declared
- ;; identifier(s) are types.
+ ;; The second element of the return value is non-nil when something
+ ;; indicating the identifier is a type occurs in the declaration.
+ ;; Specifically it is nil, or a three element list (A B C) where C is t
+ ;; when context is '<> and the "identifier" is a found type, B is t when a
+ ;; `c-typedef-kwds' ("typedef") is present, and A is t when some other
+ ;; `c-typedef-declkwds' (e.g. class, struct, enum) specifier is present.
+ ;; I.e., (some of) the declared identifier(s) are types.
;;
;; The third element of the return value is non-nil when the declaration
;; parsed might be an expression. The fourth element is the position of
@@ -9880,6 +10121,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.
@@ -9915,6 +10160,9 @@ This function might do hidden buffer changes."
at-type-decl
;; Set if we've a "typedef" keyword.
at-typedef
+ ;; Set if `context' is '<> and the identifier is definitely a type, or
+ ;; has already been recorded as a found type.
+ at-<>-type
;; Set if we've found a specifier that can start a declaration
;; where there's no type.
maybe-typeless
@@ -9993,6 +10241,11 @@ This function might do hidden buffer changes."
(setq kwd-sym (c-keyword-sym (match-string 1)))
(save-excursion
(c-forward-keyword-clause 1)
+ (when (and (c-major-mode-is 'c++-mode)
+ (c-keyword-member kwd-sym 'c-<>-sexp-kwds)
+ (save-match-data
+ (looking-at c-fun-name-substitute-key)))
+ (c-forward-c++-requires-clause))
(setq kwd-clause-end (point))))
((and c-opt-cpp-prefix
(looking-at c-noise-macro-with-parens-name-re))
@@ -10032,6 +10285,11 @@ This function might do hidden buffer changes."
(point))))
found-type-list))
+ ;; Might we have a C++20 concept? i.e. template<foo bar>?
+ (setq at-<>-type
+ (and (eq context '<>)
+ (memq found-type '(t known prefix found))))
+
;; Signal a type declaration for "struct foo {".
(when (and backup-at-type-decl
(eq (char-after) ?{))
@@ -10320,8 +10578,11 @@ This function might do hidden buffer changes."
t)
(when (if (save-match-data (looking-at "\\s("))
(c-safe (c-forward-sexp 1) t)
- (goto-char (match-end 1))
- t)
+ (if (save-match-data
+ (looking-at c-fun-name-substitute-key)) ; requires
+ (c-forward-c++-requires-clause)
+ (goto-char (match-end 1))
+ t))
(when (and (not got-suffix-after-parens)
(= paren-depth 0))
(setq got-suffix-after-parens (match-beginning 0)))
@@ -10511,8 +10772,16 @@ This function might do hidden buffer changes."
(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
@@ -10571,8 +10840,8 @@ This function might do hidden buffer changes."
backup-maybe-typeless
(when c-recognize-typeless-decls
(or (not got-suffix)
- (not (looking-at
- c-after-suffixed-type-maybe-decl-key))))))
+ (looking-at
+ c-after-suffixed-type-maybe-decl-key)))))
;; Got an empty paren pair and a preceding type that probably
;; really is the identifier. Shift the type backwards to make
;; the last one the identifier. This is analogous to the
@@ -10628,8 +10897,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 c-record-type-identifiers nil))
(throw 'at-decl-or-cast t))
;; CASE 11
@@ -10835,11 +11109,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)))))
@@ -10865,15 +11145,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)))
@@ -10914,8 +11212,8 @@ This function might do hidden buffer changes."
(c-forward-type))))
(list id-start
- (and (or at-type-decl at-typedef)
- (cons at-type-decl at-typedef))
+ (and (or at-type-decl at-typedef at-<>-type)
+ (list at-type-decl at-typedef at-<>-type))
maybe-expression
type-start
(or (eq context 'top) make-top)))
@@ -12372,6 +12670,8 @@ comment at the start of cc-engine.el for more info."
in-paren 'in-paren))
((looking-at c-pre-brace-non-bracelist-key)
(setq braceassignp nil))
+ ((looking-at c-fun-name-substitute-key)
+ (setq braceassignp nil))
((looking-at c-return-key))
((and (looking-at c-symbol-start)
(not (looking-at c-keywords-regexp)))
@@ -12382,6 +12682,11 @@ comment at the start of cc-engine.el for more info."
(setq after-type-id-pos (point))))
((eq (char-after) ?\()
(setq parens-before-brace t)
+ ;; Have we a requires with a parenthesis list?
+ (when (save-excursion
+ (and (zerop (c-backward-token-2 1 nil lim))
+ (looking-at c-fun-name-substitute-key)))
+ (setq braceassignp nil))
nil)
(t nil))
(save-excursion
@@ -14144,6 +14449,25 @@ comment at the start of cc-engine.el for more info."
(goto-char placeholder)
(c-add-syntax 'inher-cont (c-point 'boi)))
+ ;; CASE 5D.7: Continuation of a "concept foo =" line in C++20 (or
+ ;; similar).
+ ((and c-equals-nontype-decl-key
+ (save-excursion
+ (prog1
+ (and (zerop (c-backward-token-2 1 nil lim))
+ (looking-at c-operator-re)
+ (equal (match-string 0) "=")
+ (zerop (c-backward-token-2 1 nil lim))
+ (looking-at c-symbol-start)
+ (not (looking-at c-keywords-regexp))
+ (zerop (c-backward-token-2 1 nil lim))
+ (looking-at c-equals-nontype-decl-key)
+ (eq (c-beginning-of-statement-1 lim) 'same))
+ (setq placeholder (point)))))
+ (goto-char placeholder)
+ (c-add-stmt-syntax 'topmost-intro-cont nil nil containing-sexp
+ paren-state))
+
;; CASE 5D.5: Continuation of the "expression part" of a
;; top level construct. Or, perhaps, an unrecognized construct.
(t
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2495d21a10..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.
@@ -99,6 +99,8 @@
(cc-bytecomp-defun c-font-lock-invalid-string)
(cc-bytecomp-defun c-font-lock-fontify-region)
+(cc-bytecomp-defvar font-lock-reference-face) ; For Emacs 29
+
;; Note that font-lock in XEmacs doesn't expand face names as
;; variables, so we have to use the (eval . FORM) in the font lock
@@ -112,8 +114,11 @@
;; In Emacs font-lock-builtin-face has traditionally been
;; used for preprocessor directives.
'font-lock-builtin-face)
- (t
- 'font-lock-reference-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)))
(cc-bytecomp-defvar font-lock-constant-face)
@@ -124,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
@@ -134,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.
@@ -163,9 +173,8 @@
(defconst c-doc-markup-face-name
(if (c-face-name-p 'font-lock-doc-markup-face)
- ;; If it happens to occur in the future. (Well, the more
- ;; pragmatic reason is to get unique faces for the test
- ;; suite.)
+ ;; Exists in Emacs 28+. (For other emacsen, the pragmatic
+ ;; reason is to get unique faces for the test suite.)
'font-lock-doc-markup-face
c-label-face-name))
@@ -558,8 +567,10 @@ stuff. Used on level 1 and higher."
(c-lang-const c-opt-cpp-prefix)
re
(c-lang-const c-syntactic-ws)
- "\\(<[^>\n\r]*>?\\)")
- `(,(+ ncle-depth re-depth sws-depth 1)
+ "\\(<\\([^>\n\r]*\\)>?\\)")
+ `(,(+ ncle-depth re-depth sws-depth
+ (if (featurep 'xemacs) 2 1)
+ )
font-lock-string-face t)
`((let ((beg (match-beginning
,(+ ncle-depth re-depth sws-depth 1)))
@@ -581,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
@@ -878,6 +890,27 @@ casts and declarations are fontified. Used on level 2 and
higher."
c-reference-face-name))
(goto-char (match-end 1))))))))))
+ ;; Module declarations (e.g. in C++20).
+ ,@(when (c-major-mode-is 'c++-mode)
+ '(c-font-lock-c++-modules))
+
+ ;; The next regexp is highlighted with narrowing. This is so that the
+ ;; final "context" bit of the regexp, "\\(?:[^=]\\|$\\)", which cannot
+ ;; match anything non-empty at LIMIT, will match "$" instead.
+ ,@(when (c-lang-const c-equals-nontype-decl-kwds)
+ `((,(byte-compile
+ `(lambda (limit)
+ (save-restriction
+ (narrow-to-region (point-min) limit)
+ ,(c-make-font-lock-search-form
+ (concat (c-lang-const c-equals-nontype-decl-key) ;no \\(
+ (c-lang-const c-simple-ws) "+\\("
+ (c-lang-const c-symbol-key) "\\)"
+ (c-lang-const c-simple-ws) "*"
+ "=\\(?:[^=]\\|$\\)")
+ `((,(+ 1 (c-lang-const c-simple-ws-depth))
+ font-lock-type-face t)))))))))
+
;; Fontify the special declarations in Objective-C.
,@(when (c-major-mode-is 'objc-mode)
`(;; Fontify class names in the beginning of message expressions.
@@ -934,16 +967,16 @@ casts and declarations are fontified. Used on level 2
and higher."
(save-excursion
(let ((pos (point)))
(c-backward-syntactic-ws (max (- (point) 500) (point-min)))
- (c-clear-char-properties
- (if (and (not (bobp))
- (memq (c-get-char-property (1- (point)) 'c-type)
- '(c-decl-arg-start
- c-decl-end
- c-decl-id-start
- c-decl-type-start)))
- (1- (point))
- pos)
- limit 'c-type)))
+ (when (and (not (bobp))
+ (memq (c-get-char-property (1- (point)) 'c-type)
+ '(c-decl-arg-start
+ c-decl-end
+ c-decl-id-start
+ c-decl-type-start
+ c-not-decl)))
+ (setq pos (1- (point))))
+ (c-clear-char-properties pos limit 'c-type)
+ (c-clear-char-properties pos limit 'c-<>-c-types-set)))
;; Update `c-state-cache' to the beginning of the region. This will
;; make `c-beginning-of-syntax' go faster when it's used later on,
@@ -1066,7 +1099,7 @@ casts and declarations are fontified. Used on level 2
and higher."
nil)
(defun c-font-lock-declarators (limit list types not-top
- &optional template-class)
+ &optional template-class accept-anon)
;; Assuming the point is at the start of a declarator in a declaration,
;; fontify the identifier it declares. (If TYPES is t, it does this via the
;; macro `c-fontify-types-and-refs'.)
@@ -1086,6 +1119,8 @@ casts and declarations are fontified. Used on level 2
and higher."
;; a default (introduced by "="), it will be fontified as a type.
;; E.g. "<class X = Y>".
;;
+ ;; ACCEPT-ANON is non-nil when we accept anonymous declarators.
+ ;;
;; Nil is always returned. The function leaves point at the delimiter after
;; the last declarator it processes.
;;
@@ -1098,37 +1133,51 @@ casts and declarations are fontified. Used on level 2
and higher."
limit list not-top
(cond ((eq types t) 'c-decl-type-start)
((null types) 'c-decl-id-start))
- (lambda (id-start _id-end end-pos _not-top is-function init-char)
+ (lambda (id-start id-end end-pos _not-top is-function init-char)
(if (eq types t)
- ;; Register and fontify the identifier as a type.
- (let ((c-promote-possible-types t))
- (goto-char id-start)
- (c-forward-type))
- ;; The following doesn't work properly (yet, 2018-09-22).
- ;; (c-put-font-lock-face id-start id-end
- ;; (if is-function
- ;; 'font-lock-function-name-face
- ;; 'font-lock-variable-name-face))
- (when (and c-last-identifier-range
- (not (get-text-property (car c-last-identifier-range)
- 'face)))
- ;; We use `c-last-identifier-range' rather than `id-start' and
- ;; `id-end', since the latter two can be erroneous. E.g. in
- ;; "~Foo", `id-start' is at the tilde. This is a bug in
- ;; `c-forward-declarator'.
- (c-put-font-lock-face (car c-last-identifier-range)
- (cdr c-last-identifier-range)
- (cond
- ((not (memq types '(nil t))) types)
- (is-function 'font-lock-function-name-face)
- (t 'font-lock-variable-name-face)))))
+ (when id-start
+ ;; Register and fontify the identifier as a type.
+ (let ((c-promote-possible-types t))
+ (goto-char id-start)
+ (c-forward-type)))
+ (when id-start
+ (goto-char id-start)
+ (when c-opt-identifier-prefix-key
+ (unless (and (looking-at c-opt-identifier-prefix-key) ; For
operator~
+ (eq (match-end 1) id-end))
+ (while (and (< (point) id-end)
+ (re-search-forward c-opt-identifier-prefix-key
id-end t))
+ (c-forward-syntactic-ws limit))))
+ ;; 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))))
+ ;; 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
(goto-char end-pos)
(c-forward-token-2 1 nil limit) ; Over "="
(let ((c-promote-possible-types t))
- (c-forward-type t))))))
+ (c-forward-type t)))))
+ accept-anon) ; Last argument to c-do-declarators.
nil))
(defun c-get-fontification-context (match-pos not-front-decl &optional toplev)
@@ -1155,131 +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)
- (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))))))))))
- (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.
@@ -1354,9 +1431,12 @@ casts and declarations are fontified. Used on level 2
and higher."
'c-decl-type-start
'c-decl-id-start)))))
(c-font-lock-declarators
- (min limit (point-max)) decl-list
+ (min limit (point-max))
+ decl-list
(not (null (cadr decl-or-cast)))
- (not toplev) template-class))
+ (not toplev)
+ template-class
+ (memq context '(decl <>))))
;; A declaration has been successfully identified, so do all the
;; fontification of types and refs that've been recorded.
@@ -1516,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.
@@ -1909,6 +1989,163 @@ casts and declarations are fontified. Used on level 2
and higher."
(forward-char))))) ; over the terminating "]" or other close paren.
nil)
+(defun c-forward-c++-module-name (limit)
+ ;; Is there a C++20 module name at point? If so, return a cons of the start
+ ;; and end of that name, in which case point will be moved over the name and
+ ;; following whitespace. Otherwise nil will be returned and point will be
+ ;; unmoved. This function doesn't regard a partition as part of the name.
+ ;; The entire construct must end not after LIMIT.
+ (when (and
+ (looking-at c-module-name-re)
+ (<= (match-end 0) limit)
+ (not (looking-at c-keywords-regexp)))
+ (goto-char (match-end 0))
+ (prog1 (cons (match-beginning 0) (match-end 0))
+ (c-forward-syntactic-ws limit))))
+
+(defun c-forward-c++-module-partition-name (limit)
+ ;; Is there a C++20 module partition name (starting with its colon) at
+ ;; point? If so return a cons of the start and end of the name, not
+ ;; including the colon, in which case point will be move to after the name
+ ;; and following whitespace. Otherwise nil will be returned and point not
+ ;; moved. The entire construct must end not after LIMIT.
+ (when (and
+ (eq (char-after) ?:)
+ (progn
+ (forward-char)
+ (c-forward-syntactic-ws limit)
+ (looking-at c-module-name-re))
+ (<= (match-end 0) limit)
+ (not (looking-at c-keywords-regexp)))
+ (goto-char (match-end 0))
+ (prog1 (cons (match-beginning 0) (match-end 0))
+ (c-forward-syntactic-ws limit))))
+
+(defun c-font-lock-c++-modules (limit)
+ ;; Fontify the C++20 module stanzas, characterized by the keywords `module',
+ ;; `export' and `import'. Note that this has to be done by a function (as
+ ;; opposed to regexps) due to the presence of optional C++ attributes.
+ ;;
+ ;; This function will be called from font-lock for a region bounded by POINT
+ ;; and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; Fontification".
+ (while (and (< (point) limit)
+ (re-search-forward
+ "\\<\\(module\\|export\\|import\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (goto-char (match-end 1))
+ (let (name-bounds pos beg end
+ module-names) ; A list of conses of start and end
+ ; of pertinent module names
+ (unless (c-skip-comments-and-strings limit)
+ (when
+ (cond
+ ;; module foo...; Note we don't handle module; or module
+ ;; :private; here, since they don't really need handling.
+ ((save-excursion
+ (when (equal (match-string-no-properties 1) "export")
+ (c-forward-syntactic-ws limit)
+ (re-search-forward "\\=\\(module\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (and (equal (match-string-no-properties 1) "module")
+ (< (point) limit)
+ (progn (c-forward-syntactic-ws limit)
+ (setq name-bounds (c-forward-c++-module-name
+ limit)))
+ (setq pos (point))))
+ (push name-bounds module-names)
+ (goto-char pos)
+ ;; Is there a partition name?
+ (when (setq name-bounds (c-forward-c++-module-partition-name
+ limit))
+ (push name-bounds module-names))
+ t)
+
+ ;; import
+ ((save-excursion
+ (when (equal (match-string-no-properties 1) "export")
+ (c-forward-syntactic-ws limit)
+ (re-search-forward "\\=\\(import\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (and (equal (match-string-no-properties 1) "import")
+ (< (point) limit)
+ (progn (c-forward-syntactic-ws limit)
+ (setq pos (point)))))
+ (goto-char pos)
+ (cond
+ ;; import foo;
+ ((setq name-bounds (c-forward-c++-module-name limit))
+ (push name-bounds module-names)
+ t)
+ ;; import :foo;
+ ((setq name-bounds (c-forward-c++-module-partition-name limit))
+ (push name-bounds module-names)
+ t)
+ ;; import "foo";
+ ((and (eq (char-after) ?\")
+ (setq pos (point))
+ (c-safe (c-forward-sexp) t)) ; Should already have string
face.
+ (when (eq (char-before) ?\")
+ (setq beg pos
+ end (point)))
+ (c-forward-syntactic-ws limit)
+ t)
+ ;; import <foo>;
+ ((and (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?")
+ (< (match-end 0) limit))
+ (setq beg (point))
+ (goto-char (match-end 0))
+ (when (match-end 1)
+ (setq end (point)))
+ (if (featurep 'xemacs)
+ (c-put-font-lock-face
+ (1+ beg) (if end (1- end) (point)) font-lock-string-face)
+ (c-put-font-lock-face
+ beg (or end (point)) font-lock-string-face))
+ (c-forward-syntactic-ws limit)
+ t)
+ (t nil)))
+
+ ;; export
+ ;; There is no fontification to be done here, but we need to
+ ;; skip over the declaration or declaration sequence.
+ ((save-excursion
+ (when (equal (match-string-no-properties 0) "export")
+ (c-forward-syntactic-ws limit)
+ (setq pos (point))))
+ (goto-char (point))
+ (if (eq (char-after) ?{)
+ ;; Declaration sequence.
+ (unless (and (c-go-list-forward nil limit)
+ (eq (char-before) ?}))
+ (goto-char limit)
+ nil)
+ ;; Single declaration
+ (unless (c-end-of-decl-1)
+ (goto-char limit)
+ nil)))) ; Nothing more to do, here.
+
+ ;; Optional attributes?
+ (while (and (c-looking-at-c++-attribute)
+ (< (match-end 0) limit))
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws limit))
+ ;; Finally, there must be a semicolon.
+ (if (and (< (point) limit)
+ (eq (char-after) ?\;))
+ (progn
+ (forward-char)
+ ;; Fontify any module names we've encountered.
+ (dolist (name module-names)
+ (c-put-font-lock-face (car name) (cdr name)
+ c-reference-face-name)))
+ ;; No semicolon, so put warning faces on any delimiters.
+ (when beg
+ (c-put-font-lock-face beg (1+ beg) font-lock-warning-face))
+ (when end
+ (c-put-font-lock-face (1- end) end font-lock-warning-face))))))))
(c-lang-defconst c-simple-decl-matchers
"Simple font lock matchers for types and declarations. These are used
@@ -2289,8 +2526,12 @@ higher."
(widen)
(goto-char (point-min))
(while (re-search-forward target-re nil t)
- (put-text-property (match-beginning 0) (match-end 0)
- 'fontified nil)
+ (when (and
+ (get-text-property (match-beginning 0) 'fontified)
+ (not (memq (c-get-char-property (match-beginning 0) 'face)
+ c-literal-faces)))
+ (c-put-font-lock-face (match-beginning 0) (match-end 0)
+ font-lock-type-face))
(dolist (win-boundary window-boundaries)
(when (and (< (match-beginning 0) (cdr win-boundary))
(> (match-end 0) (car win-boundary))
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 75f1660f22..291af038b7 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:
@@ -403,7 +403,7 @@ The syntax tables aren't stored directly since they're
quite large."
t (if (c-lang-const c-recognize-<>-arglists)
`(lambda ()
;(if (c-lang-const c-recognize-<>-arglists)
- (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table))))
+ (let ((table (funcall ',(c-lang-const c-make-mode-syntax-table))))
(modify-syntax-entry ?\( "." table)
(modify-syntax-entry ?\) "." table)
(modify-syntax-entry ?\[ "." table)
@@ -456,6 +456,7 @@ so that all identifiers are recognized as words.")
c-depropertize-CPP
c-before-change-check-ml-strings
c-before-change-check-<>-operators
+ c-before-after-change-check-c++-modules
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
c-parse-quotes-before-change
@@ -516,6 +517,7 @@ parameters \(point-min) and \(point-max).")
c-parse-quotes-after-change
c-after-change-mark-abnormal-strings
c-extend-font-lock-region-for-macros
+ c-before-after-change-check-c++-modules
c-neutralize-syntax-in-CPP
c-restore-<>-properties
c-change-expand-fl-region)
@@ -932,6 +934,8 @@ This value is by default merged into `c-operators'."
t)))
(when ops
(c-make-keywords-re 'appendable ops))))
+(c-lang-defvar c-opt-identifier-prefix-key
+ (c-lang-const c-opt-identifier-prefix-key))
(c-lang-defconst c-after-id-concat-ops
"Operators that can occur after a binary operator on `c-identifier-ops'
@@ -1018,6 +1022,16 @@ e.g. identifiers with template arguments such as
\"A<X,Y>\" in C++."
"")))
(c-lang-defvar c-identifier-key (c-lang-const c-identifier-key))
+(c-lang-defconst c-module-name-re
+ "This regexp matches (a component of) a module name.
+Currently (2022-09) just C++ Mode uses this."
+ t nil
+ c++ (concat (c-lang-const c-symbol-key)
+ "\\(?:\\."
+ (c-lang-const c-symbol-key)
+ "\\)*"))
+(c-lang-defvar c-module-name-re (c-lang-const c-module-name-re))
+
(c-lang-defconst c-identifier-last-sym-match
;; This was a docstring constant in 5.30 but it's no longer used.
;; It's only kept to avoid breaking third party code.
@@ -1316,6 +1330,10 @@ since CC Mode treats every identifier as an expression."
,@(when (c-major-mode-is 'java-mode)
'(">>>")))
+ ;; The C++ "spaceship" operator.
+ ,@(when (c-major-mode-is 'c++-mode)
+ `((left-assoc "<=>")))
+
;; Relational.
(left-assoc "<" ">" "<=" ">="
,@(when (c-major-mode-is 'java-mode)
@@ -1429,10 +1447,9 @@ form\". See also `c-op-identifier-prefix'."
"^" "??'" "xor" "&" "bitand" "|" "??!" "bitor" "~" "??-" "compl"
"!" "=" "<" ">" "+=" "-=" "*=" "/=" "%=" "^="
"??'=" "xor_eq" "&=" "and_eq" "|=" "??!=" "or_eq"
- "<<" ">>" ">>=" "<<=" "==" "!=" "not_eq" "<=" ">="
+ "<<" ">>" ">>=" "<<=" "==" "!=" "not_eq" "<=>" "<=" ">="
"&&" "and" "||" "??!??!" "or" "++" "--" "," "->*" "->"
- "()" "[]" "<::>" "??(??)")
- ;; These work like identifiers in Pike.
+ "()" "[]" "\"\"" "<::>" "??(??)")
pike '("`+" "`-" "`&" "`|" "`^" "`<<" "`>>" "`*" "`/" "`%" "`~"
"`==" "`<" "`>" "`!" "`[]" "`[]=" "`->" "`->=" "`()" "``+"
"``-" "``&" "``|" "``^" "``<<" "``>>" "``*" "``/" "``%"
@@ -1551,8 +1568,10 @@ operators."
"List of all arithmetic operators, including \"+=\", etc."
;; Note: in the following, there are too many operators for AWK and IDL.
t (append (c-lang-const c-assignment-operators)
- '("+" "-" "*" "/" "%"
+ `("+" "-" "*" "/" "%"
"<<" ">>"
+ ,@(if (c-major-mode-is 'c++-mode)
+ '("<=>"))
"<" ">" "<=" ">="
"==" "!="
"&" "^" "|"
@@ -2202,7 +2221,7 @@ the appropriate place for that."
'("_Bool" "_Complex" "_Imaginary") ; Conditionally defined in C99.
(c-lang-const c-primitive-type-kwds))
c++ (append
- '("bool" "wchar_t" "char16_t" "char32_t")
+ '("bool" "wchar_t" "char8_t" "char16_t" "char32_t")
(c-lang-const c-primitive-type-kwds))
;; Objective-C extends C, but probably not the new stuff in C99.
objc (append
@@ -2275,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
@@ -2289,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)))
@@ -2581,6 +2611,35 @@ will be handled."
t (c-make-keywords-re t (c-lang-const c-equals-type-clause-kwds)))
(c-lang-defvar c-equals-type-clause-key (c-lang-const
c-equals-type-clause-key))
+(c-lang-defconst c-equals-nontype-decl-kwds
+ "Keywords which are followed by an identifier then an \"=\"
+sign, which declares the identifier to be something other than a
+type."
+ t nil
+ c++ '("concept"))
+
+(c-lang-defconst c-equals-nontype-decl-key
+ ;; An unadorned regular expression which matches any member of
+ ;; `c-equals-decl-kwds', or nil if such don't exist in the current language.
+ t (when (c-lang-const c-equals-nontype-decl-kwds)
+ (c-make-keywords-re nil (c-lang-const c-equals-nontype-decl-kwds))))
+(c-lang-defvar c-equals-nontype-decl-key
+ (c-lang-const c-equals-nontype-decl-key))
+
+(c-lang-defconst c-fun-name-substitute-kwds
+ "Keywords which take the place of type+declarator at the beginning
+of a function-like structure, such as a C++20 \"requires\"
+clause. An arglist may or may not follow such a keyword."
+ t nil
+ c++ '("requires"))
+
+(c-lang-defconst c-fun-name-substitute-key
+ ;; An adorned regular expression which matches any member of
+ ;; `c-fun-name-substitute-kwds'.
+ t (c-make-keywords-re t (c-lang-const c-fun-name-substitute-kwds)))
+(c-lang-defvar c-fun-name-substitute-key
+ (c-lang-const c-fun-name-substitute-key))
+
(c-lang-defconst c-modifier-kwds
"Keywords that can prefix normal declarations of identifiers
\(and typically act as flags). Things like argument declarations
@@ -2594,8 +2653,8 @@ will be handled."
t nil
(c c++) '("extern" "inline" "register" "static")
c (append '("auto") (c-lang-const c-modifier-kwds))
- c++ (append '("constexpr" "explicit" "friend" "mutable" "template"
- "thread_local" "virtual")
+ c++ (append '("consteval" "constexpr" "constinit" "explicit"
+ "friend" "mutable" "template" "thread_local" "virtual")
;; "using" is now handled specially (2020-09-14).
(c-lang-const c-modifier-kwds))
objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static")
@@ -2624,6 +2683,7 @@ If any of these also are on `c-type-list-kwds',
`c-ref-list-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses
will be handled."
t nil
+ c++ '("export")
objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize"
"@compatibility_alias")
java '("import" "package")
@@ -2669,7 +2729,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
(c c++) '(;; GCC extension.
"__attribute__"
;; MSVC extension.
- "__declspec"))
+ "__declspec")
+ c++ (append (c-lang-const c-decl-hangon-kwds) '("alignas")))
(c-lang-defconst c-decl-hangon-key
;; Adorned regexp matching `c-decl-hangon-kwds'.
@@ -2885,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."
@@ -2893,7 +2963,7 @@ contain type identifiers."
"__attribute__"
;; MSVC extension.
"__declspec")
- c++ (append (c-lang-const c-paren-nontype-kwds) '("noexcept")))
+ c++ (append (c-lang-const c-paren-nontype-kwds) '("noexcept" "alignas")))
(c-lang-defconst c-paren-nontype-key
t (c-make-keywords-re t (c-lang-const c-paren-nontype-kwds)))
@@ -2925,6 +2995,17 @@ if this isn't nil."
;; In CORBA PSDL:
"ref"))
+(c-lang-defconst c-pre-concept-<>-kwds
+ "Keywords that may be followed by an angle bracket expression containing
+uses of \"concepts\". This is currently (2022-09) used only by C++."
+ t nil
+ c++ '("template"))
+
+(c-lang-defconst c-pre-concept-<>-key
+ ;; Regexp matching any element of `c-pre-concept-<>-kwds'.
+ t (c-make-keywords-re t (c-lang-const c-pre-concept-<>-kwds)))
+(c-lang-defvar c-pre-concept-<>-key (c-lang-const c-pre-concept-<>-key))
+
(c-lang-defconst c-<>-arglist-kwds
"Keywords that can be followed by a C++ style template arglist; see
`c-recognize-<>-arglists' for details. That language constant is
@@ -2937,7 +3018,8 @@ assumed to be set if this isn't nil."
(c-lang-defconst c-<>-sexp-kwds
;; All keywords that can be followed by an angle bracket sexp.
t (c--delete-duplicates (append (c-lang-const c-<>-type-kwds)
- (c-lang-const c-<>-arglist-kwds))
+ (c-lang-const c-<>-arglist-kwds)
+ (c-lang-const c-import-<>-kwds))
:test 'string-equal))
(c-lang-defconst c-opt-<>-sexp-key
@@ -3099,6 +3181,25 @@ This construct is \"<keyword> <expression> :\"."
idl nil
awk nil)
+(c-lang-defconst c-import-<>-kwds
+ "Keywords which can start an expression like \"import <...>\" in C++20.
+The <, and > operators are like those of #include <...>, they are
+not really template operators."
+ t nil
+ c++ '("import"))
+
+(c-lang-defconst c-module-kwds
+ "The keywords which introduce module constructs in C++20 onwards."
+ t nil
+ c++ '("module" "import" "export"))
+
+(c-lang-defconst c-module-key
+ ;; Adorned regexp matching module declaration keywords, or nil if there are
+ ;; none.
+ t (if (c-lang-const c-module-kwds)
+ (c-make-keywords-re t (c-lang-const c-module-kwds))))
+(c-lang-defvar c-module-key (c-lang-const c-module-key))
+
(c-lang-defconst c-constant-kwds
"Keywords for constants."
t nil
@@ -3113,6 +3214,10 @@ This construct is \"<keyword> <expression> :\"."
java '("true" "false" "null") ; technically "literals", not keywords
pike '("UNDEFINED")) ;; Not a keyword, but practically works as one.
+(c-lang-defconst c-constant-key
+ t (c-make-keywords-re t (c-lang-const c-constant-kwds)))
+(c-lang-defvar c-constant-key (c-lang-const c-constant-key))
+
(c-lang-defconst c-primary-expr-kwds
"Keywords besides constants and operators that start primary expressions."
t nil
@@ -3384,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.
@@ -3748,7 +3956,10 @@ is in effect when this is matched (see
`c-identifier-syntax-table')."
;; "throw" in `c-type-modifier-kwds' is followed
;; by a parenthesis list, but no extra measures
;; are necessary to handle that.
- (regexp-opt (c-lang-const c-type-modifier-kwds) t)
+ (regexp-opt
+ (append (c-lang-const c-fun-name-substitute-kwds)
+ (c-lang-const c-type-modifier-kwds))
+ t)
"\\>")
"")
"\\)")
@@ -4278,7 +4489,7 @@ This macro is expanded at compile time to a form tailored
for the mode
in question, so MODE must be a constant. Therefore MODE is not
evaluated and should not be quoted."
(declare (debug nil))
- `(funcall ,(c-make-init-lang-vars-fun mode)))
+ `(funcall #',(c-make-init-lang-vars-fun mode)))
(cc-provide 'cc-langs)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 027fd8f42f..2aa6b90dea 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 ()
@@ -1421,6 +1421,13 @@ Note that the style variables are always made local to
the buffer."
(c-clear-syn-tab (point)))
(t (c-benign-error "c-remove-string-fences: Wrong position")))))
+(defvar c-open-string-opener nil
+ "The position of the opening delimiter of an unterminated string or nil.
+This is valid only immediately after a buffer change, and refers
+only to an opener in the (logical) line containing the END
+position of `after-change-functions'.")
+(make-variable-buffer-local 'c-open-string-opener)
+
(defun c-before-change-check-unbalanced-strings (beg end)
;; If BEG or END is inside an unbalanced string, remove the syntax-table
;; text property from respectively the start or end of the string. Also
@@ -1685,13 +1692,14 @@ Note that the style variables are always made local to
the buffer."
(c-put-syn-tab (1- (point)) '(15))
(c-put-syn-tab (match-end 0) '(15))
(setq c-new-BEG (min c-new-BEG (point))
- c-new-END (max c-new-END (match-end 0))))
+ c-new-END (max c-new-END (match-end 0)))
+ (setq c-open-string-opener (1- (point))))
((or (eq (match-end 0) (point-max))
(eq (char-after (match-end 0)) ?\\)) ; \ at EOB
(c-put-syn-tab (1- (point)) '(15))
(setq c-new-BEG (min c-new-BEG (point))
c-new-END (max c-new-END (match-end 0))) ; Do we need
c-new-END?
- ))
+ (setq c-open-string-opener (1- (point)))))
(goto-char (min (1+ (match-end 0)) (point-max))))
(setq s nil)))))
@@ -2072,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
@@ -2130,6 +2139,7 @@ with // and /*, not more generic line and block comments."
;; (c-new-BEG c-new-END) will be the region to fontify.
(setq c-new-BEG beg c-new-END end)
(setq c-maybe-stale-found-type nil)
+ (setq c-open-string-opener nil)
;; A workaround for syntax-ppss's failure to notice syntax-table text
;; property changes.
(when (fboundp 'syntax-ppss)
@@ -2394,7 +2404,7 @@ 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)
+ (>= (point) bod-lim)
(progn (c-forward-syntactic-ws)
;; Have we got stuck in a comment at EOB?
(not (and (eobp)
@@ -2418,7 +2428,8 @@ with // and /*, not more generic line and block comments."
(and (> (point) bod-lim)
(or (memq (char-before) '(?\( ?\[))
(and (eq (char-before) ?\<)
- (eq (c-get-char-property
+ (equal
+ (c-get-char-property
(1- (point)) 'syntax-table)
c-<-as-paren-syntax))
(and (eq (char-before) ?{)
@@ -2440,49 +2451,67 @@ with // and /*, not more generic line and block
comments."
(and (/= new-pos pos) new-pos))))
(defun c-fl-decl-end (pos)
- ;; If POS is inside a declarator, return the end of the token that follows
- ;; the declarator, otherwise return nil. POS being in a literal does not
- ;; count as being in a declarator (on pragmatic grounds). POINT is not
- ;; preserved.
+ ;; If POS is inside a declarator, return the position of the end of the
+ ;; paren pair that terminates it, or of the end of the token that follows
+ ;; the declarator, otherwise return nil. If there is no such token, the end
+ ;; of the last token in the buffer is used. POS being in a literal is now
+ ;; (2022-07) handled correctly. POINT is not preserved.
(goto-char pos)
(let ((lit-start (c-literal-start))
(lim (c-determine-limit 1000))
- enclosing-attribute pos1)
- (unless lit-start
- (c-backward-syntactic-ws
- lim)
- (when (setq enclosing-attribute (c-enclosing-c++-attribute))
- (goto-char (car enclosing-attribute))) ; Only happens in C++ Mode.
- (when (setq pos1 (c-on-identifier))
- (goto-char pos1)
- (let ((lim (save-excursion
+ enclosing-attribute pos1 ml-delim)
+ (if lit-start
+ (goto-char lit-start))
+ (when (and lit-start c-ml-string-opener-re
+ (setq ml-delim (c-ml-string-opener-around-point)))
+ (goto-char (car ml-delim)))
+ (c-backward-syntactic-ws lim)
+ (when (setq enclosing-attribute (c-enclosing-c++-attribute))
+ (goto-char (car enclosing-attribute)) ; Only happens in C++ Mode.
+ (c-backward-syntactic-ws lim))
+ (while (and (> (point) lim)
+ (memq (char-before) '(?\[ ?\()))
+ (backward-char)
+ (c-backward-syntactic-ws lim))
+ (when (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (let* ((lim1 (save-excursion
(and (c-beginning-of-macro)
- (progn (c-end-of-macro) (point))))))
- (and (c-forward-declarator lim)
- (if (eq (char-after) ?\()
- (and
- (c-go-list-forward nil lim)
- (progn (c-forward-syntactic-ws lim)
- (not (eobp)))
- (progn
- (if (looking-at c-symbol-char-key)
- ;; Deal with baz (foo((bar)) type var), where
- ;; foo((bar)) is not semantically valid. The result
- ;; must be after var).
- (and
- (goto-char pos)
- (setq pos1 (c-on-identifier))
- (goto-char pos1)
- (progn
- (c-backward-syntactic-ws lim)
- (eq (char-before) ?\())
- (c-fl-decl-end (1- (point))))
- (c-backward-syntactic-ws lim)
- (point))))
- (and (progn (c-forward-syntactic-ws lim)
- (not (eobp)))
- (c-backward-syntactic-ws lim)
- (point)))))))))
+ (progn (c-end-of-macro) (point)))))
+ (decl-res (c-forward-declarator)))
+ (if (or (cadr (cddr (cddr decl-res))) ; We scanned an arglist.
+ (and (eq (char-after) ?\() ; Move over a non arglist (...).
+ (prog1 (c-go-list-forward)
+ (c-forward-syntactic-ws))))
+ (if (looking-at c-symbol-char-key)
+ ;; Deal with baz (foo((bar)) type var), where `pos'
+ ;; was inside foo, but foo((bar)) is not semantically
+ ;; valid. The result must be after var).
+ (and
+ (goto-char pos)
+ (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (progn
+ (c-backward-syntactic-ws lim1)
+ (eq (char-before) ?\())
+ (c-fl-decl-end (1- (point))))
+ (c-forward-over-token)
+ (point))
+ (if (progn (c-forward-syntactic-ws)
+ (not (eobp)))
+ (progn
+ (c-forward-over-token)
+ ;; Cope with having POS withing a syntactically invalid
+ ;; (...), by moving backward out of the parens and trying
+ ;; again.
+ (when (and (eq (char-before) ?\))
+ (c-go-list-backward (point) lim1))
+ (c-fl-decl-end (point))))
+ (let ((lit-start (c-literal-start)))
+ (when lit-start
+ (goto-char lit-start))
+ (c-backward-syntactic-ws)))
+ (and (>= (point) pos) (point)))))))
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
@@ -2688,11 +2717,9 @@ This function is called from `c-common-init', once per
mode initialization."
At the time of call, point is just after the newly inserted CHAR.
When CHAR is \" and not within a comment, t will be returned if
-the quotes on the current line are already balanced (i.e. if the
-last \" is not marked with a string fence syntax-table text
-property). For other cases, the default value of
-`electric-pair-inhibit-predicate' is called and its value
-returned.
+the quotes on the current line are already balanced. For other
+cases, the default value of `electric-pair-inhibit-predicate' is
+called and its value returned.
This function is the appropriate value of
`electric-pair-inhibit-predicate' for CC Mode modes, which mark
@@ -2700,11 +2727,7 @@ invalid strings with such a syntax table text property
on the
opening \" and the next unescaped end of line."
(if (and (eq char ?\")
(not (memq (cadr (c-semi-pp-to-literal (1- (point)))) '(c c++))))
- (let ((last-quote (save-match-data
- (save-excursion
- (goto-char (c-point 'eoll))
- (search-backward "\"")))))
- (not (equal (c-get-char-property last-quote 'c-fl-syn-tab) '(15))))
+ (not c-open-string-opener)
(funcall (default-value 'electric-pair-inhibit-predicate) char)))
@@ -3138,8 +3161,6 @@ Key bindings:
(message "Using CC Mode version %s" c-version)
(c-keep-region-active))
-(define-obsolete-variable-alias 'c-prepare-bug-report-hooks
- 'c-prepare-bug-report-hook "24.3")
(defvar c-prepare-bug-report-hook nil)
;; Dynamic variables used by reporter.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 5ce80e0657..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.")
@@ -1235,10 +1240,10 @@ POS and RES.")
(if win (set-window-point win pos)))
(when compilation-auto-jump-to-first-error
(cl-case compilation-auto-jump-to-first-error
- ('if-location-known
+ (if-location-known
(when (compilation--file-known-p)
(compile-goto-error)))
- ('first-known
+ (first-known
(let (match)
(while (and (not (compilation--file-known-p))
(setq match (text-property-search-forward
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ba0adcc913..539b277149 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -2,7 +2,7 @@
;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
-;; Author: Ilya Zakharevich
+;; Author: Ilya Zakharevich <ilyaz@cpan.org>
;; Bob Olson
;; Jonathan Rockway <jon@jrock.us>
;; Maintainer: emacs-devel@gnu.org
@@ -24,8 +24,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/>.
-;; Corrections made by Ilya Zakharevich ilyaz@cpan.org
-
;;; Commentary:
;; You can either fine-tune the bells and whistles of this mode or
@@ -54,7 +52,7 @@
;; (define-key global-map [M-S-down-mouse-3] #'imenu)
;; This version supports the syntax added by the MooseX::Declare CPAN
-;; module, as well as Perl 5.10 keyword support.
+;; module, as well as Perl 5.10 keywords.
;;; Code:
@@ -634,7 +632,7 @@ mode-compile.el.
If your Emacs does not default to `cperl-mode' on Perl files, and you
want it to: put the following into your .emacs file:
- (defalias \\='perl-mode \\='cperl-mode)
+ (add-to-list \\='major-mode-remap-alist \\='(perl-mode . cperl-mode))
Get perl5-info from
$CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz
@@ -958,13 +956,6 @@ Unless KEEP, removes the old indentation."
"Abbrev table in use in CPerl mode buffers."
:parents (list cperl-mode-electric-keywords-abbrev-table))
-;; ;; TODO: Commented out as we don't know what it is used for. If
-;; ;; there are no bug reports about this for Emacs 28.1, this
-;; ;; can probably be removed. (Code search online reveals nothing.)
-;; (when (boundp 'edit-var-mode-alist)
-;; ;; FIXME: What package uses this?
-;; (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
-
(defvar cperl-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "{" 'cperl-electric-lbrace)
@@ -3016,7 +3007,7 @@ and closing parentheses and brackets."
;; Now it is a hash reference
(+ cperl-indent-level cperl-close-paren-offset))
;; Labels do not take :: ...
- (if (looking-at "\\(\\w\\|_\\)+[ \t]*:")
+ (if (looking-at "\\(\\w\\|_\\)+[ \t]*:[^:]")
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
;; Do not move `parse-data', this should
@@ -3171,7 +3162,7 @@ Returns true if comment is found. In POD will not move
the point."
Mark as generic string if STRING, as generic comment otherwise.
A single character is marked as punctuation and directly
fontified. Do nothing if BEGIN and END are equal. If
-`cperl-use-syntax-text-property' is nil, just fontify."
+`cperl-use-syntax-table-text-property' is nil, just fontify."
(if (and cperl-use-syntax-table-text-property
(> end begin))
(progn
@@ -3727,7 +3718,6 @@ This is part of `cperl-find-pods-heres' (below)."
overshoot
warning-message)))
-;; Debugging this may require (setq max-specpdl-size 2000)...
(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max
end-of-here-doc)
"Scan the buffer for hard-to-parse Perl constructions.
If `cperl-pod-here-fontify' is non-nil after evaluation,
@@ -6045,39 +6035,6 @@ Style of printout regulated by the variable
`cperl-ps-print-face-properties'."
(ps-extend-face-list cperl-ps-print-face-properties)
(ps-print-buffer-with-faces file)))
-;; (defun cperl-ps-print-init ()
-;; "Initialization of `ps-print' components for faces used in CPerl."
-;; ;; Guard against old versions
-;; (defvar ps-underlined-faces nil)
-;; (defvar ps-bold-faces nil)
-;; (defvar ps-italic-faces nil)
-;; (setq ps-bold-faces
-;; (append '(font-lock-emphasized-face
-;; cperl-array-face
-;; font-lock-keyword-face
-;; font-lock-variable-name-face
-;; font-lock-constant-face
-;; font-lock-reference-face
-;; font-lock-other-emphasized-face
-;; cperl-hash-face)
-;; ps-bold-faces))
-;; (setq ps-italic-faces
-;; (append '(cperl-nonoverridable-face
-;; font-lock-constant-face
-;; font-lock-reference-face
-;; font-lock-other-emphasized-face
-;; cperl-hash-face)
-;; ps-italic-faces))
-;; (setq ps-underlined-faces
-;; (append '(font-lock-emphasized-face
-;; cperl-array-face
-;; font-lock-other-emphasized-face
-;; cperl-hash-face
-;; cperl-nonoverridable-face font-lock-type-face)
-;; ps-underlined-faces))
-;; (cons 'font-lock-type-face ps-underlined-faces))
-
-
(cperl-windowed-init)
(defconst cperl-styles-entries
@@ -8366,7 +8323,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
@@ -8535,8 +8492,8 @@ POS defaults to the point."
(let ((p (cperl-get-here-doc-region pos)))
(or p (error "Not inside a HERE document"))
(narrow-to-region (car p) (cdr p))
- (message
- "When you are finished with narrow editing, type C-x n w")))
+ (message (substitute-command-keys
+ "When you are finished with narrow editing, type \\[widen]"))))
(defun cperl-select-this-pod-or-here-doc (&optional pos)
"Select the HERE-DOC (or POD section) at POS.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
new file mode 100644
index 0000000000..c587061837
--- /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 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 exising 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)
+ . ("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 . ("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)
+ . ("digestif"))
+ (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 . ("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.")
+
+(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...)
+Honour `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.
+Honour `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)
+ (spinner
+ :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
+ :initform `(nil nil t) :accessor eglot--spinner)
+ (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 (cl-loop for s in ss do (eglot-shutdown s 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)))
+ (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))
+ (cancelled 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 honour `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 cancelled
+ (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 cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "%s: %s" code message)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg)))))
+ :timeout-fn (lambda ()
+ (unless cancelled
+ (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 cancelled '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
+ (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
+ :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)))
+ (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)))
+ (retval (url-unhex-string (url-filename (url-generic-parse-url uri))))
+ ;; 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)))
+
+(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 behaviour 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 of 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 on-line documentation."
+ (interactive) (browse-url "https://github.com/joaotavora/eglot#readme";))
+
+(easy-menu-define eglot-menu nil "Eglot"
+ `("Eglot"
+ ;; Commands for getting information and customization.
+ ["Read manual" eglot-manual]
+ ["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."
+ (pcase-let* ((server (eglot-current-server))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner
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 (and doing (not done-p))
+ `("/" ,(eglot--mode-line-props doing
+ 'compilation-mode-line-run '())))
+ ,@(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
+See info node `(emacs)Directory Variables' for various ways to to
+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 (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)
+ (setf (eglot--spinner server) (list nil :textDocument/didChange t))
+ (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-backend-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)
+
+ ;; On emacs versions < 26.2,
+ ;; `replace-buffer-contents' is buggy - it calls
+ ;; change functions with invalid arguments - so we
+ ;; manually call the change functions here.
+ ;;
+ ;; See emacs bugs #32237, #32278:
+ ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
+ ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
+ (let ((inhibit-modification-hooks t)
+ (length (- end beg))
+ (beg (marker-position beg))
+ (end (marker-position end)))
+ (run-hook-with-args 'before-change-functions
+ beg end)
+ (replace-buffer-contents temp)
+ (run-hook-with-args 'after-change-functions
+ beg (+ beg (length newText))
+ length))))
+ (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 cancelled 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)
+ (eglot--glob-compile globPattern t t))
+ 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))
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-find file globs :test (lambda (f g) (funcall g f))))
+ (jsonrpc-notify
+ server :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
+ ((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 9dc67010aa..537b9484bd 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -220,8 +220,8 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
Load the compiled code when finished.
Use `emacs-lisp-byte-compile-and-load' in combination with
-`native-comp-deferred-compilation' set to t to achieve asynchronous
-native compilation."
+`inhibit-automatic-native-compilation' set to nil to achieve
+asynchronous native compilation."
(interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer)
(load (native-compile buffer-file-name)))
@@ -1646,6 +1646,7 @@ Return the result of evaluation."
;; printing, not while evaluating.
(defvar elisp--eval-defun-result)
(let ((debug-on-error eval-expression-debug-on-error)
+ (edebugging edebug-all-defs)
elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
@@ -1670,8 +1671,9 @@ Return the result of evaluation."
(elisp--eval-defun-1
(macroexpand form)))))
(print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (eval-region beg end standard-output
+ (print-level eval-expression-print-level)
+ (should-print (if (not edebugging) standard-output)))
+ (eval-region beg end should-print
(lambda (_ignore)
;; Skipping to the end of the specified region
;; will make eval-region return.
@@ -1824,8 +1826,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
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 65bc42c099..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
@@ -1705,7 +1704,7 @@ Point should be just after a string that matches TAG."
;;;###autoload
(defalias 'next-file 'tags-next-file)
(make-obsolete 'next-file
- "use tags-next-file or fileloop-initialize and
fileloop-next-file instead" "27.1")
+ "use `tags-next-file' or `fileloop-initialize' and
`fileloop-next-file' instead" "27.1")
;;;###autoload
(defun tags-next-file (&optional initialize novisit)
"Select next file among files in current tags table.
@@ -1784,10 +1783,10 @@ Bind `case-fold-search' during the evaluation,
depending on the value of
(defun tags--compat-initialize (initialize)
(fileloop-initialize
(tags--compat-files initialize)
+ (lambda () (tags-loop-eval tags-loop-scan))
(if tags-loop-operate
(lambda () (tags-loop-eval tags-loop-operate))
- (lambda () (message "Scanning file %s...found" buffer-file-name) nil))
- (lambda () (tags-loop-eval tags-loop-scan))))
+ (lambda () (message "Scanning file %s...found" buffer-file-name) nil))))
;;;###autoload
(defun tags-loop-continue (&optional first-time)
@@ -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.el b/lisp/progmodes/flymake.el
index 15ee5cb7d5..294cf47087 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -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)))
@@ -1538,7 +1539,7 @@ POS can be a buffer position or a button"
(flymake-show-diagnostic (if (button-type pos) (button-start pos) pos))))
(defun flymake--tabulated-entries-1 (diags project-root)
- "Helper for `flymake--diagnostic-buffer-entries'.
+ "Helper for `flymake--diagnostics-buffer-entries'.
PROJECT-ROOT indicates that each entry should be preceded by the
filename of the diagnostic relative to that directory."
(cl-loop
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 c256198b3c..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
@@ -2943,8 +2943,7 @@ Return position where LINE begins."
start-posn)))
(defun gdb-pad-string (string padding)
- (declare (obsolete string-pad "29.1"))
- (string-pad string padding nil t))
+ (string-pad string (abs padding) nil (natnump padding)))
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
@@ -2962,8 +2961,7 @@ When non-nil, PROPERTIES will be added to the whole row
when
calling `gdb-table-string'."
(let ((rows (gdb-table-rows table))
(row-properties (gdb-table-row-properties table))
- (column-sizes (gdb-table-column-sizes table))
- (right-align (gdb-table-right-align table)))
+ (column-sizes (gdb-table-column-sizes table)))
(when (not column-sizes)
(setf (gdb-table-column-sizes table)
(make-list (length row) 0)))
@@ -2973,9 +2971,7 @@ calling `gdb-table-string'."
(append row-properties (list properties)))
(setf (gdb-table-column-sizes table)
(cl-mapcar (lambda (x s)
- (let ((new-x
- (max (abs x) (string-width (or s "")))))
- (if right-align new-x (- new-x))))
+ (max (abs x) (string-width (or s ""))))
(gdb-table-column-sizes table)
row))
;; Avoid trailing whitespace at eol
@@ -2991,7 +2987,10 @@ calling `gdb-table-string'."
(lambda (row properties)
(apply #'propertize
(mapconcat #'identity
- (cl-mapcar (lambda (s x) (string-pad s x nil t))
+ (cl-mapcar (lambda (s x)
+ (string-pad
+ s x nil
+ (not (gdb-table-right-align table))))
row column-sizes)
sep)
properties))
@@ -4034,11 +4033,12 @@ DOC is an optional documentation string."
(file (gdb-mi--field frame 'fullname))
(line (gdb-mi--field frame 'line)))
(if file
- (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)
- ;; If we're unable to get a file name / line for $PC, simply
- ;; follow $PC, disassembling the next 10 (x ~15 (on IA) ==
- ;; 150 bytes) instructions.
- "-data-disassemble -s $pc -e \"$pc + 150\" -- 0"))
+ (format "-data-disassemble -f %s -l %s -n -1 -- 0"
+ (file-local-name file) line)
+ ;; If we're unable to get a file name / line for $PC, simply
+ ;; follow $PC, disassembling the next 10 (x ~15 (on IA) ==
+ ;; 150 bytes) instructions.
+ "-data-disassemble -s $pc -e \"$pc + 150\" -- 0"))
gdb-disassembly-handler
;; We update disassembly only after we have actual frame information
;; about all threads, so no there's `update' signal in this list
@@ -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/glasses.el b/lisp/progmodes/glasses.el
index c7b0587336..c0bd6f220c 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -84,12 +84,22 @@ performed."
(defcustom glasses-face nil
- "Face to be put on capitals of an identifier looked through glasses.
-If it is nil, no face is placed at the capitalized letter.
+ "Face to use for capital letters of identifiers where separators were added.
+If it is nil, the capital letters will display with their usual faces.
For example, you can set `glasses-separator' to an empty string and
`glasses-face' to `bold'. Then unreadable identifiers will have no separators,
-but will have their capitals in bold."
+but will have their capitals in bold.
+
+As another example, you may wish to have a clear visual indication of
+where the `glasses-separator' string was inserted by `glasses-mode',
+as opposed to where they are part of the original identifiers. This
+can be useful when the program source code uses mixed CamelCase and
+normal_readable identifiers, and you want to know which underscores
+were added by this mode. Customizing this face to something like `bold'
+will show the capital letters following the inserted `glasses-separator'
+in a distinct face. Note that you must use `customize-variable' for
+changing the face; just assigning the value has no effect."
:type '(choice (const :tag "None" nil) face)
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 4c1f801980..2446e86abb 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -126,11 +126,22 @@ include it when specifying `grep-command'.
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'."
+\\[customize] or call the function `grep-apply-setting'.
+
+Also see `grep-command-position'."
:type '(choice string
(const :tag "Not Set" nil))
:set #'grep-apply-setting)
+(defcustom grep-command-position nil
+ "Where to put point when prompting for a grep command.
+This controls the placement of point in the minibuffer when Emacs
+prompts for the grep command. If nil, put point at the end of
+the suggested command. If non-nil, this should be the one-based
+position in the minibuffer where to place point."
+ :type '(choice (const :tag "At the end" nil)
+ natnum))
+
(defcustom grep-template nil
"The default command to run for \\[lgrep].
The following place holders should be present in the string:
@@ -931,10 +942,15 @@ list is empty)."
(progn
(grep-compute-defaults)
(let ((default (grep-default-command)))
- (list (read-shell-command "Run grep (like this): "
- (if current-prefix-arg default grep-command)
- 'grep-history
- (if current-prefix-arg nil default))))))
+ (list (read-shell-command
+ "Run grep (like this): "
+ (if current-prefix-arg
+ default
+ (if grep-command-position
+ (cons grep-command grep-command-position)
+ grep-command))
+ 'grep-history
+ (if current-prefix-arg nil default))))))
;; If called non-interactively, also compute the defaults if we
;; haven't already.
(when (eq grep-highlight-matches 'auto-detect)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index ccc5720575..9b7d7a0535 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -159,143 +159,96 @@ Used to gray out relevant toolbar icons.")
(t
(comint-interrupt-subjob)))))
-(easy-mmode-defmap gud-menu-map
- '(([help] "Info (debugger)" . gud-goto-info)
- ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode
- :enable (and (not emacs-basic-display)
- (display-graphic-p)
- (fboundp 'x-show-tip))
- :visible (memq gud-minor-mode
- '(gdbmi guiler dbx sdb xdb pdb))
- :button (:toggle . gud-tooltip-mode))
- ([refresh] "Refresh" . gud-refresh)
- ([run] menu-item "Run" gud-run
- :enable (not gud-running)
- :visible (or (memq gud-minor-mode '(gdb dbx jdb))
- (and (eq gud-minor-mode 'gdbmi)
- (or (not (gdb-show-run-p))
- (bound-and-true-p
- gdb-active-process)))))
- ([go] . (menu-item (if (bound-and-true-p gdb-active-process)
- "Continue" "Run")
- gud-go
- :visible (and (eq gud-minor-mode 'gdbmi)
- (gdb-show-run-p))))
- ([stop] menu-item "Stop" gud-stop-subjob
- :visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
- (and (eq gud-minor-mode 'gdbmi)
- (gdb-show-stop-p))))
- ([until] menu-item "Continue to selection" gud-until
- :enable (not gud-running)
- :visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
- (gud-tool-bar-item-visible-no-fringe)))
- ([remove] menu-item "Remove Breakpoint" gud-remove
- :enable (not gud-running)
- :visible (gud-tool-bar-item-visible-no-fringe))
- ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
- :enable (not gud-running)
- :visible (memq gud-minor-mode
- '(gdbmi gdb sdb xdb)))
- ([break] menu-item "Set Breakpoint" gud-break
- :enable (not gud-running)
- :visible (gud-tool-bar-item-visible-no-fringe))
- ([up] menu-item "Up Stack" gud-up
- :enable (not gud-running)
- :visible (memq gud-minor-mode
- '(gdbmi gdb guiler dbx xdb jdb pdb)))
- ([down] menu-item "Down Stack" gud-down
- :enable (not gud-running)
- :visible (memq gud-minor-mode
- '(gdbmi gdb guiler dbx xdb jdb pdb)))
- ([pp] menu-item "Print S-expression" gud-pp
- :enable (and (not gud-running)
- (bound-and-true-p gdb-active-process))
- :visible (and (string-equal
- (buffer-local-value
- 'gud-target-name gud-comint-buffer)
- "emacs")
- (eq gud-minor-mode 'gdbmi)))
- ([print*] . (menu-item (if (eq gud-minor-mode 'jdb)
- "Dump object"
- "Print Dereference")
- gud-pstar
- :enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdb jdb))))
- ([print] menu-item "Print Expression" gud-print
- :enable (not gud-running))
- ([watch] menu-item "Watch Expression" gud-watch
- :enable (not gud-running)
- :visible (eq gud-minor-mode 'gdbmi))
- ([finish] menu-item "Finish Function" gud-finish
- :enable (not gud-running)
- :visible (memq gud-minor-mode
- '(gdbmi gdb guiler xdb jdb pdb)))
- ([stepi] menu-item "Step Instruction" gud-stepi
- :enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
- ([nexti] menu-item "Next Instruction" gud-nexti
- :enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdb dbx)))
- ([step] menu-item "Step Line" gud-step
- :enable (not gud-running))
- ([next] menu-item "Next Line" gud-next
- :enable (not gud-running))
- ([cont] menu-item "Continue" gud-cont
- :enable (not gud-running)
- :visible (not (eq gud-minor-mode 'gdbmi))))
- "Menu for `gud-mode'."
- :name "Gud")
-
-(easy-mmode-defmap gud-minor-mode-map
- (append
- `(([menu-bar debug] . ("Gud" . ,gud-menu-map)))
- ;; Get tool bar like functionality from the menu bar on a text only
- ;; terminal.
- (unless window-system
- `(([menu-bar down]
- . (,(propertize "down" 'face 'font-lock-doc-face) . gud-down))
- ([menu-bar up]
- . (,(propertize "up" 'face 'font-lock-doc-face) . gud-up))
- ([menu-bar finish]
- . (,(propertize "finish" 'face 'font-lock-doc-face) . gud-finish))
- ([menu-bar step]
- . (,(propertize "step" 'face 'font-lock-doc-face) . gud-step))
- ([menu-bar next]
- . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next))
- ([menu-bar until] menu-item
- ,(propertize "until" 'face 'font-lock-doc-face) gud-until
- :visible (memq gud-minor-mode '(gdbmi gdb perldb)))
- ([menu-bar cont] menu-item
- ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont
- :visible (not (eq gud-minor-mode 'gdbmi)))
- ([menu-bar run] menu-item
- ,(propertize "run" 'face 'font-lock-doc-face) gud-run
- :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
- ([menu-bar go] menu-item
- ,(propertize " go " 'face 'font-lock-doc-face) gud-go
- :visible (and (eq gud-minor-mode 'gdbmi)
- (gdb-show-run-p)))
- ([menu-bar stop] menu-item
- ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
- :visible (or (and (eq gud-minor-mode 'gdbmi)
- (gdb-show-stop-p))
- (not (eq gud-minor-mode 'gdbmi))))
- ([menu-bar print]
- . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
- ([menu-bar tools] . undefined)
- ([menu-bar buffer] . undefined)
- ([menu-bar options] . undefined)
- ([menu-bar edit] . undefined)
- ([menu-bar file] . undefined))))
- "Map used in visited files.")
-
-(setf (alist-get 'gud-minor-mode minor-mode-map-alist)
- gud-minor-mode-map)
-
-(defvar gud-mode-map
+(defvar-keymap gud-mode-map
;; Will inherit from comint-mode via define-derived-mode.
- (make-sparse-keymap)
- "`gud-mode' keymap.")
+ :doc "`gud-mode' keymap.")
+
+(defvar-keymap gud-minor-mode-map
+ :parent gud-mode-map)
+
+(easy-menu-define gud-menu-map gud-mode-map
+ "Menu for `gud-mode'."
+ '("Gud"
+ ["Continue" gud-cont
+ :enable (not gud-running)
+ :visible (not (eq gud-minor-mode 'gdbmi))]
+ ["Next Line" gud-next
+ :enable (not gud-running)]
+ ["Step Line" gud-step
+ :enable (not gud-running)]
+ ["Next Instruction" gud-nexti
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb dbx))]
+ ["Step Instruction" gud-stepi
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb dbx))]
+ ["Finish Function" gud-finish
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb guiler xdb jdb pdb))]
+ ["Watch Expression" gud-watch
+ :enable (not gud-running)
+ :visible (eq gud-minor-mode 'gdbmi)]
+ ["Print Expression" gud-print
+ :enable (not gud-running)]
+ ["Dump object-Derefenrece" gud-pstar
+ :label (if (eq gud-minor-mode 'jdb)
+ "Dump object"
+ "Print Dereference")
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb jdb))]
+ ["Print S-expression" gud-pp
+ :enable (and (not gud-running)
+ (bound-and-true-p gdb-active-process))
+ :visible (and (string-equal
+ (buffer-local-value
+ 'gud-target-name gud-comint-buffer)
+ "emacs")
+ (eq gud-minor-mode 'gdbmi))]
+ ["Down Stack" gud-down
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb guiler dbx xdb jdb pdb))]
+ ["Up Stack" gud-up
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode
+ '(gdbmi gdb guiler dbx xdb jdb pdb))]
+ ["Set Breakpoint" gud-break
+ :enable (not gud-running)
+ :visible (gud-tool-bar-item-visible-no-fringe)]
+ ["Temporary Breakpoint" gud-tbreak
+ :enable (not gud-running)
+ :visible (memq gud-minor-mode '(gdbmi gdb sdb xdb))]
+ ["Remove Breakpoint" gud-remove
+ :enable (not gud-running)
+ :visible (gud-tool-bar-item-visible-no-fringe)]
+ ["Continue to selection" gud-until
+ :enable (not gud-running)
+ :visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
+ (gud-tool-bar-item-visible-no-fringe))]
+ ["Stop" gud-stop-subjob
+ :visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
+ (and (eq gud-minor-mode 'gdbmi)
+ (gdb-show-stop-p)))]
+ ["Continue-Run" gud-go
+ :label (if (bound-and-true-p gdb-active-process)
+ "Continue" "Run")
+ :visible (and (eq gud-minor-mode 'gdbmi)
+ (gdb-show-run-p))]
+ ["Run" gud-run
+ :enable (not gud-running)
+ :visible (or (memq gud-minor-mode '(gdb dbx jdb))
+ (and (eq gud-minor-mode 'gdbmi)
+ (or (not (gdb-show-run-p))
+ (bound-and-true-p
+ gdb-active-process))))]
+ ["Refresh" gud-refresh]
+ ["Show GUD tooltips" gud-tooltip-mode
+ :enable (and (not emacs-basic-display)
+ (display-graphic-p)
+ (fboundp 'x-show-tip))
+ :visible (memq gud-minor-mode
+ '(gdbmi guiler dbx sdb xdb pdb))
+ :button (:toggle . gud-tooltip-mode)]
+ ["Info (debugger)" gud-goto-info]))
(defvar gud-tool-bar-map
(let ((map (make-sparse-keymap)))
@@ -799,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/hideif.el b/lisp/progmodes/hideif.el
index d09e1f4cdf..767216c03f 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -196,9 +196,7 @@ Effective only if `hide-ifdef-expand-reinclusion-guard' is
t."
"C" #'hif-clear-all-ifdef-defined
"C-q" #'hide-ifdef-toggle-read-only
"C-w" #'hide-ifdef-toggle-shadowing
- "<remap> <read-only-mode>" #'hide-ifdef-toggle-outside-read-only
- ;; `toggle-read-only' is obsoleted by `read-only-mode'.
- "<remap> <toggle-read-only>" #'hide-ifdef-toggle-outside-read-only)
+ "<remap> <read-only-mode>" #'hide-ifdef-toggle-outside-read-only)
(defcustom hide-ifdef-mode-prefix-key "\C-c@"
"Prefix key for all Hide-Ifdef mode commands."
@@ -407,7 +405,7 @@ overlays created."
;; hidden with `hide-ifdef-lines' equals to nil while another part with 't,
;; this case happens.
;; TODO: Should we merge? or just create a container overlay? -- this can
- ;; prevent `hideif-show-ifdef' expanding too many hidden contents since there
+ ;; prevent `show-ifdefs' expanding too many hidden contents since there
;; is only a big overlay exists there without any smaller overlays.
(save-restriction
(widen) ; Otherwise `point-min' and `point-max' will be restricted and thus
@@ -727,7 +725,7 @@ Assuming we've just regexp-matched with
`hif-decfloat-regexp' and it matched.
if REMATCH is t, do a rematch."
;; In elisp `(string-to-number "01.e2")' will return 1 instead of the
expected
;; 100.0; therefore we need to write our own.
- ;; This function relies on the regexp groups of `hif-dexfloat-regexp'
+ ;; This function relies on the regexp groups of `hif-hexfloat-regexp'
(if (or fix exp)
(setq fix (hif-delete-char-in-string ?' fix)
exp (hif-delete-char-in-string ?' exp))
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index f574ec84fb..6de079f05a 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
@@ -256,7 +256,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))
@@ -267,7 +267,9 @@ This has effect only if `search-invisible' is set to
`open'."
))
"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).
+ (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC
+ FIND-BLOCK-BEGINNING-FUNC FIND-NEXT-BLOCK-FUNC
+ LOOKING-AT-BLOCK-START-P-FUNC).
If non-nil, hideshow will use these values as regexps to define blocks
and comments, respectively for major mode MODE.
@@ -288,6 +290,15 @@ cases, FORWARD-SEXP-FUNC specifies another function to use
instead.
See the documentation for `hs-adjust-block-beginning' to see what is the
use of ADJUST-BEG-FUNC.
+See the documentation for `hs-find-block-beginning-func' to see
+what is the use of FIND-BLOCK-BEGINNING-FUNC.
+
+See the documentation for `hs-find-next-block-func' to see what
+is the use of FIND-NEXT-BLOCK-FUNC.
+
+See the documentation for `hs-looking-at-block-start-p-func' to
+see what is the use of LOOKING-AT-BLOCK-START-P-FUNC.
+
If any of the elements is left nil or omitted, hideshow tries to guess
appropriate values. The regexps should not contain leading or trailing
whitespace. Case does not matter.")
@@ -340,17 +351,17 @@ 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)
+ (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.")
@@ -433,6 +444,39 @@ It should not move the point.
See `hs-c-like-adjust-block-beginning' for an example of using this.")
+(defvar-local hs-find-block-beginning-func #'hs-find-block-beginning
+ "Function used to do `hs-find-block-beginning'.
+It should reposition point at the beginning of the current block
+and return point, or nil if original point was not in a block.
+
+Specifying this function is necessary for languages such as
+Python, where regexp search and `syntax-ppss' check is not enough
+to find the beginning of the current block.")
+
+(defvar-local hs-find-next-block-func #'hs-find-next-block
+ "Function used to do `hs-find-next-block'.
+It should reposition point at next block start.
+
+It is called with three arguments REGEXP, MAXP, and COMMENTS.
+REGEXP is a regexp representing block start. When block start is
+found, `match-data' should be set using REGEXP. MAXP is a buffer
+position that bounds the search. When COMMENTS is nil, comments
+should be skipped. When COMMENTS is not nil, REGEXP matches not
+only beginning of a block but also beginning of a comment. In
+this case, the function should find nearest block or comment.
+
+Specifying this function is necessary for languages such as
+Python, where regexp search is not enough to find the beginning
+of the next block.")
+
+(defvar-local hs-looking-at-block-start-p-func #'hs-looking-at-block-start-p
+ "Function used to do `hs-looking-at-block-start-p'.
+It should return non-nil if the point is at the block start.
+
+Specifying this function is necessary for languages such as
+Python, where `looking-at' and `syntax-ppss' check is not enough
+to check if the point is at the block start.")
+
(defvar hs-headline nil
"Text of the line where a hidden block begins, set during isearch.
You can display this in the mode line by adding the symbol `hs-headline'
@@ -565,7 +609,7 @@ The block beginning is adjusted by
`hs-adjust-block-beginning'
and then further adjusted to be at the end of the line."
(if comment-reg
(hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
- (when (hs-looking-at-block-start-p)
+ (when (funcall hs-looking-at-block-start-p-func)
(let ((mdata (match-data t))
(header-end (match-end 0))
p q ov)
@@ -672,7 +716,14 @@ function; and adjust-block-beginning function."
0 (1- (match-end 0)))
c-start-regexp)))
hs-forward-sexp-func (or (nth 4 lookup) #'forward-sexp)
- hs-adjust-block-beginning (or (nth 5 lookup) #'identity)))
+ hs-adjust-block-beginning (or (nth 5 lookup) #'identity)
+ hs-find-block-beginning-func (or (nth 6 lookup)
+ #'hs-find-block-beginning)
+ hs-find-next-block-func (or (nth 7 lookup)
+ #'hs-find-next-block)
+ hs-looking-at-block-start-p-func
+ (or (nth 8 lookup)
+ #'hs-looking-at-block-start-p)))
(setq hs-minor-mode nil)
(error "%s Mode doesn't support Hideshow Minor Mode"
(format-mode-line mode-name))))
@@ -683,7 +734,7 @@ Return point, or nil if original point was not in a block."
(let ((done nil)
(here (point)))
;; look if current line is block start
- (if (hs-looking-at-block-start-p)
+ (if (funcall hs-looking-at-block-start-p-func)
(point)
;; look backward for the start of a block that contains the cursor
(while (and (re-search-backward hs-block-start-regexp nil t)
@@ -698,19 +749,25 @@ Return point, or nil if original point was not in a
block."
(goto-char here)
nil))))
+(defun hs-find-next-block (regexp maxp comments)
+ "Reposition point at next block-start.
+Skip comments if COMMENTS is nil, and search for REGEXP in
+region (point MAXP)."
+ (when (not comments)
+ (forward-comment (point-max)))
+ (and (< (point) maxp)
+ (re-search-forward regexp maxp t)))
+
(defun hs-hide-level-recursive (arg minp maxp)
"Recursively hide blocks ARG levels below point in region (MINP MAXP)."
- (when (hs-find-block-beginning)
+ (when (funcall hs-find-block-beginning-func)
(setq minp (1+ (point)))
(funcall hs-forward-sexp-func 1)
(setq maxp (1- (point))))
(unless hs-allow-nesting
(hs-discard-overlays minp maxp))
(goto-char minp)
- (while (progn
- (forward-comment (buffer-size))
- (and (< (point) maxp)
- (re-search-forward hs-block-start-regexp maxp t)))
+ (while (funcall hs-find-next-block-func hs-block-start-regexp maxp nil)
(when (save-match-data
(not (nth 8 (syntax-ppss)))) ; not inside comments or strings
(if (> arg 1)
@@ -721,14 +778,20 @@ Return point, or nil if original point was not in a
block."
(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 ()
+ "Reposition point at the end of match of the block-start regexp.
+Return point, or nil if original point was not in a block."
+ (when (and (funcall hs-find-block-beginning-func)
+ (funcall hs-looking-at-block-start-p-func))
+ ;; point is inside a block
+ (goto-char (match-end 0))))
+
(defun hs-overlay-at (position)
"Return hideshow overlay at POSITION, or nil if none to be found."
(let ((overlays (overlays-at position))
@@ -745,12 +808,13 @@ and `case-fold-search' are both t."
(if (and c-reg (nth 0 c-reg))
;; point is inside a comment, and that comment is hideable
(goto-char (nth 0 c-reg))
- (end-of-line)
- (when (and (not c-reg)
- (hs-find-block-beginning)
- (hs-looking-at-block-start-p))
- ;; point is inside a block
- (goto-char (match-end 0)))))
+ (when (not c-reg)
+ (end-of-line)
+ (when (not (hs-find-block-beginning-match))
+ ;; We should also consider ourselves "in" a hidden block when
+ ;; point is right at the edge after a hidden block (bug#52092).
+ (beginning-of-line)
+ (hs-find-block-beginning-match)))))
(end-of-line)
(hs-overlay-at (point))))
@@ -790,10 +854,8 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also
hide the comments."
hs-c-start-regexp
"\\)")
""))))
- (while (progn
- (unless hs-hide-comments-when-hiding-all
- (forward-comment (point-max)))
- (re-search-forward re (point-max) t))
+ (while (funcall hs-find-next-block-func re (point-max)
+ hs-hide-comments-when-hiding-all)
(if (match-beginning 1)
;; We have found a block beginning.
(progn
@@ -838,8 +900,8 @@ Upon completion, point is repositioned and the normal hook
(<= (count-lines (car c-reg) (nth 1 c-reg)) 1)))
(message "(not enough comment lines to hide)"))
((or c-reg
- (hs-looking-at-block-start-p)
- (hs-find-block-beginning))
+ (funcall hs-looking-at-block-start-p-func)
+ (funcall hs-find-block-beginning-func))
(hs-hide-block-at-point end c-reg)
(run-hooks 'hs-hide-hook))))))
@@ -868,9 +930,9 @@ See documentation for functions `hs-hide-block' and
`run-hooks'."
(when (car c-reg)
(setq p (car c-reg)
q (cadr c-reg))))
- ((and (hs-find-block-beginning)
+ ((and (funcall hs-find-block-beginning-func)
;; ugh, fresh match-data
- (hs-looking-at-block-start-p))
+ (funcall hs-looking-at-block-start-p-func))
(setq p (point)
q (progn (hs-forward-sexp (match-data t) 1) (point)))))
(when (and p q)
@@ -893,9 +955,9 @@ The hook `hs-hide-hook' is run; see `run-hooks'."
"Toggle hiding/showing of a block.
See `hs-hide-block' and `hs-show-block'.
Argument E should be the event that triggered this action."
- (interactive)
+ (interactive (list last-nonmenu-event))
(hs-life-goes-on
- (posn-set-point (event-end e))
+ (when e (posn-set-point (event-end e)))
(if (hs-already-hidden-p)
(hs-show-block)
(hs-hide-block))))
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/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 721dfa51ad..18b9899169 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1722,12 +1722,12 @@ code line."
(dir (file-name-directory
(directory-file-name (file-name-directory file)))))
(replace-match "" nil nil nil 1)
- (insert (substitute-command-keys "`"))
+ (insert (substitute-quotes "`"))
;; Include the parent directory which may be regarded as
;; the category for the FN.
(help-insert-xref-button (file-relative-name file dir)
'octave-help-file fn)
- (insert (substitute-command-keys "'"))))
+ (insert (substitute-quotes "'"))))
;; Make 'See also' clickable.
(with-syntax-table octave-mode-syntax-table
(when (re-search-forward "^\\s-*See also:" nil t)
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 70cb460568..db9df67279 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -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]*")))
@@ -242,6 +247,12 @@
(not (nth 3 (syntax-ppss
(match-beginning 0))))))
(string-to-syntax ". p"))))
+ ;; If "\" is acting as a backslash operator, it shouldn't start an
+ ;; escape sequence, so change its syntax. This allows us to handle
+ ;; correctly the \() construct (Bug#11996) as well as references
+ ;; to string values.
+ ("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss))
+ (string-to-syntax "."))))
;; Handle funny names like $DB'stop.
("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
@@ -280,6 +291,7 @@
(backward-sexp 1)
(member (buffer-substring (point) end)
perl--syntax-exp-intro-keywords)))
+ (bobp)
(memq (char-before)
'(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))))
nil ;; A division sign instead of a regexp-match.
@@ -328,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 7738de6a74..f87230bd2f 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -100,11 +100,9 @@
menu)
-(defvar prog-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\C-\M-q] 'prog-indent-sexp)
- map)
- "Keymap used for programming modes.")
+(defvar-keymap prog-mode-map
+ :doc "Keymap used for programming modes."
+ "C-M-q" #'prog-indent-sexp)
(defvar prog-indentation-context nil
"When non-nil, provides context for indenting embedded code chunks.
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 30f51704dc..ac278edd40 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.2
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -1498,7 +1498,8 @@ the progress. The function returns the number of detected
projects."
(interactive "DDirectory: \nP")
(project--ensure-read-project-list)
- (let ((queue (directory-files dir t nil t)) (count 0)
+ (let ((queue (list dir))
+ (count 0)
(known (make-hash-table
:size (* 2 (length project--list))
:test #'equal )))
@@ -1506,15 +1507,20 @@ projects."
(puthash project t known))
(while queue
(when-let ((subdir (pop queue))
- ((file-directory-p subdir))
- ((not (gethash subdir known))))
- (when-let (pr (project--find-in-directory subdir))
- (project-remember-project pr t)
- (message "Found %s..." (project-root pr))
+ ((file-directory-p subdir)))
+ (when-let ((project (project--find-in-directory subdir))
+ (project-root (project-root project))
+ ((not (gethash project-root known))))
+ (project-remember-project project t)
+ (puthash project-root t known)
+ (message "Found %s..." project-root)
(setq count (1+ count)))
- (when (and recursive (file-symlink-p subdir))
- (setq queue (nconc (directory-files subdir t nil t) queue))
- (puthash subdir t known))))
+ (when (and recursive (file-directory-p subdir))
+ (setq queue
+ (nconc
+ (directory-files
+ subdir t directory-files-no-dot-files-regexp t)
+ queue)))))
(unless (eq recursive 'in-progress)
(if (zerop count)
(message "No projects were found")
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 e1347754c4..cec0d54a44 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -5,7 +5,7 @@
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
;; Version: 0.28
-;; Package-Requires: ((emacs "24.4") (cl-lib "1.0"))
+;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -34,7 +34,8 @@
;; Implements Syntax highlighting, Indentation, Movement, Shell
;; interaction, Shell completion, Shell virtualenv support, Shell
;; package support, Shell syntax highlighting, Pdb tracking, Symbol
-;; completion, Skeletons, FFAP, Code Check, ElDoc, Imenu.
+;; completion, Skeletons, FFAP, Code Check, ElDoc, Imenu, Flymake,
+;; Import management.
;; Syntax highlighting: Fontification of code is provided and supports
;; python's triple quoted strings properly.
@@ -69,7 +70,7 @@
;; variables. This example enables IPython globally:
;; (setq python-shell-interpreter "ipython"
-;; python-shell-interpreter-args "-i")
+;; python-shell-interpreter-args "--simple-prompt")
;; Using the "console" subcommand to start IPython in server-client
;; mode is known to fail intermittently due a bug on IPython itself
@@ -240,11 +241,29 @@
;; I'd recommend the first one since you'll get the same behavior for
;; all modes out-of-the-box.
+;; Flymake: A Flymake backend, using the pyflakes program by default,
+;; is provided. You can also use flake8 or pylint by customizing
+;; `python-flymake-command'.
+
+;; Import management: The commands `python-sort-imports',
+;; `python-add-import', `python-remove-import', and
+;; `python-fix-imports' automate the editing of import statements at
+;; the top of the buffer, which tend to be a tedious task in larger
+;; projects. These commands require that the isort library is
+;; available to the interpreter pointed at by `python-interpreter'.
+;; The last command also requires pyflakes. These dependencies can be
+;; installed, among other methods, with the following command:
+;;
+;; pip install isort pyflakes
+
;;; Code:
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
+(require 'compat nil 'noerror)
+(require 'project nil 'noerror)
+(require 'seq)
(eval-when-compile (require 'subr-x)) ;For `string-empty-p'.
;; Avoid compiler warnings
@@ -265,6 +284,12 @@
:version "24.3"
:link '(emacs-commentary-link "python"))
+(defcustom python-interpreter "python"
+ "Python interpreter for noninteractive use.
+To customize the Python shell, modify `python-shell-interpreter'
+instead."
+ :version "29.1"
+ :type 'string)
;;; Bindings
@@ -275,6 +300,7 @@
(define-key map [remap backward-sentence] #'python-nav-backward-block)
(define-key map [remap forward-sentence] #'python-nav-forward-block)
(define-key map [remap backward-up-list] #'python-nav-backward-up-list)
+ (define-key map [remap up-list] #'python-nav-up-list)
(define-key map [remap mark-defun] #'python-mark-defun)
(define-key map "\C-c\C-j" #'imenu)
;; Indent specific
@@ -303,6 +329,11 @@
(define-key map "\C-c\C-v" #'python-check)
(define-key map "\C-c\C-f" #'python-eldoc-at-point)
(define-key map "\C-c\C-d" #'python-describe-at-point)
+ ;; Import management
+ (define-key map "\C-c\C-ia" #'python-add-import)
+ (define-key map "\C-c\C-if" #'python-fix-imports)
+ (define-key map "\C-c\C-ir" #'python-remove-import)
+ (define-key map "\C-c\C-is" #'python-sort-imports)
;; Utilities
(substitute-key-definition #'complete-symbol #'completion-at-point
map global-map)
@@ -348,7 +379,17 @@
["Help on symbol" python-eldoc-at-point
:help "Get help on symbol at point"]
["Complete symbol" completion-at-point
- :help "Complete symbol before point"]))
+ :help "Complete symbol before point"]
+ "-----"
+ ["Add import" python-add-import
+ :help "Add an import statement to the top of this buffer"]
+ ["Remove import" python-remove-import
+ :help "Remove an import statement from the top of this buffer"]
+ ["Sort imports" python-sort-imports
+ :help "Sort the import statements at the top of this buffer"]
+ ["Fix imports" python-fix-imports
+ :help "Add missing imports and remove unused ones from the current
buffer"]
+ ))
map)
"Keymap for `python-mode'.")
@@ -488,16 +529,6 @@ The type returned can be `comment', `string' or `paren'."
(eql (syntax-class (syntax-after (point)))
(syntax-class (string-to-syntax ")"))))
-(define-obsolete-function-alias
- 'python-info-ppss-context #'python-syntax-context "24.3")
-
-(define-obsolete-function-alias
- 'python-info-ppss-context-type #'python-syntax-context-type "24.3")
-
-(define-obsolete-function-alias
- 'python-info-ppss-comment-or-string-p
- #'python-syntax-comment-or-string-p "24.3")
-
(defun python-font-lock-syntactic-face-function (state)
"Return syntactic face given STATE."
(if (nth 3 state)
@@ -506,11 +537,22 @@ The type returned can be `comment', `string' or `paren'."
font-lock-string-face)
font-lock-comment-face))
+(defconst python--f-string-start-regexp
+ (rx bow
+ (or "f" "F" "fr" "Fr" "fR" "FR" "rf" "rF" "Rf" "RF")
+ (or "\"" "\"\"\"" "'" "'''"))
+ "A regular expression matching the beginning of an f-string.
+
+See URL
`https://docs.python.org/3/reference/lexical_analysis.html#string-and-bytes-literals'.")
+
(defun python--f-string-p (ppss)
"Return non-nil if the pos where PPSS was found is inside an f-string."
(and (nth 3 ppss)
- (let ((spos (1- (nth 8 ppss))))
- (and (memq (char-after spos) '(?f ?F))
+ (let* ((spos (1- (nth 8 ppss)))
+ (before-quote
+ (buffer-substring-no-properties (max (- spos 4) (point-min))
+ (min (+ spos 2) (point-max)))))
+ (and (string-match-p python--f-string-start-regexp before-quote)
(or (< (point-min) spos)
(not (memq (char-syntax (char-before spos)) '(?w ?_))))))))
@@ -529,7 +571,7 @@ the {...} holes that appear within f-strings."
(while
(progn
(while (and (not (python--f-string-p ppss))
- (re-search-forward "\\<f['\"]" limit 'move))
+ (re-search-forward python--f-string-start-regexp limit
'move))
(setq ppss (syntax-ppss)))
(< (point) limit))
(cl-assert (python--f-string-p ppss))
@@ -902,17 +944,11 @@ It makes underscores and dots word constituent chars.")
;;; Indentation
-(define-obsolete-variable-alias
- 'python-indent 'python-indent-offset "24.3")
-
(defcustom python-indent-offset 4
"Default indentation offset for Python."
:type 'integer
:safe 'integerp)
-(define-obsolete-variable-alias
- 'python-guess-indent 'python-indent-guess-indent-offset "24.3")
-
(defcustom python-indent-guess-indent-offset t
"Non-nil tells Python mode to guess `python-indent-offset' value."
:type 'boolean
@@ -1524,6 +1560,10 @@ marks the next defun after the ones already marked."
The name of the defun should be grouped so it can be retrieved
via `match-string'.")
+(defvar python-nav-beginning-of-block-regexp
+ (python-rx line-start (* space) block-start)
+ "Regexp matching block start.")
+
(defun python-nav--beginning-of-defun (&optional arg)
"Internal implementation of `python-nav-beginning-of-defun'.
With positive ARG search backwards, else search forwards."
@@ -2300,6 +2340,16 @@ virtualenv."
"`compilation-error-regexp-alist' for inferior Python."
:type '(alist regexp))
+(defcustom python-shell-dedicated nil
+ "Whether to make Python shells dedicated by default.
+This option influences `run-python' when called without a prefix
+argument. If `buffer' or `project', create a Python shell
+dedicated to the current buffer or its project (if one is found)."
+ :version "29.1"
+ :type '(choice (const :tag "To buffer" buffer)
+ (const :tag "To project" project)
+ (const :tag "Not dedicated" nil)))
+
(defvar python-shell-output-filter-in-progress nil)
(defvar python-shell-output-filter-buffer nil)
@@ -2662,12 +2712,19 @@ from `python-shell-prompt-regexp',
(defun python-shell-get-process-name (dedicated)
"Calculate the appropriate process name for inferior Python process.
-If DEDICATED is t returns a string with the form
-`python-shell-buffer-name'[`buffer-name'] else returns the value
-of `python-shell-buffer-name'."
- (if dedicated
- (format "%s[%s]" python-shell-buffer-name (buffer-name))
- python-shell-buffer-name))
+If DEDICATED is nil, this is simply `python-shell-buffer-name'.
+If DEDICATED is `buffer' or `project', append the current buffer
+name respectively the current project name."
+ (pcase dedicated
+ ('nil python-shell-buffer-name)
+ ('project
+ (if-let ((proj (and (featurep 'project)
+ (project-current))))
+ (format "%s[%s]" python-shell-buffer-name (file-name-nondirectory
+ (directory-file-name
+ (project-root proj))))
+ python-shell-buffer-name))
+ (_ (format "%s[%s]" python-shell-buffer-name (buffer-name)))))
(defun python-shell-internal-get-process-name ()
"Calculate the appropriate process name for Internal Python process.
@@ -3030,8 +3087,8 @@ interpreter is run. Variables
`python-shell-font-lock-enable',
`python-shell-completion-setup-code',
`python-shell-completion-string-code',
-`python-eldoc-setup-code', `python-eldoc-string-code',
-`python-ffap-setup-code' and `python-ffap-string-code' can
+`python-eldoc-setup-code',
+`python-ffap-setup-code' can
customize this mode for different Python interpreters.
This mode resets `comint-output-filter-functions' locally, so you
@@ -3125,8 +3182,8 @@ killed."
Argument CMD defaults to `python-shell-calculate-command' return
value. When called interactively with `prefix-arg', it allows
the user to edit such value and choose whether the interpreter
-should be DEDICATED for the current buffer. When numeric prefix
-arg is other than 0 or 4 do not SHOW.
+should be DEDICATED to the current buffer or project. When
+numeric prefix arg is other than 0 or 4 do not SHOW.
For a given buffer and same values of DEDICATED, if a process is
already running for it, it will do nothing. This means that if
@@ -3140,15 +3197,47 @@ process buffer for a list of commands.)"
(if current-prefix-arg
(list
(read-shell-command "Run Python: " (python-shell-calculate-command))
- (y-or-n-p "Make dedicated process? ")
+ (alist-get (car (read-multiple-choice "Make dedicated process?"
+ '((?b "to buffer")
+ (?p "to project")
+ (?n "no"))))
+ '((?b . buffer) (?p . project)))
(= (prefix-numeric-value current-prefix-arg) 4))
- (list (python-shell-calculate-command) nil t)))
- (let ((buffer
- (python-shell-make-comint
- (or cmd (python-shell-calculate-command))
- (python-shell-get-process-name dedicated) show)))
+ (list (python-shell-calculate-command)
+ python-shell-dedicated
+ t)))
+ (let* ((project (and (eq 'project dedicated)
+ (featurep 'project)
+ (project-current t)))
+ (default-directory (if project
+ (project-root project)
+ default-directory))
+ (buffer (python-shell-make-comint
+ (or cmd (python-shell-calculate-command))
+ (python-shell-get-process-name dedicated)
+ show)))
(get-buffer-process buffer)))
+(defun python-shell-restart (&optional show)
+ "Restart the Python shell.
+Optional argument SHOW (interactively, the prefix argument), if
+non-nil, means also display the Python shell buffer."
+ (interactive "P")
+ (with-current-buffer
+ (or (and (derived-mode-p 'inferior-python-mode)
+ (current-buffer))
+ (seq-some (lambda (dedicated)
+ (get-buffer (format "*%s*" (python-shell-get-process-name
+ dedicated))))
+ '(buffer project nil))
+ (user-error "No Python shell"))
+ (when-let ((proc (get-buffer-process (current-buffer))))
+ (kill-process proc)
+ (while (accept-process-output proc)))
+ (python-shell-make-comint (python-shell-calculate-command)
+ (string-trim (buffer-name) "\\*" "\\*")
+ show)))
+
(defun run-python-internal ()
"Run an inferior Internal Python process.
Input and output via buffer named after
@@ -3176,15 +3265,13 @@ startup."
If current buffer is in `inferior-python-mode', return it."
(if (derived-mode-p 'inferior-python-mode)
(current-buffer)
- (let* ((dedicated-proc-name (python-shell-get-process-name t))
- (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
- (global-proc-name (python-shell-get-process-name nil))
- (global-proc-buffer-name (format "*%s*" global-proc-name))
- (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
- (global-running (comint-check-proc global-proc-buffer-name)))
- ;; Always prefer dedicated
- (or (and dedicated-running dedicated-proc-buffer-name)
- (and global-running global-proc-buffer-name)))))
+ (seq-some
+ (lambda (dedicated)
+ (let* ((proc-name (python-shell-get-process-name dedicated))
+ (buffer-name (format "*%s*" proc-name)))
+ (when (comint-check-proc buffer-name)
+ buffer-name)))
+ '(buffer project nil))))
(defun python-shell-get-process ()
"Return inferior Python process for current buffer."
@@ -3225,17 +3312,11 @@ be asked for their values."
"Instead call `python-shell-get-process' and create one if returns nil."
"25.1")
-(define-obsolete-variable-alias
- 'python-buffer 'python-shell-internal-buffer "24.3")
-
(defvar python-shell-internal-buffer nil
"Current internal shell buffer for the current buffer.
This is really not necessary at all for the code to work but it's
there for compatibility with CEDET.")
-(define-obsolete-variable-alias
- 'python-preoutput-result 'python-shell-internal-last-output "24.3")
-
(defvar python-shell-internal-last-output nil
"Last output captured by the internal shell.
This is really not necessary at all for the code to work but it's
@@ -3248,9 +3329,6 @@ there for compatibility with CEDET.")
(get-process proc-name)
(run-python-internal))))
-(define-obsolete-function-alias
- 'python-proc #'python-shell-internal-get-or-create-process "24.3")
-
(defun python-shell--save-temp-file (string)
(let* ((temporary-file-directory
(if (file-remote-p default-directory)
@@ -3335,15 +3413,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
@@ -3352,7 +3440,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)
@@ -3367,12 +3455,6 @@ Returns the output. See
`python-shell-send-string-no-output'."
(replace-regexp-in-string "_emacs_out +" "" string)
(python-shell-internal-get-or-create-process))))
-(define-obsolete-function-alias
- 'python-send-receive #'python-shell-internal-send-string "24.3")
-
-(define-obsolete-function-alias
- 'python-send-string #'python-shell-internal-send-string "24.3")
-
(defun python-shell-buffer-substring (start end &optional nomain no-cookie)
"Send buffer substring from START to END formatted for shell.
This is a wrapper over `buffer-substring' that takes care of
@@ -3987,7 +4069,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)))
@@ -3997,15 +4080,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)
@@ -4018,7 +4104,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
@@ -4285,7 +4375,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
@@ -4538,9 +4630,6 @@ JUSTIFY should be used (if applicable) as in
`fill-paragraph'."
;;; Skeletons
-(define-obsolete-variable-alias
- 'python-use-skeletons 'python-skeleton-autoinsert "24.3")
-
(defcustom python-skeleton-autoinsert nil
"Non-nil means template skeletons will be automagically inserted.
This happens when pressing \"if<SPACE>\", for example, to prompt for
@@ -4713,6 +4802,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))"
@@ -4831,7 +4922,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
@@ -4916,9 +5009,37 @@ Interactively, prompt for symbol."
(defun python-hideshow-forward-sexp-function (_arg)
"Python specific `forward-sexp' function for `hs-minor-mode'.
Argument ARG is ignored."
- (python-nav-end-of-defun)
- (unless (python-info-current-line-empty-p)
- (backward-char)))
+ (python-nav-end-of-block))
+
+(defun python-hideshow-find-next-block (regexp maxp comments)
+ "Python specific `hs-find-next-block' function for `hs-minor-mode'.
+Call `python-nav-forward-block' to find next block and check if
+block-start ends within MAXP. If COMMENTS is not nil, comments
+are also searched. REGEXP is passed to `looking-at' to set
+`match-data'."
+ (let* ((next-block (save-excursion
+ (or (and
+ (python-info-looking-at-beginning-of-block)
+ (re-search-forward
+ (python-rx block-start) maxp t))
+ (and (python-nav-forward-block)
+ (< (point) maxp)
+ (re-search-forward
+ (python-rx block-start) maxp t))
+ (1+ maxp))))
+ (next-comment
+ (or (when comments
+ (save-excursion
+ (cl-loop while (re-search-forward "#" maxp t)
+ if (python-syntax-context 'comment)
+ return (point))))
+ (1+ maxp)))
+ (next-block-or-comment (min next-block next-comment)))
+ (when (<= next-block-or-comment maxp)
+ (goto-char next-block-or-comment)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at regexp)))))
;;; Imenu
@@ -5408,13 +5529,23 @@ operator."
"Check if point is at `beginning-of-defun' using SYNTAX-PPSS.
When CHECK-STATEMENT is non-nil, the current statement is checked
instead of the current physical line."
- (and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss))))
- (save-excursion
- (when check-statement
- (python-nav-beginning-of-statement))
- (beginning-of-line 1)
+ (save-excursion
+ (when check-statement
+ (python-nav-beginning-of-statement))
+ (beginning-of-line 1)
+ (and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss))))
(looking-at python-nav-beginning-of-defun-regexp))))
+(defun python-info-looking-at-beginning-of-block ()
+ "Check if point is at the beginning of block."
+ (let ((pos (point)))
+ (save-excursion
+ (python-nav-beginning-of-statement)
+ (beginning-of-line)
+ (and
+ (<= (point) pos (+ (point) (current-indentation)))
+ (looking-at python-nav-beginning-of-block-regexp)))))
+
(defun python-info-current-line-comment-p ()
"Return non-nil if current line is a comment line."
(char-equal
@@ -5539,6 +5670,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."
@@ -5780,6 +5918,225 @@ REPORT-FN is Flymake's callback function."
(process-send-eof python--flymake-proc))))
+;;; Import management
+(defconst python--list-imports "\
+from isort import find_imports_in_stream, find_imports_in_paths
+from sys import argv, stdin
+
+query, files, result = argv[1] or None, argv[2:], {}
+
+if files:
+ imports = find_imports_in_paths(files, top_only=True)
+else:
+ imports = find_imports_in_stream(stdin, top_only=True)
+
+for imp in imports:
+ if query is None or query == (imp.alias or imp.attribute or imp.module):
+ key = (imp.module, imp.attribute or '', imp.alias or '')
+ if key not in result:
+ result[key] = imp.statement()
+
+for key in sorted(result):
+ print(result[key])
+"
+ "Script to list import statements in Python code.")
+
+(defvar python-import-history nil
+ "History variable for `python-import' commands.")
+
+(defun python--import-sources ()
+ "List files containing Python imports that may be useful in the current
buffer."
+ (if-let (((featurep 'project)) ;For compatibility with Emacs < 26
+ (proj (project-current)))
+ (seq-filter (lambda (s) (string-match-p "\\.py[ciw]?\\'" s))
+ (project-files proj))
+ (list default-directory)))
+
+(defun python--list-imports (name source)
+ "List all Python imports matching NAME in SOURCE.
+If NAME is nil, list all imports. SOURCE can be a buffer or a
+list of file names or directories; the latter are searched
+recursively."
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let* ((temp (current-buffer))
+ (status (if (bufferp source)
+ (with-current-buffer source
+ (call-process-region (point-min) (point-max)
+ python-interpreter
+ nil (list temp nil) nil
+ "-c" python--list-imports
+ (or name "")))
+ (with-current-buffer buffer
+ (apply #'call-process
+ python-interpreter
+ nil (list temp nil) nil
+ "-c" python--list-imports
+ (or name "")
+ (mapcar #'file-local-name source)))))
+ lines)
+ (unless (eq 0 status)
+ (error "%s exited with status %s (maybe isort is missing?)"
+ python-interpreter status))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (buffer-substring-no-properties (point) (pos-eol))
+ lines)
+ (forward-line 1))
+ (nreverse lines)))))
+
+(defun python--query-import (name source prompt)
+ "Read a Python import statement defining NAME.
+A list of candidates is produced by `python--list-imports' using
+the NAME and SOURCE arguments. An interactive query, using the
+PROMPT string, is made unless there is a single candidate."
+ (let* ((cands (python--list-imports name source))
+ ;; Don't use DEF argument of `completing-read', so it is able
+ ;; to return the empty string.
+ (minibuffer-default-add-function
+ (lambda ()
+ (setq minibuffer-default (with-minibuffer-selected-window
+ (thing-at-point 'symbol)))))
+ (statement (cond ((and name (length= cands 1))
+ (car cands))
+ (prompt
+ (completing-read prompt
+ (or cands python-import-history)
+ nil nil nil
+ 'python-import-history)))))
+ (unless (string-empty-p statement)
+ statement)))
+
+(defun python--do-isort (&rest args)
+ "Edit the current buffer using isort called with ARGS.
+Return non-nil if the buffer was actually modified."
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let ((temp (current-buffer)))
+ (with-current-buffer buffer
+ (let ((status (apply #'call-process-region
+ (point-min) (point-max)
+ python-interpreter
+ nil (list temp nil) nil
+ "-m" "isort" "-" args))
+ (tick (buffer-chars-modified-tick)))
+ (unless (eq 0 status)
+ (error "%s exited with status %s (maybe isort is missing?)"
+ python-interpreter status))
+ (replace-buffer-contents temp)
+ (not (eq tick (buffer-chars-modified-tick)))))))))
+
+;;;###autoload
+(defun python-add-import (name)
+ "Add an import statement to the current buffer.
+
+Interactively, ask for an import statement using all imports
+found in the current project as suggestions. With a prefix
+argument, restrict the suggestions to imports defining the symbol
+at point. If there is only one such suggestion, act without
+asking.
+
+When calling from Lisp, use a non-nil NAME to restrict the
+suggestions to imports defining NAME."
+ (interactive (list (when current-prefix-arg (thing-at-point 'symbol))))
+ (when-let ((statement (python--query-import name
+ (python--import-sources)
+ "Add import: ")))
+ (if (python--do-isort "--add" statement)
+ (message "Added `%s'" statement)
+ (message "(No changes in Python imports needed)"))))
+
+;;;###autoload
+(defun python-import-symbol-at-point ()
+ "Add an import statement for the symbol at point to the current buffer.
+This works like `python-add-import', but with the opposite
+behavior regarding the prefix argument."
+ (interactive nil)
+ (python-add-import (unless current-prefix-arg (thing-at-point 'symbol))))
+
+;;;###autoload
+(defun python-remove-import (name)
+ "Remove an import statement from the current buffer.
+
+Interactively, ask for an import statement to remove, displaying
+the imports of the current buffer as suggestions. With a prefix
+argument, restrict the suggestions to imports defining the symbol
+at point. If there is only one such suggestion, act without
+asking."
+ (interactive (list (when current-prefix-arg (thing-at-point 'symbol))))
+ (when-let ((statement (python--query-import name (current-buffer)
+ "Remove import: ")))
+ (if (python--do-isort "--rm" statement)
+ (message "Removed `%s'" statement)
+ (message "(No changes in Python imports needed)"))))
+
+;;;###autoload
+(defun python-sort-imports ()
+ "Sort Python imports in the current buffer."
+ (interactive)
+ (if (python--do-isort)
+ (message "Sorted imports")
+ (message "(No changes in Python imports needed)")))
+
+;;;###autoload
+(defun python-fix-imports ()
+ "Add missing imports and remove unused ones from the current buffer."
+ (interactive)
+ (let ((buffer (current-buffer))
+ undefined unused add remove)
+ ;; Compute list of undefined and unused names
+ (with-temp-buffer
+ (let ((temp (current-buffer)))
+ (with-current-buffer buffer
+ (call-process-region (point-min) (point-max)
+ python-interpreter
+ nil temp nil
+ "-m" "pyflakes"))
+ (goto-char (point-min))
+ (when (looking-at-p ".* No module named pyflakes$")
+ (error "%s couldn't find pyflakes" python-interpreter))
+ (while (not (eobp))
+ (cond ((looking-at ".* undefined name '\\([^']+\\)'$")
+ (push (match-string 1) undefined))
+ ((looking-at ".*'\\([^']+\\)' imported but unused$")
+ (push (match-string 1) unused)))
+ (forward-line 1))))
+ ;; Compute imports to be added
+ (dolist (name (seq-uniq undefined))
+ (when-let ((statement (python--query-import name
+ (python--import-sources)
+ (format "\
+Add import for undefined name `%s' (empty to skip): "
+ name))))
+ (push statement add)))
+ ;; Compute imports to be removed
+ (dolist (name (seq-uniq unused))
+ ;; The unused imported names, as provided by pyflakes, are of
+ ;; the form "module.var" or "module.var as alias", independently
+ ;; of style of import statement used.
+ (let* ((filter
+ (lambda (statement)
+ (string= name
+ (thread-last
+ statement
+ (replace-regexp-in-string "^\\(from\\|import\\) "
"")
+ (replace-regexp-in-string " import " ".")))))
+ (statements (seq-filter filter (python--list-imports nil
buffer))))
+ (when (length= statements 1)
+ (push (car statements) remove))))
+ ;; Edit buffer and say goodbye
+ (if (not (or add remove))
+ (message "(No changes in Python imports needed)")
+ (apply #'python--do-isort
+ (append (mapcan (lambda (x) (list "--add" x)) add)
+ (mapcan (lambda (x) (list "--rm" x)) remove)))
+ (message "%s" (concat (when add "Added ")
+ (when add (string-join add ", "))
+ (when remove (if add " and removed " "Removed "))
+ (when remove (string-join remove ", " )))))))
+
+
+;;; Major mode
(defun python-electric-pair-string-delimiter ()
(when (and electric-pair-mode
(memq last-command-event '(?\" ?\'))
@@ -5870,14 +6227,17 @@ REPORT-FN is Flymake's callback function."
(add-to-list
'hs-special-modes-alist
- '(python-mode
- "\\s-*\\_<\\(?:def\\|class\\)\\_>"
+ `(python-mode
+ ,python-nav-beginning-of-block-regexp
;; Use the empty string as end regexp so it doesn't default to
;; "\\s)". This way parens at end of defun are properly hidden.
""
"#"
python-hideshow-forward-sexp-function
- nil))
+ nil
+ python-nav-beginning-of-block
+ python-hideshow-find-next-block
+ python-info-looking-at-beginning-of-block))
(setq-local outline-regexp (python-rx (* space) block-start))
(setq-local outline-level
@@ -5898,8 +6258,10 @@ REPORT-FN is Flymake's callback function."
;;; Completion predicates for M-x
;; Commands that only make sense when editing Python code
-(dolist (sym '(python-check
+(dolist (sym '(python-add-import
+ python-check
python-fill-paragraph
+ python-fix-imports
python-indent-dedent-line
python-indent-dedent-line-backspace
python-indent-guess-indent-offset
@@ -5924,9 +6286,11 @@ REPORT-FN is Flymake's callback function."
python-nav-forward-statement
python-nav-if-name-main
python-nav-up-list
+ python-remove-import
python-shell-send-buffer
python-shell-send-defun
- python-shell-send-statement))
+ python-shell-send-statement
+ python-sort-imports))
(put sym 'completion-predicate #'python--completion-predicate))
(defun python-shell--completion-predicate (_ buffer)
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 be9f325d93..558b62b20a 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -31,6 +31,9 @@
;; available for filenames, variables known from the script, the shell and
;; the environment as well as commands.
+;; A Flymake backend using the "shellcheck" program is provided. See
+;; https://www.shellcheck.net/ for installation instructions.
+
;;; Known Bugs:
;; - In Bourne the keyword `in' is not anchored to case, for, select ...
@@ -141,7 +144,9 @@
(eval-when-compile
(require 'skeleton)
(require 'cl-lib)
- (require 'comint))
+ (require 'comint)
+ (require 'let-alist)
+ (require 'subr-x))
(require 'executable)
(autoload 'comint-completion-at-point "comint")
@@ -1580,6 +1585,7 @@ with your script for an edit-interpret-debug cycle."
((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
(t sh-shell-file))
nil nil)
+ (add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t)
(add-hook 'hack-local-variables-hook
#'sh-after-hack-local-variables nil t))
@@ -2982,14 +2988,6 @@ option followed by a colon `:' if the option accepts an
argument."
(match-string 1))))))
-(defun sh-maybe-here-document (arg)
- "Insert self. Without prefix, following unquoted `<' inserts here document.
-The document is bounded by `sh-here-document-word'."
- (declare (obsolete sh-electric-here-document-mode "24.3"))
- (interactive "*P")
- (self-insert-command (prefix-numeric-value arg))
- (or arg (sh--maybe-here-document)))
-
(defun sh--maybe-here-document ()
(when (and (looking-back "[^<]<<[ E-]" (line-beginning-position))
(save-excursion
@@ -3111,6 +3109,88 @@ shell command and conveniently use this command."
(delete-region (1+ (point))
(progn (skip-chars-backward " \t") (point)))))))
+;;; Flymake backend
+
+(defcustom sh-shellcheck-program "shellcheck"
+ "Name of the shellcheck executable."
+ :type 'string
+ :version "29.1")
+
+(defcustom sh-shellcheck-arguments nil
+ "Additional arguments to the shellcheck program."
+ :type '(repeat string)
+ :version "29.1")
+
+(defvar-local sh--shellcheck-process nil)
+
+(defalias 'sh--json-read
+ (if (fboundp 'json-parse-buffer)
+ (lambda () (json-parse-buffer :object-type 'alist))
+ (require 'json)
+ 'json-read))
+
+(defun sh-shellcheck-flymake (report-fn &rest _args)
+ "Flymake backend using the shellcheck program.
+Takes a Flymake callback REPORT-FN as argument, as expected of a
+member of `flymake-diagnostic-functions'."
+ (when (process-live-p sh--shellcheck-process)
+ (kill-process sh--shellcheck-process))
+ (let* ((source (current-buffer))
+ (dialect (named-let recur ((s sh-shell))
+ (pcase s
+ ((or 'bash 'dash 'sh) (symbol-name s))
+ ('ksh88 "ksh")
+ ((guard s)
+ (recur (alist-get s sh-ancestor-alist))))))
+ (sentinel
+ (lambda (proc _event)
+ (when (memq (process-status proc) '(exit signal))
+ (unwind-protect
+ (if (with-current-buffer source
+ (not (eq proc sh--shellcheck-process)))
+ (flymake-log :warning "Canceling obsolete check %s" proc)
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (thread-last
+ (sh--json-read)
+ (alist-get 'comments)
+ (seq-filter
+ (lambda (item)
+ (let-alist item (string= .file "-"))))
+ (mapcar
+ (lambda (item)
+ (let-alist item
+ (flymake-make-diagnostic
+ source
+ (cons .line .column)
+ (unless (and (eq .line .endLine)
+ (eq .column .endColumn))
+ (cons .endLine .endColumn))
+ (pcase .level
+ ("error" :error)
+ ("warning" :warning)
+ (_ :note))
+ (format "SC%s: %s" .code .message)))))
+ (funcall report-fn))))
+ (kill-buffer (process-buffer proc)))))))
+ (unless dialect
+ (error "`sh-shellcheck-flymake' is not suitable for shell type `%s'"
+ sh-shell))
+ (setq sh--shellcheck-process
+ (make-process
+ :name "shellcheck" :noquery t :connection-type 'pipe
+ :buffer (generate-new-buffer " *flymake-shellcheck*")
+ :command `(,sh-shellcheck-program
+ "--format=json1"
+ "-s" ,dialect
+ ,@sh-shellcheck-arguments
+ "-")
+ :sentinel sentinel))
+ (save-restriction
+ (widen)
+ (process-send-region sh--shellcheck-process (point-min) (point-max))
+ (process-send-eof sh--shellcheck-process))))
+
(provide 'sh-script)
;;; sh-script.el ends here
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index e06eb9a6f7..34327f756e 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -79,12 +79,11 @@
"\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
"Regexp used by `subword-backward-internal'.")
-(defvar subword-mode-map
+(defvar-keymap subword-mode-map
;; We originally remapped motion keys here, but now use Emacs core
;; hooks. Leave this keymap around so that user additions to it
;; keep working.
- (make-sparse-keymap)
- "Keymap used in `subword-mode' minor mode.")
+ :doc "Keymap used in `subword-mode' minor mode.")
;;;###autoload
(define-obsolete-function-alias
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index fa799a0fb3..310a9be4f6 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)
@@ -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 f3db971bcf..bb36688ef8 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
-;; Version: 1.5.0
+;; Version: 1.5.1
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -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"))))
@@ -1764,6 +1771,12 @@ utility function used by commands like
`dired-do-find-regexp' and
:version "28.1"
:package-version '(xref . "1.0.4"))
+(defmacro xref--with-connection-local-variables (&rest body)
+ (declare (debug t))
+ (if (>= emacs-major-version 27)
+ `(with-connection-local-variables ,@body)
+ `(progn ,@body)))
+
;;;###autoload
(defun xref-matches-in-files (regexp files)
"Find all matches for REGEXP in FILES.
@@ -1810,13 +1823,14 @@ to control which program to use when looking for
matches."
(insert (mapconcat #'identity files "\0"))
(setq default-directory dir)
(setq status
- (xref--process-file-region (point-min)
- (point-max)
- shell-file-name
- output
- nil
- shell-command-switch
- command)))
+ (xref--with-connection-local-variables
+ (xref--process-file-region (point-min)
+ (point-max)
+ shell-file-name
+ output
+ nil
+ shell-command-switch
+ command))))
(goto-char (point-min))
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
diff --git a/lisp/recentf.el b/lisp/recentf.el
index b80ee3dd7d..32badb1a37 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -411,7 +411,8 @@ returned nil."
"Convert file NAME to absolute, and canonicalize it.
NAME is first passed to the function `expand-file-name', then to
`recentf-filename-handlers' to post process it."
- (recentf-apply-filename-handlers (expand-file-name name)))
+ (let ((non-essential t))
+ (recentf-apply-filename-handlers (expand-file-name name))))
(defun recentf-include-p (filename)
"Return non-nil if FILENAME should be included in the recent list.
diff --git a/lisp/repeat.el b/lisp/repeat.el
index a32f3a4c50..0ae68d6024 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -89,9 +89,15 @@
;;;;; ************************* USER OPTIONS ************************** ;;;;;
+(defgroup repeat nil
+ "Convenient way to repeat previous commands."
+ :prefix "repeat-"
+ :version "29.1"
+ :group 'convenience)
+
(defcustom repeat-too-dangerous '(kill-this-buffer)
"Commands too dangerous to repeat with \\[repeat]."
- :group 'convenience
+ :group 'repeat
:type '(repeat function))
;; If the last command was self-insert-command, the char to be inserted was
@@ -120,7 +126,7 @@ if `repeat' is bound to C-x z, typing C-x z z z repeats the
previous command
3 times. If this variable is a sequence of characters, then re-execution
only occurs if the final character by which `repeat' was invoked is a
member of that sequence. If this variable is nil, no re-execution occurs."
- :group 'convenience
+ :group 'repeat
:type '(choice (const :tag "Repeat for all keys" t)
(const :tag "Don't repeat" nil)
(sexp :tag "Repeat for specific keys")))
@@ -338,8 +344,8 @@ recently executed command not bound to an input event\"."
"Key that stops the modal repeating of keys in sequence.
For example, you can set it to <return> like `isearch-exit'."
:type '(choice (const :tag "No special key to exit repeating sequence" nil)
- (key-sequence :tag "Key that exits repeating sequence"))
- :group 'convenience
+ (key :tag "Kbd keys that exit repeating sequence"))
+ :group 'repeat
:version "28.1")
(defcustom repeat-exit-timeout nil
@@ -350,16 +356,19 @@ You can also set the property `repeat-exit-timeout' on
the command symbol.
This property can override the value of this variable."
:type '(choice (const :tag "No timeout to exit repeating sequence" nil)
(number :tag "Timeout in seconds to exit repeating"))
- :group 'convenience
+ :group 'repeat
:version "28.1")
+(defvar repeat-exit-function nil
+ "Function that exits the repeating sequence.")
+
(defvar repeat-exit-timer nil
"Timer activated after the last key typed in the repeating key sequence.")
(defcustom repeat-keep-prefix nil
"Whether to keep the prefix arg of the previous command when repeating."
:type 'boolean
- :group 'convenience
+ :group 'repeat
:version "28.1")
(defcustom repeat-check-key t
@@ -377,7 +386,7 @@ When the variable value is non-nil, but the property value
is `no',
then don't check the last key. Also when the variable value is nil,
but the property value is `t', then check the last key."
:type 'boolean
- :group 'convenience
+ :group 'repeat
:version "28.1")
(defcustom repeat-echo-function #'repeat-echo-message
@@ -390,7 +399,7 @@ a repeating map, or nil after deactivating the transient
repeating mode."
repeat-echo-mode-line)
(const :tag "No visual feedback" ignore)
(function :tag "Function"))
- :group 'convenience
+ :group 'repeat
:version "28.1")
(defvar repeat-in-progress nil
@@ -408,7 +417,7 @@ the map can't be set on the command symbol property
`repeat-map'.")
When Repeat mode is enabled, and the command symbol has the property named
`repeat-map', this map is activated temporarily for the next command.
See `describe-repeat-maps' for a list of all repeatable commands."
- :global t :group 'convenience
+ :global t :group 'repeat
(if (not repeat-mode)
(remove-hook 'post-command-hook 'repeat-post-hook)
(add-hook 'post-command-hook 'repeat-post-hook)
@@ -466,36 +475,47 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
;; Adding an exit key
(when repeat-exit-key
- (define-key map repeat-exit-key 'ignore))
+ (define-key map (if (key-valid-p repeat-exit-key)
+ (kbd repeat-exit-key)
+ repeat-exit-key)
+ 'ignore))
(when (and repeat-keep-prefix (not prefix-arg))
(setq prefix-arg current-prefix-arg))
(setq repeat-in-progress t)
(let ((exitfun (set-transient-map map)))
-
- (when repeat-exit-timer
- (cancel-timer repeat-exit-timer)
- (setq repeat-exit-timer nil))
+ (repeat--exit)
+ (setq repeat-exit-function exitfun)
(let* ((prop (repeat--command-property 'repeat-exit-timeout))
(timeout (unless (eq prop 'no) (or prop
repeat-exit-timeout))))
(when timeout
(setq repeat-exit-timer
- (run-with-idle-timer
- timeout nil
- (lambda ()
- (setq repeat-in-progress nil)
- (funcall exitfun)
- (funcall repeat-echo-function nil))))))))))))
+ (run-with-idle-timer timeout nil
#'repeat-exit))))))))))
(setq repeat-map nil)
(setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command))
(when (and was-in-progress (not repeat-in-progress))
- (when repeat-exit-timer
- (cancel-timer repeat-exit-timer)
- (setq repeat-exit-timer nil))
- (funcall repeat-echo-function nil))))
+ (repeat-exit))))
+
+;;;###autoload
+(defun repeat-exit ()
+ "Exit the repeating sequence.
+This function can be used to force exit of repetition while it's active."
+ (interactive)
+ (setq repeat-in-progress nil)
+ (repeat--exit)
+ (funcall repeat-echo-function nil))
+
+(defun repeat--exit ()
+ "Internal function to clean up previously set exit function and timer."
+ (when repeat-exit-timer
+ (cancel-timer repeat-exit-timer)
+ (setq repeat-exit-timer nil))
+ (when repeat-exit-function
+ (funcall repeat-exit-function)
+ (setq repeat-exit-function nil)))
(defun repeat-echo-message-string (keymap)
"Return a string with a list of repeating keys."
@@ -510,7 +530,9 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
(if repeat-exit-key
(substitute-command-keys
(format ", or exit with \\`%s'"
- (key-description repeat-exit-key)))
+ (if (key-valid-p repeat-exit-key)
+ repeat-exit-key
+ (key-description repeat-exit-key))))
""))))
(defun repeat-echo-message (keymap)
diff --git a/lisp/replace.el b/lisp/replace.el
index 2bb9c1b90d..8f81ec33a6 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -73,14 +73,6 @@ See `query-replace-from-history-variable' and
This is a list of cons cells (FROM-STRING . TO-STRING), or nil
if there are no default values.")
-(defvar query-replace-interactive nil
- "Non-nil means `query-replace' uses the last search string.
-That becomes the \"string to replace\".")
-(make-obsolete-variable 'query-replace-interactive
- "use `M-n' to pull the last incremental search string
-to the minibuffer that reads the string to replace, or invoke replacements
-from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
-
(defcustom query-replace-from-to-separator " → "
"String that separates FROM and TO in the history of replacement pairs.
When nil, the pair will not be added to the history (same behavior
@@ -213,96 +205,94 @@ by this function to the end of values available via
Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp.
The return value can also be a pair (FROM . TO) indicating that the user
wants to replace FROM with TO."
- (if query-replace-interactive
- (car (if regexp-flag regexp-search-ring search-ring))
- (let* ((history-add-new-input nil)
- (separator-string
- (when query-replace-from-to-separator
- ;; Check if the first non-whitespace char is displayable
- (if (char-displayable-p
- (string-to-char (string-replace
- " " "" query-replace-from-to-separator)))
- query-replace-from-to-separator
- " -> ")))
- (separator
- (when separator-string
- (propertize separator-string
- 'display separator-string
- 'face 'minibuffer-prompt
- 'separator t)))
- (minibuffer-history
- (append
- (when separator
- (mapcar (lambda (from-to)
- (concat (query-replace-descr (car from-to))
- separator
- (query-replace-descr (cdr from-to))))
- query-replace-defaults))
- (symbol-value query-replace-from-history-variable)))
- (minibuffer-allow-text-properties t) ; separator uses text-properties
- (default (when (and query-replace-read-from-default (not
regexp-flag))
- (funcall query-replace-read-from-default)))
- (prompt
- (cond ((and query-replace-read-from-regexp-default regexp-flag)
prompt)
- (default (format-prompt prompt default))
- ((and query-replace-defaults separator)
- (format-prompt prompt (car minibuffer-history)))
- (query-replace-defaults
- (format-prompt
- prompt (format "%s -> %s"
- (query-replace-descr
- (caar query-replace-defaults))
- (query-replace-descr
- (cdar query-replace-defaults)))))
- (t (format-prompt prompt nil))))
- (from
- ;; The save-excursion here is in case the user marks and copies
- ;; a region in order to specify the minibuffer input.
- ;; That should not clobber the region for the query-replace itself.
- (save-excursion
- (minibuffer-with-setup-hook
- (lambda ()
- (setq-local text-property-default-nonsticky
- (append '((separator . t) (face . t))
- text-property-default-nonsticky)))
- (if regexp-flag
- (read-regexp
- (if query-replace-read-from-regexp-default
- (string-remove-suffix ": " prompt)
- prompt)
- query-replace-read-from-regexp-default
- 'minibuffer-history)
- (read-from-minibuffer
- prompt nil nil nil nil
- (if default
- (delete-dups
- (cons default (query-replace-read-from-suggestions)))
- (query-replace-read-from-suggestions))
- t)))))
- (to))
- (if (and (zerop (length from)) query-replace-defaults (not default))
- (cons (caar query-replace-defaults)
- (query-replace-compile-replacement
- (cdar query-replace-defaults) regexp-flag))
- (setq from (or (and (zerop (length from)) default)
- (query-replace--split-string from)))
- (when (consp from) (setq to (cdr from) from (car from)))
- (add-to-history query-replace-from-history-variable from nil t)
- ;; Warn if user types \n or \t, but don't reject the input.
- (and regexp-flag
- (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)"
from)
- (let ((match (match-string 3 from)))
- (cond
- ((string= match "\\n")
- (message "Note: `\\n' here doesn't match a newline; to do
that, type C-q C-j instead"))
- ((string= match "\\t")
- (message "Note: `\\t' here doesn't match a tab; to do that,
just type TAB")))
- (sit-for 2)))
- (if (not to)
- from
- (add-to-history query-replace-to-history-variable to nil t)
- (add-to-history 'query-replace-defaults (cons from to) nil t)
- (cons from (query-replace-compile-replacement to regexp-flag)))))))
+ (let* ((history-add-new-input nil)
+ (separator-string
+ (when query-replace-from-to-separator
+ ;; Check if the first non-whitespace char is displayable
+ (if (char-displayable-p
+ (string-to-char (string-replace
+ " " "" query-replace-from-to-separator)))
+ query-replace-from-to-separator
+ " -> ")))
+ (separator
+ (when separator-string
+ (propertize separator-string
+ 'display separator-string
+ 'face 'minibuffer-prompt
+ 'separator t)))
+ (minibuffer-history
+ (append
+ (when separator
+ (mapcar (lambda (from-to)
+ (concat (query-replace-descr (car from-to))
+ separator
+ (query-replace-descr (cdr from-to))))
+ query-replace-defaults))
+ (symbol-value query-replace-from-history-variable)))
+ (minibuffer-allow-text-properties t) ; separator uses text-properties
+ (default (when (and query-replace-read-from-default (not regexp-flag))
+ (funcall query-replace-read-from-default)))
+ (prompt
+ (cond ((and query-replace-read-from-regexp-default regexp-flag)
prompt)
+ (default (format-prompt prompt default))
+ ((and query-replace-defaults separator)
+ (format-prompt prompt (car minibuffer-history)))
+ (query-replace-defaults
+ (format-prompt
+ prompt (format "%s -> %s"
+ (query-replace-descr
+ (caar query-replace-defaults))
+ (query-replace-descr
+ (cdar query-replace-defaults)))))
+ (t (format-prompt prompt nil))))
+ (from
+ ;; The save-excursion here is in case the user marks and copies
+ ;; a region in order to specify the minibuffer input.
+ ;; That should not clobber the region for the query-replace itself.
+ (save-excursion
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local text-property-default-nonsticky
+ (append '((separator . t) (face . t))
+ text-property-default-nonsticky)))
+ (if regexp-flag
+ (read-regexp
+ (if query-replace-read-from-regexp-default
+ (string-remove-suffix ": " prompt)
+ prompt)
+ query-replace-read-from-regexp-default
+ 'minibuffer-history)
+ (read-from-minibuffer
+ prompt nil nil nil nil
+ (if default
+ (delete-dups
+ (cons default (query-replace-read-from-suggestions)))
+ (query-replace-read-from-suggestions))
+ t)))))
+ (to))
+ (if (and (zerop (length from)) query-replace-defaults (not default))
+ (cons (caar query-replace-defaults)
+ (query-replace-compile-replacement
+ (cdar query-replace-defaults) regexp-flag))
+ (setq from (or (and (zerop (length from)) default)
+ (query-replace--split-string from)))
+ (when (consp from) (setq to (cdr from) from (car from)))
+ (add-to-history query-replace-from-history-variable from nil t)
+ ;; Warn if user types \n or \t, but don't reject the input.
+ (and regexp-flag
+ (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
+ (let ((match (match-string 3 from)))
+ (cond
+ ((string= match "\\n")
+ (message "Note: `\\n' here doesn't match a newline; to do that,
type C-q C-j instead"))
+ ((string= match "\\t")
+ (message "Note: `\\t' here doesn't match a tab; to do that,
just type TAB")))
+ (sit-for 2)))
+ (if (not to)
+ from
+ (add-to-history query-replace-to-history-variable to nil t)
+ (add-to-history 'query-replace-defaults (cons from to) nil t)
+ (cons from (query-replace-compile-replacement to regexp-flag))))))
(defun query-replace-compile-replacement (to regexp-flag)
"Maybe convert a regexp replacement TO to Lisp.
@@ -448,6 +438,10 @@ Arguments FROM-STRING, TO-STRING, DELIMITED, START, END,
BACKWARD, and
REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see).
To customize possible responses, change the bindings in `query-replace-map'."
+ (declare (interactive-args
+ (start (use-region-beginning))
+ (end (use-region-end))
+ (region-noncontiguous-p (use-region-noncontiguous-p))))
(interactive
(let ((common
(query-replace-read-args
@@ -461,10 +455,9 @@ To customize possible responses, change the bindings in
`query-replace-map'."
;; These are done separately here
;; so that command-history will record these expressions
;; rather than the values they had this time.
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
+ (use-region-beginning) (use-region-end)
(nth 3 common)
- (if (use-region-p) (region-noncontiguous-p)))))
+ (use-region-noncontiguous-p))))
(perform-replace from-string to-string t nil delimited nil nil start end
backward region-noncontiguous-p))
(define-key esc-map "%" 'query-replace)
@@ -541,6 +534,10 @@ Use \\[repeat-complex-command] after this command for
details.
Arguments REGEXP, TO-STRING, DELIMITED, START, END, BACKWARD, and
REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see)."
+ (declare (interactive-args
+ (start (use-region-beginning))
+ (end (use-region-end))
+ (region-noncontiguous-p (use-region-noncontiguous-p))))
(interactive
(let ((common
(query-replace-read-args
@@ -555,10 +552,9 @@ REGION-NONCONTIGUOUS-P are passed to `perform-replace'
(which see)."
;; These are done separately here
;; so that command-history will record these expressions
;; rather than the values they had this time.
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
+ (use-region-beginning) (use-region-end)
(nth 3 common)
- (if (use-region-p) (region-noncontiguous-p)))))
+ (use-region-noncontiguous-p))))
(perform-replace regexp to-string t t delimited nil nil start end backward
region-noncontiguous-p))
(define-key esc-map [?\C-%] 'query-replace-regexp)
@@ -592,6 +588,10 @@ Fourth and fifth arg START and END specify the region to
operate on.
Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to
`perform-replace' (which see)."
+ (declare (interactive-args
+ (start (use-region-beginning))
+ (end (use-region-end))
+ (region-noncontiguous-p (use-region-noncontiguous-p))))
(interactive
(let* ((from (read-regexp "Map query replace (regexp): " nil
query-replace-from-history-variable))
@@ -603,9 +603,8 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P
are passed to
(list from to
(and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
- (if (use-region-p) (region-noncontiguous-p)))))
+ (use-region-beginning) (use-region-end)
+ (use-region-noncontiguous-p))))
(let (replacements)
(if (listp to-strings)
(setq replacements to-strings)
@@ -665,9 +664,10 @@ which will run faster and will not set the mark or print
anything.
and TO-STRING is also null.)"
(declare (interactive-only
"use `search-forward' and `replace-match' instead.")
- (interactive-args
+ (interactive-args
(start (use-region-beginning))
- (end (use-region-end))))
+ (end (use-region-end))
+ (region-noncontiguous-p (use-region-noncontiguous-p))))
(interactive
(let ((common
(query-replace-read-args
@@ -681,7 +681,7 @@ and TO-STRING is also null.)"
(list (nth 0 common) (nth 1 common) (nth 2 common)
(use-region-beginning) (use-region-end)
(nth 3 common)
- (if (use-region-p) (region-noncontiguous-p)))))
+ (use-region-noncontiguous-p))))
(perform-replace from-string to-string nil nil delimited nil nil start end
backward region-noncontiguous-p))
(defun replace-regexp (regexp to-string &optional delimited start end backward
region-noncontiguous-p)
@@ -746,7 +746,11 @@ What you probably want is a loop like this:
(replace-match TO-STRING nil nil))
which will run faster and will not set the mark or print anything."
(declare (interactive-only
- "use `re-search-forward' and `replace-match' instead."))
+ "use `re-search-forward' and `replace-match' instead.")
+ (interactive-args
+ (start (use-region-beginning))
+ (end (use-region-end))
+ (region-noncontiguous-p (use-region-noncontiguous-p))))
(interactive
(let ((common
(query-replace-read-args
@@ -758,10 +762,9 @@ which will run faster and will not set the mark or print
anything."
(if (use-region-p) " in region" ""))
t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))
+ (use-region-beginning) (use-region-end)
(nth 3 common)
- (if (use-region-p) (region-noncontiguous-p)))))
+ (use-region-noncontiguous-p))))
(perform-replace regexp to-string nil t delimited nil nil start end backward
region-noncontiguous-p))
@@ -2814,8 +2817,8 @@ which will run faster and probably do exactly what you
want. Please
see the documentation of `replace-match' to find out how to simulate
`case-replace'.
-This function returns nil if and only if there were no matches to
-make, or the user didn't cancel the call.
+This function returns nil if there were no matches to make, or
+the user cancelled 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/reveal.el b/lisp/reveal.el
index 64e9ceef64..b3b42177f9 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -210,13 +210,11 @@ that text."
(let ((reveal-auto-hide t))
(reveal-post-command)))
-(defvar reveal-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Override the default move-beginning-of-line and move-end-of-line
- ;; which skips valuable invisible text.
- (define-key map [remap move-beginning-of-line] 'beginning-of-line)
- (define-key map [remap move-end-of-line] 'end-of-line)
- map))
+(defvar-keymap reveal-mode-map
+ ;; Override the default move-beginning-of-line and move-end-of-line
+ ;; which skips valuable invisible text.
+ "<remap> <move-beginning-of-line>" #'beginning-of-line
+ "<remap> <move-end-of-line>" #'end-of-line)
;;;###autoload
(define-minor-mode reveal-mode
diff --git a/lisp/server.el b/lisp/server.el
index dd7bccaf33..90d97c1538 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -27,12 +27,12 @@
;;; Commentary:
-;; This Lisp code is run in Emacs when it is to operate as
-;; a server for other processes.
+;; This library allows Emacs to operate as a server for other
+;; processes.
-;; Load this library and do M-x server-edit to enable Emacs as a server.
+;; Load this library and do `M-x server-start' to enable Emacs as a server.
;; Emacs opens up a socket for communication with clients. If there are no
-;; client buffers to edit, server-edit acts like (switch-to-buffer
+;; client buffers to edit, `server-edit' acts like (switch-to-buffer
;; (other-buffer))
;; When some other program runs "the editor" to edit a file,
@@ -42,10 +42,10 @@
;; Note that any number of clients may dispatch files to Emacs to be edited.
-;; When you finish editing a Server buffer, again call server-edit
+;; When you finish editing a Server buffer, again call `server-edit'
;; to mark that buffer as done for the client and switch to the next
;; Server buffer. When all the buffers for a client have been edited
-;; and exited with server-edit, the client "editor" will return
+;; and exited with `server-edit', the client "editor" will return
;; to the program that invoked it.
;; Your editing commands and Emacs's display output go to and from
@@ -54,25 +54,28 @@
;; the client. This is possible in four cases:
;; 1. On a window system, where Emacs runs in one window and the
-;; program that wants to use "the editor" runs in another.
+;; program that wants to use "the editor" runs in another.
-;; 2. On a multi-terminal system, where Emacs runs on one terminal and the
-;; program that wants to use "the editor" runs on another.
+;; 2. On a multi-terminal system, where Emacs runs on one terminal and
+;; the program that wants to use "the editor" runs on another.
-;; 3. When the program that wants to use "the editor" is running
-;; as a subprocess of Emacs.
+;; 3. When the program that wants to use "the editor" is running as a
+;; subprocess of Emacs.
-;; 4. On a system with job control, when Emacs is suspended, the program
-;; that wants to use "the editor" will stop and display
-;; "Waiting for Emacs...". It can then be suspended, and Emacs can be
-;; brought into the foreground for editing. When done editing, Emacs is
-;; suspended again, and the client program is brought into the foreground.
+;; 4. On a system with job control, when Emacs is suspended, the
+;; program that wants to use "the editor" will stop and display
+;; "Waiting for Emacs...". It can then be suspended, and Emacs can
+;; be brought into the foreground for editing. When done editing,
+;; Emacs is suspended again, and the client program is brought into
+;; the foreground.
-;; The buffer local variable "server-buffer-clients" lists
+;; The buffer local variable `server-buffer-clients' lists
;; the clients who are waiting for this buffer to be edited.
-;; The global variable "server-clients" lists all the waiting clients,
+;; The global variable `server-clients' lists all the waiting clients,
;; and which files are yet to be edited for each.
+;;; Code:
+
;; Todo:
;; - handle command-line-args-left.
@@ -80,8 +83,6 @@
;; to here.
;; - fix up handling of the client's environment (place it in the terminal?).
-;;; Code:
-
(eval-when-compile (require 'cl-lib))
(defgroup server nil
@@ -1588,14 +1589,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 85225b128a..641f274045 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -99,6 +99,7 @@
(require 'pcomplete)
(eval-when-compile (require 'files-x)) ;with-connection-local-variables
(require 'subr-x)
+(eval-when-compile (require 'cl-lib))
;;; Customization and Buffer Variables
@@ -307,6 +308,40 @@ for Shell mode only."
(const :tag "on" t))
:group 'shell)
+(defcustom shell-fontify-input-enable t
+ "Enable fontification of input in shell buffers.
+This variable only has effect when the shell is started. Use the
+command `comint-fontify-input-mode' to toggle fontification of
+input."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom shell-indirect-setup-hook nil
+ "Hook run in an indirect buffer for input fontification.
+Input fontification and indentation of a `shell-mode' buffer, if
+enabled, is performed in an indirect buffer, whose indentation
+and syntax highlighting is set up with `sh-mode'. In addition to
+`comint-indirect-setup-hook', run this hook with the indirect
+buffer as the current buffer after its setup is done. This can
+be used to further customize fontification and other behavior of
+the indirect buffer."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom shell-highlight-undef-enable nil
+ "Enable highlighting of undefined commands in shell buffers.
+This variable only has effect when the shell is started. Use the
+command `shell-highlight-undef-mode' to toggle highlighting of
+undefined commands."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
(defvar shell-dirstack nil
"List of directories saved by pushd in this buffer's shell.
Thus, this does not include the shell's current directory.")
@@ -522,6 +557,8 @@ Shell buffers. It implements `shell-completion-execonly'
for
(put 'shell-mode 'mode-class 'special)
+(defvar sh-shell-file)
+
(define-derived-mode shell-mode comint-mode "Shell"
"Major mode for interacting with an inferior shell.
\\<shell-mode-map>
@@ -585,6 +622,13 @@ from `shell-mode-hook', Emacs will call the `ding' function
whenever it receives the bell character in output from a
command."
:interactive nil
+ :after-hook
+ (unless comint-use-prompt-regexp
+ (if shell-fontify-input-enable
+ (comint-fontify-input-mode))
+ (if shell-highlight-undef-enable
+ (shell-highlight-undef-mode)))
+
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
@@ -604,6 +648,23 @@ command."
(setq-local ansi-color-apply-face-function #'shell-apply-ansi-color)
(shell-reapply-ansi-color)
+ (add-hook 'comint-indirect-setup-hook
+ #'shell-indirect-setup-hook 'append t)
+ (setq comint-indirect-setup-function
+ (let ((shell shell--start-prog))
+ (lambda ()
+ (require 'sh-script)
+ (cl-letf
+ (((default-value 'sh-shell-file)
+ (or shell sh-shell-file))
+ (inhibit-message t)
+ (message-log-max nil))
+ (sh-mode)))))
+
+ (setq-local indent-line-function #'comint-indent-input-line-default)
+ (setq-local indent-region-function
+ #'comint-indent-input-region-default)
+
;; This is not really correct, since the shell buffer does not really
;; edit this directory. But it is useful in the buffer list and menus.
(setq list-buffers-directory (expand-file-name default-directory))
@@ -658,6 +719,10 @@ command."
": [[:digit:]]+:[[:digit:]]+;")))
(comint-read-input-ring t)))
+(defun shell-indirect-setup-hook ()
+ "Run `shell-indirect-setup-hook'."
+ (run-hooks 'shell-indirect-setup-hook))
+
(defun shell-apply-ansi-color (beg end face)
"Apply FACE as the ansi-color face for the text between BEG and END."
(when face
@@ -1482,6 +1547,222 @@ Returns t if successful."
;; Remove the prompt.
(replace-regexp-in-string "\n.*\\'" "\n" result)))
+;;; Highlight undefined commands
+;;
+;; To highlight non-existent shell commands, customize
+;; `shell-highlight-undef-enable' to t. To highlight some shell
+;; commands as aliases, add them to `shell-highlight-undef-aliases'.
+
+(defcustom shell-highlight-undef-aliases nil
+ "List of shell commands to highlight as a command alias."
+ :group 'shell
+ :type '(repeat string)
+ :version "29.1")
+
+(defface shell-highlight-undef-defined-face
+ '((t :inherit 'font-lock-function-name-face))
+ "Face used for existing shell commands."
+ :group 'shell
+ :version "29.1")
+
+(defface shell-highlight-undef-undefined-face
+ '((t :inherit 'font-lock-warning-face))
+ "Face used for non-existent shell commands."
+ :group 'shell
+ :version "29.1")
+
+(defface shell-highlight-undef-alias-face
+ '((t :inherit 'font-lock-variable-name-face))
+ "Face used for shell command aliases."
+ :group 'shell
+ :version "29.1")
+
+(defcustom shell-highlight-undef-remote-file-name-inhibit-cache nil
+ "Whether to inhibit cache for fontifying shell commands in remote buffers.
+When fontification of non-existent commands is enabled in a
+remote shell buffer, use a cache to speed up searching for
+executable files on the remote machine. This options is used to
+control expiry of this cache. See `remote-file-name-inhibit-cache'
+for description."
+ :group 'faces
+ :type '(choice
+ (const :tag "Do not inhibit file name cache" nil)
+ (const :tag "Do not use file name cache" t)
+ (integer :tag "Do not use file name cache"
+ :format "Do not use file name cache older than %v seconds"
+ :value 10))
+ :version "29.1")
+
+(defvar shell--highlight-undef-exec-cache nil
+ "Cache of executable files found in `exec-path'.
+An alist, whose elements are of the form
+\(REMOTE TIME EXECUTABLES), where REMOTE is a string, returned by
+`file-remote-p', TIME is the return value of `float-time', and
+EXECUTABLES is a hash table with keys being the base-names of
+executable files.
+
+Cache expiry is controlled by the user option
+`remote-file-name-inhibit-cache'.")
+
+(defvar shell--highlight-undef-face 'shell-highlight-undef-defined-face)
+
+(defvar shell-highlight-undef-keywords
+ `((,#'shell-highlight-undef-matcher 6 shell--highlight-undef-face)))
+
+(defvar-local shell-highlight-undef-regexp regexp-unmatchable)
+
+(defun shell--highlight-undef-executable-find (command)
+ "Return non-nil if COMMAND is found in `exec-path'.
+Similar to `executable-find', but use cache stored in
+`shell--highlight-undef-exec-cache'."
+ (let ((remote (file-remote-p default-directory))
+ as ret found-in-cache delta-time)
+ (if (null remote)
+ (executable-find command)
+
+ (setq delta-time
+ shell-highlight-undef-remote-file-name-inhibit-cache)
+
+ (pcase (setq as (assoc remote shell--highlight-undef-exec-cache))
+ (`(,_ ,time ,hash)
+ (when (pcase delta-time
+ ((pred numberp) (<= (float-time) (+ time delta-time)))
+ ('t nil)
+ ('nil t))
+ (setq ret (gethash command hash))
+ (setq found-in-cache t)))
+ (_ (setq as (list remote 0 (make-hash-table :test #'equal)))
+ (push as shell--highlight-undef-exec-cache)))
+
+ (if found-in-cache
+ ret
+ ;; Build cache
+ (setcar (cdr as) (float-time))
+ (let ((hash (clrhash (caddr as))))
+ (dolist (dir (exec-path))
+ (pcase-dolist (`(,f . ,attr)
+ (condition-case nil
+ (directory-files-and-attributes
+ (concat remote dir) nil nil 'nosort 'integer)
+ (file-error nil)))
+ ;; Approximation. Assume every non-directory file in $PATH is an
+ ;; executable. Alternatively, we could check
+ ;; `file-executable-p', but doing so for every file in $PATH is
+ ;; slow on remote machines.
+ (unless (eq t (file-attribute-type attr))
+ (puthash f t hash))))
+ (gethash command hash))))))
+
+(defun shell-highlight-undef-matcher (end)
+ "Matcher used to highlight shell commands up to END."
+ (when (re-search-forward shell-highlight-undef-regexp end t)
+ (save-match-data
+ (let ((cmd (match-string 6))
+ (beg (match-beginning 6)))
+ (setq shell--highlight-undef-face
+ (let* ((buf (buffer-base-buffer))
+ (default-directory
+ (if buf (buffer-local-value 'default-directory buf)
+ default-directory)))
+ (cond
+ ;; Don't fontify command output. Mostly useful if
+ ;; `comint-fontify-input-mode' is disabled.
+ ((text-property-any beg (point) 'field 'output)
+ nil)
+ ((member cmd shell-highlight-undef-aliases)
+ 'shell-highlight-undef-alias-face)
+ ;; Check if it contains a directory separator
+ ((file-name-directory cmd)
+ (when (file-name-absolute-p cmd)
+ (setq cmd (concat
+ (or (bound-and-true-p comint-file-name-prefix)
+ (file-remote-p default-directory))
+ cmd)))
+ (if (or (file-executable-p cmd)
+ (file-directory-p cmd))
+ 'shell-highlight-undef-defined-face
+ 'shell-highlight-undef-undefined-face))
+ ((shell--highlight-undef-executable-find cmd)
+ 'shell-highlight-undef-defined-face)
+ (t 'shell-highlight-undef-undefined-face))))))
+ t))
+
+(defvar-local shell--highlight-undef-indirect nil
+ "Non-nil if shell commands are fontified in `comint-indirect-buffer'.")
+
+(declare-function sh-feature "sh-script" (alist &optional function))
+(defvar sh-leading-keywords)
+(defvar sh-other-keywords)
+
+(define-minor-mode shell-highlight-undef-mode
+ "Highlight undefined shell commands and aliases.
+This minor mode is mostly useful in `shell-mode' buffers and
+works better if `comint-fontify-input-mode' is enabled."
+ :init-value nil
+ (if shell--highlight-undef-indirect
+ (progn
+ (remove-hook 'comint-indirect-setup-hook
shell--highlight-undef-indirect t)
+ (setq shell--highlight-undef-indirect nil)
+ (when-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (font-lock-remove-keywords nil shell-highlight-undef-keywords))))
+ (font-lock-remove-keywords nil shell-highlight-undef-keywords))
+ (remove-hook 'comint-fontify-input-mode-hook
+ #'shell-highlight-undef-mode-restart t)
+
+ (when shell-highlight-undef-mode
+ (when comint-use-prompt-regexp
+ (setq shell-highlight-undef-mode nil)
+ (error
+ "`shell-highlight-undef-mode' is incompatible with
`comint-use-prompt-regexp'"))
+
+ (require 'sh-script)
+
+ (let* ((regexp
+ ;; Adapted from `sh-font-lock-keywords-1'
+ (concat
+ "\\("
+ "[;(){}`|&]"
+ (if comint-fontify-input-mode
+ ;; `comint-fontify-input-mode' already puts
+ ;; point-min on end of prompt
+ ""
+ (concat "\\|" comint-prompt-regexp))
+ "\\|^"
+ "\\)"
+ "[ \t]*\\(\\("
+ (regexp-opt (sh-feature sh-leading-keywords) t)
+ "[ \t]+\\)?"
+ (regexp-opt (append (sh-feature sh-leading-keywords)
+ (sh-feature sh-other-keywords))
+ t)
+ "[ \t]+\\)?\\_<\\(\\(?:\\s_\\|\\sw\\|/\\)+\\)\\_>"))
+ (setup
+ (lambda ()
+ (setq shell-highlight-undef-regexp regexp)
+ (font-lock-add-keywords nil shell-highlight-undef-keywords t))))
+ (cond (comint-fontify-input-mode
+ (setq shell--highlight-undef-indirect setup)
+ (if-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (funcall setup))
+ (add-hook 'comint-indirect-setup-hook setup nil t)))
+ (t (funcall setup))))
+
+ (add-hook 'comint-fontify-input-mode-hook
+ #'shell-highlight-undef-mode-restart nil t))
+
+ (font-lock-flush))
+
+(defun shell-highlight-undef-mode-restart ()
+ "If `shell-highlight-undef-mode' is on, restart it.
+`shell-highlight-undef-mode' performs its setup differently
+depending on `comint-fontify-input-mode'. It's useful to call
+this function when switching `comint-fontify-input-mode' in order
+to make `shell-highlight-undef-mode' redo its setup."
+ (when shell-highlight-undef-mode
+ (shell-highlight-undef-mode 1)))
+
(provide 'shell)
;;; shell.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 460aff8bd8..e804f717b0 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,8 +2484,8 @@ 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))
@@ -2653,6 +2657,9 @@ function as needed."
(cl-defmethod function-documentation ((function accessor))
(oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
+(cl-defmethod function-documentation ((f cconv--interactive-helper))
+ (function-documentation (cconv--interactive-helper--fun f)))
+
;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
(cl-defgeneric oclosure-interactive-form (_function)
"Return the interactive form of FUNCTION or nil if none.
@@ -2664,6 +2671,9 @@ instead."
;; (interactive-form function)
nil)
+(cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper))
+ `(interactive (funcall ',(cconv--interactive-helper--if f))))
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
@@ -3520,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)
@@ -4563,85 +4571,81 @@ impose the use of a shell (with its need to quote
arguments)."
(set-marker (mark-marker) (point)
(current-buffer)))))
;; Output goes in a separate buffer.
- ;; Preserve the match data in case called from a program.
- ;; FIXME: It'd be ridiculous for an Elisp function to call
- ;; shell-command and assume that it won't mess the match-data!
- (save-match-data
- (if (string-match "[ \t]*&[ \t]*\\'" command)
- ;; Command ending with ampersand means asynchronous.
- (let* ((buffer (get-buffer-create
- (or output-buffer
shell-command-buffer-name-async)))
- (bname (buffer-name buffer))
- (proc (get-buffer-process buffer))
- (directory default-directory))
- ;; Remove the ampersand.
- (setq command (substring command 0 (match-beginning 0)))
- ;; Ask the user what to do with already running process.
- (when proc
- (cond
- ((eq async-shell-command-buffer 'confirm-kill-process)
- ;; If will kill a process, query first.
- (shell-command--same-buffer-confirm "Kill it")
- (kill-process proc))
- ((eq async-shell-command-buffer 'confirm-new-buffer)
- ;; If will create a new buffer, query first.
- (shell-command--same-buffer-confirm "Use a new buffer")
- (setq buffer (generate-new-buffer bname)))
- ((eq async-shell-command-buffer 'new-buffer)
- ;; It will create a new buffer.
- (setq buffer (generate-new-buffer bname)))
- ((eq async-shell-command-buffer 'confirm-rename-buffer)
- ;; If will rename the buffer, query first.
- (shell-command--same-buffer-confirm "Rename it")
- (with-current-buffer buffer
- (rename-uniquely))
- (setq buffer (get-buffer-create bname)))
- ((eq async-shell-command-buffer 'rename-buffer)
- ;; It will rename the buffer.
- (with-current-buffer buffer
- (rename-uniquely))
- (setq buffer (get-buffer-create bname)))))
- (with-current-buffer buffer
- (shell-command-save-pos-or-erase)
- (setq default-directory directory)
- (require 'shell)
- (let ((process-environment
- (append
- (and (natnump async-shell-command-width)
- (list
- (format "COLUMNS=%d"
- async-shell-command-width)))
- (comint-term-environment)
- process-environment)))
- (setq proc
- (start-process-shell-command "Shell" buffer command)))
- (setq mode-line-process '(":%s"))
- (shell-mode)
- (setq-local revert-buffer-function
- (lambda (&rest _)
- (async-shell-command command buffer)))
- (set-process-sentinel proc #'shell-command-sentinel)
- ;; Use the comint filter for proper handling of
- ;; carriage motion (see comint-inhibit-carriage-motion).
- (set-process-filter proc #'comint-output-filter)
- (if async-shell-command-display-buffer
- ;; Display buffer immediately.
- (display-buffer buffer '(nil (allow-no-window . t)))
- ;; Defer displaying buffer until first process output.
- ;; Use disposable named advice so that the buffer is
- ;; displayed at most once per process lifetime.
- (let ((nonce (make-symbol "nonce")))
- (add-function :before (process-filter proc)
- (lambda (proc _string)
- (let ((buf (process-buffer proc)))
- (when (buffer-live-p buf)
- (remove-function (process-filter
proc)
- nonce)
- (display-buffer buf))))
- `((name . ,nonce)))))))
- ;; Otherwise, command is executed synchronously.
- (shell-command-on-region (point) (point) command
- output-buffer nil error-buffer)))))))
+ (if (string-match "[ \t]*&[ \t]*\\'" command)
+ ;; Command ending with ampersand means asynchronous.
+ (let* ((buffer (get-buffer-create
+ (or output-buffer
shell-command-buffer-name-async)))
+ (bname (buffer-name buffer))
+ (proc (get-buffer-process buffer))
+ (directory default-directory))
+ ;; Remove the ampersand.
+ (setq command (substring command 0 (match-beginning 0)))
+ ;; Ask the user what to do with already running process.
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (shell-command--same-buffer-confirm "Kill it")
+ (kill-process proc))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (shell-command--same-buffer-confirm "Use a new buffer")
+ (setq buffer (generate-new-buffer bname)))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer bname)))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (shell-command--same-buffer-confirm "Rename it")
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create bname)))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create bname)))))
+ (with-current-buffer buffer
+ (shell-command-save-pos-or-erase)
+ (setq default-directory directory)
+ (require 'shell)
+ (let ((process-environment
+ (append
+ (and (natnump async-shell-command-width)
+ (list
+ (format "COLUMNS=%d"
+ async-shell-command-width)))
+ (comint-term-environment)
+ process-environment)))
+ (setq proc
+ (start-process-shell-command "Shell" buffer command)))
+ (setq mode-line-process '(":%s"))
+ (shell-mode)
+ (setq-local revert-buffer-function
+ (lambda (&rest _)
+ (async-shell-command command buffer)))
+ (set-process-sentinel proc #'shell-command-sentinel)
+ ;; Use the comint filter for proper handling of
+ ;; carriage motion (see comint-inhibit-carriage-motion).
+ (set-process-filter proc #'comint-output-filter)
+ (if async-shell-command-display-buffer
+ ;; Display buffer immediately.
+ (display-buffer buffer '(nil (allow-no-window . t)))
+ ;; Defer displaying buffer until first process output.
+ ;; Use disposable named advice so that the buffer is
+ ;; displayed at most once per process lifetime.
+ (let ((nonce (make-symbol "nonce")))
+ (add-function :before (process-filter proc)
+ (lambda (proc _string)
+ (let ((buf (process-buffer proc)))
+ (when (buffer-live-p buf)
+ (remove-function (process-filter proc)
+ nonce)
+ (display-buffer buf))))
+ `((name . ,nonce)))))))
+ ;; Otherwise, command is executed synchronously.
+ (shell-command-on-region (point) (point) command
+ output-buffer nil error-buffer))))))
(defun shell-command--same-buffer-confirm (action)
(let ((help-form
@@ -6878,6 +6882,10 @@ point otherwise."
"Return the end of the region if `use-region-p'."
(and (use-region-p) (region-end)))
+(defun use-region-noncontiguous-p ()
+ "Return non-nil for a non-contiguous region if `use-region-p'."
+ (and (use-region-p) (region-noncontiguous-p)))
+
(defun use-region-p ()
"Return t if the region is active and it is appropriate to act on it.
This is used by commands that act specially on the region under
@@ -6887,6 +6895,11 @@ The return value is t if Transient Mark mode is enabled
and the
mark is active; furthermore, if `use-empty-active-region' is nil,
the region must not be empty. Otherwise, the return value is nil.
+If `use-empty-active-region' is non-nil, there is one further
+caveat: If the user has used `mouse-1' to set point, but used the
+mouse to move point to a different character yet, this function
+returns nil.
+
For some commands, it may be appropriate to ignore the value of
`use-empty-active-region'; in that case, use `region-active-p'.
@@ -6894,8 +6907,10 @@ Also see the convenience functions
`use-region-beginning' and
`use-region-end', which may be handy when writing `interactive'
specs."
(and (region-active-p)
- (or use-empty-active-region (> (region-end) (region-beginning)))
- t))
+ (or (> (region-end) (region-beginning))
+ (and use-empty-active-region
+ (not (eq (car-safe last-input-event) 'down-mouse-1))
+ (not (mouse-movement-p last-input-event))))))
(defun region-active-p ()
"Return t if Transient Mark mode is enabled and the mark is active.
@@ -6922,7 +6937,7 @@ see `region-noncontiguous-p' and
`extract-rectangle-bounds'."
"Return non-nil if the region contains several pieces.
An example is a rectangular region handled as a list of
separate contiguous regions for each line."
- (cdr (region-bounds)))
+ (let ((bounds (region-bounds))) (and (cdr bounds) bounds)))
(defun redisplay--unhighlight-overlay-function (rol)
"If ROL is an overlay, call `delete-overlay'."
@@ -7015,7 +7030,7 @@ which is the window that will be redisplayed. When run,
the `current-buffer'
is set to the buffer displayed in that window.")
(define-minor-mode cursor-face-highlight-mode
- "When enabled, respect the cursor-face property."
+ "When enabled, highlight text that has `cursor-face' property near point."
:global nil
(if cursor-face-highlight-mode
(add-hook 'pre-redisplay-functions
@@ -7700,13 +7715,7 @@ not vscroll."
;; Lines are not truncated...
(not
(and
- (or truncate-lines
- (and (integerp truncate-partial-width-windows)
- (< (window-total-width)
- truncate-partial-width-windows))
- (and truncate-partial-width-windows
- (not (integerp truncate-partial-width-windows))
- (not (window-full-width-p))))
+ (or truncate-lines (truncated-partial-width-window-p))
;; ...or if lines are truncated, this buffer
;; doesn't have very long lines.
(long-line-optimizations-p)))
@@ -7717,13 +7726,9 @@ not vscroll."
(not goal-column)
;; Lines aren't truncated.
(not
- (or truncate-lines
- (and (integerp truncate-partial-width-windows)
- (< (window-width)
- truncate-partial-width-windows))
- (and truncate-partial-width-windows
- (not (integerp truncate-partial-width-windows))
- (not (window-full-width-p)))))
+ (and
+ (or truncate-lines (truncated-partial-width-window-p))
+ (long-line-optimizations-p)))
;; When the text in the window is scrolled to the left,
;; display-based motion doesn't make sense (because each
;; logical line occupies exactly one screen line).
@@ -7836,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)
@@ -7948,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.
@@ -8012,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.
@@ -10400,8 +10409,15 @@ command works by setting the variable
`buffer-read-only', which
does not affect read-only regions caused by text properties. To
ignore read-only status in a Lisp program (whether due to text
properties or buffer state), bind `inhibit-read-only' temporarily
-to a non-nil value."
+to a non-nil value.
+
+Reverting a buffer will keep the read-only status set by using
+this command."
:variable buffer-read-only
+ ;; We're saving this value here so that we can restore the
+ ;; readedness state after reverting the buffer to the value that's
+ ;; been explicitly set by the user.
+ (setq-local read-only-mode--state buffer-read-only)
(cond
((and (not buffer-read-only) view-mode)
(View-exit-and-edit)
@@ -10434,7 +10450,9 @@ and setting it to nil."
map))
(define-derived-mode messages-buffer-mode special-mode "Messages"
- "Major mode used in the \"*Messages*\" buffer.")
+ "Major mode used in the \"*Messages*\" buffer."
+ ;; Make it easy to do like "tail -f".
+ (setq-local window-point-insertion-type t))
(defun messages-buffer ()
"Return the \"*Messages*\" buffer.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index e74d6fd80a..515f7d5d75 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3509,7 +3509,7 @@ Returns the tag list, or t for an error."
(error t)))
)
-;;; Tag Management -- etags (old XEmacs compatibility part)
+;;; Tag Management -- etags
;;
(defvar speedbar-fetch-etags-parse-list
'(;; Note that java has the same parse-group as c
@@ -3552,10 +3552,7 @@ This variable is ignored if `speedbar-use-imenu-flag' is
t."
FLAG then becomes a member of etags command line arguments. If flag
is \"sort\", then toggle the value of `speedbar-sort-tags'. If its
value is \"show\" then toggle the value of
-`speedbar-show-unknown-files'.
-
- This function is a convenience function for XEmacs menu created by
-Farzin Guilak <farzin@protocol.com>."
+`speedbar-show-unknown-files'."
(interactive)
(cond
((equal flag "sort")
diff --git a/lisp/startup.el b/lisp/startup.el
index b0fbf7a34c..70267fc857 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)
@@ -541,7 +542,7 @@ DIRS are relative."
(setq comp--compilable t))
(defvar native-comp-eln-load-path)
-(defvar native-comp-deferred-compilation)
+(defvar inhibit-automatic-native-compilation)
(defvar comp-enable-subr-trampolines)
(defvar startup--original-eln-load-path nil
@@ -578,6 +579,10 @@ the updated value."
It sets `command-line-processed', processes the command-line,
reads the initialization files, etc.
It is the default value of the variable `top-level'."
+ ;; Allow disabling automatic .elc->.eln processing.
+ (setq inhibit-automatic-native-compilation
+ (getenv "EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION"))
+
(if command-line-processed
(message internal--top-level-message)
(setq command-line-processed t)
@@ -596,7 +601,7 @@ It is the default value of the variable `top-level'."
;; in this session. This is necessary if libgccjit is not
;; available on MS-Windows, but Emacs was built with
;; native-compilation support.
- (setq native-comp-deferred-compilation nil
+ (setq inhibit-automatic-native-compilation t
comp-enable-subr-trampolines nil))
;; Form `native-comp-eln-load-path'.
@@ -718,8 +723,6 @@ It is the default value of the variable `top-level'."
(let ((dir default-directory))
(with-current-buffer "*Messages*"
(messages-buffer-mode)
- ;; Make it easy to do like "tail -f".
- (setq-local window-point-insertion-type t)
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(setq default-directory (or dir (expand-file-name "~/")))))
@@ -1195,7 +1198,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)
@@ -1252,6 +1255,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/strokes.el b/lisp/strokes.el
index d7a9539316..0f84588a41 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -210,9 +210,6 @@ static char * stroke_xpm[] = {
:link '(emacs-commentary-link "strokes")
:group 'mouse)
-(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter
- "24.3")
-
(defcustom strokes-lighter " Strokes"
"Mode line identifier for Strokes mode."
:type 'string)
@@ -1362,11 +1359,9 @@ If STROKES-MAP is not given, `strokes-global-map' will
be used instead."
"Return t if STROKE1's command name precedes STROKE2's in lexicographic
order."
(string-lessp (cdr stroke1) (cdr stroke2)))
-(defvar strokes-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(shift down-mouse-2)] #'strokes-do-stroke)
- (define-key map [(meta down-mouse-2)] #'strokes-do-complex-stroke)
- map))
+(defvar-keymap strokes-mode-map
+ "S-<down-mouse-2>" #'strokes-do-stroke
+ "M-<down-mouse-2>" #'strokes-do-complex-stroke)
;;;###autoload
(define-minor-mode strokes-mode
diff --git a/lisp/subr.el b/lisp/subr.el
index 16eb84caa6..86a3b7ae99 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -311,29 +311,13 @@ Then evaluate RESULT to get return value, default nil.
(signal 'wrong-type-argument (list 'consp spec)))
(unless (<= 2 (length spec) 3)
(signal 'wrong-number-of-arguments (list '(2 . 3) (length spec))))
- ;; It would be cleaner to create an uninterned symbol,
- ;; but that uses a lot more space when many functions in many files
- ;; use dolist.
- ;; FIXME: This cost disappears in byte-compiled lexical-binding files.
- (let ((temp '--dolist-tail--))
- ;; This test does not matter much because both semantics are acceptable,
- ;; but one is slightly faster with dynamic scoping and the other is
- ;; slightly faster (and has cleaner semantics) with lexical scoping.
- (if lexical-binding
- `(let ((,temp ,(nth 1 spec)))
- (while ,temp
- (let ((,(car spec) (car ,temp)))
- ,@body
- (setq ,temp (cdr ,temp))))
- ,@(cdr (cdr spec)))
- `(let ((,temp ,(nth 1 spec))
- ,(car spec))
- (while ,temp
- (setq ,(car spec) (car ,temp))
+ (let ((tail (make-symbol "tail")))
+ `(let ((,tail ,(nth 1 spec)))
+ (while ,tail
+ (let ((,(car spec) (car ,tail)))
,@body
- (setq ,temp (cdr ,temp)))
- ,@(if (cdr (cdr spec))
- `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))))
+ (setq ,tail (cdr ,tail))))
+ ,@(cdr (cdr spec)))))
(defmacro dotimes (spec &rest body)
"Loop a certain number of times.
@@ -346,35 +330,21 @@ in compilation warnings about unused variables.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (indent 1) (debug dolist))
- ;; It would be cleaner to create an uninterned symbol,
- ;; but that uses a lot more space when many functions in many files
- ;; use dotimes.
- ;; FIXME: This cost disappears in byte-compiled lexical-binding files.
- (let ((temp '--dotimes-limit--)
- (start 0)
- (end (nth 1 spec)))
- ;; This test does not matter much because both semantics are acceptable,
- ;; but one is slightly faster with dynamic scoping and the other has
- ;; cleaner semantics.
- (if lexical-binding
- (let ((counter '--dotimes-counter--))
- `(let ((,temp ,end)
- (,counter ,start))
- (while (< ,counter ,temp)
- (let ((,(car spec) ,counter))
- ,@body)
- (setq ,counter (1+ ,counter)))
- ,@(if (cddr spec)
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
- `(let ((,temp ,end)
- (,(car spec) ,start))
- (while (< ,(car spec) ,temp)
- ,@body
- (setq ,(car spec) (1+ ,(car spec))))
- ,@(cdr (cdr spec))))))
+ (let ((var (nth 0 spec))
+ (end (nth 1 spec))
+ (upper-bound (make-symbol "upper-bound"))
+ (counter (make-symbol "counter")))
+ `(let ((,upper-bound ,end)
+ (,counter 0))
+ (while (< ,counter ,upper-bound)
+ (let ((,var ,counter))
+ ,@body)
+ (setq ,counter (1+ ,counter)))
+ ,@(if (cddr spec)
+ ;; 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
@@ -385,8 +355,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.
@@ -1239,7 +1217,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
@@ -1318,7 +1296,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.
@@ -1332,7 +1310,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.
@@ -1592,6 +1570,21 @@ in the current Emacs session, then this function may
return nil."
;; is this really correct? maybe remove mouse-movement?
(memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
+(defun event--posn-at-point ()
+ ;; Use `window-point' for the case when the current buffer
+ ;; is temporarily switched to some other buffer (bug#50256)
+ (let* ((pos (window-point))
+ (posn (posn-at-point pos)))
+ (if (null posn) ;; `pos' is "out of sight".
+ (list (selected-window) pos '(0 . 0) 0)
+ ;; If `pos' is inside a chunk of text hidden by an `invisible'
+ ;; or `display' property, `posn-at-point' returns the position
+ ;; that *is* visible, whereas `event--posn-at-point' is used
+ ;; when we have a keyboard event, whose position is `point' even
+ ;; if that position is invisible.
+ (setf (nth 5 posn) pos)
+ posn)))
+
(defun event-start (event)
"Return the starting position of EVENT.
EVENT should be a mouse click, drag, or key press event. If
@@ -1618,10 +1611,7 @@ nil or (STRING . POSITION)'.
For more information, see Info node `(elisp)Click Events'."
(or (and (consp event) (nth 1 event))
- ;; Use `window-point' for the case when the current buffer
- ;; is temporarily switched to some other buffer (bug#50256)
- (posn-at-point (window-point))
- (list (selected-window) (window-point) '(0 . 0) 0)))
+ (event--posn-at-point)))
(defun event-end (event)
"Return the ending position of EVENT.
@@ -1629,10 +1619,7 @@ EVENT should be a click, drag, or key press event.
See `event-start' for a description of the value returned."
(or (and (consp event) (nth (if (consp (nth 2 event)) 2 1) event))
- ;; Use `window-point' for the case when the current buffer
- ;; is temporarily switched to some other buffer (bug#50256)
- (posn-at-point (window-point))
- (list (selected-window) (window-point) '(0 . 0) 0)))
+ (event--posn-at-point)))
(defsubst event-click-count (event)
"Return the multi-click count of EVENT, a click or drag event.
@@ -1824,8 +1811,6 @@ be a list of the form returned by `event-start' and
`event-end'."
;;;; Obsolescent names for functions.
-(make-obsolete 'buffer-has-markers-at nil "24.3")
-
(make-obsolete 'invocation-directory "use the variable of the same name."
"27.1")
(make-obsolete 'invocation-name "use the variable of the same name." "27.1")
@@ -1860,7 +1845,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")
@@ -1891,6 +1881,17 @@ be a list of the form returned by `event-start' and
`event-end'."
;; in warnings when using `values' in let-bindings.
;;(make-obsolete-variable 'values "no longer used" "28.1")
+(defvar max-specpdl-size 2500
+ "Former limit on specbindings, now without effect.
+This variable used to limit the size of the specpdl stack which,
+among other things, holds dynamic variable bindings and `unwind-protect'
+activations. To prevent runaway recursion, use `max-lisp-eval-depth'
+instead; it will indirectly limit the specpdl stack size as well.")
+(make-obsolete-variable 'max-specpdl-size nil "29.1")
+
+(make-obsolete-variable 'native-comp-deferred-compilation
+ 'inhibit-automatic-native-compilation "29.1")
+
;;;; Alternate names for functions - these are not being phased out.
@@ -1913,8 +1914,10 @@ be a list of the form returned by `event-start' and
`event-end'."
(defalias 'mkdir #'make-directory)
;; These were the XEmacs names, now obsolete:
-(define-obsolete-function-alias 'point-at-eol #'line-end-position "29.1")
-(define-obsolete-function-alias 'point-at-bol #'line-beginning-position "29.1")
+(defalias 'point-at-eol #'line-end-position)
+(make-obsolete 'point-at-eol "use `line-end-position' or `pos-eol' instead."
"29.1")
+(defalias 'point-at-bol #'line-beginning-position)
+(make-obsolete 'point-at-bol "use `line-beginning-position' or `pos-bol'
instead." "29.1")
(define-obsolete-function-alias 'user-original-login-name #'user-login-name
"28.1")
;; These are in obsolete/autoload.el, but are commonly used by
@@ -2527,7 +2530,20 @@ The variable list SPEC is the same as in `if-let'."
(declare (indent 1) (debug if-let))
(list 'if-let spec (macroexp-progn body)))
+(defmacro while-let (spec &rest body)
+ "Bind variables according to SPEC and conditionally evaluate BODY.
+Evaluate each binding in turn, stopping if a binding value is nil.
+If all bindings are non-nil, eval BODY and repeat.
+The variable list SPEC is the same as in `if-let'."
+ (declare (indent 1) (debug if-let))
+ (let ((done (gensym "done")))
+ `(catch ',done
+ (while t
+ (if-let* ,spec
+ (progn
+ ,@body)
+ (throw ',done nil))))))
;; PUBLIC: find if the current mode derives from another.
@@ -3254,7 +3270,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,
@@ -3544,11 +3567,12 @@ like) while `y-or-n-p' is running)."
(if (or (zerop l) (eq ?\s (aref prompt (1- l))))
"" " ")
(if dialog ""
- (if help-form
- (format "(y, n or %s) "
- (key-description
- (vector help-char)))
- "(y or n) "))))))
+ (substitute-command-keys
+ (if help-form
+ (format "(\\`y', \\`n' or \\`%s') "
+ (key-description
+ (vector help-char)))
+ "(\\`y' or \\`n') ")))))))
;; Preserve the actual command that eventually called
;; `y-or-n-p' (otherwise `repeat' will be repeating
;; `exit-minibuffer').
@@ -3786,10 +3810,6 @@ This finishes the change group by reverting all of its
changes."
;;;; Display-related functions.
-;; For compatibility.
-(define-obsolete-function-alias 'redraw-modeline
- #'force-mode-line-update "24.3")
-
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
Display remains until next event is input.
@@ -4077,6 +4097,13 @@ system's shell."
Otherwise, return nil."
(or (stringp object) (null object)))
+(defun list-of-strings-p (object)
+ "Return t if OBJECT is nil or a list of strings."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp object) (stringp (car object)))
+ (setq object (cdr object)))
+ (null object))
+
(defun booleanp (object)
"Return t if OBJECT is one of the two canonical boolean values: t or nil.
Otherwise, return nil."
@@ -4270,15 +4297,17 @@ Comparisons and replacements are done with fixed case."
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
- (let ((matches 0)
- (case-fold-search nil))
- (goto-char start)
- (while (search-forward string end t)
- (delete-region (match-beginning 0) (match-end 0))
- (insert replacement)
- (setq matches (1+ matches)))
- (and (not (zerop matches))
- matches))))
+ (goto-char start)
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((matches 0)
+ (case-fold-search nil))
+ (while (search-forward string nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert replacement)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches)))))
(defun replace-regexp-in-region (regexp replacement &optional start end)
"Replace REGEXP with REPLACEMENT in the region from START to END.
@@ -4305,14 +4334,16 @@ REPLACEMENT can use the following special elements:
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
- (let ((matches 0)
- (case-fold-search nil))
- (goto-char start)
- (while (re-search-forward regexp end t)
- (replace-match replacement t)
- (setq matches (1+ matches)))
- (and (not (zerop matches))
- matches))))
+ (goto-char start)
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((matches 0)
+ (case-fold-search nil))
+ (while (re-search-forward regexp nil t)
+ (replace-match replacement t)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches)))))
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
@@ -4870,16 +4901,26 @@ the function `undo--wrap-and-run-primitive-undo'."
(let ((undo--combining-change-calls t))
(if (not inhibit-modification-hooks)
(run-hook-with-args 'before-change-functions beg end))
- (let (;; (inhibit-modification-hooks t)
- (before-change-functions
- ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
- ;; (e.g. via a regexp-search or sexp-movement triggering
- ;; on-the-fly syntax-propertize), make sure that this gets
- ;; properly refreshed after subsequent changes.
- (if (memq #'syntax-ppss-flush-cache before-change-functions)
- '(syntax-ppss-flush-cache)))
- after-change-functions)
- (setq result (funcall body)))
+ (let ((bcf before-change-functions)
+ (acf after-change-functions)
+ (local-bcf (local-variable-p 'before-change-functions))
+ (local-acf (local-variable-p 'after-change-functions)))
+ (unwind-protect
+ ;; FIXME: WIBNI we could just use `inhibit-modification-hooks'?
+ (progn
+ ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
+ ;; (e.g. via a regexp-search or sexp-movement triggering
+ ;; on-the-fly syntax-propertize), make sure that this gets
+ ;; properly refreshed after subsequent changes.
+ (setq-local before-change-functions
+ (if (memq #'syntax-ppss-flush-cache bcf)
+ '(syntax-ppss-flush-cache)))
+ (setq-local after-change-functions nil)
+ (setq result (funcall body)))
+ (if local-bcf (setq before-change-functions bcf)
+ (kill-local-variable 'before-change-functions))
+ (if local-acf (setq after-change-functions acf)
+ (kill-local-variable 'after-change-functions))))
(when (not (eq buffer-undo-list t))
(let ((ap-elt
(list 'apply
@@ -5001,10 +5042,6 @@ If `default-directory' is already an existing directory,
it's not changed."
;;; Matching and match data.
-;; We use save-match-data-internal as the local variable because
-;; that works ok in practice (people should not use that variable elsewhere).
-;; We used to use an uninterned symbol; the compiler handles that properly
-;; now, but it generates slower code.
(defmacro save-match-data (&rest body)
"Execute the BODY forms, restoring the global value of the match data.
The value returned is the value of the last form in BODY.
@@ -5016,13 +5053,12 @@ rather than your caller's match data."
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
(declare (indent 0) (debug t))
- (list 'let
- '((save-match-data-internal (match-data)))
- (list 'unwind-protect
- (cons 'progn body)
- ;; It is safe to free (evaporate) markers immediately here,
- ;; as Lisp programs should not copy from save-match-data-internal.
- '(set-match-data save-match-data-internal 'evaporate))))
+ (let ((saved-match-data (make-symbol "saved-match-data")))
+ (list 'let
+ (list (list saved-match-data '(match-data)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ (list 'set-match-data saved-match-data t)))))
(defun match-string (num &optional string)
"Return the string of text matched by the previous search or regexp
operation.
@@ -5260,6 +5296,8 @@ Modifies the match data; use `save-match-data' if
necessary."
(nreverse list)))
+(defalias 'string-split #'split-string)
+
(defun combine-and-quote-strings (strings &optional separator)
"Concatenate the STRINGS, adding the SEPARATOR (default \" \").
This tries to quote the strings to avoid ambiguity such that
@@ -7007,32 +7045,32 @@ CONDITION is either:
(lambda (conditions)
(catch 'match
(dolist (condition conditions)
- (when (cond
- ((eq condition t))
- ((stringp condition)
- (string-match-p condition (buffer-name buffer)))
- ((functionp condition)
- (if (eq 1 (cdr (func-arity condition)))
- (funcall condition buffer)
- (funcall condition buffer arg)))
- ((eq (car-safe condition) 'major-mode)
- (eq
- (buffer-local-value 'major-mode buffer)
- (cdr condition)))
- ((eq (car-safe condition) 'derived-mode)
- (provided-mode-derived-p
- (buffer-local-value 'major-mode buffer)
- (cdr condition)))
- ((eq (car-safe condition) 'not)
- (not (funcall match (cdr condition))))
- ((eq (car-safe condition) 'or)
- (funcall match (cdr condition)))
- ((eq (car-safe condition) 'and)
- (catch 'fail
- (dolist (c (cdr conditions))
- (unless (funcall match c)
- (throw 'fail nil)))
- t)))
+ (when (pcase condition
+ ('t t)
+ ((pred stringp)
+ (string-match-p condition (buffer-name buffer)))
+ ((pred functionp)
+ (if (eq 1 (cdr (func-arity condition)))
+ (funcall condition buffer)
+ (funcall condition buffer arg)))
+ (`(major-mode . ,mode)
+ (eq
+ (buffer-local-value 'major-mode buffer)
+ mode))
+ (`(derived-mode . ,mode)
+ (provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ mode))
+ (`(not . ,cond)
+ (not (funcall match cond)))
+ (`(or . ,args)
+ (funcall match args))
+ (`(and . ,args)
+ (catch 'fail
+ (dolist (c args)
+ (unless (funcall match (list c))
+ (throw 'fail nil)))
+ t)))
(throw 'match t)))))))
(funcall match (list condition))))
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index cdfc30c879..7a4e7f330e 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -62,6 +62,9 @@
(gpm-mouse-stop))
(set-terminal-parameter nil 'gpm-mouse-active nil))
+(defun gpm-mouse-tty-setup ()
+ (if gpm-mouse-mode (gpm-mouse-enable) (gpm-mouse-disable)))
+
;;;###autoload
(define-minor-mode gpm-mouse-mode
"Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
@@ -80,7 +83,9 @@ GPM. This is due to limitations in GPM and the Linux kernel."
(terminal-parameter terminal 'gpm-mouse-active))))
;; Simulate selecting a terminal by selecting one of its frames ;-(
(with-selected-frame (car (frames-on-display-list terminal))
- (if gpm-mouse-mode (gpm-mouse-enable) (gpm-mouse-disable))))))
+ (gpm-mouse-tty-setup))))
+ (when gpm-mouse-mode
+ (add-hook 'tty-setup-hook #'gpm-mouse-tty-setup)))
(provide 't-mouse)
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index cf5ae09a24..2032689c65 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."
@@ -921,7 +940,7 @@ when the tab is current. Return the result as a keymap."
(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."
@@ -1091,7 +1110,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 +1137,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 +1165,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 +1915,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 +1934,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 +1950,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))
@@ -2411,6 +2450,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(keymap-set tab-prefix-map "M" #'tab-move-to)
(keymap-set tab-prefix-map "G" #'tab-group)
(keymap-set tab-prefix-map "r" #'tab-rename)
+(keymap-set tab-prefix-map "^ f" #'tab-detach)
(keymap-set tab-prefix-map "RET" #'tab-switch)
(keymap-set tab-prefix-map "b" #'switch-to-buffer-other-tab)
(keymap-set tab-prefix-map "f" #'find-file-other-tab)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 3e3b4c9559..a4e95bbc75 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -135,45 +135,35 @@ function `tab-line-tab-face-group'."
:group 'tab-line-faces)
-(defvar tab-line-tab-map
- (let ((map (make-sparse-keymap)))
- (define-key map [tab-line down-mouse-1] 'tab-line-select-tab)
- (define-key map [tab-line mouse-2] 'tab-line-close-tab)
- (define-key map [tab-line down-mouse-3] 'tab-line-tab-context-menu)
- (define-key map "\C-m" 'tab-line-select-tab)
- map)
- "Local keymap for `tab-line-mode' window tabs.")
-
-(defvar tab-line-add-map
- (let ((map (make-sparse-keymap)))
- (define-key map [tab-line down-mouse-1] 'tab-line-new-tab)
- (define-key map [tab-line down-mouse-2] 'tab-line-new-tab)
- (define-key map "\C-m" 'tab-line-new-tab)
- map)
- "Local keymap to add `tab-line-mode' window tabs.")
-
-(defvar tab-line-tab-close-map
- (let ((map (make-sparse-keymap)))
- (define-key map [tab-line mouse-1] 'tab-line-close-tab)
- (define-key map [tab-line mouse-2] 'tab-line-close-tab)
- map)
- "Local keymap to close `tab-line-mode' window tabs.")
-
-(defvar tab-line-left-map
- (let ((map (make-sparse-keymap)))
- (define-key map [tab-line down-mouse-1] 'tab-line-hscroll-left)
- (define-key map [tab-line down-mouse-2] 'tab-line-hscroll-left)
- (define-key map "\C-m" 'tab-line-new-tab)
- map)
- "Local keymap to scroll `tab-line-mode' window tabs to the left.")
-
-(defvar tab-line-right-map
- (let ((map (make-sparse-keymap)))
- (define-key map [tab-line down-mouse-1] 'tab-line-hscroll-right)
- (define-key map [tab-line down-mouse-2] 'tab-line-hscroll-right)
- (define-key map "\C-m" 'tab-line-new-tab)
- map)
- "Local keymap to scroll `tab-line-mode' window tabs to the right.")
+(defvar-keymap tab-line-tab-map
+ :doc "Local keymap for `tab-line-mode' window tabs."
+ "<tab-line> <down-mouse-1>" #'tab-line-select-tab
+ "<tab-line> <mouse-2>" #'tab-line-close-tab
+ "<tab-line> <down-mouse-3>" #'tab-line-tab-context-menu
+ "RET" #'tab-line-select-tab)
+
+(defvar-keymap tab-line-add-map
+ :doc "Local keymap to add `tab-line-mode' window tabs."
+ "<tab-line> <down-mouse-1>" #'tab-line-new-tab
+ "<tab-line> <down-mouse-2>" #'tab-line-new-tab
+ "RET" #'tab-line-new-tab)
+
+(defvar-keymap tab-line-tab-close-map
+ :doc "Local keymap to close `tab-line-mode' window tabs."
+ "<tab-line> <mouse-1>" #'tab-line-close-tab
+ "<tab-line> <mouse-2>" #'tab-line-close-tab)
+
+(defvar-keymap tab-line-left-map
+ :doc "Local keymap to scroll `tab-line-mode' window tabs to the left."
+ "<tab-line> <down-mouse-1>" #'tab-line-hscroll-left
+ "<tab-line> <down-mouse-2>" #'tab-line-hscroll-left
+ "RET" #'tab-line-new-tab)
+
+(defvar-keymap tab-line-right-map
+ :doc "Local keymap to scroll `tab-line-mode' window tabs to the right."
+ "<tab-line> <down-mouse-1>" #'tab-line-hscroll-right
+ "<tab-line> <down-mouse-2>" #'tab-line-hscroll-right
+ "RET" #'tab-line-new-tab)
(defcustom tab-line-new-tab-choice t
@@ -630,7 +620,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/tar-mode.el b/lisp/tar-mode.el
index 20ad6e1e46..49d84319c5 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -169,7 +169,7 @@ This information is useful, but it takes screen space away
from file names."
(defun tar-swap-data ()
"Swap buffer contents between current buffer and `tar-data-buffer'.
-Preserve the modified states of the buffers and set `buffer-swapped-with'."
+Preserve the modified states of the buffers and set `tar-data-swapped'."
(let ((data-buffer-modified-p (buffer-modified-p tar-data-buffer))
(current-buffer-modified-p (buffer-modified-p)))
(buffer-swap-text tar-data-buffer)
diff --git a/lisp/term.el b/lisp/term.el
index 797fb18074..755c220270 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -755,25 +755,8 @@ Buffer local variable.")
term-color-bright-cyan
term-color-bright-white])
-(defcustom term-default-fg-color nil
- "If non-nil, default color for foreground in Term mode."
- :group 'term
- :type '(choice (const nil) (string :tag "color")))
-(make-obsolete-variable 'term-default-fg-color "use the face `term' instead."
- "24.3")
-
-(defcustom term-default-bg-color nil
- "If non-nil, default color for foreground in Term mode."
- :group 'term
- :type '(choice (const nil) (string :tag "color")))
-(make-obsolete-variable 'term-default-bg-color "use the face `term' instead."
- "24.3")
-
(defface term
- `((t
- :foreground ,term-default-fg-color
- :background ,term-default-bg-color
- :inherit default))
+ `((t :inherit default))
"Default face to use in Term mode."
:group 'term)
diff --git a/lisp/term/fbterm.el b/lisp/term/fbterm.el
new file mode 100644
index 0000000000..ad7150c1a1
--- /dev/null
+++ b/lisp/term/fbterm.el
@@ -0,0 +1,27 @@
+;;; fbterm.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Note that, in some versions of fbterm, the TERM environment
+;; variable is set to "linux". When that's the case, the code below
+;; will not be executed, and only 8 colors will be available. It is
+;; therefore necessary, with these versions of fbterm, to set that
+;; environment variable to "fbterm" to enable its 256 color mode
+;; extension. See also the node "Emacs in a Linux console" of the
+;; Emacs FAQ.
+
+(require 'term/xterm)
+
+(defun terminal-init-fbterm ()
+ "Terminal initialization function for fbterm."
+
+ ;; fbterm can't display underlines, even though its terminfo data
+ ;; says it can.
+ (tty-no-underline)
+
+ ;; fbterm supports xterm's 256 color mode extension.
+ (xterm-register-default-colors xterm-standard-colors))
+
+(provide 'term/fbterm)
+
+;;; fbterm.el ends here
diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index a16169d477..24942d96c1 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -598,6 +598,45 @@ MODIFIERS is the internal modifier mask of the wheel
movement."
;; the Deskbar will not, so kill ourself here.
(unless cancel-shutdown (kill-emacs))))
+;;;; Wallpaper support.
+
+
+(declare-function haiku-write-node-attribute "haikuselect.c")
+(declare-function haiku-send-message "haikuselect.c")
+
+(defun haiku-set-wallpaper (file)
+ "Make FILE the wallpaper.
+Set the desktop background to the image FILE, on all workspaces,
+with an offset of 0, 0."
+ (let ((encoded-file (encode-coding-string
+ (expand-file-name file)
+ (or file-name-coding-system
+ default-file-name-coding-system))))
+ ;; Write the necessary information to the desktop directory.
+ (haiku-write-node-attribute "/boot/home/Desktop"
+ "be:bgndimginfo"
+ (list '(type . 0)
+ '("be:bgndimginfoerasetext" bool t)
+ (list "be:bgndimginfopath" 'string
+ encoded-file)
+ '("be:bgndimginfoworkspaces" long
+ ;; This is a mask of all the
+ ;; workspaces the background
+ ;; image will be applied to. It
+ ;; is treated as an unsigned
+ ;; value by the Tracker, despite
+ ;; the type being signed.
+ -1)
+ ;; Don't apply an offset
+ '("be:bgndimginfooffset" point (0 . 0))
+ ;; Don't stretch or crop or anything
+ '("be:bgndimginfomode" long 0)
+ ;; Don't apply a set
+ '("be:bgndimginfoset" long 0)))
+ ;; Tell the tracker to redisplay the wallpaper.
+ (haiku-send-message "application/x-vnd.Be-TRAK"
+ (list (cons 'type (haiku-numeric-enum Tbgr))))))
+
;;;; Cursors.
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index ab5a6d8698..f24af3f134 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -2,8 +2,6 @@
;; The Linux console handles Latin-1 by default.
-(declare-function gpm-mouse-enable "t-mouse" ())
-
(defun terminal-init-linux ()
"Terminal initialization function for linux."
(unless (terminal-coding-system)
@@ -15,15 +13,11 @@
;; Compositions confuse cursor movement.
(setq-default auto-composition-mode "linux")
- (ignore-errors (when gpm-mouse-mode (require 't-mouse) (gpm-mouse-enable)))
-
- ;; Don't translate ESC TAB to backtab as directed
- ;; by ncurses-6.3.
+ ;; Don't translate ESC TAB to backtab as directed by ncurses-6.3.
(define-key input-decode-map "\e\t" nil)
;; Make Latin-1 input characters work, too.
- ;; Meta will continue to work, because the kernel
- ;; turns that into Escape.
+ ;; Meta will continue to work, because the kernel turns that into Escape.
;; The arg only matters in that it is not t or nil.
(set-input-meta-mode 'iso-latin-1))
diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el
index b93e259d82..20f1573916 100644
--- a/lisp/term/pgtk-win.el
+++ b/lisp/term/pgtk-win.el
@@ -371,6 +371,7 @@ This uses `icon-map-list' to map icon file names to stock
icon names."
"Return the device class of NAME.
Users should not call this function; see `device-class' instead."
(cond
+ ((not name) nil)
((string-match-p "XTEST" name) 'test)
((string= "Virtual core pointer" name) 'core-pointer)
((string= "Virtual core keyboard" name) 'core-keyboard)
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 38266baa96..62684f52cc 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1573,45 +1573,68 @@ frames on all displays."
(defun x-device-class (name)
"Return the device class of NAME.
Users should not call this function; see `device-class' instead."
- (let ((downcased-name (downcase name)))
- (cond
- ((string-match-p "XTEST" name) 'test)
- ((string= "Virtual core pointer" name) 'core-pointer)
- ((string= "Virtual core keyboard" name) 'core-keyboard)
- ((string-match-p "eraser" downcased-name) 'eraser)
- ((string-match-p " pad" downcased-name) 'pad)
- ((or (or (string-match-p "wacom" downcased-name)
- (string-match-p "pen" downcased-name))
- (string-match-p "stylus" downcased-name))
- 'pen)
- ((or (string-prefix-p "xwayland-touch:" name)
- (string-match-p "touchscreen" downcased-name))
- 'touchscreen)
- ((or (string-match-p "trackpoint" downcased-name)
- (string-match-p "stick" downcased-name))
- 'trackpoint)
- ((or (string-match-p "mouse" downcased-name)
- (string-match-p "optical" downcased-name)
- (string-match-p "pointer" downcased-name))
- 'mouse)
- ((string-match-p "cursor" downcased-name) 'puck)
- ((or (string-match-p "keyboard" downcased-name)
- ;; One of my cheap keyboards is really named this...
- (string= name "USB USB Keykoard"))
- 'keyboard)
- ((string-match-p "button" downcased-name) 'power-button)
- ((string-match-p "touchpad" downcased-name) 'touchpad)
- ((or (string-match-p "midi" downcased-name)
- (string-match-p "piano" downcased-name))
- 'piano)
- ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD
- (and (string-match-p "/dev" downcased-name)
- (string-match-p "kbd" downcased-name)))
- 'keyboard))))
+ (and name
+ (let ((downcased-name (downcase name)))
+ (cond
+ ((string-match-p "XTEST" name) 'test)
+ ((string= "Virtual core pointer" name) 'core-pointer)
+ ((string= "Virtual core keyboard" name) 'core-keyboard)
+ ((string-match-p "eraser" downcased-name) 'eraser)
+ ((string-match-p " pad" downcased-name) 'pad)
+ ((or (or (string-match-p "wacom" downcased-name)
+ (string-match-p "pen" downcased-name))
+ (string-match-p "stylus" downcased-name))
+ 'pen)
+ ((or (string-prefix-p "xwayland-touch:" name)
+ (string-match-p "touchscreen" downcased-name))
+ 'touchscreen)
+ ((or (string-match-p "trackpoint" downcased-name)
+ (string-match-p "stick" downcased-name))
+ 'trackpoint)
+ ((or (string-match-p "mouse" downcased-name)
+ (string-match-p "optical" downcased-name)
+ (string-match-p "pointer" downcased-name))
+ 'mouse)
+ ((string-match-p "cursor" downcased-name) 'puck)
+ ((or (string-match-p "keyboard" downcased-name)
+ ;; One of my cheap keyboards is really named this...
+ (string= name "USB USB Keykoard"))
+ 'keyboard)
+ ((string-match-p "button" downcased-name) 'power-button)
+ ((string-match-p "touchpad" downcased-name) 'touchpad)
+ ((or (string-match-p "midi" downcased-name)
+ (string-match-p "piano" downcased-name))
+ 'piano)
+ ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD
+ (and (string-match-p "/dev" downcased-name)
+ (string-match-p "kbd" downcased-name)))
+ 'keyboard)))))
(setq x-dnd-movement-function #'x-dnd-movement)
(setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop)
+(defvar x-input-coding-function)
+
+(defun x-get-input-coding-system (x-locale)
+ "Return a coding system for the locale X-LOCALE.
+Return a coding system that is able to decode text sent with the
+X input method locale X-LOCALE, or nil if no coding system was
+found."
+ (if (equal x-locale "C")
+ ;; Treat the C locale specially, as it means "ascii" under X.
+ 'ascii
+ (let ((locale (locale-translate (downcase x-locale))))
+ (or (locale-name-match locale locale-preferred-coding-systems)
+ (when locale
+ (if (string-match "\\.\\([^@]+\\)" locale)
+ (locale-charset-to-coding-system
+ (match-string 1 locale))))
+ (let ((language-name
+ (locale-name-match locale locale-language-names)))
+ (and (consp language-name) (cdr language-name)))))))
+
+(setq x-input-coding-function #'x-get-input-coding-system)
+
(provide 'x-win)
(provide 'term/x-win)
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 2cf9ded04b..76675328da 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -5341,8 +5341,6 @@ The event, EV, is the mouse event."
(require 'reporter)
(if (y-or-n-p "Do you want to submit a bug report on Artist? ")
(let ((vars '(window-system
- window-system-version
- ;;
artist-rubber-banding
artist-interface-with-rect
artist-aspect-ratio
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/emacs-authors-mode.el
b/lisp/textmodes/emacs-authors-mode.el
index 866822c103..3eba8e0e45 100644
--- a/lisp/textmodes/emacs-authors-mode.el
+++ b/lisp/textmodes/emacs-authors-mode.el
@@ -130,7 +130,20 @@ Provides some basic font locking and not much else."
'(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w"))))
(setq font-lock-multiline nil)
(setq imenu-generic-expression emacs-authors-imenu-generic-expression)
- (emacs-etc--hide-local-variables))
+ (emacs-etc--hide-local-variables)
+ (setq-local outline-regexp (rx (+ (not (any ":\n"))) ": "
+ (or "changed" "co-wrote" "wrote") " ")
+ outline-minor-mode-cycle t
+ outline-level
+ (lambda ()
+ (if (looking-at (rx bol
+ (or (or " "
+ (seq "and " (or "co-wrote"
+ "changed")))
+ eol)))
+ 2
+ 1)))
+ (outline-minor-mode))
(define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1")
(define-obsolete-face-alias 'etc-authors-author 'emacs-authors-author "29.1")
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index 022e17c934..ebb31da9cf 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -73,11 +73,11 @@
(defun emacs-news--mode-common ()
(setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
- (setq-local outline-regexp "\\(:? +\\)?\\(\\*+\\) "
- outline-minor-mode-cycle t
- outline-level (lambda () (length (match-string 2)))
- 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))
;;;###autoload
@@ -274,6 +274,17 @@ documentation marks on the previous line."
(forward-line -1))
(open-line n))
+(defun emacs-news-delete-temporary-markers ()
+ "Delete any temporary markers.
+This is used when preparing a new release of Emacs."
+ (interactive nil emacs-news-mode)
+ (goto-char (point-min))
+ (re-search-forward "^Temporary note:$")
+ (forward-line -1)
+ (delete-region (point) (save-excursion (forward-paragraph) (point)))
+ (while (re-search-forward (rx bol (or "+++" "---") eol) nil t)
+ (delete-line)))
+
(provide 'emacs-news-mode)
;;; emacs-news-mode.el ends here
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 1094ef3e93..a66b72cfd0 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -425,11 +425,9 @@ like <img alt=\"Some thing.\">."
;;*---------------------------------------------------------------------*/
;;* The minor mode declaration. */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-mouse-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'flyspell-correct-word)
- map)
- "Keymap for Flyspell to put on erroneous words.")
+(defvar-keymap flyspell-mouse-map
+ :doc "Keymap for Flyspell to put on erroneous words."
+ "<mouse-2>" #'flyspell-correct-word)
(defvar flyspell-mode-map
(let ((map (make-sparse-keymap)))
@@ -1034,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)))
@@ -1068,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)))
@@ -1714,25 +1710,32 @@ of a misspelled word removed when you've corrected it."
;;*---------------------------------------------------------------------*/
;;* flyspell-goto-next-error ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-goto-next-error ()
- "Go to the next previously detected error.
+(defun flyspell-goto-next-error (&optional previous)
+ "Go to the next error.
+If PREVIOUS (interactively, the prefix), go to the previous error
+instead.
+
In general FLYSPELL-GOTO-NEXT-ERROR must be used after
FLYSPELL-BUFFER."
- (interactive)
+ (interactive "P")
(let ((pos (point))
- (max (point-max)))
- (if (and (eq (current-buffer) flyspell-old-buffer-error)
- (eq pos flyspell-old-pos-error))
- (progn
- (if (= flyspell-old-pos-error max)
- ;; goto beginning of buffer
+ (max (if previous (point-min) (point-max))))
+ (when (and (eq (current-buffer) flyspell-old-buffer-error)
+ (eq pos flyspell-old-pos-error))
+ (if previous
+ (if (= flyspell-old-pos-error max)
(progn
- (message "Restarting from beginning of buffer")
- (goto-char (point-min)))
- (forward-word 1))
- (setq pos (point))))
- ;; seek the next error
- (while (and (< pos max)
+ (message "Restarting from end of the buffer")
+ (goto-char (point-max)))
+ (forward-word -1))
+ (if (= flyspell-old-pos-error max)
+ (progn
+ (message "Restarting from beginning of buffer")
+ (goto-char (point-min)))
+ (forward-word 1)))
+ (setq pos (point)))
+ ;; Seek the next error.
+ (while (and (/= pos max)
(let ((ovs (overlays-at pos))
(r '()))
(while (and (not r) (consp ovs))
@@ -1740,13 +1743,15 @@ FLYSPELL-BUFFER."
(setq r t)
(setq ovs (cdr ovs))))
(not r)))
- (setq pos (1+ pos)))
- ;; save the current location for next invocation
- (setq flyspell-old-pos-error pos)
- (setq flyspell-old-buffer-error (current-buffer))
+ (setq pos (if previous (1- pos) (1+ pos))))
(goto-char pos)
- (if (= pos max)
- (message "No more miss-spelled word!"))))
+ (when previous
+ (forward-word -1))
+ ;; Save the current location for next invocation.
+ (setq flyspell-old-pos-error (point))
+ (setq flyspell-old-buffer-error (current-buffer))
+ (when (= (point) max)
+ (message "No more miss-spelled words"))))
;;*---------------------------------------------------------------------*/
;;* flyspell-overlay-p ... */
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 8e63368809..b3fb326cf9 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -262,12 +262,14 @@ This must be an absolute file name."
"Non-nil means use `look' rather than `grep'.
Default is based on whether `look' seems to be available."
:type 'boolean)
+(make-obsolete-variable 'ispell-look-p nil "29.1")
(defcustom ispell-have-new-look nil
"Non-nil means use the `-r' option (regexp) when running `look'."
:type 'boolean)
+(make-obsolete-variable 'ispell-have-new-look nil "29.1")
-(defcustom ispell-look-options (if ispell-have-new-look "-dfr" "-df")
+(defcustom ispell-look-options "-df"
"String of command options for `ispell-look-command'."
:type 'string)
@@ -738,7 +740,8 @@ Otherwise returns the library directory name, if that is
defined."
"Execute the forms in BODY with a reasonable `default-directory'."
(declare (indent 0) (debug t))
`(let ((default-directory default-directory))
- (unless (file-accessible-directory-p default-directory)
+ (unless (and (not (file-remote-p default-directory))
+ (file-accessible-directory-p default-directory))
(setq default-directory (expand-file-name "~/")))
,@body))
@@ -2519,8 +2522,10 @@ if defined."
(let* ((process-connection-type ispell-use-ptys-p)
(wild-p (string-search "*" word))
- (look-p (and ispell-look-p ; Only use look for an exact match.
- (or ispell-have-new-look (not wild-p))))
+ (look-p (and ispell-look-command
+ (file-exists-p ispell-look-command)
+ ;; Only use look for an exact match.
+ (not wild-p)))
(prog (if look-p ispell-look-command ispell-grep-command))
(args (if look-p ispell-look-options ispell-grep-options))
status results loc)
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index a0462756b0..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.
;;
@@ -209,10 +209,8 @@ directory by default."
(modify-syntax-entry ?. "'" st)
st))
-(defvar less-css-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'less-css-compile)
- map))
+(defvar-keymap less-css-mode-map
+ "C-c C-c" #'less-css-compile)
;;;###autoload (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode))
;;;###autoload
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 6b71f26e4f..b133b1e9e3 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,7 +1,6 @@
;;; page-ext.el --- extended page handling commands -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1991, 1993-1994, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1990-2022 Free Software Foundation, Inc.
;; Author: Robert J. Chassell <bob@gnu.org>
;; (according to ack.texi)
@@ -25,20 +24,20 @@
;;; Commentary:
;; You may use these commands to handle an address list or other
-;; small data base.
+;; small database.
;;; Summary
;; The current page commands are:
-;; forward-page C-x ]
-;; backward-page C-x [
-;; narrow-to-page C-x p
-;; count-lines-page C-x l
-;; mark-page C-x C-p (change this to C-x C-p C-m)
-;; sort-pages not bound
-;; what-page not bound
+;; `forward-page' C-x ]
+;; `backward-page' C-x [
+;; `narrow-to-page' C-x p
+;; `count-lines-page' C-x l
+;; `mark-page' C-x C-p (change this to C-x C-p C-m)
+;; `sort-pages' not bound
+;; `what-page' not bound
;; The new page handling commands all use `C-x C-p' as a prefix. This
;; means that the key binding for `mark-page' must be changed.
@@ -47,15 +46,15 @@
;; New page handling commands:
-;; pages-next-page C-x C-p C-n
-;; pages-previous-page C-x C-p C-p
-;; pages-search C-x C-p C-s
-;; pages-add-new-page C-x C-p C-a
-;; pages-sort-buffer C-x C-p s
-;; pages-set-delimiter C-x C-p C-l
-;; pages-directory C-x C-p C-d
-;; pages-directory-for-addresses C-x C-p d
-;; pages-directory-goto C-c C-c
+;; `pages-next-page' C-x C-p C-n
+;; `pages-previous-page' C-x C-p C-p
+;; `pages-search' C-x C-p C-s
+;; `pages-add-new-page' C-x C-p C-a
+;; `pages-sort-buffer' C-x C-p s
+;; `pages-set-delimiter' C-x C-p C-l
+;; `pages-directory' C-x C-p C-d
+;; `pages-directory-for-addresses' C-x C-p d
+;; `pages-directory-goto' C-c C-c
;;; Using the page commands
@@ -103,8 +102,8 @@
;;
;; 2. The first line of text in each entry is the `heading line'; it
;; will appear in the pages-directory-buffer which is constructed
-;; using the `C-x C-p C-d' (pages-directory) command or the `C-x
-;; C-p d' (pages-directory-for-addresses) command.
+;; using the `C-x C-p C-d' (`pages-directory') command or the
+;; `C-x C-p d' (`pages-directory-for-addresses') command.
;;
;; The heading line may be on the same line as the page-delimiter
;; or it may follow after. It is the first non-blank line on the
@@ -163,17 +162,18 @@
;; `pages-previous-page', `pages-add-new-page', `mark-page', and `pages-search'
;; commands.
-;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
-;; or the `C-x C-p C-d' (pages-directory) command to construct and
+;; You may use either the `C-x C-p d' (`pages-directory-for-addresses')
+;; or the `C-x C-p C-d' (`pages-directory') command to construct and
;; display a directory of all the heading lines.
;; In the directory, you may position the cursor over a heading line
-;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
+;; and type `C-c C-c' (`pages-directory-goto') to go to the entry to
;; which it refers in the pages buffer.
-;; You can type `C-c C-p C-a' (pages-add-new-page) to add a new entry in the
-;; pages buffer or address file. This is the same command you use to
-;; add a new entry when you are in the pages buffer or address file.
+;; You can type `C-c C-p C-a' (`pages-add-new-page') to add a new
+;; entry in the pages buffer or address file. This is the same
+;; command you use to add a new entry when you are in the pages buffer
+;; or address file.
;; If you wish, you may create several different directories,
;; one for each different buffer.
@@ -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/paragraphs.el b/lisp/textmodes/paragraphs.el
index cd726ad477..c500dc014f 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -514,9 +514,9 @@ Second and third arg START and END specify the region to
operate on.
If optional argument NO-QUERY is non-nil, make changes without asking
for confirmation. You can use `repunctuate-sentences-filter' to add
filters to skip occurrences of spaces that don't need to be replaced."
- (interactive (list nil
- (if (use-region-p) (region-beginning))
- (if (use-region-p) (region-end))))
+ (declare (interactive-args (start (use-region-beginning))
+ (end (use-region-end))))
+ (interactive (list nil (use-region-beginning) (use-region-end)))
(let ((regexp "\\([]\"')]?\\)\\([.?!]\\)\\([]\"')]?\\) +")
(to-string "\\1\\2\\3 "))
(if no-query
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index e8c1e6b14f..ab211fdd7b 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,6 +1,6 @@
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1994, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -23,9 +23,9 @@
;;; Commentary:
-;; This code provides the picture-mode commands documented in the Emacs
+;; This code provides the `picture-mode' commands documented in the Emacs
;; manual. The screen is treated as a semi-infinite quarter-plane with
-;; support for rectangle operations and `etch-a-sketch' character
+;; support for rectangle operations and "etch-a-sketch" character
;; insertion in any of eight directions.
;;; Code:
@@ -96,7 +96,7 @@ If scan reaches end of buffer, stop there without error."
(defun picture-forward-column (arg &optional interactive)
"Move cursor right, making whitespace if necessary.
-With argument, move that many columns."
+With prefix argument ARG, move that many columns."
(interactive "^p\nd")
(let (deactivate-mark)
(picture-update-desired-column interactive)
@@ -110,14 +110,14 @@ With argument, move that many columns."
(defun picture-backward-column (arg &optional interactive)
"Move cursor left, making whitespace if necessary.
-With argument, move that many columns."
+With prefix argument ARG, move that many columns."
(interactive "^p\nd")
(picture-update-desired-column interactive)
(picture-forward-column (- arg)))
(defun picture-move-down (arg)
"Move vertically down, making whitespace if necessary.
-With argument, move that many lines."
+With prefix argument ARG, move that many lines."
(interactive "^p")
(let (deactivate-mark)
(picture-update-desired-column nil)
@@ -134,7 +134,7 @@ With argument, move that many lines."
(defun picture-move-up (arg)
"Move vertically up, making whitespace if necessary.
-With argument, move that many lines."
+With prefix argument ARG, move that many lines."
(interactive "^p")
(picture-update-desired-column nil)
(picture-move-down (- arg)))
@@ -161,36 +161,36 @@ With argument, move that many lines."
(defun picture-movement-nw (&optional arg)
"Move up and left after self-inserting character in Picture mode.
-With prefix argument, move up and two-column left."
+With prefix argument ARG, move up and two-column left."
(interactive "P")
(picture-set-motion -1 (if arg -2 -1)))
(defun picture-movement-ne (&optional arg)
"Move up and right after self-inserting character in Picture mode.
-With prefix argument, move up and two-column right."
+With prefix argument ARG, move up and two-column right."
(interactive "P")
(picture-set-motion -1 (if arg 2 1)))
(defun picture-movement-sw (&optional arg)
"Move down and left after self-inserting character in Picture mode.
-With prefix argument, move down and two-column left."
+With prefix argument ARG, move down and two-column left."
(interactive "P")
(picture-set-motion 1 (if arg -2 -1)))
(defun picture-movement-se (&optional arg)
"Move down and right after self-inserting character in Picture mode.
-With prefix argument, move down and two-column right."
+With prefix argument ARG, move down and two-column right."
(interactive "P")
(picture-set-motion 1 (if arg 2 1)))
-(defun picture-set-motion (vert horiz)
+(defun picture-set-motion (vertical horizontal)
"Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
The mode line is updated to reflect the current direction."
- (setq picture-vertical-step vert
- picture-horizontal-step horiz)
+ (setq picture-vertical-step vertical
+ picture-horizontal-step horizontal)
(setq mode-name
(format "Picture:%s"
- (nth (+ 2 (% horiz 3) (* 5 (1+ (% vert 2))))
+ (nth (+ 2 (% horizontal 3) (* 5 (1+ (% vertical 2))))
'(wnw nw up ne ene Left left none right Right
wsw sw down se ese))))
(force-mode-line-update)
@@ -305,9 +305,9 @@ Use \"\\[command-apropos] picture-movement\" to see those
commands."
(defun picture-clear-line (arg)
"Clear out rest of line; if at end of line, advance to next line.
-Cleared-out line text goes into the kill ring, as do newlines that are
-advanced over. With argument, clear out (and save in kill ring) that
-many lines."
+Cleared-out line text goes into the kill ring, as do newlines
+that are advanced over. With prefix argument ARG, clear out (and
+save in kill ring) that many lines."
(interactive "P")
(if arg
(progn
@@ -320,7 +320,8 @@ many lines."
(defun picture-newline (arg)
"Move to the beginning of the following line.
-With argument, moves that many lines (up, if negative argument);
+With prefix argument ARG, move that many lines (up, if negative
+argument);
always moves to the beginning of a line."
(interactive "^p")
(let ((start (point))
@@ -466,8 +467,11 @@ If no such character is found, move to beginning of line."
(defun picture-tab (&optional arg)
"Tab transparently (just move point) to next tab stop.
-With prefix arg, overwrite the traversed text with spaces. The tab stop
-list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
+With prefix argument ARG, overwrite the traversed text with
+spaces. The tab stop list can be changed by \
+\\<picture-mode-map>\\[picture-set-tab-stops] and
+\\[edit-tab-stops].
+
See also documentation for variable `picture-tab-chars'."
(interactive "^P")
(let* ((opoint (point)))
@@ -515,10 +519,11 @@ Interactively, reads the register using
`register-read-with-preview'."
(defun picture-yank-rectangle (&optional insertp)
"Overlay rectangle saved by \\[picture-clear-rectangle].
-The rectangle is positioned with upper left corner at point, overwriting
-existing text. With prefix argument, the rectangle is inserted instead,
-shifting existing text. Leaves mark at one corner of rectangle and
-point at the other (diagonally opposed) corner."
+The rectangle is positioned with upper left corner at point,
+overwriting existing text. With prefix argument INSERTP, the
+rectangle is inserted instead, shifting existing text. Leave
+mark at one corner of rectangle and point at the
+other (diagonally opposed) corner."
(interactive "P")
(if (not (consp picture-killed-rectangle))
(error "No rectangle saved")
@@ -536,10 +541,11 @@ regardless of where you click."
(defun picture-yank-rectangle-from-register (register &optional insertp)
"Overlay rectangle saved in REGISTER.
-The rectangle is positioned with upper left corner at point, overwriting
-existing text. With prefix argument, the rectangle is
-inserted instead, shifting existing text. Leaves mark at one corner
-of rectangle and point at the other (diagonally opposed) corner.
+The rectangle is positioned with upper left corner at point,
+overwriting existing text. With prefix argument INSERTP, the
+rectangle is inserted instead, shifting existing text. Leave
+mark at one corner of rectangle and point at the
+other (diagonally opposed) corner.
Interactively, reads the register using `register-read-with-preview'."
(interactive (list (register-read-with-preview "Rectangle from register: ")
@@ -552,7 +558,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(defun picture-insert-rectangle (rectangle &optional insertp)
"Overlay RECTANGLE with upper left corner at point.
Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
-Leaves the region surrounding the rectangle."
+Leave the region surrounding the rectangle."
(let ((indent-tabs-mode nil))
(if (not insertp)
(save-excursion
@@ -570,7 +576,7 @@ Leaves the region surrounding the rectangle."
(if (= (current-column) 0) 1 0)))
(defun picture-draw-rectangle (start end)
- "Draw a rectangle around region."
+ "Draw a rectangle around region from START to END."
(interactive "*r") ; start will be less than end
(let* ((sl (picture-current-line))
(sc (current-column))
@@ -615,61 +621,57 @@ Leaves the region surrounding the rectangle."
(defalias 'picture-delete-char 'delete-char)
-(defvar picture-mode-map
- (let ((map (make-keymap)))
- (define-key map [remap self-insert-command] 'picture-self-insert)
- (define-key map [remap completion-separator-self-insert-command]
- 'picture-self-insert)
- (define-key map [remap completion-separator-self-insert-autofilling]
- 'picture-self-insert)
- (define-key map [remap forward-char] 'picture-forward-column)
- (define-key map [remap right-char] 'picture-forward-column)
- (define-key map [remap backward-char] 'picture-backward-column)
- (define-key map [remap left-char] 'picture-backward-column)
- (define-key map [remap delete-char] 'picture-clear-column)
- ;; There are two possibilities for what is normally on DEL.
- (define-key map [remap backward-delete-char-untabify]
- 'picture-backward-clear-column)
- (define-key map [remap delete-backward-char]
'picture-backward-clear-column)
- (define-key map [remap kill-line] 'picture-clear-line)
- (define-key map [remap open-line] 'picture-open-line)
- (define-key map [remap newline] 'picture-newline)
- (define-key map [remap newline-and-indent] 'picture-duplicate-line)
- (define-key map [remap next-line] 'picture-move-down)
- (define-key map [remap previous-line] 'picture-move-up)
- (define-key map [remap move-beginning-of-line] 'picture-beginning-of-line)
- (define-key map [remap move-end-of-line] 'picture-end-of-line)
- (define-key map [remap mouse-set-point] 'picture-mouse-set-point)
- (define-key map "\C-c\C-d" 'picture-delete-char)
- (define-key map "\t" 'picture-tab)
- (define-key map "\e\t" 'picture-tab-search)
- (define-key map "\C-c\t" 'picture-set-tab-stops)
- (define-key map "\C-c\C-k" 'picture-clear-rectangle)
- (define-key map "\C-c\C-w" 'picture-clear-rectangle-to-register)
- (define-key map "\C-c\C-y" 'picture-yank-rectangle)
- (define-key map "\C-c\C-x" 'picture-yank-rectangle-from-register)
- (define-key map "\C-c\C-r" 'picture-draw-rectangle)
- (define-key map "\C-c\C-c" 'picture-mode-exit)
- (define-key map "\C-c\C-f" 'picture-motion)
- (define-key map "\C-c\C-b" 'picture-motion-reverse)
- (define-key map "\C-c<" 'picture-movement-left)
- (define-key map "\C-c>" 'picture-movement-right)
- (define-key map "\C-c^" 'picture-movement-up)
- (define-key map "\C-c." 'picture-movement-down)
- (define-key map "\C-c`" 'picture-movement-nw)
- (define-key map "\C-c'" 'picture-movement-ne)
- (define-key map "\C-c/" 'picture-movement-sw)
- (define-key map "\C-c\\" 'picture-movement-se)
- (define-key map [(control ?c) left] 'picture-movement-left)
- (define-key map [(control ?c) right] 'picture-movement-right)
- (define-key map [(control ?c) up] 'picture-movement-up)
- (define-key map [(control ?c) down] 'picture-movement-down)
- (define-key map [(control ?c) home] 'picture-movement-nw)
- (define-key map [(control ?c) prior] 'picture-movement-ne)
- (define-key map [(control ?c) end] 'picture-movement-sw)
- (define-key map [(control ?c) next] 'picture-movement-se)
- map)
- "Keymap used in `picture-mode'.")
+(defvar-keymap picture-mode-map
+ :doc "Keymap used in `picture-mode'."
+ :full t
+ "<remap> <self-insert-command>" #'picture-self-insert
+ "<remap> <completion-separator-self-insert-command>" #'picture-self-insert
+ "<remap> <completion-separator-self-insert-autofilling>"
#'picture-self-insert
+ "<remap> <forward-char>" #'picture-forward-column
+ "<remap> <right-char>" #'picture-forward-column
+ "<remap> <backward-char>" #'picture-backward-column
+ "<remap> <left-char>" #'picture-backward-column
+ "<remap> <delete-char>" #'picture-clear-column
+ ;; There are two possibilities for what is normally on DEL.
+ "<remap> <backward-delete-char-untabify>" #'picture-backward-clear-column
+ "<remap> <delete-backward-char>" #'picture-backward-clear-column
+ "<remap> <kill-line>" #'picture-clear-line
+ "<remap> <open-line>" #'picture-open-line
+ "<remap> <newline>" #'picture-newline
+ "<remap> <newline-and-indent>" #'picture-duplicate-line
+ "<remap> <next-line>" #'picture-move-down
+ "<remap> <previous-line>" #'picture-move-up
+ "<remap> <move-beginning-of-line>" #'picture-beginning-of-line
+ "<remap> <move-end-of-line>" #'picture-end-of-line
+ "<remap> <mouse-set-point>" #'picture-mouse-set-point
+ "C-c C-d" #'picture-delete-char
+ "TAB" #'picture-tab
+ "M-TAB" #'picture-tab-search
+ "C-c TAB" #'picture-set-tab-stops
+ "C-c C-k" #'picture-clear-rectangle
+ "C-c C-w" #'picture-clear-rectangle-to-register
+ "C-c C-y" #'picture-yank-rectangle
+ "C-c C-x" #'picture-yank-rectangle-from-register
+ "C-c C-r" #'picture-draw-rectangle
+ "C-c C-c" #'picture-mode-exit
+ "C-c C-f" #'picture-motion
+ "C-c C-b" #'picture-motion-reverse
+ "C-c <" #'picture-movement-left
+ "C-c >" #'picture-movement-right
+ "C-c ^" #'picture-movement-up
+ "C-c ." #'picture-movement-down
+ "C-c `" #'picture-movement-nw
+ "C-c '" #'picture-movement-ne
+ "C-c /" #'picture-movement-sw
+ "C-c \\" #'picture-movement-se
+ "C-c <left>" #'picture-movement-left
+ "C-c <right>" #'picture-movement-right
+ "C-c <up>" #'picture-movement-up
+ "C-c <down>" #'picture-movement-down
+ "C-c <home>" #'picture-movement-nw
+ "C-c <prior>" #'picture-movement-ne
+ "C-c <end>" #'picture-movement-sw
+ "C-c <next>" #'picture-movement-se)
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index 062cea9c50..9f308646fc 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -276,7 +276,18 @@ one with the `xr' package."
;; to ignore the problematic string.
;; If TEST is nil, it is ignored without query.
;; Return the number of replacements.
- (let ((n 0) file label match-data buf macro pos cell)
+ (let ((n 0)
+ (opt-re (concat "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
+ "}[^][]*\\)*"))
+ (man-re (concat "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
+ "}[^}{]*\\)*"))
+ file label match-data buf macro pos cell)
(while (setq file (pop files))
(setq buf (reftex-get-file-buffer-force file))
(unless buf
@@ -301,7 +312,29 @@ one with the `xr' package."
(looking-at "\\\\ref[a-zA-Z]*[^a-zA-Z]")
(looking-at (format
reftex-find-label-regexp-format
- (regexp-quote label)))))
+ (regexp-quote label)))
+ ;; In case the label-keyval is inside an
+ ;; optional argument to \begin{env}
+ (looking-at (concat
+ "\\\\begin[[:space:]]*{[^}]+}"
+ "[[:space:]]*"
+ "\\[[^][]*"
+ opt-re
+ (format
+ reftex-find-label-regexp-format
+ (regexp-quote label))
+ "[^]]*\\]"))
+ ;; In case the label-keyval is inside the
+ ;; first mandatory argument to \begin{env}
+ (looking-at (concat
+ "\\\\begin[[:space:]]*{[^}]+}"
+ "[[:space:]]*"
+ "{[^}{]*"
+ man-re
+ (format
+ reftex-find-label-regexp-format
+ (regexp-quote label))
+ "[^}]*}"))))
;; OK, we should replace it.
(set-match-data match-data)
(cond
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index c7a9f20ea2..f8c7af2500 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -548,13 +548,11 @@ If this is nil, then `diary-file' will be used instead."
;;; Internal Functions:
-(defvar remember-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" #'remember-finalize)
- (define-key map "\C-c\C-c" #'remember-finalize)
- (define-key map "\C-c\C-k" #'remember-destroy)
- map)
- "Keymap used in `remember-mode'.")
+(defvar-keymap remember-mode-map
+ :doc "Keymap used in `remember-mode'."
+ "C-x C-s" #'remember-finalize
+ "C-c C-c" #'remember-finalize
+ "C-c C-k" #'remember-destroy)
(define-derived-mode remember-mode text-mode "Remember"
"Major mode for output from \\[remember].
@@ -596,11 +594,9 @@ If this is nil, use `initial-major-mode'."
-(defvar remember-notes-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'remember-notes-save-and-bury-buffer)
- map)
- "Keymap used in `remember-notes-mode'.")
+(defvar-keymap remember-notes-mode-map
+ :doc "Keymap used in `remember-notes-mode'."
+ "C-c C-c" #'remember-notes-save-and-bury-buffer)
(define-minor-mode remember-notes-mode
"Minor mode for the `remember-notes' buffer.
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index c0d4dc68af..7fe46b9628 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -3634,19 +3634,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(dolist (var '(rst-level-face-max rst-level-face-base-color
- rst-level-face-base-light
- rst-level-face-format-light
- rst-level-face-step-light
- rst-level-1-face
- rst-level-2-face
- rst-level-3-face
- rst-level-4-face
- rst-level-5-face
- rst-level-6-face))
- (make-obsolete-variable var "customize the faces `rst-level-*' instead."
- "24.3"))
-
;; Define faces for the first 6 levels. More levels are possible, however.
(defface rst-level-1 '((((background light)) (:background "grey85"))
(((background dark)) (:background "grey15")))
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..f81cedc39b 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -266,11 +266,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 +5216,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 e6c0f8c28c..ca0312d8fb 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -980,24 +980,23 @@ Inherits `shell-mode-map' with a few additions.")
(save-excursion
(beginning-of-line)
(search-forward "%" search-end t))))))
- (when (and slash (not comment))
- (setq mode
- (if (looking-at
- (concat
- (regexp-opt '("documentstyle" "documentclass"
- "begin" "subsection" "section"
- "part" "chapter" "newcommand"
- "renewcommand" "RequirePackage")
- 'words)
- "\\|NeedsTeXFormat{LaTeX"))
- (if (and (looking-at
-
"document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
- ;; SliTeX is almost never used any more nowadays.
- (tex-executable-exists-p slitex-run-command))
- #'slitex-mode
- #'latex-mode)
- #'plain-tex-mode))))
- mode))
+ (if (not (and slash (not comment)))
+ mode
+ (if (looking-at
+ (concat
+ (regexp-opt '("documentstyle" "documentclass"
+ "begin" "subsection" "section"
+ "part" "chapter" "newcommand"
+ "renewcommand" "RequirePackage")
+ 'words)
+ "\\|NeedsTeXFormat{LaTeX"))
+ (if (and (looking-at
+ "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
+ ;; SliTeX is almost never used any more nowadays.
+ (tex-executable-exists-p slitex-run-command))
+ #'slitex-mode
+ #'latex-mode)
+ #'plain-tex-mode)))))
;; `tex-mode' plays two roles: it's the parent of several sub-modes
;; but it's also the function that chooses between those submodes.
@@ -1014,7 +1013,10 @@ such as if there are no commands in the file, the value
of `tex-default-mode'
says which mode to use."
(tex-common-initialization))
-(advice-add 'tex-mode :around #'tex--redirect-to-submode)
+(advice-add 'tex-mode :around #'tex--redirect-to-submode
+ ;; Give it lower precedence than normal advice, so
+ ;; AUCTeX's advice takes precedence over it.
+ '((depth . 50)))
(defvar tex-mode--recursing nil)
(defun tex--redirect-to-submode (orig-fun)
"Redirect to one of the submodes when called directly."
@@ -1026,26 +1028,21 @@ says which mode to use."
;; We're called from one of the children already.
orig-fun
(setq tex-mode--recursing t)
- (tex--guess-mode)))))
+ (let ((mode (tex--guess-mode)))
+ ;; `tex--guess-mode' really tries to guess the *type* of file,
+ ;; so we still need to consult `major-mode-remap-alist'
+ ;; to see which mode to use for that type.
+ (alist-get mode major-mode-remap-alist mode))))))
;; The following three autoloaded aliases appear to conflict with
-;; AUCTeX. However, even though AUCTeX uses the mixed case variants
-;; for all mode relevant variables and hooks, the invocation function
-;; and setting of `major-mode' themselves need to be lowercase for
-;; AUCTeX to provide a fully functional user-level replacement. So
-;; these aliases should remain as they are, in particular since AUCTeX
-;; users are likely to use them.
-;; Note from Stef: I don't understand the above explanation, the only
-;; justification I can find to keep those confusing aliases is for those
-;; users who may have files annotated with -*- LaTeX -*- (e.g. because they
-;; received them from someone using AUCTeX).
-
-;;;###autoload
-(defalias 'TeX-mode #'tex-mode)
-;;;###autoload
-(defalias 'plain-TeX-mode #'plain-tex-mode)
-;;;###autoload
-(defalias 'LaTeX-mode #'latex-mode)
+;; AUCTeX. We keep those confusing aliases for those users who may
+;; 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 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)
;;;###autoload
(define-derived-mode plain-tex-mode tex-mode "TeX"
@@ -1560,7 +1557,7 @@ a skeleton (see `skeleton-insert').")
'(if (and (boundp 'reftex-mode) reftex-mode) (reftex-label "table"))
\n _)
("figure" nil > _ \n "\\caption{" > (skeleton-read "Caption: ") "}" > \n
- '(if (and (boundp 'reftex-mode) reftex-mode) (reftex-label "table"))))
+ '(if (and (boundp 'reftex-mode) reftex-mode) (reftex-label "figure"))))
"Skeleton element to use for the body of particular environments.
Every element of the list has the form (NAME . SKEL-ELEM) where NAME is
the name of the environment and SKEL-ELEM is an element to use in
@@ -1596,10 +1593,6 @@ Puts point on a blank line between them."
;;;; LaTeX completion.
(defvar latex-complete-bibtex-cache nil)
-
-(define-obsolete-function-alias 'latex-string-prefix-p
- #'string-prefix-p "24.3")
-
(defvar bibtex-reference-key)
(declare-function reftex-get-bibfile-list "reftex-cite.el" ())
@@ -2174,8 +2167,6 @@ IN can be either a string (with the same % escapes in it)
indicating
OUT describes the output file and is either a %-escaped string
or nil to indicate that there is no output file.")
-(define-obsolete-function-alias 'tex-string-prefix-p #'string-prefix-p "24.3")
-
(defun tex-guess-main-file (&optional all)
"Find a likely `tex-main-file'.
Looks for hints in other buffers in the same directory or in
diff --git a/lisp/time.el b/lisp/time.el
index e7066cae7a..247d715ab6 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -528,7 +528,15 @@ If the value is t instead of an alist, use the value of
(defvar-keymap world-clock-mode-map
"n" #'next-line
- "p" #'previous-line)
+ "p" #'previous-line
+ "w" #'world-clock-copy-time-as-kill)
+
+(defun world-clock-copy-time-as-kill ()
+ "Copy current line into the kill ring."
+ (interactive nil world-clock-mode)
+ (when-let ((str (buffer-substring-no-properties (pos-bol) (pos-eol))))
+ (kill-new str)
+ (message str)))
(define-derived-mode world-clock-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
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/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-gw.el b/lisp/url/url-gw.el
index c4a41f56b3..e4d1ca72a0 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -28,8 +28,6 @@
(require 'url-vars)
(require 'url-parse)
-;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
-
(autoload 'socks-open-network-stream "socks")
(defgroup url-gateway nil
@@ -51,17 +49,20 @@
"What hostname to actually rlog into before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
+(make-obsolete-variable 'url-gateway-rlogin-host nil "29.1")
(defcustom url-gateway-rlogin-user-name nil
"Username to log into the remote machine with when using rlogin."
:type '(choice (const nil) string)
:group 'url-gateway)
+(make-obsolete-variable 'url-gateway-rlogin-user-name nil "29.1")
(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
"Parameters to `url-open-rlogin'.
This list will be used as the parameter list given to rsh."
:type '(repeat string)
:group 'url-gateway)
+(make-obsolete-variable 'url-gateway-rlogin-parameters nil "29.1")
(defcustom url-gateway-telnet-host nil
"What hostname to actually login to before doing a telnet."
@@ -141,6 +142,7 @@ linked Emacs under SunOS 4.x."
;; Stolen from red gnus nntp.el
(defun url-open-rlogin (name buffer host service)
"Open a connection using rsh."
+ (declare (obsolete nil "29.1"))
(if (not (stringp service))
(setq service (int-to-string service)))
(let ((proc (if url-gateway-rlogin-user-name
@@ -205,6 +207,9 @@ linked Emacs under SunOS 4.x."
(delete-region (point) (point-max)))
proc)))
+(defvar url-gw-rlogin-obsolete-warned-once nil)
+(make-obsolete-variable url-gw-rlogin-obsolete-warned-once nil "29.1")
+
;;;###autoload
(defun url-open-stream (name buffer host service &optional gateway-method)
"Open a stream to HOST, possibly via a gateway.
@@ -255,7 +260,11 @@ overriding the value of `url-gateway-method'."
('telnet
(url-open-telnet name buffer host service))
('rlogin
- (url-open-rlogin name buffer host service))
+ (unless url-gw-rlogin-obsolete-warned-once
+ (lwarn 'url :error "Setting `url-gateway-method'
to `rlogin' is obsolete")
+ (setq url-gw-rlogin-obsolete-warned-once t))
+ (with-suppressed-warnings ((obsolete
url-open-rlogin))
+ (url-open-rlogin name buffer host service)))
(_
(error "Bad setting of url-gateway-method: %s"
url-gateway-method))))))
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 74f77cd238..cb115fceb2 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -302,11 +302,13 @@ accessible."
filename))
(put 'file-local-copy 'url-file-handlers #'url-file-local-copy)
-(defun url-insert (buffer &optional beg end)
+(defun url-insert (buffer &optional beg end inhibit-decode)
"Insert the body of a URL object.
BUFFER should be a complete URL buffer as returned by `url-retrieve'.
If the headers specify a coding-system (and current buffer is multibyte),
-it is applied to the body before it is inserted.
+it is applied to the body before it is inserted. If INHIBIT-DECODE is
+non-nil, don't do any coding system decoding even in multibyte buffers.
+
Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes
of the inserted text and CHARSET is the charset that was specified in the
header, or nil if none was found.
@@ -318,7 +320,8 @@ They count bytes from the beginning of the body."
(buffer-substring (+ (point-min) beg)
(if end (+ (point-min) end)
(point-max)))
(buffer-string))))
- (charset (if enable-multibyte-characters
+ (charset (if (and enable-multibyte-characters
+ (not inhibit-decode))
(mail-content-type-get (mm-handle-type handle)
'charset))))
(mm-destroy-parts handle)
@@ -362,6 +365,16 @@ if it had been inserted from a file named URL."
(url-insert-buffer-contents buffer url visit beg end replace)))
(put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents)
+;;;###autoload
+(defun url-insert-file-contents-literally (url)
+ "Insert the data retrieved from URL literally in the current buffer."
+ (let ((buffer (url-retrieve-synchronously url)))
+ (unless buffer
+ (signal 'file-error (list url "No Data")))
+ (url-insert buffer nil nil t)
+ (kill-buffer buffer)
+ nil))
+
(defun url-file-name-completion (url _directory &optional _predicate)
;; Even if it's not implemented, it's not an error to ask for completion,
;; in case it's available (bug#14806).
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index 479f64c3e0..0c1f79a0c5 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -47,6 +47,9 @@
(error "Malformed url: %s" (url-recreate-url url)))
nil))
+(defvar url-misc-rlogin-obsolete-warned-once nil)
+(make-obsolete-variable url-misc-rlogin-obsolete-warned-once nil "29.1")
+
(defun url-do-terminal-emulator (type server port user)
(switch-to-buffer
(apply
@@ -58,6 +61,9 @@
(t (error "Unknown terminal emulator required: %s" type)))
nil
(cond ((eq type 'rlogin)
+ (unless url-misc-rlogin-obsolete-warned-once
+ (lwarn 'url :error "Method `rlogin' is obsolete")
+ (setq url-misc-rlogin-obsolete-warned-once t))
(if user (list server "-l" user) (list server)))
((eq type 'telnet)
(if port (list server port) (list server)))
@@ -74,7 +80,7 @@
nil)
;;;###autoload
-(defalias 'url-rlogin 'url-generic-emulator-loader)
+(define-obsolete-function-alias 'url-rlogin #'url-generic-emulator-loader
"29.1")
;;;###autoload
(defalias 'url-telnet 'url-generic-emulator-loader)
;;;###autoload
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 24b064773b..91f47d0325 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -96,17 +96,6 @@ If the specified port number is the default, return nil."
(or file "/")
(if frag (concat "#" frag)))))
-(defun url-recreate-url-attributes (urlobj)
- "Recreate the attributes of an URL string from the parsed URLOBJ."
- (declare (obsolete nil "24.3"))
- (when (url-attributes urlobj)
- (concat ";"
- (mapconcat (lambda (x)
- (if (cdr x)
- (concat (car x) "=" (cdr x))
- (car x)))
- (url-attributes urlobj) ";"))))
-
;;;###autoload
(defun url-generic-parse-url (url)
"Return an URL-struct of the parts of URL.
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-vars.el b/lisp/url/url-vars.el
index 859a5c75ed..4cdca05554 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -350,13 +350,11 @@ Should be a symbol specifying how to get a connection
from the local machine.
Currently supported methods:
`telnet': Run telnet in a subprocess to connect;
-`rlogin': Rlogin to another machine to connect;
`socks': Connect through a socks server;
`tls': Connect with TLS;
`ssl': Connect with SSL (deprecated, use `tls' instead);
`native': Connect directly."
:type '(radio (const :tag "Telnet to gateway host" :value telnet)
- (const :tag "Rlogin to gateway host" :value rlogin)
(const :tag "Use SOCKS proxy" :value socks)
(const :tag "Use SSL/TLS for all connections" :value tls)
(const :tag "Use SSL for all connections (obsolete)" :value ssl)
diff --git a/lisp/url/url.el b/lisp/url/url.el
index d08ff04eda..92057742ca 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -280,7 +280,9 @@ how long to wait for a response before giving up."
;; Querying over consumer internet in the US takes 100
;; ms, so split the difference.
(accept-process-output nil 0.05)))
- (unless (eq data-buffer proc-buffer)
+ ;; Kill the process buffer on redirects.
+ (when (and data-buffer
+ (not (eq data-buffer proc-buffer)))
(let (kill-buffer-query-functions)
(kill-buffer proc-buffer)))))
data-buffer))
@@ -291,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 d710578fff..e3c0e2ca06 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -208,8 +208,6 @@ a case simply use the directory containing the changed
file."
'((t (:inherit font-lock-comment-face)))
"Face for highlighting acknowledgments."
:version "21.1")
-(define-obsolete-face-alias 'change-log-acknowledgement
- 'change-log-acknowledgment "24.3")
(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
@@ -808,7 +806,7 @@ if it were to exist."
(defun add-log-find-changelog-buffer (changelog-file-name)
"Find a ChangeLog buffer for CHANGELOG-FILE-NAME.
-Respect `add-log-use-pseudo-changelog', which see."
+Respect `add-log--pseudo-changelog-buffer-name', which see."
(if (or (file-exists-p changelog-file-name)
(not add-log-dont-create-changelog-file))
(find-file-noselect changelog-file-name)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 6b30de3cb3..a9591c9d82 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -279,20 +279,21 @@ and hunk-based syntax highlighting otherwise as a
fallback."
:doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."
(key-description diff-minor-mode-prefix) diff-mode-shared-map)
-(define-minor-mode diff-auto-refine-mode
- "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode).
+(with-suppressed-warnings ((obsolete diff-auto-refine-mode))
+ (define-minor-mode diff-auto-refine-mode
+ "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode).
Diff Auto Refine mode is a buffer-local minor mode used with
`diff-mode'. When enabled, Emacs automatically highlights
changes in detail as the user visits hunks. When transitioning
from disabled to enabled, it tries to refine the current hunk, as
well."
- :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine"
- (if diff-auto-refine-mode
- (progn
- (customize-set-variable 'diff-refine 'navigation)
- (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))
- (customize-set-variable 'diff-refine nil)))
+ :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine"
+ (if diff-auto-refine-mode
+ (progn
+ (customize-set-variable 'diff-refine 'navigation)
+ (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))
+ (customize-set-variable 'diff-refine nil))))
(make-obsolete 'diff-auto-refine-mode "set `diff-refine' instead." "27.1")
(make-obsolete-variable 'diff-auto-refine-mode
"set `diff-refine' instead." "27.1")
@@ -2336,10 +2337,22 @@ Call FUN with two args (BEG and END) for each hunk."
(let ((inhibit-read-only t))
(undo arg)))
+;;;###autoload
+(defcustom diff-add-log-use-relative-names nil
+ "Use relative file names when generating ChangeLog skeletons.
+The files will be relative to the root directory of the VC
+repository. This option affects the behavior of
+`diff-add-log-current-defuns'."
+ :type 'boolean
+ :safe #'booleanp
+ :version "29.1")
+
(defun diff-add-log-current-defuns ()
"Return an alist of defun names for the current diff.
The elements of the alist are of the form (FILE . (DEFUN...)),
-where DEFUN... is a list of function names found in FILE."
+where DEFUN... is a list of function names found in FILE. If
+`diff-add-log-use-relative-names' is non-nil, file names in the alist
+are relative to the root directory of the VC repository."
(save-excursion
(goto-char (point-min))
(let* ((defuns nil)
@@ -2373,7 +2386,12 @@ where DEFUN... is a list of function names found in
FILE."
;; hunks (e.g., "diff --git ..." etc).
(re-search-forward diff-hunk-header-re nil t)
(setq hunk-end (save-excursion (diff-end-of-hunk)))
- (pcase-let* ((filename (substring-no-properties (diff-find-file-name)))
+ (pcase-let* ((filename (substring-no-properties
+ (if diff-add-log-use-relative-names
+ (file-relative-name
+ (diff-find-file-name)
+ (vc-root-dir))
+ (diff-find-file-name))))
(=lines 0)
(+lines 0)
(-lines 0)
@@ -2928,6 +2946,15 @@ hunk text is not found in the source file."
(forward-line 1)))
(nreverse props)))
+;;;###autoload
+(defun diff-vc-deduce-fileset ()
+ (let ((backend (vc-responsible-backend default-directory))
+ files)
+ (save-excursion
+ (goto-char (point-min))
+ (while (progn (diff-file-next) (not (eobp)))
+ (push (diff-find-file-name nil t) files)))
+ (list backend (nreverse files) nil nil 'patch)))
(defun diff--filter-substring (str)
(when diff-font-lock-prettify
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index d45e13ea72..bd2e9f1977 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -36,14 +36,6 @@
:group 'ediff
:group 'frames)
-
-;; Determine which window setup function to use based on current window system.
-(defun ediff-choose-window-setup-function-automatically ()
- (declare (obsolete ediff-setup-windows-default "24.3"))
- (if (display-graphic-p)
- #'ediff-setup-windows-multiframe
- #'ediff-setup-windows-plain))
-
(defcustom ediff-window-setup-function #'ediff-setup-windows-default
"Function called to set up windows.
Ediff provides a choice of three functions:
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index e958673fea..4624ada417 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -325,6 +325,11 @@ automatically."
(defface log-edit-summary '((t :inherit font-lock-function-name-face))
"Face for the summary in `log-edit-mode' buffers.")
+(defface log-edit-headers-separator
+ '((t :height 0.1 :inverse-video t :extend t))
+ "Face for the separator line in `log-edit-mode' buffers."
+ :version "29.1")
+
(defface log-edit-header '((t :inherit font-lock-keyword-face))
"Face for the headers in `log-edit-mode' buffers.")
@@ -393,7 +398,7 @@ The first subexpression is the actual text of the field.")
nil lax))
("^\n"
(progn (goto-char (match-end 0)) (1+ (match-end 0))) nil
- (0 '(face (:height 0.1 :inverse-video t :extend t)
+ (0 '(face log-edit-headers-separator
display-line-numbers-disable t rear-nonsticky t))))
(log-edit--match-first-line (0 'log-edit-summary))))
@@ -664,6 +669,19 @@ comment history, see `log-edit-comment-ring', and hides
`log-edit-files-buf'."
(indent-rigidly (point) (point-max)
(- log-edit-common-indent common)))))
+(defvar vc-patch-string)
+
+(autoload 'vc-diff-patch-string "vc")
+(defun log-edit-diff-patch ()
+ (vc-diff-patch-string vc-patch-string))
+
+(defvar vc-log-fileset)
+
+(defun log-edit-diff-fileset ()
+ "Display diffs for the files to be committed."
+ (interactive)
+ (vc-diff nil nil (list log-edit-vc-backend vc-log-fileset)))
+
(defun log-edit-show-diff ()
"Show the diff for the files to be committed."
(interactive)
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/pcvs-util.el b/lisp/vc/pcvs-util.el
index 89f8d26880..ddc3ea6e81 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -164,8 +164,6 @@ arguments. If ARGS is not a list, no argument will be
passed."
(if oneline (line-end-position) (point-max))))
(file-error nil)))
-(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3")
-
;;;;
;;;; file names
;;;;
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index f6b17d4ce0..6f77f99555 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -339,7 +339,7 @@ in the repository root directory of FILE."
"Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
@@ -1324,6 +1324,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-cvs.el b/lisp/vc/vc-cvs.el
index 52cc42791f..2dd3d416ac 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -545,7 +545,7 @@ Will fail unless you have administrative privileges on the
repo."
;;;
;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision
limit)
"Print commit log associated with FILES into specified BUFFER.
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 068a66b25b..037de415e6 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -266,7 +266,7 @@ See `run-hooks'."
:enable (vc-find-backend-function vc-dir-backend 'push)
:help "Push the current branch's changes"))
(define-key map [update]
- '(menu-item "Update to Latest Version" vc-update
+ '(menu-item "Update to Latest Version" vc-pull
:help "Update the current fileset's files to their tip
revisions"))
(define-key map [revert]
'(menu-item "Revert to Base Version" vc-revert
@@ -306,8 +306,8 @@ See `run-hooks'."
(define-key map "=" #'vc-diff) ;; C-x v =
(define-key map "D" #'vc-root-diff) ;; C-x v D
(define-key map "i" #'vc-register) ;; C-x v i
- (define-key map "+" #'vc-update) ;; C-x v +
- ;; I'd prefer some kind of symmetry with vc-update:
+ (define-key map "+" #'vc-pull) ;; C-x v +
+ ;; I'd prefer some kind of symmetry with vc-pull:
(define-key map "P" #'vc-push) ;; C-x v P
(define-key map "l" #'vc-print-log) ;; C-x v l
(define-key map "L" #'vc-print-root-log) ;; C-x v L
@@ -356,10 +356,10 @@ See `run-hooks'."
(define-key map "G" #'vc-dir-ignore)
(let ((branch-map (make-sparse-keymap)))
- (define-key map "B" branch-map)
- (define-key branch-map "c" #'vc-create-tag)
+ (define-key map "b" branch-map)
+ (define-key branch-map "c" #'vc-create-branch)
(define-key branch-map "l" #'vc-print-branch-log)
- (define-key branch-map "s" #'vc-retrieve-tag))
+ (define-key branch-map "s" #'vc-switch-branch))
(let ((mark-map (make-sparse-keymap)))
(define-key map "*" mark-map)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index e2a490092b..dc3ed52650 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -109,6 +109,8 @@
;; TODO:
;; - log buffers need font-locking.
+(eval-when-compile (require 'cl-lib))
+
;; General customization
(defcustom vc-logentry-check-hook nil
@@ -194,7 +196,7 @@ Another is that undo information is not kept."
(defvar vc-sentinel-movepoint) ;Dynamically scoped.
-(defun vc--process-sentinel (p code)
+(defun vc--process-sentinel (p code &optional success)
(let ((buf (process-buffer p)))
;; Impatient users sometime kill "slow" buffers; check liveness
;; to avoid "error in process sentinel: Selecting deleted buffer".
@@ -215,7 +217,7 @@ Another is that undo information is not kept."
;; each sentinel read&set process-mark, but since `cmd' needs
;; to work both for async and sync processes, this would be
;; difficult to achieve.
- (vc-exec-after code)
+ (vc-exec-after code success)
(move-marker m (point)))
;; But sometimes the sentinels really want to move point.
(when vc-sentinel-movepoint
@@ -232,11 +234,14 @@ Another is that undo information is not kept."
'help-echo
"A command is in progress in this buffer"))))
-(defun vc-exec-after (code)
+(defun vc-exec-after (code &optional success)
"Eval CODE when the current buffer's process is done.
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel.
-CODE should be a function of no arguments."
+CODE should be a function of no arguments.
+
+If SUCCESS, it should be a process object. Only run CODE if the
+SUCCESS process has a zero exit code."
(let ((proc (get-buffer-process (current-buffer))))
(cond
;; If there's no background process, just execute the code.
@@ -247,13 +252,15 @@ CODE should be a function of no arguments."
((or (null proc) (eq (process-status proc) 'exit))
;; Make sure we've read the process's output before going further.
(when proc (accept-process-output proc))
- (if (functionp code) (funcall code) (eval code t)))
+ (when (or (not success)
+ (zerop (process-exit-status success)))
+ (if (functionp code) (funcall code) (eval code t))))
;; If a process is running, add CODE to the sentinel
((eq (process-status proc) 'run)
(vc-set-mode-line-busy-indicator)
(letrec ((fun (lambda (p _msg)
(remove-function (process-sentinel p) fun)
- (vc--process-sentinel p code))))
+ (vc--process-sentinel p code success))))
(add-function :after (process-sentinel proc) fun)))
(t (error "Unexpected process state"))))
nil)
@@ -262,6 +269,13 @@ CODE should be a function of no arguments."
(declare (indent 0) (debug (def-body)))
`(vc-exec-after (lambda () ,@body)))
+(defvar vc-filter-command-function #'list
+ "Function called to transform VC commands before execution.
+The function is called inside the buffer in which the command
+will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS
+arguments to `vc-do-command'. It should return a list of three
+elements, the new values for these arguments.")
+
(defvar vc-post-command-functions nil
"Hook run at the end of `vc-do-command'.
Each function is called inside the buffer in which the command was run
@@ -282,6 +296,23 @@ the man pages for \"torsocks\" for more details about Tor."
:version "27.1"
:group 'vc)
+(defun vc-user-edit-command (command file-or-list flags)
+ "Prompt the user to edit VC command COMMAND and FLAGS.
+Intended to be used as the value of `vc-filter-command-function'."
+ (let* ((files-separator-p (string= "--" (car (last flags))))
+ (edited (split-string-and-unquote
+ (read-shell-command
+ (format "Edit VC command & arguments%s: "
+ (if file-or-list
+ " (files list to be appended)"
+ ""))
+ (combine-and-quote-strings
+ (cons command (remq nil (if files-separator-p
+ (butlast flags)
+ flags))))))))
+ (list (car edited) file-or-list
+ (nconc (cdr edited) (and files-separator-p '("--"))))))
+
;;;###autoload
(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
"Execute a slave command, notifying user and checking for errors.
@@ -296,117 +327,142 @@ FILE-OR-LIST is the name of a working file; it may be a
list of
files or be nil (to execute commands that don't expect a file
name or set of files). If an optional list of FLAGS is present,
that is inserted into the command line before the filename.
+
Return the return value of the slave command in the synchronous
case, and the process object in the asynchronous case."
- ;; FIXME: file-relative-name can return a bogus result because
- ;; it doesn't look at the actual file-system to see if symlinks
- ;; come into play.
- (let* ((files
- (mapcar (lambda (f) (file-relative-name (expand-file-name f)))
- (if (listp file-or-list) file-or-list (list file-or-list))))
- ;; Keep entire commands in *Messages* but avoid resizing the
- ;; echo area. Messages in this function are formatted in
- ;; a such way that the important parts are at the beginning,
- ;; due to potential truncation of long messages.
- (message-truncate-lines t)
- (full-command
- (concat (if vc-tor "torsocks " "")
- (if (string= (substring command -1) "\n")
- (substring command 0 -1)
- command)
- " " (vc-delistify flags)
- " " (vc-delistify files)))
- (vc-inhibit-message
- (or (eq vc-command-messages 'log)
- (eq (selected-window) (active-minibuffer-window)))))
+ (let (;; Keep entire commands in *Messages* but avoid resizing the
+ ;; echo area. Messages in this function are formatted in
+ ;; a such way that the important parts are at the beginning,
+ ;; due to potential truncation of long messages.
+ (message-truncate-lines t)
+ (vc-inhibit-message
+ (or (eq vc-command-messages 'log)
+ (eq (selected-window) (active-minibuffer-window)))))
(save-current-buffer
(unless (or (eq buffer t)
(and (stringp buffer)
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
- (vc-setup-buffer buffer))
- ;; If there's some previous async process still running, just kill it.
- (let ((squeezed (remq nil flags))
- (inhibit-read-only t)
- (status 0))
- (when files
- (setq squeezed (nconc squeezed files)))
- (let (;; Since some functions need to parse the output
- ;; from external commands, set LC_MESSAGES to C.
- (process-environment (cons "LC_MESSAGES=C" process-environment))
- (w32-quote-process-args t))
- (if (eq okstatus 'async)
- ;; Run asynchronously.
- (let ((proc
- (let ((process-connection-type nil))
- (apply #'start-file-process command (current-buffer)
- command squeezed))))
- (when vc-command-messages
- (let ((inhibit-message vc-inhibit-message))
- (message "Running in background: %s" full-command)))
- ;; Get rid of the default message insertion, in case we don't
- ;; set a sentinel explicitly.
- (set-process-sentinel proc #'ignore)
- (set-process-filter proc #'vc-process-filter)
- (setq status proc)
- (when vc-command-messages
- (vc-run-delayed
- (let ((message-truncate-lines t)
- (inhibit-message vc-inhibit-message))
- (message "Done in background: %s" full-command)))))
- ;; Run synchronously
- (when vc-command-messages
- (let ((inhibit-message vc-inhibit-message))
- (message "Running in foreground: %s" full-command)))
- (let ((buffer-undo-list t))
- (setq status (apply #'process-file command nil t nil squeezed)))
- (when (and (not (eq t okstatus))
- (or (not (integerp status))
- (and okstatus (< okstatus status))))
- (unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
- (pop-to-buffer (current-buffer))
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer))
- (error "Failed (%s): %s"
- (if (integerp status) (format "status %d" status) status)
- full-command))
- (when vc-command-messages
- (let ((inhibit-message vc-inhibit-message))
- (message "Done (status=%d): %s" status full-command)))))
- (vc-run-delayed
- (run-hook-with-args 'vc-post-command-functions
- command file-or-list flags))
- status))))
+ (vc-setup-buffer buffer))
+ (cl-destructuring-bind (command file-or-list flags)
+ (funcall vc-filter-command-function command file-or-list flags)
+ (when vc-tor
+ (push command flags)
+ (setq command "torsocks"))
+ (let* (;; FIXME: file-relative-name can return a bogus result
+ ;; because it doesn't look at the actual file-system to
+ ;; see if symlinks come into play.
+ (files
+ (mapcar (lambda (f)
+ (file-relative-name (expand-file-name f)))
+ (if (listp file-or-list)
+ file-or-list
+ (list file-or-list))))
+ (full-command
+ (concat (if (string= (substring command -1) "\n")
+ (substring command 0 -1)
+ command)
+ " " (vc-delistify flags)
+ " " (vc-delistify files)))
+ (squeezed (remq nil flags))
+ (inhibit-read-only t)
+ (status 0))
+ ;; If there's some previous async process still running,
+ ;; just kill it.
+ (when files
+ (setq squeezed (nconc squeezed files)))
+ (let (;; Since some functions need to parse the output
+ ;; from external commands, set LC_MESSAGES to C.
+ (process-environment
+ (cons "LC_MESSAGES=C" process-environment))
+ (w32-quote-process-args t))
+ (if (eq okstatus 'async)
+ ;; Run asynchronously.
+ (let ((proc
+ (let ((process-connection-type nil))
+ (apply #'start-file-process command
+ (current-buffer) command squeezed))))
+ (when vc-command-messages
+ (let ((inhibit-message vc-inhibit-message))
+ (message "Running in background: %s"
+ full-command)))
+ ;; Get rid of the default message insertion, in case
+ ;; we don't set a sentinel explicitly.
+ (set-process-sentinel proc #'ignore)
+ (set-process-filter proc #'vc-process-filter)
+ (setq status proc)
+ (when vc-command-messages
+ (vc-run-delayed
+ (let ((message-truncate-lines t)
+ (inhibit-message vc-inhibit-message))
+ (message "Done in background: %s"
+ full-command)))))
+ ;; Run synchronously
+ (when vc-command-messages
+ (let ((inhibit-message vc-inhibit-message))
+ (message "Running in foreground: %s" full-command)))
+ (let ((buffer-undo-list t))
+ (setq status (apply #'process-file
+ command nil t nil squeezed)))
+ (when (and (not (eq t okstatus))
+ (or (not (integerp status))
+ (and okstatus (< okstatus status))))
+ (unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (shrink-window-if-larger-than-buffer))
+ (error "Failed (%s): %s"
+ (if (integerp status)
+ (format "status %d" status)
+ status)
+ full-command))
+ (when vc-command-messages
+ (let ((inhibit-message vc-inhibit-message))
+ (message "Done (status=%d): %s"
+ status full-command)))))
+ (vc-run-delayed
+ (run-hook-with-args 'vc-post-command-functions
+ command file-or-list flags))
+ status)))))
+
+(defvar vc--inhibit-async-window nil)
(defun vc-do-async-command (buffer root command &rest args)
"Run COMMAND asynchronously with ARGS, displaying the result.
Send the output to BUFFER, which should be a buffer or the name
of a buffer, which is created.
ROOT should be the directory in which the command should be run.
+The process object is returned.
Display the buffer in some window, but don't select it."
- (let* ((dir default-directory)
- (inhibit-read-only t)
- window new-window-start)
+ (let ((dir default-directory)
+ (inhibit-read-only t)
+ new-window-start proc)
(setq buffer (get-buffer-create buffer))
(if (get-buffer-process buffer)
(error "Another VC action on %s is running" root))
(with-current-buffer buffer
(setq default-directory root)
- (goto-char (point-max))
- (unless (eq (point) (point-min))
- (insert " \n"))
- (setq new-window-start (point))
- (insert "Running \"" command)
- (dolist (arg args)
- (insert " " arg))
- (insert "\"...\n")
- ;; Run in the original working directory.
- (let ((default-directory dir))
- (apply #'vc-do-command t 'async command nil args)))
- (setq window (display-buffer buffer))
- (if window
- (set-window-start window new-window-start))
- buffer))
+ (let* (;; Run in the original working directory.
+ (default-directory dir)
+ (orig-fun vc-filter-command-function)
+ (vc-filter-command-function
+ (lambda (&rest args)
+ (cl-destructuring-bind (&whole args cmd _ flags)
+ (apply orig-fun args)
+ (goto-char (point-max))
+ (unless (eq (point) (point-min))
+ (insert " \n"))
+ (setq new-window-start (point))
+ (insert "Running \"" cmd)
+ (dolist (flag flags)
+ (insert " " flag))
+ (insert "\"...\n")
+ args))))
+ (setq proc (apply #'vc-do-command t 'async command nil args))))
+ (unless vc--inhibit-async-window
+ (when-let ((window (display-buffer buffer)))
+ (set-window-start window new-window-start)))
+ proc))
(defvar compilation-error-regexp-alist)
@@ -624,6 +680,8 @@ NOT-URGENT means it is ok to continue if the user says not
to save."
(declare-function log-edit-empty-buffer-p "log-edit" ())
+(defvar vc-patch-string)
+
(defun vc-log-edit (fileset mode backend)
"Set up `log-edit' for use on FILE."
(setq default-directory
@@ -653,15 +711,17 @@ NOT-URGENT means it is ok to continue if the user says
not to save."
(mapcar
(lambda (file) (file-relative-name file root))
fileset))))
- (log-edit-diff-function . vc-diff)
+ (log-edit-diff-function
+ . ,(if vc-patch-string 'log-edit-diff-patch
'log-edit-diff-fileset))
(log-edit-vc-backend . ,backend)
- (vc-log-fileset . ,fileset))
+ (vc-log-fileset . ,fileset)
+ (vc-patch-string . ,vc-patch-string))
nil
mode)
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
-(defun vc-start-logentry (files comment initial-contents msg logbuf mode
action &optional after-hook backend)
+(defun vc-start-logentry (files comment initial-contents msg logbuf mode
action &optional after-hook backend patch-string)
"Accept a comment for an operation on FILES.
If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the
action on close to ACTION. If COMMENT is a string and
@@ -673,7 +733,8 @@ empty comment. Remember the file's buffer in
`vc-parent-buffer'
\(current one if no file). Puts the log-entry buffer in major mode
MODE, defaulting to `log-edit-mode' if MODE is nil.
AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'.
-BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
+BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer.
+PATCH-STRING is a patch to check in."
(let ((parent
(if (vc-dispatcher-browsing)
;; If we are called from a directory browser, the parent buffer is
@@ -688,6 +749,8 @@ BACKEND, if non-nil, specifies a VC backend for the Log
Edit buffer."
(setq-local vc-parent-buffer parent)
(setq-local vc-parent-buffer-name
(concat " from " (buffer-name vc-parent-buffer)))
+ (when patch-string
+ (setq-local vc-patch-string patch-string))
(vc-log-edit files mode backend)
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
@@ -697,7 +760,11 @@ BACKEND, if non-nil, specifies a VC backend for the Log
Edit buffer."
(erase-buffer)
(when (stringp comment) (insert comment)))
(if (or (not comment) initial-contents)
- (message "%s Type C-c C-c when done" msg)
+ (message (substitute-command-keys
+ (if (eq major-mode 'log-edit-mode)
+ "%s Type \\[log-edit-done] when done"
+ "%s Type \\`C-c C-c' when done"))
+ msg)
(vc-finish-logentry (eq comment t)))))
;; vc-finish-logentry is typically called from a log-edit buffer (see
@@ -753,7 +820,8 @@ the buffer contents as a comment."
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
(or (derived-mode-p 'vc-dir-mode)
- (derived-mode-p 'dired-mode)))
+ (derived-mode-p 'dired-mode)
+ (derived-mode-p 'diff-mode)))
;; These are unused.
;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 46a486a46c..3c6afec037 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -53,7 +53,8 @@
;; - responsible-p (file) OK
;; - receive-file (file rev) NOT NEEDED
;; - unregister (file) OK
-;; * checkin (files rev comment) OK
+;; * checkin (files comment rev) OK
+;; - checkin-patch (patch-string comment) OK
;; * find-revision (file rev buffer) OK
;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
@@ -81,7 +82,7 @@
;; - annotate-time () OK
;; - annotate-current-time () NOT NEEDED
;; - annotate-extract-revision-at-line () OK
-;; TAG SYSTEM
+;; TAG/BRANCH SYSTEM
;; - create-tag (dir name branchp) OK
;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
@@ -94,6 +95,7 @@
;; - find-file-hook () OK
;; - conflicted-files OK
;; - repository-url (file-or-dir) OK
+;; - prepare-patch (rev) OK
;;; Code:
@@ -127,6 +129,12 @@ If nil, use the value of `vc-annotate-switches'. If t,
use no switches."
(repeat :tag "Argument List" :value ("") string))
:version "25.1")
+;; Check if local value of `vc-git-annotate-switches' is safe.
+;; Currently only "-w" (ignore whitespace) is considered safe, but
+;; this list might be extended in the future (probably most options
+;; are perfectly safe.)
+;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable (lambda
(switches) (equal switches "-w")))
+
(defcustom vc-git-log-switches nil
"String or list of strings specifying switches for Git log under VC."
:type '(choice (const :tag "None" nil)
@@ -365,8 +373,9 @@ in the order given by `git status'."
(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
- (let (process-file-side-effects)
- (vc-git--rev-parse "HEAD")))
+ (let* ((process-file-side-effects nil)
+ (commit (vc-git--rev-parse "HEAD" t)))
+ (or (vc-git-symbolic-commit commit) commit)))
(defun vc-git--symbolic-ref (file)
(or
@@ -617,7 +626,7 @@ or an empty string if none."
;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
@@ -857,6 +866,47 @@ The car of the list is the current branch."
;;; STATE-CHANGING FUNCTIONS
+(defcustom vc-git-log-edit-summary-target-len nil
+ "Target length for Git commit summary lines.
+If a number, characters in Summary: lines beyond this length are
+displayed in the `vc-git-log-edit-summary-target-warning' face.
+A value of any other type means no highlighting.
+
+By setting this to an integer around 50, you can improve the
+compatibility of your commit messages with Git commands that
+print the summary line in width-constrained contexts. However,
+many commit summaries will need to exceed this length.
+
+See also `vc-git-log-edit-summary-max-len'."
+ :type '(choice (const :tag "No target" nil)
+ (natnum :tag "Target length"))
+ :safe (lambda (x) (or (not x) (natnump x))))
+
+(defface vc-git-log-edit-summary-target-warning
+ '((t :inherit warning))
+ "Face for Git commit summary lines beyond the target length.
+See `vc-git-log-edit-summary-target-len'.")
+
+(defcustom vc-git-log-edit-summary-max-len 68
+ "Maximum length for Git commit summary lines.
+If a number, characters in summary lines beyond this length are
+displayed in the `vc-git-log-edit-summary-max-warning' face.
+A value of any other type means no highlighting.
+
+It is good practice to avoid writing summary lines longer than
+this because otherwise the summary line will be truncated in many
+contexts in which Git commands display summary lines.
+
+See also `vc-git-log-edit-summary-target-len'."
+ :type '(choice (const :tag "No target" nil)
+ (natnum :tag "Target length"))
+ :safe (lambda (x) (or (not x) (natnump x))))
+
+(defface vc-git-log-edit-summary-max-warning
+ '((t :inherit error))
+ "Face for Git commit summary lines beyond the maximum length.
+See `vc-git-log-edit-summary-max-len'.")
+
(defun vc-git-create-repo ()
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
@@ -910,9 +960,38 @@ If toggling on, also insert its message into the buffer."
"C-c C-n" #'vc-git-log-edit-toggle-no-verify
"C-c C-e" #'vc-git-log-edit-toggle-amend)
+(defun vc-git--log-edit-summary-check (limit)
+ (and (re-search-forward "^Summary: " limit t)
+ (when-let ((regex
+ (cond ((and (natnump vc-git-log-edit-summary-max-len)
+ (natnump vc-git-log-edit-summary-target-len))
+ (format ".\\{,%d\\}\\(.\\{,%d\\}\\)\\(.*\\)"
+ vc-git-log-edit-summary-target-len
+ (- vc-git-log-edit-summary-max-len
+ vc-git-log-edit-summary-target-len)))
+ ((natnump vc-git-log-edit-summary-max-len)
+ (format ".\\{,%d\\}\\(?2:.*\\)"
+ vc-git-log-edit-summary-max-len))
+ ((natnump vc-git-log-edit-summary-target-len)
+ (format ".\\{,%d\\}\\(.*\\)"
+ vc-git-log-edit-summary-target-len)))))
+ (re-search-forward regex limit t))))
+
(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
"Major mode for editing Git log messages.
-It is based on `log-edit-mode', and has Git-specific extensions.")
+It is based on `log-edit-mode', and has Git-specific extensions."
+ (setq-local
+ log-edit-font-lock-keywords
+ (append log-edit-font-lock-keywords
+ '((vc-git--log-edit-summary-check
+ (1 'vc-git-log-edit-summary-target-warning prepend t)
+ (2 'vc-git-log-edit-summary-max-warning prepend t))))))
+
+(defvar vc-git-patch-string nil)
+
+(defun vc-git-checkin-patch (patch-string comment)
+ (let ((vc-git-patch-string patch-string))
+ (vc-git-checkin nil comment)))
(defun vc-git-checkin (files comment &optional _rev)
(let* ((file1 (or (car files) default-directory))
@@ -936,12 +1015,45 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(if (eq system-type 'windows-nt)
(let ((default-directory (file-name-directory file1)))
(make-nearby-temp-file "git-msg")))))
+ (when vc-git-patch-string
+ (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet"))
+ ;; Check that all staged changes also exist in the patch.
+ ;; This is needed to allow adding/removing files that are
+ ;; currently staged to the index. So remove the whole file diff
+ ;; from the patch because commit will take it from the index.
+ (with-temp-buffer
+ (vc-git-command (current-buffer) t nil "diff" "--cached")
+ (goto-char (point-min))
+ (let ((pos (point)) file-diff file-beg)
+ (while (not (eobp))
+ (forward-line 1) ; skip current "diff --git" line
+ (search-forward "diff --git" nil 'move)
+ (move-beginning-of-line 1)
+ (setq file-diff (buffer-substring pos (point)))
+ (if (and (setq file-beg (string-search
+ file-diff vc-git-patch-string))
+ ;; Check that file diff ends with an empty string
+ ;; or the beginning of the next file diff.
+ (string-match-p "\\`\\'\\|\\`diff --git"
+ (substring
+ vc-git-patch-string
+ (+ file-beg (length file-diff)))))
+ (setq vc-git-patch-string
+ (string-replace file-diff "" vc-git-patch-string))
+ (user-error "Index not empty"))
+ (setq pos (point))))))
+ (let ((patch-file (make-temp-file "git-patch")))
+ (with-temp-file patch-file
+ (insert vc-git-patch-string))
+ (unwind-protect
+ (vc-git-command nil 0 patch-file "apply" "--cached")
+ (delete-file patch-file))))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge.
- (apply #'vc-git-command nil 0 (if only files)
+ (apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string))
files)
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
@@ -959,7 +1071,8 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(write-region (car args) nil msg-file))
(setq args (cdr args)))
args)
- (if only (list "--only" "--") '("-a")))))
+ (unless vc-git-patch-string
+ (if only (list "--only" "--") '("-a"))))))
(if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))))
(defun vc-git-find-revision (file rev buffer)
@@ -1006,31 +1119,37 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(defun vc-git--pushpull (command prompt extra-args)
"Run COMMAND (a string; either push or pull) on the current Git branch.
If PROMPT is non-nil, prompt for the Git command to run."
+ (require 'vc-dispatcher)
(let* ((root (vc-git-root default-directory))
(buffer (format "*vc-git : %s*" (expand-file-name root)))
- (git-program vc-git-program)
- args)
- ;; If necessary, prompt for the exact command.
- ;; TODO if pushing, prompt if no default push location - cf bzr.
- (when prompt
- (setq args (split-string
- (read-shell-command
- (format "Git %s command: " command)
- (format "%s %s" git-program command)
- 'vc-git-history)
- " " t))
- (setq git-program (car args)
- command (cadr args)
- args (cddr args)))
- (setq args (nconc args extra-args))
- (require 'vc-dispatcher)
- (apply #'vc-do-async-command buffer root git-program command args)
+ (git-program vc-git-program)
+ ;; TODO if pushing, prompt if no default push location - cf bzr.
+ (vc-filter-command-function
+ (if prompt
+ (lambda (&rest args)
+ (cl-destructuring-bind (&whole args git _ flags)
+ (apply #'vc-user-edit-command args)
+ (setq git-program git
+ command (car flags)
+ extra-args (cdr flags))
+ args))
+ vc-filter-command-function))
+ (proc (apply #'vc-do-async-command
+ buffer root git-program command extra-args)))
+ ;; "git pull" includes progress output that uses ^M to move point
+ ;; to the beginning of the line. Just translate these to newlines
+ ;; (but don't do anything with the CRLF sequence).
+ (add-function :around (process-filter proc)
+ (lambda (filter process string)
+ (funcall filter process
+ (replace-regexp-in-string "\r\\(\\'\\|[^\n]\\)"
+ "\n\\1" string))))
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'git)
(setq-local compile-command
(concat git-program " " command " "
- (mapconcat #'identity args " ")))
+ (mapconcat #'identity extra-args " ")))
(setq-local compilation-directory root)
;; Either set `compilation-buffer-name-function' locally to nil
;; or use `compilation-arguments' to set `name-function'.
@@ -1039,7 +1158,8 @@ If PROMPT is non-nil, prompt for the Git command to run."
(list compile-command nil
(lambda (_name-of-mode) buffer)
nil))))
- (vc-set-async-update buffer)))
+ (vc-set-async-update buffer)
+ proc))
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
@@ -1053,6 +1173,25 @@ Normally, this runs \"git push\". If PROMPT is non-nil,
prompt
for the Git command to run."
(vc-git--pushpull "push" prompt nil))
+(defun vc-git-pull-and-push (prompt)
+ "Pull changes into the current Git branch, and then push.
+The push will only be performed if the pull was successful.
+
+Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
+for the Git command to run."
+ (let ((proc (vc-git--pushpull "pull" prompt '("--stat"))))
+ (when (process-buffer proc)
+ (with-current-buffer (process-buffer proc)
+ (if (and (eq (process-status proc) 'exit)
+ (zerop (process-exit-status proc)))
+ (let ((vc--inhibit-async-window t))
+ (vc-git-push nil))
+ (vc-exec-after
+ (lambda ()
+ (let ((vc--inhibit-async-window t))
+ (vc-git-push nil)))
+ proc))))))
+
(defun vc-git-merge-branch ()
"Merge changes into the current Git branch.
This prompts for a branch to merge from."
@@ -1209,7 +1348,12 @@ If LIMIT is a revision string, use it as an
end-revision."
(defun vc-git-log-incoming (buffer remote-location)
(vc-setup-buffer buffer)
- (vc-git-command nil 0 nil "fetch")
+ (vc-git-command nil 0 nil "fetch"
+ (unless (string= remote-location "")
+ ;; `remote-location' is in format "repository/branch",
+ ;; so remove everything except a repository name.
+ (replace-regexp-in-string
+ "/.*" "" remote-location)))
(vc-git-command
buffer 'async nil
"log"
@@ -1482,13 +1626,25 @@ 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)))))
-;;; TAG SYSTEM
+;;; TAG/BRANCH SYSTEM
+
+(declare-function vc-read-revision "vc"
+ (prompt &optional files backend default initial-input))
(defun vc-git-create-tag (dir name branchp)
- (let ((default-directory dir))
- (and (vc-git-command nil 0 nil "update-index" "--refresh")
+ (let ((default-directory dir)
+ (start-point (when branchp (vc-read-revision
+ (format-prompt "Start point"
+ (car (vc-git-branches)))
+ (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"
+ (if branchp "branch" "tag"))))
(if branchp
- (vc-git-command nil 0 nil "checkout" "-b" name)
+ (vc-git-command nil 0 nil "checkout" "-b" name
+ (when (and start-point (not (eq start-point "")))
+ start-point))
(vc-git-command nil 0 nil "tag" name)))))
(defun vc-git-retrieve-tag (dir name _update)
@@ -1519,11 +1675,15 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
;; does not (and cannot) quote.
(vc-git--rev-parse (concat rev "~1"))))
-(defun vc-git--rev-parse (rev)
+(defun vc-git--rev-parse (rev &optional short)
(with-temp-buffer
(and
- (vc-git--out-ok "rev-parse" rev)
- (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
+ (if short
+ (vc-git--out-ok "rev-parse" "--short" rev)
+ (vc-git--out-ok "rev-parse" rev))
+ (string-trim-right
+ (buffer-substring-no-properties (point-min) (min (+ (point-min) 40)
+ (point-max)))))))
(defun vc-git-next-revision (file rev)
"Git-specific version of `vc-next-revision'."
@@ -1588,6 +1748,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))
@@ -1847,19 +2030,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 f4a44df3c2..1b1c1683dd 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)
@@ -1345,7 +1362,7 @@ REV is the revision to check out into WORKFILE."
;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
@@ -1507,6 +1524,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-hooks.el b/lisp/vc/vc-hooks.el
index 1f0eeb7e18..6ad26cfe67 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -857,6 +857,9 @@ In the latter case, VC mode is deactivated for this buffer."
;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
(defvar-keymap vc-prefix-map
"a" #'vc-update-change-log
+ "b c" #'vc-create-branch
+ "b l" #'vc-print-branch-log
+ "b s" #'vc-switch-branch
"d" #'vc-dir
"g" #'vc-annotate
"G" #'vc-ignore
@@ -879,13 +882,11 @@ In the latter case, VC mode is deactivated for this
buffer."
"=" #'vc-diff
"D" #'vc-root-diff
"~" #'vc-revision-other-window
- "x" #'vc-delete-file)
+ "x" #'vc-delete-file
+ "!" #'vc-edit-next-command)
(fset 'vc-prefix-map vc-prefix-map)
(define-key ctl-x-map "v" 'vc-prefix-map)
-(with-suppressed-warnings ((obsolete vc-switch-backend))
- (keymap-set vc-prefix-map "b" #'vc-switch-backend))
-
(defvar vc-menu-map
(let ((map (make-sparse-keymap "Version Control")))
;;(define-key map [show-files]
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 08b53a7169..9c2bdf6674 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -207,7 +207,7 @@ switches."
;; dir-status-files called from vc-dir, which loads vc,
;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(autoload 'vc-expand-dirs "vc")
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index b05adfb2d5..df51f52bc7 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -247,6 +247,11 @@
;; revision argument is only supported with some older VCSes, like
;; RCS and CVS, and is otherwise silently ignored.
;;
+;; - checkin-patch (patch-string comment)
+;;
+;; Commit a single patch PATCH-STRING to this backend, bypassing
+;; the changes in filesets. COMMENT is used as a check-in comment.
+;;
;; * find-revision (file rev buffer)
;;
;; Fetch revision REV of file FILE and put it into BUFFER.
@@ -444,7 +449,7 @@
;;
;; Return the common ancestor between REV1 and REV2 revisions.
-;; TAG SYSTEM
+;; TAG/BRANCH SYSTEM
;;
;; - create-tag (dir name branchp)
;;
@@ -459,8 +464,9 @@
;; - retrieve-tag (dir name update)
;;
;; Retrieve the version tagged by NAME of all registered files at or below
DIR.
+;; If NAME is a branch name, switch to that branch.
;; If UPDATE is non-nil, then update buffers of any files in the
-;; tag that are currently visited. The default implementation
+;; tag/branch that are currently visited. The default implementation
;; does a sanity check whether there aren't any uncommitted changes at
;; or below DIR, and then performs a tree walk, using the `checkout'
;; function to retrieve the corresponding revisions.
@@ -568,6 +574,16 @@
;; 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.
;;; Changes from the pre-25.1 API:
;;
@@ -659,8 +675,6 @@
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;; - Add a primitives for switching to a branch (creating it if required.
-;;
;; - Add the ability to list tags and branches.
;;
;;;; Unify two different versions of the amend capability
@@ -804,12 +818,12 @@ not specific to any particular backend."
(defcustom vc-annotate-switches nil
"A string or list of strings specifying switches for annotate under VC.
When running annotate under a given BACKEND, VC uses the first
-non-nil value of `vc-BACKEND-annotate-switches', `vc-annotate-switches',
-and `annotate-switches', in that order. Since nil means to check the
-next variable in the sequence, either of the first two may use
-the value t to mean no switches at all. `vc-annotate-switches'
-should contain switches that are specific to version control, but
-not specific to any particular backend.
+non-nil value of `vc-BACKEND-annotate-switches' and
+`vc-annotate-switches', in that order. Since nil means to check
+the next variable in the sequence, setting the first to the value
+t means no switches at all. `vc-annotate-switches' should
+contain switches that are specific to version control, but not
+specific to any particular backend.
As very few switches (if any) are used across different VC tools,
please consider using the specific `vc-BACKEND-annotate-switches'
@@ -1010,7 +1024,11 @@ responsible for the given file."
(lambda (backend)
(when-let ((dir (vc-call-backend
backend 'responsible-p file)))
- (cons backend dir)))
+ ;; We run DIR through `expand-file-name'
+ ;; so that abbreviated directories, such
+ ;; as "~/", wouldn't look "less specific"
+ ;; due to their artificially shorter length.
+ (cons backend (expand-file-name dir))))
vc-handled-backends))))
;; Just a single response (or none); use it.
(if (< (length dirs) 2)
@@ -1045,7 +1063,8 @@ Within directories, only files already under version
control are noticed."
((derived-mode-p 'log-edit-mode) log-edit-vc-backend)
((derived-mode-p 'diff-mode) diff-vc-backend)
;; Maybe we could even use comint-mode rather than shell-mode?
- ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
+ ((derived-mode-p
+ 'dired-mode 'shell-mode 'eshell-mode 'compilation-mode)
(ignore-errors (vc-responsible-backend default-directory)))
(vc-mode (vc-backend buffer-file-name))))
@@ -1102,6 +1121,8 @@ BEWARE: this function may change the current buffer."
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
(dired-vc-deduce-fileset state-model-only-files not-state-changing))
+ ((derived-mode-p 'diff-mode)
+ (diff-vc-deduce-fileset))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1114,7 +1135,8 @@ BEWARE: this function may change the current buffer."
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
(or (derived-mode-p 'vc-dir-mode)
- (derived-mode-p 'dired-mode)))))
+ (derived-mode-p 'dired-mode)
+ (derived-mode-p 'diff-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
(vc-deduce-fileset-1 not-state-changing allow-unregistered
state-model-only-files)))
@@ -1230,6 +1252,8 @@ with, using the most specific one."
(error "Fileset files are missing, so cannot be operated on"))
((eq state 'ignored)
(error "Fileset files are ignored by the version-control system"))
+ ((eq model 'patch)
+ (vc-checkin files backend nil nil nil (buffer-string)))
((or (null state) (eq state 'unregistered))
(cond (verbose
(let ((backend (vc-read-backend "Backend to register to: ")))
@@ -1613,15 +1637,18 @@ Type \\[vc-next-action] to check in changes.")
(format "I stole the lock on %s, " file-description)
(current-time-string)
".\n")
- (message "Please explain why you stole the lock. Type C-c C-c when
done.")))
+ (message
+ (substitute-command-keys
+ "Please explain why you stole the lock. Type \\`C-c C-c' when done"))))
-(defun vc-checkin (files backend &optional comment initial-contents rev)
+(defun vc-checkin (files backend &optional comment initial-contents rev
patch-string)
"Check in FILES. COMMENT is a comment string; if omitted, a
buffer is popped up to accept a comment. If INITIAL-CONTENTS is
non-nil, then COMMENT is used as the initial contents of the log
entry buffer.
The optional argument REV may be a string specifying the new revision
level (only supported for some older VCSes, like RCS and CVS).
+The optional argument PATCH-STRING is a string to check in as a patch.
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(run-hooks 'vc-before-checkin-hook)
@@ -1643,7 +1670,9 @@ Runs the normal hooks `vc-before-checkin-hook' and
`vc-checkin-hook'."
;; vc-checkin-switches, but 'the' local buffer is
;; not a well-defined concept for filesets.
(progn
- (vc-call-backend backend 'checkin files comment rev)
+ (if patch-string
+ (vc-call-backend backend 'checkin-patch patch-string comment)
+ (vc-call-backend backend 'checkin files comment rev))
(mapc #'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
(vc-checkout-time . ,(file-attribute-modification-time
@@ -1651,7 +1680,52 @@ Runs the normal hooks `vc-before-checkin-hook' and
`vc-checkin-hook'."
(vc-working-revision . nil)))
(message "Checking in %s...done" (vc-delistify files)))
'vc-checkin-hook
- backend))
+ 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))))
+ (dolist (f files)
+ (with-current-buffer (get-file-buffer f)
+ (revert-buffer t t t)))
+ (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
@@ -1779,6 +1853,26 @@ objects, and finally killing buffer ORIGINAL."
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
+(defvar vc-patch-string nil)
+
+(defun vc-diff-patch-string (patch-string)
+ "Report diffs to be committed from the patch.
+Like `vc-diff-internal' but uses PATCH-STRING to display
+in the output buffer."
+ (let ((buffer "*vc-diff*"))
+ (vc-setup-buffer buffer)
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t))
+ (insert patch-string))
+ (setq buffer-read-only t)
+ (diff-mode)
+ (setq-local diff-vc-backend (vc-responsible-backend default-directory))
+ (setq-local revert-buffer-function
+ (lambda (_ _) (vc-diff-patch-string patch-string)))
+ (setq-local vc-patch-string patch-string)
+ (pop-to-buffer (current-buffer))
+ (vc-run-delayed (vc-diff-finish (current-buffer) nil))))
+
(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer)
"Report diffs between two revisions of a fileset.
Output goes to the buffer BUFFER, which defaults to *vc-diff*.
@@ -1870,19 +1964,40 @@ 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
(setq files (cadr vc-fileset))
(setq backend (car vc-fileset))))
((null backend) (setq backend (vc-backend (car files)))))
- (let ((completion-table
- (vc-call-backend backend 'revision-completion-table files)))
+ ;; Override any `vc-filter-command-function' value, as user probably
+ ;; doesn't want to edit the command to get the completions.
+ (let* ((vc-filter-command-function #'list)
+ (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."
@@ -1968,19 +2083,20 @@ state of each file in the fileset."
(when buffer-file-name (vc-buffer-sync not-urgent))))
;;;###autoload
-(defun vc-diff (&optional historic not-urgent)
+(defun vc-diff (&optional historic not-urgent fileset)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
working revisions. With a prefix argument HISTORIC, it reads two revision
designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
-saving the buffer."
+saving the buffer. The optional argument FILESET can override the
+deduced fileset."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-diff)
(vc-maybe-buffer-sync not-urgent)
- (let ((fileset (vc-deduce-fileset t)))
+ (let ((fileset (or fileset (vc-deduce-fileset t))))
(vc-buffer-sync-fileset fileset not-urgent)
(vc-diff-internal t fileset nil nil
(called-interactively-p 'interactive)))))
@@ -2294,7 +2410,7 @@ changes from the current branch."
((vc-find-backend-function backend 'merge-branch)
(vc-call-backend backend 'merge-branch))
;; Otherwise, do a per-file merge.
- ((vc-find-backend-function backend 'merge)
+ ((vc-find-backend-function backend 'merge-file)
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
@@ -2397,7 +2513,23 @@ checked out in that new branch."
(message "Making %s... done" (if branchp "branch" "tag")))
;;;###autoload
-(defun vc-retrieve-tag (dir name)
+(defun vc-create-branch (dir name)
+ "Descending recursively from DIR, make a branch called NAME.
+After a new branch is made, the files are checked out in that new branch.
+Uses `vc-create-tag' with the non-nil arg `branchp'."
+ (interactive
+ (let ((granularity
+ (vc-call-backend (vc-responsible-backend default-directory)
+ 'revision-granularity)))
+ (list
+ (if (eq granularity 'repository)
+ default-directory
+ (read-directory-name "Directory: " default-directory default-directory
t))
+ (read-string "New branch name: " nil 'vc-revision-history))))
+ (vc-create-tag dir name t))
+
+;;;###autoload
+(defun vc-retrieve-tag (dir name &optional branchp)
"For each file in or below DIR, retrieve their tagged version NAME.
NAME can name a branch, in which case this command will switch to the
named branch in the directory DIR.
@@ -2407,6 +2539,8 @@ If NAME is empty, it refers to the latest revisions of
the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped).
+If the prefix argument BRANCHP is given, switch the branch
+and check out the files in that branch.
This function runs the hook `vc-retrieve-tag-hook' when finished."
(interactive
(let* ((granularity
@@ -2422,15 +2556,21 @@ This function runs the hook `vc-retrieve-tag-hook' when
finished."
(read-directory-name "Directory: " default-directory nil t))))
(list
dir
- (vc-read-revision (format-prompt "Tag name to retrieve" "latest
revisions")
+ (vc-read-revision (format-prompt
+ (if current-prefix-arg
+ "Switch to branch"
+ "Tag name to retrieve")
+ "latest revisions")
(list dir)
- (vc-responsible-backend dir)))))
+ (vc-responsible-backend dir))
+ current-prefix-arg)))
(let* ((backend (vc-responsible-backend dir))
(update (when (vc-call-backend backend 'update-on-retrieve-tag)
(yes-or-no-p "Update any affected buffers? ")))
(msg (if (or (not name) (string= name ""))
(format "Updating %s... " (abbreviate-file-name dir))
- (format "Retrieving tag %s into %s... "
+ (format "Retrieving %s %s into %s... "
+ (if branchp "branch" "tag")
name (abbreviate-file-name dir)))))
(message "%s" msg)
(vc-call-backend backend 'retrieve-tag dir name update)
@@ -2438,6 +2578,25 @@ This function runs the hook `vc-retrieve-tag-hook' when
finished."
(run-hooks 'vc-retrieve-tag-hook)
(message "%s" (concat msg "done"))))
+;;;###autoload
+(defun vc-switch-branch (dir name)
+ "Switch to the branch NAME in the directory DIR.
+If NAME is empty, it refers to the latest revisions of the current branch.
+Uses `vc-retrieve-tag' with the non-nil arg `branchp'."
+ (interactive
+ (let* ((granularity
+ (vc-call-backend (vc-responsible-backend default-directory)
+ 'revision-granularity))
+ (dir
+ (if (eq granularity 'repository)
+ (expand-file-name (vc-root-dir))
+ (read-directory-name "Directory: " default-directory nil t))))
+ (list
+ dir
+ (vc-read-revision (format-prompt "Switch to branch" "latest revisions")
+ (list dir)
+ (vc-responsible-backend dir)))))
+ (vc-retrieve-tag dir name t))
;; Miscellaneous other entry points
@@ -2663,8 +2822,10 @@ with its diffs (if the underlying VCS supports that)."
(defun vc-print-branch-log (branch)
"Show the change log for BRANCH root in a window."
(interactive
- (list
- (vc-read-revision "Branch to log: ")))
+ (let* ((backend (vc-responsible-backend default-directory))
+ (rootdir (vc-call-backend backend 'root default-directory)))
+ (list
+ (vc-read-revision "Branch to log: " (list rootdir) backend))))
(when (equal branch "")
(error "No branch specified"))
(let* ((backend (vc-responsible-backend default-directory))
@@ -2676,10 +2837,11 @@ with its diffs (if the underlying VCS supports that)."
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
"Show log of changes that will be received with pull from REMOTE-LOCATION.
-When called interactively with a prefix argument, prompt for 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."
(interactive
(when current-prefix-arg
- (list (read-string "Remote location (empty for default): "))))
+ (list (read-string "Remote location/branch (empty for default): "))))
(let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
@@ -2689,10 +2851,11 @@ When called interactively with a prefix argument,
prompt for REMOTE-LOCATION."
;;;###autoload
(defun vc-log-outgoing (&optional remote-location)
"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."
+When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
+In some version control systems REMOTE-LOCATION can be a remote branch name."
(interactive
(when current-prefix-arg
- (list (read-string "Remote location (empty for default): "))))
+ (list (read-string "Remote location/branch (empty for default): "))))
(let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
@@ -2879,6 +3042,28 @@ It also signals an error in a Bazaar bound branch."
(vc-call-backend backend 'push arg)
(user-error "VC push is unsupported for `%s'" backend))))
+;;;###autoload
+(defun vc-pull-and-push (&optional arg)
+ "First pull, and then push the current branch.
+The push will only be performed if the pull operation was successful.
+
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
+
+On a distributed version control system, this runs a \"pull\"
+operation on the current branch, prompting for the precise
+command if required. Optional prefix ARG non-nil forces a prompt
+for the VCS command to run. If this is successful, a \"push\"
+operation will then be done.
+
+On a non-distributed version control system, this signals an error.
+It also signals an error in a Bazaar bound branch."
+ (interactive "P")
+ (let* ((vc-fileset (vc-deduce-fileset t))
+ (backend (car vc-fileset)))
+ (if (vc-find-backend-function backend 'pull-and-push)
+ (vc-call-backend backend 'pull-and-push arg)
+ (user-error "VC pull-and-push is unsupported for `%s'" backend))))
+
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
If version backups should be used for FILE, and there exists
@@ -3124,6 +3309,139 @@ log entries should be gathered."
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
+(defvar vc-filter-command-function)
+
+;;;###autoload
+(defun vc-edit-next-command ()
+ "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."
+ (interactive)
+ (letrec ((minibuffer-depth (minibuffer-depth))
+ (command this-command)
+ (keys (key-description (this-command-keys)))
+ (old vc-filter-command-function)
+ (echofun (lambda () keys))
+ (postfun
+ (lambda ()
+ (unless (or (eq this-command command)
+ (> (minibuffer-depth) minibuffer-depth))
+ (remove-hook 'post-command-hook postfun)
+ (remove-hook 'prefix-command-echo-keystrokes-functions
+ echofun)
+ (setq vc-filter-command-function old)))))
+ (add-hook 'post-command-hook postfun)
+ (add-hook 'prefix-command-echo-keystrokes-functions echofun)
+ (setq vc-filter-command-function
+ (lambda (&rest args)
+ (apply #'vc-user-edit-command (apply old args))))))
+
+(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)))))
+
+;;;###autoload
+(defun vc-prepare-patch (addressee subject revisions)
+ "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."
+ (interactive
+ (let ((revs (vc-read-multiple-revisions
+ "Revisions: " nil nil nil
+ (or (and-let* ((revs (log-view-get-marked)))
+ (mapconcat #'identity revs ","))
+ (and-let* ((file (buffer-file-name)))
+ (vc-working-revision file)))))
+ 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."
@@ -3239,8 +3557,6 @@ to provide the `find-revision' operation instead."
;; These things should probably be generally available
-(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3")
-
(defun vc-file-tree-walk (dirname func &rest args)
"Walk recursively through DIRNAME.
Invoke FUNC f ARGS on each VC-managed file f underneath it."
diff --git a/lisp/view.el b/lisp/view.el
index 287112f2d4..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,
@@ -441,7 +434,9 @@ Entry to view-mode runs the normal hook `view-mode-hook'."
(setq view-page-size nil
view-half-page-size nil
view-old-buffer-read-only buffer-read-only
- buffer-read-only t))
+ buffer-read-only t)
+ ;; Make reverting the buffer preserve unreadableness.
+ (setq-local read-only-mode--state t))
(define-obsolete-function-alias 'view-mode-enable 'view-mode "24.4")
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 09f5b069f4..6904bac4d0 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -27,16 +27,16 @@
;; wdired.el (the "w" is for writable) provides an alternative way of
;; renaming files.
;;
-;; Have you ever wanted to use C-x r t (string-rectangle), M-%
-;; (query-replace), M-c (capitalize-word), etc... to change the name of
-;; the files in a "dired" buffer? Now you can do this. All the power
-;; of Emacs commands are available when renaming files!
+;; Have you ever wanted to use `C-x r t' (`string-rectangle'), `M-%'
+;; (`query-replace'), `M-c' (`capitalize-word'), etc... to change the
+;; name of the files in a Dired buffer? Now you can do this. All the
+;; power of Emacs commands are available when renaming files!
;;
;; This package provides a function that makes the filenames of a
-;; dired buffer editable, by changing the buffer mode (which inhibits
-;; all of the commands of dired mode). Here you can edit the names of
-;; one or more files and directories, and when you press C-c C-c, the
-;; renaming takes effect and you are back to dired mode.
+;; Dired buffer editable, by changing the buffer mode (which inhibits
+;; all of the commands of Dired mode). Here you can edit the names of
+;; one or more files and directories, and when you press `C-c C-c',
+;; the renaming takes effect and you are back to dired mode.
;;
;; Other things you can do with WDired:
;;
@@ -46,11 +46,11 @@
;; - Change the target of symbolic links.
;;
;; - Change the permission bits of the filenames (in systems with a
-;; working unix-alike `dired-chmod-program'). See and customize the
-;; variable `wdired-allow-to-change-permissions'. To change a single
-;; char (toggling between its two more usual values) you can press
-;; the space bar over it or left-click the mouse. To set any char to
-;; an specific value (this includes the SUID, SGID and STI bits) you
+;; working unix-alike "chmod"). See and customize the variable
+;; `wdired-allow-to-change-permissions'. To change a single char
+;; (toggling between its two more usual values), you can press the
+;; space bar over it or left-click the mouse. To set any char to a
+;; specific value (this includes the SUID, SGID and STI bits) you
;; can use the key labeled as the letter you want. Please note that
;; permissions of the links cannot be changed in that way, because
;; the change would affect to their targets, and this would not be
@@ -58,18 +58,14 @@
;;
;; - Mark files for deletion, by deleting their whole filename.
-;;; Usage:
+;; * Usage:
-;; You can edit the names of the files by typing C-x C-q or by
-;; executing M-x wdired-change-to-wdired-mode. Use C-c C-c when
-;; finished or C-c C-k to abort. While editing filenames, a new
-;; submenu "WDired" is available at top level. You can customize the
-;; behavior of this package from this menu.
-
-;;; Change Log:
-
-;; Previous versions with complete changelogs were posted to
-;; gnu.emacs.sources.
+;; You can edit the names of the files by typing `C-x C-q' or
+;; `M-x wdired-change-to-wdired-mode'. Use `C-c C-c' when
+;; finished or `C-c C-k' to abort.
+;;
+;; You can customize the behavior of this package from the "WDired"
+;; menu or with `M-x customize-group RET wdired RET'.
;;; Code:
@@ -127,8 +123,8 @@ If `advanced', the bits are freely editable. You can use
newlines), but if you want your changes to be useful, you better put a
intelligible value.
-Anyway, the real change of the permissions is done by the external
-program `dired-chmod-program', which must exist."
+The real change of the permissions is done by the external
+program \"chmod\", which must exist."
:type '(choice (const :tag "Not allowed" nil)
(const :tag "Toggle/set bits" t)
(other :tag "Bits freely editable" advanced)))
@@ -1028,7 +1024,8 @@ Like original function but it skips read-only words."
(setq filename (wdired-get-filename nil t))
(if (= (length perms-new) 10)
(condition-case nil
- (set-file-modes filename (wdired-perms-to-number perms-new))
+ (set-file-modes filename (wdired-perms-to-number perms-new)
+ 'nofollow)
(error
(setq errors (1+ errors))
(dired-log "Setting mode of `%s' to `%s' failed\n\n"
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 41b0a34f9e..4238461b7e 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,30 +740,35 @@ 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-indentationp'
+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"))
:group 'whitespace)
-(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
- "Specify regexp for empty lines at beginning of buffer.
+(defcustom whitespace-empty-at-bob-regexp "\\`\\([ \t\n]*\\(?:\n\\|$\\)\\)"
+ "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.
-It must be an integer or nil. If nil, the `fill-column' variable value is
-used.
+The value must be an integer or nil. If nil, use the value
+of the `fill-column' variable.
-Used when `whitespace-style' includes `lines', `lines-tail' or
-`lines-char'."
+The characters beyond the column specified by this variable are
+highlighted using the `whitespace-line' face.
+
+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
@@ -1129,28 +1164,33 @@ SYMBOL is a valid symbol associated with CHAR.
See `whitespace-style-value-list'.")
-(defvar whitespace-active-style nil
+(defvar-local whitespace-active-style nil
"Used to save locally `whitespace-style' value.")
-(defvar whitespace-point (point)
+(defvar-local whitespace-point (point)
"Used to save locally current point value.
Used by function `whitespace-trailing-regexp' (which see).")
(defvar-local whitespace-point--used nil
"Region whose highlighting depends on `whitespace-point'.")
-(defvar whitespace-font-lock-refontify nil
- "Used to save locally the font-lock refontify state.
-Used by function `whitespace-post-command-hook' (which see).")
-
-(defvar whitespace-bob-marker nil
- "Used to save locally the bob marker value.
-Used by function `whitespace-post-command-hook' (which see).")
-
-(defvar whitespace-eob-marker nil
- "Used to save locally the eob marker value.
-Used by function `whitespace-post-command-hook' (which see).")
-
-(defvar whitespace-buffer-changed nil
+(defvar-local whitespace-bob-marker nil
+ "Position of the buffer's first non-empty line.
+This marker is positioned at the beginning of the first line in
+the buffer that contains a non-space character. If no such line
+exists, this is positioned at the end of the buffer (which could
+be after `whitespace-eob-marker' if the buffer contains nothing
+but empty lines).")
+
+(defvar-local whitespace-eob-marker nil
+ "Position after the buffer's last non-empty line.
+This marker is positioned at the beginning of the first line
+immediately following the last line in the buffer that contains a
+non-space character. If no such line exists, this is positioned
+at the beginning of the buffer (which could be before
+`whitespace-bob-marker' if the buffer contains nothing but empty
+lines).")
+
+(defvar-local whitespace-buffer-changed nil
"Used to indicate locally if buffer changed.
Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
functions (which see).")
@@ -1770,7 +1810,7 @@ cleaning up these problems."
;;;; Internal functions
-(defvar whitespace-font-lock-keywords nil
+(defvar-local whitespace-font-lock-keywords nil
"Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.")
@@ -1997,10 +2037,10 @@ resultant list will be returned."
the-list)
-(defvar whitespace-display-table nil
+(defvar-local whitespace-display-table nil
"Used to save a local display table.")
-(defvar whitespace-display-table-was-local nil
+(defvar-local whitespace-display-table-was-local nil
"Used to remember whether a buffer initially had a local display table.")
(defun whitespace-turn-on ()
@@ -2061,12 +2101,16 @@ resultant list will be returned."
(setq whitespace-point--used
(let ((ol (make-overlay (point) (point) nil nil t)))
(delete-overlay ol) ol))
- (setq-local whitespace-font-lock-refontify 0)
(setq-local whitespace-bob-marker (point-min-marker))
(setq-local whitespace-eob-marker (point-max-marker))
+ (whitespace--update-bob-eob)
(setq-local whitespace-buffer-changed nil)
(add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
(add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
+ (add-hook 'after-change-functions #'whitespace--update-bob-eob
+ ;; The -1 ensures that it runs before any
+ ;; `font-lock-mode' hook functions.
+ -1 t)
;; Add whitespace-mode color into font lock.
(setq
whitespace-font-lock-keywords
@@ -2119,11 +2163,11 @@ resultant list will be returned."
`((,whitespace-big-indent-regexp 1 'whitespace-big-indent t)))
,@(when (memq 'empty whitespace-active-style)
;; Show empty lines at beginning of buffer.
- `((,#'whitespace-empty-at-bob-regexp
- 1 whitespace-empty t)
+ `((,#'whitespace--empty-at-bob-matcher
+ 0 whitespace-empty t)
;; Show empty lines at end of buffer.
- (,#'whitespace-empty-at-eob-regexp
- 1 whitespace-empty t)))
+ (,#'whitespace--empty-at-eob-matcher
+ 0 whitespace-empty t)))
,@(when (or (memq 'space-after-tab whitespace-active-style)
(memq 'space-after-tab::tab whitespace-active-style)
(memq 'space-after-tab::space whitespace-active-style))
@@ -2158,6 +2202,8 @@ resultant list will be returned."
(when (whitespace-style-face-p)
(remove-hook 'post-command-hook #'whitespace-post-command-hook t)
(remove-hook 'before-change-functions #'whitespace-buffer-changed t)
+ (remove-hook 'after-change-functions #'whitespace--update-bob-eob
+ t)
(font-lock-remove-keywords nil whitespace-font-lock-keywords)
(font-lock-flush)))
@@ -2206,114 +2252,83 @@ resultant list will be returned."
(format ".\\{%d\\}" rem)))))
limit t))
-(defun whitespace-empty-at-bob-regexp (limit)
- "Match spaces at beginning of buffer (BOB) which do not contain point at
BOB."
- (let ((b (point))
- r)
- (cond
- ;; at bob
- ((= b 1)
- (setq r (and (looking-at whitespace-empty-at-bob-regexp)
- (or (/= whitespace-point 1)
- (progn (whitespace-point--used (match-beginning 0)
- (match-end 0))
- nil))))
- (set-marker whitespace-bob-marker (if r (match-end 1) b)))
- ;; inside bob empty region
- ((<= limit whitespace-bob-marker)
- (setq r (looking-at whitespace-empty-at-bob-regexp))
- (if r
- (when (< (match-end 1) limit)
- (set-marker whitespace-bob-marker (match-end 1)))
- (set-marker whitespace-bob-marker b)))
- ;; intersection with end of bob empty region
- ((<= b whitespace-bob-marker)
- (setq r (looking-at whitespace-empty-at-bob-regexp))
- (set-marker whitespace-bob-marker (if r (match-end 1) b)))
- ;; it is not inside bob empty region
- (t
- (setq r nil)))
- ;; move to end of matching
- (and r (goto-char (match-end 1)))
- r))
-
-
-(defsubst whitespace-looking-back (regexp limit)
+(defun whitespace--empty-at-bob-matcher (limit)
+ "Match empty/space-only lines at beginning of buffer (BoB).
+Match does not extend past position LIMIT. For improved UX, the
+line containing `whitespace-point' and subsequent lines are
+excluded from the match. (The idea is that the user might be
+about to start typing, and if they do, that line and any
+following empty lines will no longer be BoB empty lines.
+Highlighting those lines can be distracting.)"
+ (let ((p (point))
+ (e (min whitespace-bob-marker limit
+ ;; EoB marker will be before BoB marker if the buffer
+ ;; has nothing but empty lines.
+ whitespace-eob-marker
+ (save-excursion (goto-char whitespace-point)
+ (line-beginning-position)))))
+ (when (= p 1)
+ ;; See the comment in `whitespace--update-bob-eob' for why this
+ ;; text property is added here.
+ (put-text-property 1 whitespace-bob-marker
+ 'font-lock-multiline t))
+ (when (< p e)
+ (set-match-data (list p e))
+ (goto-char e))))
+
+(defsubst whitespace--looking-back (regexp)
(save-excursion
- (when (/= 0 (skip-chars-backward " \t\n" limit))
+ (when (/= 0 (skip-chars-backward " \t\n"))
(unless (bolp)
(forward-line 1))
(looking-at regexp))))
-
-(defun whitespace-empty-at-eob-regexp (limit)
- "Match spaces at end of buffer which do not contain the point at end of \
-buffer."
- (let ((b (point))
- (e (1+ (buffer-size)))
- r)
- (cond
- ;; at eob
- ((= limit e)
- (goto-char limit)
- (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
- (when (and r (= whitespace-point e))
- (setq r nil)
- (whitespace-point--used (match-beginning 0) (match-end 0)))
- (if r
- (set-marker whitespace-eob-marker (match-beginning 1))
- (set-marker whitespace-eob-marker limit)
- (goto-char b))) ; return back to initial position
- ;; inside eob empty region
- ((>= b whitespace-eob-marker)
- (goto-char limit)
- (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
- (if r
- (when (> (match-beginning 1) b)
- (set-marker whitespace-eob-marker (match-beginning 1)))
- (set-marker whitespace-eob-marker limit)
- (goto-char b))) ; return back to initial position
- ;; intersection with beginning of eob empty region
- ((>= limit whitespace-eob-marker)
- (goto-char limit)
- (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
- (if r
- (set-marker whitespace-eob-marker (match-beginning 1))
- (set-marker whitespace-eob-marker limit)
- (goto-char b))) ; return back to initial position
- ;; it is not inside eob empty region
- (t
- (setq r nil)))
- r))
-
+(defun whitespace--empty-at-eob-matcher (limit)
+ "Match empty/space-only lines at end of buffer (EoB).
+Match does not extend past position LIMIT. For improved UX, the
+line containing `whitespace-point' and preceding lines are
+excluded from the match. (The idea is that the user might be
+about to start typing, and if they do, that line and previous
+empty lines will no longer be EoB empty lines. Highlighting
+those lines can be distracting.)"
+ (when (= limit (1+ (buffer-size)))
+ ;; See the comment in `whitespace--update-bob-eob' for why this
+ ;; text property is added here.
+ (put-text-property whitespace-eob-marker limit
+ 'font-lock-multiline t))
+ (let ((b (max (point) whitespace-eob-marker
+ whitespace-bob-marker ; See comment in the bob func.
+ (save-excursion (goto-char whitespace-point)
+ (forward-line 1)
+ (point)))))
+ (when (< b limit)
+ (set-match-data (list b limit))
+ (goto-char limit))))
(defun whitespace-buffer-changed (_beg _end)
"Set `whitespace-buffer-changed' variable to t."
(setq whitespace-buffer-changed t))
-
(defun whitespace-post-command-hook ()
"Save current point into `whitespace-point' variable.
Also refontify when necessary."
(unless (and (eq whitespace-point (point))
(not whitespace-buffer-changed))
+ (when (and (not whitespace-buffer-changed)
+ (memq 'empty whitespace-active-style))
+ ;; No need to handle the `whitespace-buffer-changed' case here
+ ;; because that is taken care of by the `font-lock-multiline'
+ ;; text property.
+ (when (<= (min (point) whitespace-point) whitespace-bob-marker)
+ (font-lock-flush 1 whitespace-bob-marker))
+ (when (>= (max (point) whitespace-point) whitespace-eob-marker)
+ (font-lock-flush whitespace-eob-marker (1+ (buffer-size)))))
+ (setq-local whitespace-buffer-changed nil)
(setq whitespace-point (point)) ; current point position
- (let ((refontify
- (cond
- ;; It is at end of buffer (eob).
- ((= whitespace-point (1+ (buffer-size)))
- (when (whitespace-looking-back whitespace-empty-at-eob-regexp
- nil)
- (match-beginning 0)))
- ;; It is at end of line ...
- ((and (eolp)
- ;; ... with trailing SPACE or TAB
- (or (memq (preceding-char) '(?\s ?\t))))
- (line-beginning-position))
- ;; It is at beginning of buffer (bob).
- ((and (= whitespace-point 1)
- (looking-at whitespace-empty-at-bob-regexp))
- (match-end 0))))
+ (let ((refontify (and (eolp) ; It is at end of line ...
+ ;; ... with trailing SPACE or TAB
+ (or (memq (preceding-char) '(?\s ?\t)))
+ (line-beginning-position)))
(ostart (overlay-start whitespace-point--used)))
(cond
((not refontify)
@@ -2367,6 +2382,78 @@ to `indent-tabs-mode' and `tab-width'."
(when whitespace-mode
(font-lock-flush)))))
+(defun whitespace--update-bob-eob (&optional beg end &rest _)
+ "Update `whitespace-bob-marker' and `whitespace-eob-marker'.
+Also apply `font-lock-multiline' text property. If BEG and END
+are non-nil, assume that only characters in that range have
+changed since the last call to this function (for optimization
+purposes)."
+ (when (memq 'empty whitespace-active-style)
+ ;; When a line is changed, `font-lock-mode' normally limits
+ ;; re-processing to only the changed line. That behavior is
+ ;; problematic for highlighting `empty' lines because adding or
+ ;; deleting a character might affect lines before or after the
+ ;; change. To address this, all `empty' lines are marked with a
+ ;; non-nil `font-lock-multiline' text property. This forces
+ ;; `font-lock-mode' to re-process all of the lines whenever
+ ;; there's an edit within any one of them.
+ ;;
+ ;; The text property must be set on `empty' lines twice per
+ ;; relevant change:
+ ;;
+ ;; 1. Before the change. This is necessary to ensure that
+ ;; previously highlighted lines become un-highlighted if
+ ;; necessary. The text property must be added after the
+ ;; previous `font-lock-mode' run (the run in reaction to the
+ ;; previous change) because `font-lock-mode' clears the text
+ ;; property when it runs.
+ ;;
+ ;; 2. After the change, but before `font-lock-mode' reacts to
+ ;; the change. This is necessary to ensure that new `empty'
+ ;; lines become highlighted.
+ ;;
+ ;; This hook function is responsible for #2, while the
+ ;; `whitespace--empty-at-bob-matcher' and
+ ;; `whitespace--empty-at-eob-matcher' functions are responsible
+ ;; for #1. (Those functions run after `font-lock-mode' clears the
+ ;; text property and before the next change.)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((inhibit-read-only t))
+ (when (or (null beg)
+ (<= beg (save-excursion
+ (goto-char whitespace-bob-marker)
+ ;; Any change in the first non-`empty'
+ ;; line, even if it's not the first
+ ;; character in the line, can potentially
+ ;; cause subsequent lines to become
+ ;; classified as `empty' (e.g., delete the
+ ;; "x" from " x").
+ (forward-line 1)
+ (point))))
+ (goto-char 1)
+ (set-marker whitespace-bob-marker (point))
+ (save-match-data
+ (when (looking-at whitespace-empty-at-bob-regexp)
+ (set-marker whitespace-bob-marker (match-end 1))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-multiline t))))
+ (when (or (null end)
+ (>= end (save-excursion
+ (goto-char whitespace-eob-marker)
+ ;; See above comment for the BoB case.
+ (forward-line -1)
+ (point))))
+ (goto-char (1+ (buffer-size)))
+ (set-marker whitespace-eob-marker (point))
+ (save-match-data
+ (when (whitespace--looking-back
+ whitespace-empty-at-eob-regexp)
+ (set-marker whitespace-eob-marker (match-beginning 1))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-multiline t)))))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 7fc476e5df..a90f7bc160 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -35,12 +35,10 @@
;;; The Mode.
-(defvar widget-browse-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "q" #'bury-buffer)
- map)
- "Keymap for `widget-browse-mode'.")
+(defvar-keymap widget-browse-mode-map
+ :doc "Keymap for `widget-browse-mode'."
+ :parent widget-keymap
+ "q" #'bury-buffer)
(easy-menu-define widget-browse-mode-customize-menu
widget-browse-mode-map
@@ -245,11 +243,9 @@ VALUE is assumed to be a list of widgets."
;;; Widget Minor Mode.
-(defvar widget-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- map)
- "Keymap used in Widget Minor Mode.")
+(defvar-keymap widget-minor-mode-map
+ :doc "Keymap used in Widget Minor Mode."
+ :parent widget-keymap)
;;;###autoload
(define-minor-mode widget-minor-mode
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index ec2eb146e9..4d9663cea9 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3452,11 +3452,9 @@ It reads a directory name from an editable text field."
(defvar widget-key-sequence-default-value [ignore]
"Default value for an empty key sequence.")
-(defvar widget-key-sequence-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-field-keymap)
- (define-key map [(control ?q)] 'widget-key-sequence-read-event)
- map))
+(defvar-keymap widget-key-sequence-map
+ :parent widget-field-keymap
+ "C-q" #'widget-key-sequence-read-event)
(define-widget 'key-sequence 'restricted-sexp
"A key sequence. This is obsolete; use the `key' type instead."
@@ -4145,6 +4143,15 @@ is inline."
(define-obsolete-function-alias 'widget-visibility-value-create
#'widget-toggle-value-create "29.1")
+;;; Buffer predicates.
+(define-widget 'buffer-predicate 'lazy
+ "A buffer predicate."
+ :tag "Buffer predicate"
+ :type '(choice (const :tag "All buffers" t)
+ (const :tag "No buffers" nil)
+ ;; FIXME: This should be expanded somehow.
+ sexp))
+
(provide 'wid-edit)
;;; wid-edit.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index 4d88ffa903..905803b19e 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5672,9 +5672,9 @@ the original point in both windows."
:type 'boolean
:group 'windows)
-(defun split-window-below (&optional size)
- "Split the selected window into two windows, one above the other.
-The selected window is above. The newly split-off window is
+(defun split-window-below (&optional size window-to-split)
+ "Split WINDOW-TO-SPLIT into two windows, one above the other.
+WINDOW-TO-SPLIT is above. The newly split-off window is
below and displays the same buffer. Return the new window.
If optional argument SIZE is omitted or nil, both windows get the
@@ -5683,22 +5683,22 @@ same height, or close to it. If SIZE is positive, the
upper
lower (new) window gets -SIZE lines.
If the variable `split-window-keep-point' is non-nil, both
-windows get the same value of point as the selected window.
+windows get the same value of point as the WINDOW-TO-SPLIT.
Otherwise, the window starts are chosen so as to minimize the
amount of redisplay; this is convenient on slow terminals."
- (interactive "P")
- (let ((old-window (selected-window))
- (old-point (window-point))
- (size (and size (prefix-numeric-value size)))
+ (interactive `(,(when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))
+ ,(selected-window)))
+ (let ((old-point (window-point))
moved-by-window-height moved new-window bottom)
(when (and size (< size 0) (< (- size) window-min-height))
;; `split-window' would not signal an error here.
(error "Size of new window too small"))
- (setq new-window (split-window nil size))
+ (setq new-window (split-window window-to-split size))
(unless split-window-keep-point
- (with-current-buffer (window-buffer)
+ (with-current-buffer (window-buffer window-to-split)
;; Use `save-excursion' around vertical movements below
- ;; (Bug#10971). Note: When the selected window's buffer has a
+ ;; (Bug#10971). Note: When WINDOW-TO-SPLIT's buffer has a
;; header line, up to two lines of the buffer may not show up
;; in the resulting configuration.
(save-excursion
@@ -5713,24 +5713,31 @@ amount of redisplay; this is convenient on slow
terminals."
(setq bottom (point)))
(and moved-by-window-height
(<= bottom (point))
- (set-window-point old-window (1- bottom)))
+ (set-window-point window-to-split (1- bottom)))
(and moved-by-window-height
(<= (window-start new-window) old-point)
(set-window-point new-window old-point)
(select-window new-window))))
;; Always copy quit-restore parameter in interactive use.
- (let ((quit-restore (window-parameter old-window 'quit-restore)))
+ (let ((quit-restore (window-parameter window-to-split 'quit-restore)))
(when quit-restore
(set-window-parameter new-window 'quit-restore quit-restore)))
new-window))
(defalias 'split-window-vertically 'split-window-below)
-(defun split-window-right (&optional size)
- "Split the selected window into two side-by-side windows.
-The selected window is on the left. The newly split-off window
-is on the right and displays the same buffer. Return the new
-window.
+(defun split-root-window-below (&optional size)
+ "Split root window of current frame in two.
+The current window configuration is retained in the top window,
+the lower window takes up the whole width of the frame. SIZE is
+handled as in `split-window-below'."
+ (interactive "P")
+ (split-window-below size (frame-root-window)))
+
+(defun split-window-right (&optional size window-to-split)
+ "Split WINDOW-TO-SPLIT into two side-by-side windows.
+WINDOW-TO-SPLIT is on the left. The newly split-off window is on
+the right and displays the same buffer. Return the new window.
If optional argument SIZE is omitted or nil, both windows get the
same width, or close to it. If SIZE is positive, the left-hand
@@ -5739,21 +5746,30 @@ right-hand (new) window gets -SIZE columns. Here, SIZE
includes
the width of the window's scroll bar; if there are no scroll
bars, it includes the width of the divider column to the window's
right, if any."
- (interactive "P")
- (let ((old-window (selected-window))
- (size (and size (prefix-numeric-value size)))
- new-window)
+ (interactive `(,(when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))
+ ,(selected-window)))
+ (let (new-window)
(when (and size (< size 0) (< (- size) window-min-width))
;; `split-window' would not signal an error here.
(error "Size of new window too small"))
- (setq new-window (split-window nil size t))
+ (setq new-window (split-window window-to-split size t))
;; Always copy quit-restore parameter in interactive use.
- (let ((quit-restore (window-parameter old-window 'quit-restore)))
+ (let ((quit-restore (window-parameter window-to-split 'quit-restore)))
(when quit-restore
(set-window-parameter new-window 'quit-restore quit-restore)))
new-window))
(defalias 'split-window-horizontally 'split-window-right)
+
+(defun split-root-window-right (&optional size)
+ "Split root window of current frame into two side-by-side windows.
+The current window configuration is retained within the left
+window, and a new window is created on the right, taking up the
+whole height of the frame. SIZE is treated as by
+`split-window-right'."
+ (interactive "P")
+ (split-window-right size (frame-root-window)))
;;; Balancing windows.
@@ -6606,24 +6622,6 @@ fourth element is BUFFER."
window 'quit-restore
(list 'tab 'tab (selected-window) buffer)))))
-(defcustom display-buffer-function nil
- "If non-nil, function to call to handle `display-buffer'.
-It will receive two args, the buffer and a flag which if non-nil
-means that the currently selected window is not acceptable. It
-should choose or create a window, display the specified buffer in
-it, and return the window.
-
-The specified function should call `display-buffer-record-window'
-with corresponding arguments to set up the quit-restore parameter
-of the window used."
- :type '(choice
- (const nil)
- (function :tag "function"))
- :group 'windows)
-
-(make-obsolete-variable 'display-buffer-function
- 'display-buffer-alist "24.3")
-
(defcustom pop-up-frame-alist nil
"Alist of parameters for automatically generated new frames.
If non-nil, the value you specify here is used by the default
@@ -7729,38 +7727,34 @@ specified by the ACTION argument."
;; Handle the old form of the first argument.
(inhibit-same-window (and action (not (listp action)))))
(unless (listp action) (setq action nil))
- (if display-buffer-function
- ;; If `display-buffer-function' is defined, let it do the job.
- (funcall display-buffer-function buffer inhibit-same-window)
- ;; Otherwise, use the defined actions.
- (let* ((user-action
- (display-buffer-assq-regexp
- buffer display-buffer-alist action))
- (special-action (display-buffer--special-action buffer))
- ;; Extra actions from the arguments to this function:
- (extra-action
- (cons nil (append (if inhibit-same-window
- '((inhibit-same-window . t)))
- (if frame
- `((reusable-frames . ,frame))))))
- ;; Construct action function list and action alist.
- (actions (list display-buffer-overriding-action
- user-action special-action action extra-action
- display-buffer-base-action
- display-buffer-fallback-action))
- (functions (apply 'append
- (mapcar (lambda (x)
- (setq x (car x))
- (if (functionp x) (list x) x))
- actions)))
- (alist (apply 'append (mapcar 'cdr actions)))
- window)
- (unless (buffer-live-p buffer)
- (error "Invalid buffer"))
- (while (and functions (not window))
- (setq window (funcall (car functions) buffer alist)
- functions (cdr functions)))
- (and (windowp window) window)))))
+ (let* ((user-action
+ (display-buffer-assq-regexp
+ buffer display-buffer-alist action))
+ (special-action (display-buffer--special-action buffer))
+ ;; Extra actions from the arguments to this function:
+ (extra-action
+ (cons nil (append (if inhibit-same-window
+ '((inhibit-same-window . t)))
+ (if frame
+ `((reusable-frames . ,frame))))))
+ ;; Construct action function list and action alist.
+ (actions (list display-buffer-overriding-action
+ user-action special-action action extra-action
+ display-buffer-base-action
+ display-buffer-fallback-action))
+ (functions (apply 'append
+ (mapcar (lambda (x)
+ (setq x (car x))
+ (if (functionp x) (list x) x))
+ actions)))
+ (alist (apply 'append (mapcar 'cdr actions)))
+ window)
+ (unless (buffer-live-p buffer)
+ (error "Invalid buffer"))
+ (while (and functions (not window))
+ (setq window (funcall (car functions) buffer alist)
+ functions (cdr functions)))
+ (and (windowp window) window))))
(defun display-buffer-other-frame (buffer)
"Display buffer BUFFER preferably in another frame.
@@ -9044,10 +9038,7 @@ in some window."
;; vertical-motion returns a number that is 1 larger than it
;; should. We need to fix that.
(setq end-invisible-p
- (and (or truncate-lines
- (and (natnump truncate-partial-width-windows)
- (< (window-total-width window)
- truncate-partial-width-windows)))
+ (and (or truncate-lines (truncated-partial-width-window-p window))
(save-excursion
(goto-char finish)
(> (- (current-column) (window-hscroll window))
@@ -10449,7 +10440,7 @@ Otherwise, consult the value of
`truncate-partial-width-windows'
(let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
(window-buffer window))))
(if (integerp t-p-w-w)
- (< (window-width window) t-p-w-w)
+ (< (window-total-width window) t-p-w-w)
t-p-w-w))))
@@ -10597,6 +10588,17 @@ displaying that processes's buffer."
(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
+(defvar-keymap window-prefix-map
+ :doc "Keymap for subcommands of \\`C-x w'."
+ "2" #'split-root-window-below
+ "3" #'split-root-window-right
+ "s" #'window-toggle-side-windows
+ "^ f" #'tear-off-window
+ "^ t" #'tab-window-detach
+ "-" #'fit-window-to-buffer
+ "0" #'delete-windows-on)
+(define-key ctl-x-map "w" window-prefix-map)
+
(provide 'window)
;;; window.el ends here
diff --git a/lisp/winner.el b/lisp/winner.el
index 89f337170c..c8354b18be 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -171,8 +171,7 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(/= 0 (minibuffer-depth)))
(push (selected-frame) winner-modified-list)))
-;; A `post-command-hook' for emacsen with
-;; `window-configuration-change-hook'.
+;; Used as `post-command-hook'.
(defun winner-save-old-configurations ()
(when (zerop (minibuffer-depth))
(unless (eq this-command winner-last-command)
@@ -191,8 +190,7 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(winner-insert-if-new (selected-frame))
(winner-remember))
-;; A `post-command-hook' for other emacsen.
-;; Also called by `winner-undo' before "undoing".
+;; Called by `winner-undo' before "undoing".
(defun winner-save-conditionally ()
(when (zerop (minibuffer-depth))
(winner-save-unconditionally)))
@@ -318,9 +316,6 @@ You may want to include buffer names such as *Help*,
*Apropos*,
"Functions to run whenever Winner mode is turned on or off."
:type 'hook)
-(define-obsolete-variable-alias 'winner-mode-leave-hook
- 'winner-mode-off-hook "24.3")
-
(defcustom winner-mode-off-hook nil
"Functions to run whenever Winner mode is turned off."
:type 'hook)
@@ -333,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/x-dnd.el b/lisp/x-dnd.el
index 2bda67fe3f..058ab99f5c 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)
@@ -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/xdg.el b/lisp/xdg.el
index dd0d51290d..82f1f07df5 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -30,6 +30,7 @@
;; - Thumbnail Managing Standard
;; - xdg-user-dirs configuration
;; - Desktop Entry Specification
+;; - Unofficial extension $XDG_SESSION_TYPE from systemd
;;; Code:
@@ -281,6 +282,18 @@ Optional argument GROUP defaults to the string \"Desktop
Entry\"."
(when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
(nreverse res)))
+(defun xdg-current-desktop ()
+ "Return a list of strings identifying the current desktop environment.
+
+According to the XDG Desktop Entry Specification version 0.5:
+
+ If $XDG_CURRENT_DESKTOP is set then it contains a
+ colon-separated list of strings ... $XDG_CURRENT_DESKTOP
+ should have been set by the login manager, according to the
+ value of the DesktopNames found in the session file."
+ (when-let ((ret (getenv "XDG_CURRENT_DESKTOP")))
+ (string-split ret ":")))
+
;; MIME apps specification
;; https://standards.freedesktop.org/mime-apps-spec/mime-apps-spec-1.0.1.html
@@ -385,6 +398,18 @@ Results are cached in `xdg-mime-table'."
(put 'xdg-mime-table 'mtime (current-time)))
(puthash subtype (delq nil files) (cdr (assoc type
xdg-mime-table)))))))
+
+;; Unofficial extension from systemd.
+
+(defun xdg-session-type ()
+ "Return the value of $XDG_SESSION_TYPE.
+Should be one of \"unspecified\", \"tty\", \"x11\", \"wayland\",
+or \"mir\".
+
+This is not part of any official Freedesktop.org standard, but is
+documented in the man page `pam_systemd'."
+ (getenv "XDG_SESSION_TYPE"))
+
(provide 'xdg)
;;; xdg.el ends here
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 41a1190c64..109748baec 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -1198,7 +1198,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/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c
index d17acae728..b09795ec38 100644
--- a/lwlib/lwlib-Xaw.c
+++ b/lwlib/lwlib-Xaw.c
@@ -594,6 +594,8 @@ make_dialog (char* name,
int nr_xft_data = left_buttons + right_buttons + 1;
instance->xft_data = calloc (nr_xft_data + 1,
sizeof(*instance->xft_data));
+ if (!instance->xft_data)
+ memory_full ((nr_xft_data + 1) * sizeof *instance->xft_data);
fill_xft_data (&instance->xft_data[0], w, xft_font);
XtAddCallback (dialog, XtNdestroyCallback, destroy_xft_data,
diff --git a/m4/assert_h.m4 b/m4/assert_h.m4
new file mode 100644
index 0000000000..c1306daef4
--- /dev/null
+++ b/m4/assert_h.m4
@@ -0,0 +1,61 @@
+# assert-h.m4
+dnl Copyright (C) 2011-2022 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+AC_DEFUN([gl_ASSERT_H],
+[
+ AC_CACHE_CHECK([for static_assert], [gl_cv_static_assert],
+ [gl_save_CFLAGS=$CFLAGS
+ for gl_working in "yes, a keyword" "yes, an <assert.h> macro"; do
+ AS_CASE([$gl_working],
+ [*assert.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_ASSERT_H"])
+
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if defined __clang__ && __STDC_VERSION__ < 202311
+ #pragma clang diagnostic error "-Wc2x-extensions"
+ #pragma clang diagnostic error "-Wc++17-extensions"
+ #endif
+ #ifdef INCLUDE_ASSERT_H
+ #include <assert.h>
+ #endif
+ static_assert (2 + 2 == 4, "arithmetic does not work");
+ static_assert (2 + 2 == 4);
+ ]],
+ [[
+ static_assert (sizeof (char) == 1, "sizeof does not work");
+ static_assert (sizeof (char) == 1);
+ ]])],
+ [gl_cv_static_assert=$gl_working],
+ [gl_cv_static_assert=no])
+ CFLAGS=$gl_save_CFLAGS
+ test "$gl_cv_static_assert" != no && break
+ done])
+
+ GL_GENERATE_ASSERT_H=false
+ AS_CASE([$gl_cv_static_assert],
+ [yes*keyword*],
+ [AC_DEFINE([HAVE_C_STATIC_ASSERT], [1],
+ [Define to 1 if the static_assert keyword works.])],
+ [no],
+ [GL_GENERATE_ASSERT_H=true
+ gl_NEXT_HEADERS([assert.h])])
+
+ dnl The "zz" puts this toward config.h's end, to avoid potential
+ dnl collisions with other definitions. #undef assert so that
+ dnl programs are not tempted to use it without specifically
+ dnl including assert.h. Break the #undef apart with a comment
+ dnl so that 'configure' does not comment it out.
+ AH_VERBATIM([zzstatic_assert],
+[#if (!defined HAVE_C_STATIC_ASSERT && !defined assert \
+ && (!defined __cplusplus \
+ || (__cpp_static_assert < 201411 \
+ && __GNUG__ < 6 && __clang_major__ < 6)))
+ #include <assert.h>
+ #undef/**/assert
+#endif])
+])
diff --git a/m4/c-bool.m4 b/m4/c-bool.m4
new file mode 100644
index 0000000000..bb109b7796
--- /dev/null
+++ b/m4/c-bool.m4
@@ -0,0 +1,51 @@
+# Check for bool that conforms to C2023.
+
+dnl Copyright 2022 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_C_BOOL],
+[
+ AC_CACHE_CHECK([for bool, true, false], [gl_cv_c_bool],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE([[
+ #if true == false
+ #error "true == false"
+ #endif
+ extern bool b;
+ bool b = true == false;]])],
+ [gl_cv_c_bool=yes],
+ [gl_cv_c_bool=no])])
+ if test "$gl_cv_c_bool" = yes; then
+ AC_DEFINE([HAVE_C_BOOL], [1],
+ [Define to 1 if bool, true and false work as per C2023.])
+ fi
+
+ AC_CHECK_HEADERS_ONCE([stdbool.h])
+
+ dnl The "zz" puts this toward config.h's end, to avoid potential
+ dnl collisions with other definitions.
+ dnl If 'bool', 'true' and 'false' do not work, arrange for them to work.
+ dnl In C, this means including <stdbool.h> if it is not already included.
+ dnl However, if the preprocessor mistakenly treats 'true' as 0,
+ dnl define it to a bool expression equal to 1; this is needed in
+ dnl Sun C++ 5.11 (Oracle Solaris Studio 12.2, 2010) and older.
+ AH_VERBATIM([zzbool],
+[#ifndef HAVE_C_BOOL
+# if !defined __cplusplus && !defined __bool_true_false_are_defined
+# if HAVE_STDBOOL_H
+# include <stdbool.h>
+# else
+# if defined __SUNPRO_C
+# error "<stdbool.h> is not usable with this configuration. To make it
usable, add -D_STDC_C99= to $CC."
+# else
+# error "<stdbool.h> does not exist on this platform. Use gnulib module
'stdbool-c99' instead of gnulib module 'stdbool'."
+# endif
+# endif
+# endif
+# if !true
+# define true (!false)
+# endif
+#endif])
+])
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index f0aeb4d0e4..c3e0713b57 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,4 +1,4 @@
-# gettime.m4 serial 11
+# gettime.m4 serial 12
dnl Copyright (C) 2002, 2004-2006, 2009-2022 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -9,7 +9,34 @@ AC_DEFUN([gl_GETTIME],
dnl Prerequisites of lib/gettime.c.
AC_REQUIRE([gl_CLOCK_TIME])
AC_REQUIRE([gl_TIMESPEC])
- AC_CHECK_FUNCS_ONCE([timespec_get])
+
+ AC_REQUIRE([gl_CHECK_FUNC_TIMESPEC_GET])
+ if test $gl_cv_func_timespec_get = yes; then
+ AC_DEFINE([HAVE_TIMESPEC_GET], [1],
+ [Define if you have the timespec_get function.])
+ fi
+])
+
+dnl Tests whether the function timespec_get exists.
+dnl Sets gl_cv_func_timespec_get.
+AC_DEFUN([gl_CHECK_FUNC_TIMESPEC_GET],
+[
+ dnl Persuade OpenBSD <time.h> to declare timespec_get().
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ dnl We can't use AC_CHECK_FUNC here, because timespec_get() is defined as a
+ dnl static inline function in <time.h> on MSVC 14.
+ AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <time.h>
+ struct timespec ts;
+ ]],
+ [[return timespec_get (&ts, 0);]])
+ ],
+ [gl_cv_func_timespec_get=yes],
+ [gl_cv_func_timespec_get=no])
+ ])
])
AC_DEFUN([gl_GETTIME_RES],
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 30911d1581..d17cbec58c 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 73
+# gnulib-common.m4 serial 74
dnl Copyright (C) 2007-2022 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -115,7 +115,7 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _GL_HAS_C_ATTRIBUTE(attr) 0
#endif
-]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's _Alignas instead.
+]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's alignas instead.
[
/* _GL_ATTRIBUTE_ALLOC_SIZE ((N)) declares that the Nth argument of the
function
is the size of the returned memory block.
@@ -313,7 +313,8 @@ AC_DEFUN([gl_COMMON_BODY], [
#else
# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED
#endif
-/* Alternative spelling of this macro, for convenience. */
+/* Alternative spelling of this macro, for convenience and for
+ compatibility with glibc/include/libc-symbols.h. */
#define _GL_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
/* Earlier spellings of this macro. */
#define _UNUSED_PARAMETER_ _GL_ATTRIBUTE_MAYBE_UNUSED
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 0c43dde716..f1ac499132 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -46,6 +46,7 @@ AC_DEFUN([gl_EARLY],
# Code from module acl-permissions:
# Code from module alloca-opt:
# Code from module allocator:
+ # Code from module assert-h:
# Code from module at-internal:
# Code from module attribute:
# Code from module binary-io:
@@ -122,8 +123,8 @@ AC_DEFUN([gl_EARLY],
# Code from module intprops:
# Code from module inttypes-incomplete:
# Code from module largefile:
- AC_REQUIRE([AC_SYS_LARGEFILE])
AC_REQUIRE([gl_YEAR2038_EARLY])
+ AC_REQUIRE([AC_SYS_LARGEFILE])
# Code from module lchmod:
# Code from module libc-config:
# Code from module libgmp:
@@ -171,6 +172,7 @@ AC_DEFUN([gl_EARLY],
# Code from module stat-time:
# Code from module std-gnu11:
# Code from module stdalign:
+ # Code from module stdbool:
# Code from module stdckdint:
# Code from module stddef:
# Code from module stdint:
@@ -233,6 +235,9 @@ AC_DEFUN([gl_INIT],
gl_FUNC_ALLOCA
gl_CONDITIONAL_HEADER([alloca.h])
AC_PROG_MKDIR_P
+ gl_ASSERT_H
+ gl_CONDITIONAL_HEADER([assert.h])
+ AC_PROG_MKDIR_P
gl___BUILTIN_EXPECT
gl_BYTESWAP
gl_CONDITIONAL_HEADER([byteswap.h])
@@ -486,6 +491,7 @@ AC_DEFUN([gl_INIT],
gl_STDALIGN_H
gl_CONDITIONAL_HEADER([stdalign.h])
AC_PROG_MKDIR_P
+ gl_C_BOOL
gl_STDDEF_H
gl_STDDEF_H_REQUIRE_DEFAULTS
gl_CONDITIONAL_HEADER([stddef.h])
@@ -1214,6 +1220,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/allocator.c
lib/allocator.h
lib/arg-nonnull.h
+ lib/assert.in.h
lib/at-func.c
lib/attribute.h
lib/binary-io.c
@@ -1420,8 +1427,10 @@ AC_DEFUN([gl_FILE_LIST], [
m4/absolute-header.m4
m4/acl.m4
m4/alloca.m4
+ m4/assert_h.m4
m4/builtin-expect.m4
m4/byteswap.m4
+ m4/c-bool.m4
m4/canonicalize.m4
m4/clock_time.m4
m4/copy-file-range.m4
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4
index 1964b1ea47..dfe21f56d5 100644
--- a/m4/nanosleep.m4
+++ b/m4/nanosleep.m4
@@ -1,4 +1,4 @@
-# serial 41
+# serial 42
dnl From Jim Meyering.
dnl Check for the nanosleep function.
@@ -100,15 +100,22 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
#else /* A simpler test for native Windows. */
if (nanosleep (&ts_sleep, &ts_remaining) < 0)
return 3;
+ /* Test for 32-bit mingw bug: negative nanosecond values do not
+ cause failure. */
+ ts_sleep.tv_sec = 1;
+ ts_sleep.tv_nsec = -1;
+ if (nanosleep (&ts_sleep, &ts_remaining) != -1)
+ return 7;
#endif
return 0;
}]])],
[gl_cv_func_nanosleep=yes],
- [case $? in dnl (
- 4|5|6) gl_cv_func_nanosleep='no (mishandles large arguments)';; dnl (
- *) gl_cv_func_nanosleep=no;;
+ [case $? in
+ 4|5|6) gl_cv_func_nanosleep='no (mishandles large arguments)' ;;
+ 7) gl_cv_func_nanosleep='no (mishandles negative tv_nsec)' ;;
+ *) gl_cv_func_nanosleep=no ;;
esac],
- [case "$host_os" in dnl ((
+ [case "$host_os" in
linux*) # Guess it halfway works when the kernel is Linux.
gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;;
mingw*) # Guess no on native Windows.
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index 78577cb2ac..324e91dae2 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -1,4 +1,4 @@
-# Check for stdalign.h that conforms to C11.
+# Check for alignas and alignof that conform to C23.
dnl Copyright 2011-2022 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
@@ -9,12 +9,18 @@ dnl with or without modifications, as long as this notice is
preserved.
AC_DEFUN([gl_STDALIGN_H],
[
- AC_CACHE_CHECK([for working stdalign.h],
+ AC_CACHE_CHECK([for alignas and alignof],
[gl_cv_header_working_stdalign_h],
- [AC_COMPILE_IFELSE(
+ [gl_save_CFLAGS=$CFLAGS
+ for gl_working in "yes, keywords" "yes, <stdalign.h> macros"; do
+ AS_CASE([$gl_working],
+ [*stdalign.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_STDALIGN_H"])
+ AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[[#include <stdint.h>
- #include <stdalign.h>
+ #ifdef INCLUDE_STDALIGN_H
+ #include <stdalign.h>
+ #endif
#include <stddef.h>
/* Test that alignof yields a result consistent with offsetof.
@@ -30,7 +36,7 @@ AC_DEFUN([gl_STDALIGN_H],
char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1];
char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1];
- /* Test _Alignas only on platforms where gnulib can help. */
+ /* Test alignas only on platforms where gnulib can help. */
#if \
((defined __cplusplus && 201103 <= __cplusplus) \
|| (__TINYC__ && defined __attribute__) \
@@ -45,12 +51,84 @@ AC_DEFUN([gl_STDALIGN_H],
? 1 : -1];
#endif
]])],
- [gl_cv_header_working_stdalign_h=yes],
- [gl_cv_header_working_stdalign_h=no])])
-
- if test $gl_cv_header_working_stdalign_h = yes; then
- GL_GENERATE_STDALIGN_H=false
- else
- GL_GENERATE_STDALIGN_H=true
- fi
+ [gl_cv_header_working_stdalign_h=$gl_working],
+ [gl_cv_header_working_stdalign_h=no])
+
+ CFLAGS=$gl_save_CFLAGS
+ test "$gl_cv_header_working_stdalign_h" != no && break
+ done])
+
+ GL_GENERATE_STDALIGN_H=false
+ AS_CASE([$gl_cv_header_working_stdalign_h],
+ [no],
+ [GL_GENERATE_STDALIGN_H=true],
+ [yes*keyword*],
+ [AC_DEFINE([HAVE_C_ALIGNASOF], [1],
+ [Define to 1 if the alignas and alignof keywords work.])])
+
+ AC_CHECK_HEADERS_ONCE([stdalign.h])
+
+ dnl The "zz" puts this toward config.h's end, to avoid potential
+ dnl collisions with other definitions.
+ AH_VERBATIM([zzalignas],
+[#if !defined HAVE_C_ALIGNASOF && __cplusplus < 201103 && !defined alignof
+# if HAVE_STDALIGN_H
+# include <stdalign.h>
+# else
+ /* Substitute. Keep consistent with gnulib/lib/stdalign.in.h. */
+# ifndef _GL_STDALIGN_H
+# define _GL_STDALIGN_H
+# undef _Alignas
+# undef _Alignof
+# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \
+ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \
+ && !defined __clang__) \
+ || (defined __clang__ && __clang_major__ < 8))
+# ifdef __cplusplus
+# if (201103 <= __cplusplus || defined _MSC_VER)
+# define _Alignof(type) alignof (type)
+# else
+ template <class __t> struct __alignof_helper { char __a; __t __b; };
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+# define _GL_STDALIGN_NEEDS_STDDEF 1
+# endif
+# else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+# define _GL_STDALIGN_NEEDS_STDDEF 1
+# endif
+# endif
+# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))
+# define alignof _Alignof
+# endif
+# define __alignof_is_defined 1
+# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112
+# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)
+# define _Alignas(a) alignas (a)
+# elif (!defined __attribute__ \
+ && ((defined __APPLE__ && defined __MACH__ \
+ ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \
+ : __GNUC__ && !defined __ibmxl__) \
+ || (4 <= __clang_major__) \
+ || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \
+ || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__))
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+# elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+# endif
+# endif
+# if ((defined _Alignas \
+ && !(defined __cplusplus && (201103 <= __cplusplus || defined
_MSC_VER))) \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
+# define alignas _Alignas
+# endif
+# if (defined alignas \
+ || (defined __cplusplus && (201103 <= __cplusplus || defined
_MSC_VER)))
+# define __alignas_is_defined 1
+# endif
+# if _GL_STDALIGN_NEEDS_STDDEF
+# include <stddef.h>
+# endif
+# endif /* _GL_STDALIGN_H */
+# endif
+#endif])
])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 98d7b6e01b..4ac8fd0075 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -2,7 +2,7 @@
# Copyright (C) 2000-2001, 2003-2007, 2009-2022 Free Software Foundation, Inc.
-# serial 19
+# serial 20
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -19,6 +19,12 @@ AC_DEFUN_ONCE([gl_TIME_H],
gl_NEXT_HEADERS([time.h])
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+#include <time.h>
+ ]], [asctime_r ctime_r])
+
AC_REQUIRE([AC_C_RESTRICT])
AC_CACHE_CHECK([for TIME_UTC in <time.h>],
diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp
index 8728c8dac4..ff6be8d083 100644
--- a/msdos/sed2v2.inp
+++ b/msdos/sed2v2.inp
@@ -114,6 +114,7 @@ s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
#else\
#undef HAVE_INTTYPES_H\
#endif
+s/^#undef HAVE_STDBOOL_H/#define HAVE_STDBOOL_H 1/
/^#undef HAVE_STDINT_H/c\
#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3\
#define HAVE_STDINT_H 1\
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 79430bbaf1..3af0db6e0a 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -182,6 +182,7 @@ s/@PACKAGE@/emacs/
/^GL_GNULIB_GETLOADAVG *=/s/@GL_GNULIB_GETLOADAVG@/1/
/^GL_GNULIB_GETRANDOM *=/s/@GL_GNULIB_GETRANDOM@/1/
/^GL_GNULIB_UNISTD_H_GETOPT *=/s/@GL_GNULIB_UNISTD_H_GETOPT@/1/
+/^GL_GNULIB_LCHMOD *=/s/@GL_GNULIB_LCHMOD@/1/
/^GL_GNULIB_MEMMEM *=/s/@GL_GNULIB_MEMMEM@/1/
/^GL_GNULIB_MEMRCHR *=/s/@GL_GNULIB_MEMRCHR@/1/
/^GL_GNULIB_MEMPCPY *=/s/@GL_GNULIB_MEMPCPY@/1/
@@ -216,7 +217,8 @@ s/@PACKAGE@/emacs/
/^HAVE_GETHOSTNAME *=/s/@HAVE_GETHOSTNAME@/1/
/^HAVE_GETLOGIN *=/s/@HAVE_GETLOGIN@/1/
/^HAVE_GETPAGESIZE *=/s/@HAVE_GETPAGESIZE@/1/
-/^HAVE_INTTYPES_H *=/s/@HAVE_INTTYPES_H@/HAVE_INTTYPES_H/
+/^HAVE_INTTYPES_H *=/s/@HAVE_INTTYPES_H@/1/
+/^HAVE_LCHMOD *=/s/@HAVE_LCHMOD@/0/
/^HAVE_LINK *=/s/@HAVE_LINK@/1/
/^HAVE_LONG_LONG_INT *=/s/@HAVE_LONG_LONG_INT@/1/
/^HAVE_LSTAT *=/s/@HAVE_LSTAT@/HAVE_LSTAT/
@@ -293,7 +295,8 @@ s/@PACKAGE@/emacs/
/^NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H *=/s/@[^@\n]*@//
/^NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H *=/s!@[^@\n]*@!<sys/types.h>!
/^NEXT_AS_FIRST_DIRECTIVE_TIME_H *=/s/@[^@\n]*@/<time.h>/
-/^NEXT_AS_FIRST_DIRECTIVE_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
+/^NEXT_ASSERT_H *=/s/@[^@\n]*@/<assert.h>/
+/^NEXT_DIRENT_H *=/s/@[^@\n]*@/<dirent.h>/
/^NEXT_DIRENT_H *=/s/@[^@\n]*@/<dirent.h>/
/^NEXT_ERRNO_H *=/s/@[^@\n]*@//
/^NEXT_FCNTL_H *=/s/@[^@\n]*@/<fcntl.h>/
@@ -323,6 +326,7 @@ s/@PACKAGE@/emacs/
/^LIB_GETRANDOM[^ =]* *= *@/s/@[^@\n]*@//
/^SIG_ATOMIC_T_SUFFIX *=/s/@SIG_ATOMIC_T_SUFFIX@//
/^SIZE_T_SUFFIX *=/s/@SIZE_T_SUFFIX@/u/
+/^ASSERT_H *=/s/@[^@\n]*@/assert.h/
/^ALLOCA_H *=/s/@[^@\n]*@/alloca.h/
/^BYTESWAP_H *=/s/@[^@\n]*@/byteswap.h/
/^DIRENT_H *=/s/@[^@\n]*@//
@@ -412,6 +416,9 @@ s/^ -*test -z.*|| rm/ -rm/
s/@echo /@djecho /
#
# Determine which headers to generate
+# DJGPP assert.h lacks static_assert, so assert.h will have to be
+# generated
+s/= @GL_GENERATE_ASSERT_H_CONDITION@/= 1/
s/= @GL_GENERATE_ALLOCA_H_CONDITION@/= 1/
s/= @GL_GENERATE_BYTESWAP_H_CONDITION@/= 1/
s/= @GL_GENERATE_EXECINFO_H_CONDITION@/= 1/
@@ -497,6 +504,14 @@ s/\.in-h\; *\\$/.in-h >> $@-t/
s/'\; \\ *$/' >> $@-t/
/< \$(srcdir)\/string\.in-h >>/d
}
+/^assert\.h/,/^ \$(AM_V_AT)mv \$@-t \$@/{
+ s/\$(gl_V_at){/\$(gl_V_at)/
+ s/< \$(srcdir)\/assert\.in-h/& > $@-t/
+ s/ sed/ \$(gl_V_at) \$(SED_HEADER_STDOUT)\\\
+ /
+ s/\} > \$@-t/>> $@-t/
+ s/< \$(srcdir)\/verify\.h; \\/\$(srcdir)\/verify\.h >> \$@-t/
+}
s!\$(MKDIR_P)[ ][ ]*sys!command.com /c "if not exist sys\\stat.h
md sys"!
/^ @for dir in/,/^[^ ]/c\
-rm -rf $(MOSTLYCLEANDIRS)
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index 82bf13bc92..c1200f73fb 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -59,7 +59,7 @@ ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc}
${MKDIR_P} ${ns_appdir}
( cd ${srcdir}/${ns_appsrc} ; tar cfh - . ) | \
( cd ${ns_appdir} ; umask 022; tar xf - )
- [ "`cd ${srcdir} && /bin/pwd`" = "`/bin/pwd`" ] || \
+ [ "`cd ${srcdir} && pwd -P`" = "`pwd -P`" ] || \
( cd ${ns_appsrc} ; tar cfh - . ) | \
( cd ${ns_appdir} ; umask 022; tar xf - )
touch ${ns_appdir}
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/Makefile.in b/nt/Makefile.in
index c904e6d451..c5a9bf4363 100644
--- a/nt/Makefile.in
+++ b/nt/Makefile.in
@@ -163,8 +163,8 @@ $(DESTDIR)${archlibdir}: all
@echo
@echo "Installing utilities run internally by Emacs."
umask 022; ${MKDIR_P} "$(DESTDIR)${archlibdir}"
- exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && /bin/pwd`; \
- if [ "$$exp_archlibdir" != "`/bin/pwd`" ]; then \
+ exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P`; \
+ if [ "$$exp_archlibdir" != "`pwd -P`" ]; then \
for file in ${UTILITIES}; do \
$(INSTALL_PROGRAM) $(INSTALL_STRIP) $$file
"$(DESTDIR)${archlibdir}/$$file" ; \
done ; \
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.13 b/src/ChangeLog.13
index abf2a9421a..268a59219c 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -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.
@@ -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/Makefile.in b/src/Makefile.in
index 1f941874ea..059e6c717b 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -426,25 +426,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 \
- $(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 \
+ 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)
@@ -498,7 +499,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 34bedac36b..f69c65dedc 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 */
@@ -3129,6 +3129,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))
@@ -3697,18 +3702,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;
}
@@ -5368,7 +5375,7 @@ void
check_pure_size (void)
{
if (pure_bytes_used_before_overflow)
- message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d"
+ message (("emacs:0:Pure Lisp storage overflow (approx. %jd"
" bytes needed)"),
pure_bytes_used + pure_bytes_used_before_overflow);
}
@@ -5938,8 +5945,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);
@@ -6273,6 +6279,11 @@ garbage_collect (void)
image_prune_animation_caches (false);
#endif
+ /* ELisp code run by `gc-post-hook' could result in itree iteration,
+ which must not happen while the itree is already busy. See
+ bug#58639. */
+ eassert (!itree_iterator_busy_p ());
+
if (!NILP (Vpost_gc_hook))
{
specpdl_ref gc_count = inhibit_garbage_collection ();
@@ -6495,16 +6506,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 `interval_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. */
@@ -6528,8 +6548,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 &&
diff --git a/src/buffer.c b/src/buffer.c
index d4a0c37bed..b67b989326 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);
@@ -638,52 +638,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
@@ -726,8 +707,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. */
@@ -926,17 +906,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. */
@@ -944,26 +932,94 @@ 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)
+ /* FIXME: This loop sets the overlays' `buffer` field to NULL but
+ doesn't set the itree_nodes' `parent`, `left` and `right`
+ fields accordingly. I believe it's harmless, but a bit untidy since
+ other parts of the code are careful to set those fields to NULL when
+ the overlay is deleted.
+ Of course, we can't set them to NULL from within the iteration
+ because the iterator may need them (tho we could if we added
+ an ITREE_POST_ORDER iteration order). */
+ ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
{
- drop_overlay (b, ov);
- next = ov->next;
- ov->next = NULL;
+ modify_overlay (b, node->begin, node->end);
+ /* Where are the nodes freed ? --ap */
+ XOVERLAY (node->data)->buffer = 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 `interval_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
@@ -993,9 +1049,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);
@@ -1978,10 +2032,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
@@ -2381,6 +2433,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.
@@ -2452,9 +2521,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'. */
@@ -2481,6 +2547,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)
@@ -2597,7 +2664,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);
@@ -2784,7 +2852,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))
@@ -2867,272 +2936,159 @@ 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);
+ ITREE_FOREACH_ABORT ();
+ break;
+ }
+ else if (node->begin == end)
+ {
+ next = node->begin;
+ if ((! empty || end < ZV) && beg < end)
+ {
+ ITREE_FOREACH_ABORT ();
+ 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;
+ ITREE_FOREACH_ABORT ();
+ 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];
@@ -3140,11 +3096,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)
@@ -3169,11 +3125,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)
@@ -3186,47 +3142,28 @@ 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));
+ struct itree_node *node;
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
- if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
- return 1;
- }
-
- 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)
+ {
+ ITREE_FOREACH_ABORT ();
+ 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;
@@ -3255,6 +3192,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. */
@@ -3271,47 +3235,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++;
}
}
@@ -3426,25 +3361,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,
@@ -3459,36 +3396,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);
@@ -3543,384 +3451,26 @@ 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)
-{
- 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)
- {
- 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;
- }
- }
-
- 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;
+ if (! current_buffer->overlays)
+ return;
+ itree_insert_gap (current_buffer->overlays, pos, length);
}
void
adjust_overlays_for_delete (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);
- }
-
- if (startpos >= end)
- break;
-
- 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;
- }
-
- /* Splice the constructed (wrong) lists into the buffer's lists,
- and let the recenter function make it sane again. */
- if (beforep)
- {
- beforep->next = current_buffer->overlays_before;
- set_buffer_overlays_before (current_buffer, before_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);
-}
-
-/* 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)
-{
- /* 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)
+ if (! current_buffer->overlays)
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)
- {
- 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;
- }
+ itree_delete_gap (current_buffer->overlays, pos, length);
}
+
DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
doc: /* Return t if OBJECT is an overlay. */)
@@ -3942,7 +3492,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))
@@ -3950,6 +3500,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))
@@ -3964,39 +3518,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. */
@@ -4018,35 +3549,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.
@@ -4057,12 +3559,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);
@@ -4084,37 +3585,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 (! 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))
@@ -4137,8 +3632,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)))
@@ -4148,26 +3641,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);
}
@@ -4175,21 +3652,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
@@ -4220,8 +3694,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,
@@ -4229,8 +3705,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,
@@ -4238,9 +3716,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,
@@ -4251,7 +3736,7 @@ OVERLAY. */)
{
CHECK_OVERLAY (overlay);
- return Fcopy_sequence (XOVERLAY (overlay)->plist);
+ return Fcopy_sequence (OVERLAY_PLIST (overlay));
}
@@ -4279,8 +3764,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,
@@ -4325,7 +3809,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);
@@ -4341,39 +3825,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,
@@ -4383,32 +3840,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. */
@@ -4418,19 +3858,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,
@@ -4439,11 +3876,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;
}
@@ -4460,12 +3894,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));
@@ -4481,15 +3916,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);
}
@@ -4560,70 +3994,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))
@@ -4631,7 +4028,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))
@@ -4639,7 +4036,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
@@ -4662,7 +4058,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);
}
@@ -4690,30 +4086,15 @@ 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);
- }
+ struct itree_node *node;
+
+ ITREE_FOREACH (node, current_buffer->overlays, pos, pos, ASCENDING)
+ {
+ if (node->end == pos
+ && ! NILP (Foverlay_get (node->data, Qevaporate)))
+ hit_list = Fcons (node->data, hit_list);
+ }
+
for (; CONSP (hit_list); hit_list = XCDR (hit_list))
Fdelete_overlay (XCAR (hit_list));
}
@@ -5339,9 +4720,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);
@@ -5546,6 +4925,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
@@ -6517,6 +5938,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 77f9ea20af..3ea4125645 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
@@ -274,7 +274,9 @@ struct buffer_text
end_unchanged contain no useful information. */
modiff_count overlay_unchanged_modified;
- /* CHARS_MODIFF as of last redisplay that finished. */
+ /* CHARS_MODIFF as of last redisplay that finished. It's used
+ when we only care about changes in actual buffer text, not in
+ any other kind of changes, like properties etc. */
modiff_count chars_unchanged_modified;
/* Properties of this buffer's text. */
@@ -695,16 +697,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
@@ -714,6 +708,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)
{
@@ -1169,8 +1171,11 @@ 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
**);
@@ -1184,6 +1189,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. */
@@ -1224,18 +1230,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)
@@ -1270,7 +1274,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,
@@ -1388,25 +1393,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;
}
@@ -1690,4 +1739,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/bytecode.c b/src/bytecode.c
index d75767bb0c..c765e1be2b 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1431,7 +1431,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
NEXT;
CASE (Binteractive_p): /* Obsolete since 24.1. */
- PUSH (call0 (intern ("interactive-p")));
+ PUSH (call0 (Qinteractive_p));
NEXT;
CASE (Bforward_char):
@@ -1749,6 +1749,8 @@ get_byte_code_arity (Lisp_Object args_template)
void
syms_of_bytecode (void)
{
+ DEFSYM (Qinteractive_p, "interactive-p");
+
defsubr (&Sbyte_code);
defsubr (&Sinternal_stack_stats);
diff --git a/src/callproc.c b/src/callproc.c
index 2d457b3c84..4d4b86629c 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
@@ -1306,29 +1309,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 +1350,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/character.c b/src/character.c
index 968daccafa..5df49adade 100644
--- a/src/character.c
+++ b/src/character.c
@@ -178,12 +178,16 @@ usage: (characterp OBJECT) */
return (CHARACTERP (object) ? Qt : Qnil);
}
-DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
- doc: /* Return the character of the maximum code. */
+DEFUN ("max-char", Fmax_char, Smax_char, 0, 1, 0,
+ doc: /* Return the maximum character code.
+If UNICODE is non-nil, return the maximum character code defined
+by the Unicode Standard. */
attributes: const)
- (void)
+ (Lisp_Object unicode)
{
- return make_fixnum (MAX_CHAR);
+ return (!NILP (unicode)
+ ? make_fixnum (MAX_UNICODE_CHAR)
+ : make_fixnum (MAX_CHAR));
}
DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
diff --git a/src/coding.c b/src/coding.c
index 0ae8eb3282..ab73bda844 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -12014,9 +12014,9 @@ See also the function `find-operation-coding-system'.
*/);
Vnetwork_coding_system_alist = Qnil;
DEFVAR_LISP ("locale-coding-system", Vlocale_coding_system,
- doc: /* Coding system to use with system messages.
-Also used for decoding keyboard input on X Window system, and for
-encoding standard output and error streams. */);
+ doc: /* Coding system to use with system messages.
+Potentially also used for decoding keyboard input on X Windows, and is
+used for encoding standard output and error streams. */);
Vlocale_coding_system = Qnil;
/* The eol mnemonics are reset in startup.el system-dependently. */
diff --git a/src/comp.c b/src/comp.c
index 70e7d5a8bb..14012634cc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -68,6 +68,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#undef gcc_jit_context_get_type
#undef gcc_jit_context_new_array_access
#undef gcc_jit_context_new_array_type
+#undef gcc_jit_context_new_bitcast
#undef gcc_jit_context_new_binary_op
#undef gcc_jit_context_new_call
#undef gcc_jit_context_new_call_through_ptr
@@ -108,6 +109,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#undef gcc_jit_struct_set_fields
#undef gcc_jit_type_get_const
#undef gcc_jit_type_get_pointer
+#undef gcc_jit_type_is_pointer
#undef gcc_jit_version_major
#undef gcc_jit_version_minor
#undef gcc_jit_version_patchlevel
@@ -180,8 +182,13 @@ DEF_DLL_FN (gcc_jit_rvalue *,
gcc_jit_context_new_call_through_ptr,
(gcc_jit_context *ctxt, gcc_jit_location *loc,
gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args));
DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_cast,
+ (gcc_jit_context * ctxt, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue, gcc_jit_type *type));
+#ifdef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_bitcast,
(gcc_jit_context *ctxt, gcc_jit_location *loc,
gcc_jit_rvalue *rvalue, gcc_jit_type *type));
+#endif
DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison,
(gcc_jit_context *ctxt, gcc_jit_location *loc,
enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue
*b));
@@ -224,6 +231,9 @@ DEF_DLL_FN (gcc_jit_type *, gcc_jit_struct_as_type,
(gcc_jit_struct *struct_type));
DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_const, (gcc_jit_type *type));
DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_pointer, (gcc_jit_type *type));
+#ifdef LIBGCCJIT_HAVE_REFLECTION
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_is_pointer, (gcc_jit_type *type));
+#endif
DEF_DLL_FN (void, gcc_jit_block_add_assignment,
(gcc_jit_block *block, gcc_jit_location *loc, gcc_jit_lvalue
*lvalue,
gcc_jit_rvalue *rvalue));
@@ -293,6 +303,9 @@ init_gccjit_functions (void)
LOAD_DLL_FN (library, gcc_jit_context_get_type);
LOAD_DLL_FN (library, gcc_jit_context_new_array_access);
LOAD_DLL_FN (library, gcc_jit_context_new_array_type);
+#ifdef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+ LOAD_DLL_FN (library, gcc_jit_context_new_bitcast);
+#endif
LOAD_DLL_FN (library, gcc_jit_context_new_binary_op);
LOAD_DLL_FN (library, gcc_jit_context_new_call);
LOAD_DLL_FN (library, gcc_jit_context_new_call_through_ptr);
@@ -334,6 +347,9 @@ init_gccjit_functions (void)
LOAD_DLL_FN (library, gcc_jit_struct_set_fields);
LOAD_DLL_FN (library, gcc_jit_type_get_const);
LOAD_DLL_FN (library, gcc_jit_type_get_pointer);
+#ifdef LIBGCCJIT_HAVE_REFLECTION
+ LOAD_DLL_FN (library, gcc_jit_type_is_pointer);
+#endif
LOAD_DLL_FN_OPT (library, gcc_jit_context_add_command_line_option);
LOAD_DLL_FN_OPT (library, gcc_jit_context_add_driver_option);
#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer)
@@ -368,6 +384,9 @@ init_gccjit_functions (void)
#define gcc_jit_context_get_type fn_gcc_jit_context_get_type
#define gcc_jit_context_new_array_access fn_gcc_jit_context_new_array_access
#define gcc_jit_context_new_array_type fn_gcc_jit_context_new_array_type
+#ifdef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+# define gcc_jit_context_new_bitcast fn_gcc_jit_context_new_bitcast
+#endif
#define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op
#define gcc_jit_context_new_call fn_gcc_jit_context_new_call
#define gcc_jit_context_new_call_through_ptr
fn_gcc_jit_context_new_call_through_ptr
@@ -410,6 +429,9 @@ init_gccjit_functions (void)
#define gcc_jit_rvalue_get_type fn_gcc_jit_rvalue_get_type
#define gcc_jit_struct_as_type fn_gcc_jit_struct_as_type
#define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields
+#ifdef LIBGCCJIT_HAVE_REFLECTION
+# define gcc_jit_type_is_pointer fn_gcc_jit_type_is_pointer
+#endif
#define gcc_jit_type_get_const fn_gcc_jit_type_get_const
#define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer
#if defined (LIBGCCJIT_HAVE_gcc_jit_version)
@@ -518,7 +540,9 @@ typedef struct {
static f_reloc_t freloc;
-#define NUM_CAST_TYPES 15
+#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+# define NUM_CAST_TYPES 15
+#endif
typedef struct {
EMACS_INT len;
@@ -593,13 +617,15 @@ typedef struct {
gcc_jit_rvalue *current_thread_ref;
/* Other globals. */
gcc_jit_rvalue *pure_ptr;
- /* libgccjit has really limited support for casting therefore this union will
- be used for the scope. */
+#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+ /* This version of libgccjit has really limited support for casting
+ therefore this union will be used for the scope. */
gcc_jit_type *cast_union_type;
gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES];
gcc_jit_function *cast_ptr_to_int;
gcc_jit_function *cast_int_to_ptr;
gcc_jit_type *cast_types[NUM_CAST_TYPES];
+#endif
gcc_jit_function *func; /* Current function being compiled. */
bool func_has_non_local; /* From comp-func has-non-local slot. */
EMACS_INT func_speed; /* From comp-func speed slot. */
@@ -1100,6 +1126,7 @@ emit_cond_jump (gcc_jit_rvalue *test,
}
+#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
static int
type_to_cast_index (gcc_jit_type * type)
{
@@ -1109,6 +1136,7 @@ type_to_cast_index (gcc_jit_type * type)
xsignal1 (Qnative_ice, build_string ("unsupported cast"));
}
+#endif
static gcc_jit_rvalue *
emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
@@ -1145,14 +1173,48 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue
*obj)
}
#endif
+#ifdef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
+ bool old_is_ptr = gcc_jit_type_is_pointer (old_type) != NULL;
+ bool new_is_ptr = gcc_jit_type_is_pointer (new_type) != NULL;
+
+ gcc_jit_rvalue *tmp = obj;
+
+ /* `gcc_jit_context_new_bitcast` requires that the types being converted
+ between have the same layout and as such, doesn't allow converting
+ between an arbitrarily sized integer/boolean and a pointer. Casting it
+ to a uintptr/void* is still necessary, to ensure that it can be bitcast
+ into a (void *)/uintptr respectively. */
+ if (old_is_ptr != new_is_ptr)
+ {
+ if (old_is_ptr)
+ {
+ tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, tmp,
+ comp.void_ptr_type);
+ tmp = gcc_jit_context_new_bitcast (comp.ctxt, NULL, tmp,
+ comp.uintptr_type);
+ }
+ else
+ {
+ tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, tmp,
+ comp.uintptr_type);
+ tmp = gcc_jit_context_new_bitcast (comp.ctxt, NULL, tmp,
+ comp.void_ptr_type);
+ }
+ }
+ return gcc_jit_context_new_cast (comp.ctxt, NULL, tmp, new_type);
+
+#else /* !LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast */
+
int old_index = type_to_cast_index (old_type);
int new_index = type_to_cast_index (new_type);
/* Lookup the appropriate cast function in the cast matrix. */
return gcc_jit_context_new_call (comp.ctxt,
- NULL,
- comp.cast_functions_from_to[old_index][new_index],
- 1, &obj);
+ NULL,
+ comp.cast_functions_from_to
+ [old_index][new_index],
+ 1, &obj);
+#endif
}
static gcc_jit_rvalue *
@@ -3318,6 +3380,7 @@ define_thread_state_struct (void)
gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.thread_state_s));
}
+#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
static gcc_jit_function *
define_type_punning (const char *name,
gcc_jit_type *from, gcc_jit_field *from_field,
@@ -3451,6 +3514,7 @@ define_cast_functions (void)
comp.void_ptr_type,
cast_union_fields[0]);
+
for (int i = 0; i < NUM_CAST_TYPES; ++i)
comp.cast_types[i] = cast_types[i].type;
@@ -3460,6 +3524,7 @@ define_cast_functions (void)
comp.cast_functions_from_to[i][j] =
define_cast_from_to (cast_types[i], cast_types[j]);
}
+#endif /* !LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast */
static void
define_CHECK_TYPE (void)
@@ -4467,7 +4532,7 @@ the latter is supposed to be used by the Emacs build
procedure. */)
}
if (NILP (base_dir))
error ("Cannot find suitable directory for output in "
- "`comp-native-load-path'.");
+ "`native-comp-eln-load-path'.");
}
if (!file_name_absolute_p (SSDATA (base_dir)))
@@ -4660,7 +4725,9 @@ Return t on success. */)
define_jmp_buf ();
define_handler_struct ();
define_thread_state_struct ();
+#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
define_cast_functions ();
+#endif
return Qt;
}
@@ -5107,6 +5174,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
return;
if (!native_comp_deferred_compilation
+ || !NILP (Vinhibit_automatic_native_compilation)
|| noninteractive
|| !NILP (Vpurify_flag)
|| !COMPILEDP (definition)
@@ -5610,6 +5678,14 @@ For internal use. */);
doc: /* Non-nil when comp.el can be native compiled.
For internal use. */);
/* Compiler control customizes. */
+ DEFVAR_LISP ("inhibit-automatic-native-compilation",
+ Vinhibit_automatic_native_compilation,
+ doc: /* If non-nil, inhibit automatic native compilation of
loaded .elc files.
+
+After compilation, each function definition is updated to the native
+compiled one. */);
+ Vinhibit_automatic_native_compilation = Qnil;
+
DEFVAR_BOOL ("native-comp-deferred-compilation",
native_comp_deferred_compilation,
doc: /* If non-nil compile loaded .elc files asynchronously.
@@ -5792,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/composite.c b/src/composite.c
index 22422cca09..6b256171ac 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -800,6 +800,53 @@ composition_gstring_width (Lisp_Object gstring, ptrdiff_t
from, ptrdiff_t to,
return width;
}
+/* Adjust the width of each grapheme cluster of GSTRING because
+ zero-width grapheme clusters are not displayed. If the width is
+ zero, then the width of the last glyph in the cluster is
+ incremented. */
+
+void
+composition_gstring_adjust_zero_width (Lisp_Object gstring)
+{
+ ptrdiff_t from = 0;
+ int width = 0;
+
+ for (ptrdiff_t i = 0; ; i++)
+ {
+ Lisp_Object glyph;
+
+ if (i < LGSTRING_GLYPH_LEN (gstring))
+ glyph = LGSTRING_GLYPH (gstring, i);
+ else
+ glyph = Qnil;
+
+ if (NILP (glyph) || from != LGLYPH_FROM (glyph))
+ {
+ eassert (i > 0);
+ Lisp_Object last = LGSTRING_GLYPH (gstring, i - 1);
+
+ if (width == 0)
+ {
+ if (NILP (LGLYPH_ADJUSTMENT (last)))
+ LGLYPH_SET_ADJUSTMENT (last,
+ CALLN (Fvector,
+ make_fixnum (0), make_fixnum (0),
+ make_fixnum (LGLYPH_WIDTH (last)
+ + 1)));
+ else
+ ASET (LGLYPH_ADJUSTMENT (last), 2,
+ make_fixnum (LGLYPH_WADJUST (last) + 1));
+ }
+ if (NILP (glyph))
+ break;
+ from = LGLYPH_FROM (glyph);
+ width = 0;
+ }
+ width += (NILP (LGLYPH_ADJUSTMENT (glyph))
+ ? LGLYPH_WIDTH (glyph) : LGLYPH_WADJUST (glyph));
+ }
+}
+
static Lisp_Object gstring_work;
static Lisp_Object gstring_work_headers;
@@ -876,7 +923,8 @@ fill_gstring_body (Lisp_Object gstring)
}
LGLYPH_SET_ADJUSTMENT (g, Qnil);
}
- if (i < LGSTRING_GLYPH_LEN (gstring))
+ len = LGSTRING_GLYPH_LEN (gstring);
+ for (; i < len; i++)
LGSTRING_SET_GLYPH (gstring, i, Qnil);
}
diff --git a/src/composite.h b/src/composite.h
index d77dd0d506..8a6fd203d0 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -340,6 +340,7 @@ extern Lisp_Object composition_gstring_from_id (ptrdiff_t);
extern bool composition_gstring_p (Lisp_Object);
extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
struct font_metrics *);
+extern void composition_gstring_adjust_zero_width (Lisp_Object);
extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t *, ptrdiff_t *,
diff --git a/src/conf_post.h b/src/conf_post.h
index 6ecebf36ab..fb8d2e5d96 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -30,14 +30,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif
/* To help make dependencies clearer elsewhere, this file typically
- does not #include other files. The exceptions are stdbool.h
- because it is unlikely to interfere with configuration and bool is
- such a core part of the C language, and ms-w32.h (DOS_NT
+ does not #include other files. The exception is ms-w32.h (DOS_NT
only) because it historically was included here and changing that
would take some work. */
-#include <stdbool.h>
-
#if defined WINDOWSNT && !defined DEFER_MS_W32_H
# include <ms-w32.h>
#endif
diff --git a/src/data.c b/src/data.c
index b19e10582e..221a6f5883 100644
--- a/src/data.c
+++ b/src/data.c
@@ -4124,6 +4124,7 @@ syms_of_data (void)
DEFSYM (Qsymbolp, "symbolp");
DEFSYM (Qfixnump, "fixnump");
DEFSYM (Qintegerp, "integerp");
+ DEFSYM (Qbooleanp, "booleanp");
DEFSYM (Qnatnump, "natnump");
DEFSYM (Qwholenump, "wholenump");
DEFSYM (Qstringp, "stringp");
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 943a4aff8e..1c74180f15 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -398,7 +398,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
case DBUS_TYPE_BOOLEAN:
/* There must be an argument. */
if (EQ (QCboolean, object))
- wrong_type_argument (intern ("booleanp"), object);
+ wrong_type_argument (Qbooleanp, object);
sprintf (signature, "%c", dtype);
break;
@@ -649,7 +649,7 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
case DBUS_TYPE_BOOLEAN:
/* There must be an argument. */
if (EQ (QCboolean, object))
- wrong_type_argument (intern ("booleanp"), object);
+ wrong_type_argument (Qbooleanp, object);
{
dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
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 12ba927261..2f5f4335fe 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2874,18 +2874,17 @@ typedef struct {
INLINE void
reset_mouse_highlight (Mouse_HLInfo *hlinfo)
{
-
- hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
- hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
- hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0;
- hlinfo->mouse_face_beg_x = hlinfo->mouse_face_end_x = 0;
- hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
- hlinfo->mouse_face_mouse_frame = NULL;
- hlinfo->mouse_face_window = Qnil;
- hlinfo->mouse_face_overlay = Qnil;
- hlinfo->mouse_face_past_end = false;
- hlinfo->mouse_face_hidden = false;
- hlinfo->mouse_face_defer = false;
+ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
+ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
+ hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0;
+ hlinfo->mouse_face_beg_x = hlinfo->mouse_face_end_x = 0;
+ hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
+ hlinfo->mouse_face_mouse_frame = NULL;
+ hlinfo->mouse_face_window = Qnil;
+ hlinfo->mouse_face_overlay = Qnil;
+ hlinfo->mouse_face_past_end = false;
+ hlinfo->mouse_face_hidden = false;
+ hlinfo->mouse_face_defer = false;
}
/***********************************************************************
diff --git a/src/dispnew.c b/src/dispnew.c
index 53a47c4b2f..5a9ba8909e 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1810,9 +1810,12 @@ allocate_matrices_for_window_redisplay (struct window *w)
if (w->desired_matrix == NULL)
{
w->desired_matrix = new_glyph_matrix (NULL);
- w->current_matrix = new_glyph_matrix (NULL);
+ eassert (w->current_matrix == NULL);
}
+ if (w->current_matrix == NULL)
+ w->current_matrix = new_glyph_matrix (NULL);
+
dim.width = required_matrix_width (w);
dim.height = required_matrix_height (w);
adjust_glyph_matrix (w, w->desired_matrix, 0, 0, dim);
@@ -3149,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);
@@ -4929,7 +4941,9 @@ update_frame_1 (struct frame *f, bool force_p, bool
inhibit_id_p,
{
if (MATRIX_ROW_ENABLED_P (desired_matrix, i))
{
- if (FRAME_TERMCAP_P (f))
+ /* Note that output_buffer_size being 0 means that we want the
+ old default behavior of flushing output every now and then. */
+ if (FRAME_TERMCAP_P (f) && FRAME_TTY (f)->output_buffer_size == 0)
{
/* Flush out every so many lines.
Also flush out if likely to have more than 1k buffered
@@ -6504,9 +6518,6 @@ init_display_interactive (void)
if (!inhibit_window_system && display_arg)
{
Vinitial_window_system = Qx;
-#ifdef HAVE_X11
- Vwindow_system_version = make_fixnum (11);
-#endif
#ifdef USE_NCURSES
/* In some versions of ncurses,
tputs crashes if we have not called tgetent.
@@ -6521,7 +6532,6 @@ init_display_interactive (void)
if (!inhibit_window_system)
{
Vinitial_window_system = Qw32;
- Vwindow_system_version = make_fixnum (1);
return;
}
#endif /* HAVE_NTGUI */
@@ -6530,7 +6540,6 @@ init_display_interactive (void)
if (!inhibit_window_system && !will_dump_p ())
{
Vinitial_window_system = Qns;
- Vwindow_system_version = make_fixnum (10);
return;
}
#endif
@@ -6539,7 +6548,6 @@ init_display_interactive (void)
if (!inhibit_window_system && !will_dump_p ())
{
Vinitial_window_system = Qpgtk;
- Vwindow_system_version = make_fixnum (3);
return;
}
#endif
@@ -6548,7 +6556,6 @@ init_display_interactive (void)
if (!inhibit_window_system && !will_dump_p ())
{
Vinitial_window_system = Qhaiku;
- Vwindow_system_version = make_fixnum (1);
return;
}
#endif
@@ -6766,10 +6773,6 @@ Use of this variable as a boolean is deprecated.
Instead,
use `display-graphic-p' or any of the other `display-*-p'
predicates which report frame's specific UI-related capabilities. */);
- DEFVAR_LISP ("window-system-version", Vwindow_system_version,
- doc: /* The version number of the window system in use.
-For X windows, this is 11. */);
-
DEFVAR_BOOL ("cursor-in-echo-area", cursor_in_echo_area,
doc: /* Non-nil means put cursor in minibuffer, at end of any
message there. */);
@@ -6817,5 +6820,4 @@ static void
syms_of_display_for_pdumper (void)
{
Vinitial_window_system = Qnil;
- Vwindow_system_version = Qnil;
}
diff --git a/src/doc.c b/src/doc.c
index 34b80d03aa..67a5f845b9 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -342,7 +342,7 @@ string is passed through `substitute-command-keys'. */)
doc = module_function_documentation (XMODULE_FUNCTION (fun));
#endif
else
- doc = call1 (intern ("function-documentation"), fun);
+ doc = call1 (Qfunction_documentation, fun);
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
@@ -643,7 +643,14 @@ default_to_grave_quoting_style (void)
DEFUN ("text-quoting-style", Ftext_quoting_style,
Stext_quoting_style, 0, 0, 0,
doc: /* Return the current effective text quoting style.
-See variable `text-quoting-style'. */)
+If the variable `text-quoting-style' is `grave', `straight' or
+`curve', just return that value. If it is nil (the default), return
+`grave' if curved quotes cannot be displayed (for instance, on a
+terminal with no support for these characters), otherwise return
+`quote'. Any other value is treated as `grave'.
+
+Note that in contrast to the variable `text-quoting-style', this
+function will never return nil. */)
(void)
{
/* Use grave accent and apostrophe `like this'. */
@@ -694,7 +701,11 @@ The value should be one of these symbols:
`grave': quote with grave accent and apostrophe \\=`like this\\=';
i.e., do not alter the original quote marks.
nil: like `curve' if curved single quotes are displayable,
- and like `grave' otherwise. This is the default. */);
+ and like `grave' otherwise. This is the default.
+
+You should never read the value of this variable directly from a Lisp
+program. Use the function `text-quoting-style' instead, as that will
+compute the correct value for the current terminal in the nil case. */);
Vtext_quoting_style = Qnil;
DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
diff --git a/src/dynlib.h b/src/dynlib.h
index 03b8f98356..9a11c12898 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#define DYNLIB_H
#include <attribute.h>
-#include <stdbool.h>
typedef void *dynlib_handle_ptr;
dynlib_handle_ptr dynlib_open (const char *path);
diff --git a/src/editfns.c b/src/editfns.c
index 8018065568..c7cc63d8d3 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
{
@@ -3597,8 +3567,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",
- STRING_CHAR ((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");
@@ -4565,7 +4542,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 1c392d65df..fcdf103c19 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -78,7 +78,6 @@ To add a new module function, proceed as follows:
#include "emacs-module.h"
#include <stdarg.h>
-#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdlib.h>
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 6642b55d93..bef89b059f 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -30,7 +30,8 @@ information how to write modules and use this header file.
#include <stdint.h>
#include <time.h>
-#ifndef __cplusplus
+#if ((defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 202311 \
+ && !defined __bool_true_false_are_defined && !defined __cplusplus)
#include <stdbool.h>
#endif
diff --git a/src/emacs.c b/src/emacs.c
index 3c76841281..8ad70fecd4 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -299,7 +299,7 @@ Initialization options:\n\
-x to be used in #!/usr/bin/emacs -x\n\
and has approximately the same meaning\n\
as -Q --script\n\
---terminal, -t DEVICE use DEVICE for terminal I/O\n \
+--terminal, -t DEVICE use DEVICE for terminal I/O\n\
--user, -u USER load ~USER/.emacs instead of your own\n\
\n\
",
@@ -891,19 +891,17 @@ load_pdump (int argc, char **argv)
}
/* Where's our executable? */
- ptrdiff_t bufsize;
-#ifndef NS_SELF_CONTAINED
- ptrdiff_t exec_bufsize;
-#endif
- emacs_executable = find_emacs_executable (argv[0], &bufsize);
-#ifndef NS_SELF_CONTAINED
- exec_bufsize = bufsize;
-#endif
+ ptrdiff_t exec_bufsize, bufsize, needed;
+ emacs_executable = find_emacs_executable (argv[0], &exec_bufsize);
/* If we couldn't find our executable, go straight to looking for
the dump in the hardcoded location. */
if (!(emacs_executable && *emacs_executable))
- goto hardcoded;
+ {
+ bufsize = 0;
+ dump_file = NULL;
+ goto hardcoded;
+ }
if (dump_file)
{
@@ -931,8 +929,8 @@ load_pdump (int argc, char **argv)
strip_suffix_length))
exenamelen = prefix_length;
}
- ptrdiff_t needed = exenamelen + strlen (suffix) + 1;
- dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1);
+ bufsize = exenamelen + strlen (suffix) + 1;
+ dump_file = xpalloc (NULL, &bufsize, 1, -1, 1);
memcpy (dump_file, emacs_executable, exenamelen);
strcpy (dump_file + exenamelen, suffix);
result = pdumper_load (dump_file, emacs_executable);
@@ -2566,6 +2564,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 56b4296662..ea23829948 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -211,15 +211,8 @@ backtrace_thread_next (struct thread_state *tstate, union
specbinding *pdl)
void
init_eval_once (void)
{
- /* Don't forget to update docs (lispref node "Local Variables"). */
-#ifndef HAVE_NATIVE_COMP
- max_specpdl_size = 1800; /* See bug#46818. */
- max_lisp_eval_depth = 800;
-#else
- /* Original values increased for comp.el. */
- max_specpdl_size = 2500;
+ /* Don't forget to update docs (lispref node "Eval"). */
max_lisp_eval_depth = 1600;
-#endif
Vrun_hooks = Qnil;
pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
}
@@ -270,8 +263,7 @@ max_ensure_room (intmax_t *m, intmax_t a, intmax_t b)
static void
restore_stack_limits (Lisp_Object data)
{
- integer_to_intmax (XCAR (data), &max_specpdl_size);
- integer_to_intmax (XCDR (data), &max_lisp_eval_depth);
+ integer_to_intmax (data, &max_lisp_eval_depth);
}
/* Call the Lisp debugger, giving it argument ARG. */
@@ -283,9 +275,6 @@ call_debugger (Lisp_Object arg)
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object val;
intmax_t old_depth = max_lisp_eval_depth;
- /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
- ptrdiff_t counti = specpdl_ref_to_count (count);
- intmax_t old_max = max (max_specpdl_size, counti);
/* The previous value of 40 is too small now that the debugger
prints using cl-prin1 instead of prin1. Printing lists nested 8
@@ -293,20 +282,8 @@ call_debugger (Lisp_Object arg)
currently requires 77 additional frames. See bug#31919. */
max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
- /* While debugging Bug#16603, previous value of 100 was found
- too small to avoid specpdl overflow in the debugger itself. */
- max_ensure_room (&max_specpdl_size, counti, 200);
-
- if (old_max == counti)
- {
- /* We can enter the debugger due to specpdl overflow (Bug#16603). */
- specpdl_ptr--;
- grow_specpdl ();
- }
-
/* Restore limits after leaving the debugger. */
- record_unwind_protect (restore_stack_limits,
- Fcons (make_int (old_max), make_int (old_depth)));
+ record_unwind_protect (restore_stack_limits, make_int (old_depth));
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
@@ -507,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))
@@ -574,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. */
@@ -938,12 +918,9 @@ usage: (let* VARLIST BODY...) */)
lexenv = Vinternal_interpreter_environment;
Lisp_Object varlist = XCAR (args);
- while (CONSP (varlist))
+ FOR_EACH_TAIL (varlist)
{
- maybe_quit ();
-
elt = XCAR (varlist);
- varlist = XCDR (varlist);
if (SYMBOLP (elt))
{
var = elt;
@@ -1677,10 +1654,12 @@ process_quit_flag (void)
void
probably_quit (void)
{
+ specpdl_ref gc_count = inhibit_garbage_collection ();
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
process_quit_flag ();
else if (pending_signals)
process_pending_signals ();
+ unbind_to (gc_count, Qnil);
}
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
@@ -1737,6 +1716,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
+ eassert (!itree_iterator_busy_p ());
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -1757,8 +1737,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
{
/* Edebug takes care of restoring these variables when it exits. */
max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20);
- ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ());
- max_ensure_room (&max_specpdl_size, counti, 40);
call2 (Vsignal_hook_function, error_symbol, data);
}
@@ -1827,8 +1805,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
{
max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
specpdl_ref count = SPECPDL_INDEX ();
- ptrdiff_t counti = specpdl_ref_to_count (count);
- max_ensure_room (&max_specpdl_size, counti, 200);
specbind (Qdebugger, Qdebug_early);
call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
unbind_to (count, Qnil);
@@ -1844,12 +1820,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
{
max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
specpdl_ref count = SPECPDL_INDEX ();
- ptrdiff_t counti = specpdl_ref_to_count (count);
AUTO_STRING (redisplay_trace, "*Redisplay_trace*");
Lisp_Object redisplay_trace_buffer;
AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace*
*/
Lisp_Object delayed_warning;
- max_ensure_room (&max_specpdl_size, counti, 200);
redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil);
current_buffer = XBUFFER (redisplay_trace_buffer);
if (!backtrace_yet) /* Are we on the first backtrace of the command? */
@@ -2381,17 +2355,12 @@ grow_specpdl_allocation (void)
eassert (specpdl_ptr == specpdl_end);
specpdl_ref count = SPECPDL_INDEX ();
- ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000);
+ ptrdiff_t max_size = PTRDIFF_MAX - 1000;
union specbinding *pdlvec = specpdl - 1;
ptrdiff_t size = specpdl_end - specpdl;
ptrdiff_t pdlvecsize = size + 1;
if (max_size <= size)
- {
- if (max_specpdl_size < 400)
- max_size = max_specpdl_size = 400;
- if (max_size <= size)
- xsignal0 (Qexcessive_variable_binding);
- }
+ xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */
pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
specpdl = pdlvec + 1;
specpdl_end = specpdl + pdlvecsize - 1;
@@ -2409,9 +2378,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);
}
@@ -2427,7 +2394,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);
@@ -2468,7 +2435,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;
@@ -3001,7 +2970,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);
@@ -3031,7 +3000,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;
@@ -3067,15 +3037,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);
}
@@ -4234,22 +4202,6 @@ Lisp_Object backtrace_top_function (void)
void
syms_of_eval (void)
{
- DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
- doc: /* Limit on number of Lisp variable bindings and
`unwind-protect's.
-
-If Lisp code tries to use more bindings than this amount, an error is
-signaled.
-
-You can safely increase this variable substantially if the default
-value proves inconveniently small. However, if you increase it too
-much, Emacs could run out of memory trying to make the stack bigger.
-Note that this limit may be silently increased by the debugger if
-`debug-on-error' or `debug-on-quit' is set.
-
-\"spec\" is short for \"special variables\", i.e., dynamically bound
-variables. \"PDL\" is short for \"push-down list\", which is an old
-term for \"stack\". */);
-
DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
doc: /* Limit on depth in `eval', `apply' and `funcall' before
error.
@@ -4408,6 +4360,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 9697f6c8cf..92335b639c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3808,7 +3808,7 @@ file_offset (Lisp_Object val)
}
}
- wrong_type_argument (intern ("file-offset"), val);
+ wrong_type_argument (Qfile_offset, val);
}
/* Return a special time value indicating the error number ERRNUM. */
@@ -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 ();
@@ -4875,7 +4874,7 @@ by calling `format-decode', which see. */)
if (! NILP (insval))
{
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
- wrong_type_argument (intern ("inserted-chars"), insval);
+ wrong_type_argument (Qinserted_chars, insval);
inserted = XFIXNAT (insval);
}
}
@@ -4898,7 +4897,7 @@ by calling `format-decode', which see. */)
insval = call3 (Qformat_decode,
Qnil, make_fixnum (inserted), visit);
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
- wrong_type_argument (intern ("inserted-chars"), insval);
+ wrong_type_argument (Qinserted_chars, insval);
inserted = XFIXNAT (insval);
}
else
@@ -4921,7 +4920,7 @@ by calling `format-decode', which see. */)
insval = call3 (Qformat_decode,
Qnil, make_fixnum (oinserted), visit);
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
- wrong_type_argument (intern ("inserted-chars"), insval);
+ wrong_type_argument (Qinserted_chars, insval);
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
point back to position before inserted text and leave
@@ -4944,7 +4943,7 @@ by calling `format-decode', which see. */)
if (!NILP (insval))
{
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
- wrong_type_argument (intern ("inserted-chars"), insval);
+ wrong_type_argument (Qinserted_chars, insval);
inserted = XFIXNAT (insval);
}
}
@@ -4962,7 +4961,7 @@ by calling `format-decode', which see. */)
if (!NILP (insval))
{
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
- wrong_type_argument (intern ("inserted-chars"), insval);
+ wrong_type_argument (Qinserted_chars, insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
buffer's characters => move point back to
@@ -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);
}
@@ -6019,11 +6019,6 @@ A non-nil CURRENT-ONLY argument means save only current
buffer. */)
bool old_message_p = 0;
struct auto_save_unwind auto_save_unwind;
- intmax_t sum = INT_ADD_WRAPV (specpdl_end - specpdl, 40, &sum)
- ? INTMAX_MAX : sum;
- if (max_specpdl_size < sum)
- max_specpdl_size = sum;
-
if (minibuf_level)
no_message = Qt;
@@ -6367,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;
}
@@ -6431,9 +6426,11 @@ syms_of_fileio (void)
DEFSYM (Qfile_date_error, "file-date-error");
DEFSYM (Qfile_missing, "file-missing");
DEFSYM (Qpermission_denied, "permission-denied");
+ DEFSYM (Qfile_offset, "file-offset");
DEFSYM (Qfile_notify_error, "file-notify-error");
DEFSYM (Qremote_file_error, "remote-file-error");
DEFSYM (Qexcl, "excl");
+ DEFSYM (Qinserted_chars, "inserted-chars");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
doc: /* Coding system for encoding file names.
diff --git a/src/fns.c b/src/fns.c
index 7e78bba3a0..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.
@@ -449,25 +464,87 @@ Symbols are also allowed; their print names are used
instead. */)
CHECK_STRING (string2);
ptrdiff_t n = min (SCHARS (string1), SCHARS (string2));
- if (!STRING_MULTIBYTE (string1) && !STRING_MULTIBYTE (string2))
+
+ if ((!STRING_MULTIBYTE (string1) || SCHARS (string1) == SBYTES (string1))
+ && (!STRING_MULTIBYTE (string2) || SCHARS (string2) == SBYTES (string2)))
{
- /* Both arguments are unibyte (hot path). */
+ /* Each argument is either unibyte or all-ASCII multibyte:
+ 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))
+ {
+ /* 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)
+ {
+ /* 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;
+ }
- ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
-
- while (i1 < n)
+ /* 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))
{
- /* When we find a mismatch, we must compare the
- characters, not just the bytes. */
- int c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
- int c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
- if (c1 != c2)
- return c1 < c2 ? Qt : Qnil;
+ /* string1 multibyte, string2 unibyte */
+ ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0;
+ while (i1 < n)
+ {
+ int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte);
+ int c2 = SREF (string2, i2++);
+ if (c1 != c2)
+ return c1 < c2 ? Qt : Qnil;
+ }
+ return i1 < SCHARS (string2) ? Qt : Qnil;
+ }
+ else
+ {
+ /* string1 unibyte, string2 multibyte */
+ ptrdiff_t i1 = 0, i2 = 0, i2_byte = 0;
+ while (i1 < n)
+ {
+ int c1 = SREF (string1, i1++);
+ int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte);
+ if (c1 != c2)
+ return c1 < c2 ? Qt : Qnil;
+ }
+ return i1 < SCHARS (string2) ? Qt : Qnil;
}
- return i1 < SCHARS (string2) ? Qt : Qnil;
}
DEFUN ("string-version-lessp", Fstring_version_lessp,
@@ -610,7 +687,10 @@ DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
doc: /* Concatenate all the arguments and make the result a list.
The result is a list whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
-The last argument is not copied, just used as the tail of the new list.
+
+All arguments except the last argument are copied. The last argument
+is just used as the tail of the new list.
+
usage: (append &rest SEQUENCES) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@@ -1412,6 +1492,7 @@ are shared, however.
Elements of ALIST that are not conses are also shared. */)
(Lisp_Object alist)
{
+ CHECK_LIST (alist);
if (NILP (alist))
return alist;
alist = Fcopy_sequence (alist);
@@ -1563,10 +1644,21 @@ If N is zero or negative, return nil.
If N is greater or equal to the length of LIST, return LIST (or a copy). */)
(Lisp_Object n, Lisp_Object list)
{
- CHECK_FIXNUM (n);
- EMACS_INT m = XFIXNUM (n);
- if (m <= 0)
- return Qnil;
+ EMACS_INT m;
+ if (FIXNUMP (n))
+ {
+ m = XFIXNUM (n);
+ if (m <= 0)
+ return Qnil;
+ }
+ else if (BIGNUMP (n))
+ {
+ if (mpz_sgn (*xbignum_val (n)) < 0)
+ return Qnil;
+ m = MOST_POSITIVE_FIXNUM;
+ }
+ else
+ wrong_type_argument (Qintegerp, n);
CHECK_LIST (list);
if (NILP (list))
return Qnil;
@@ -1594,10 +1686,21 @@ If N is greater or equal to the length of LIST, return
LIST unmodified.
Otherwise, return LIST after truncating it. */)
(Lisp_Object n, Lisp_Object list)
{
- CHECK_FIXNUM (n);
- EMACS_INT m = XFIXNUM (n);
- if (m <= 0)
- return Qnil;
+ EMACS_INT m;
+ if (FIXNUMP (n))
+ {
+ m = XFIXNUM (n);
+ if (m <= 0)
+ return Qnil;
+ }
+ else if (BIGNUMP (n))
+ {
+ if (mpz_sgn (*xbignum_val (n)) < 0)
+ return Qnil;
+ m = MOST_POSITIVE_FIXNUM;
+ }
+ else
+ wrong_type_argument (Qintegerp, n);
CHECK_LIST (list);
Lisp_Object tail = list;
--m;
@@ -2369,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);
}
@@ -2385,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)
{
@@ -2394,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);
}
@@ -2428,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;
@@ -2454,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)
{
@@ -2463,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;
@@ -2491,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.
@@ -2647,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;
@@ -2908,15 +3056,37 @@ FUNCTION must be a function of one argument, and must
return a value
return empty_unibyte_string;
Lisp_Object *args;
SAFE_ALLOCA_LISP (args, args_alloc);
+ if (EQ (function, Qidentity))
+ {
+ /* Fast path when no function call is necessary. */
+ if (CONSP (sequence))
+ {
+ Lisp_Object src = sequence;
+ Lisp_Object *dst = args;
+ do
+ {
+ *dst++ = XCAR (src);
+ src = XCDR (src);
+ }
+ while (!NILP (src));
+ goto concat;
+ }
+ else if (VECTORP (sequence))
+ {
+ memcpy (args, XVECTOR (sequence)->contents, leni * sizeof *args);
+ goto concat;
+ }
+ }
ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);
- ptrdiff_t nargs = 2 * nmapped - 1;
eassert (nmapped == leni);
+ concat: ;
+ ptrdiff_t nargs = args_alloc;
if (NILP (separator) || (STRINGP (separator) && SCHARS (separator) == 0))
- nargs = nmapped;
+ nargs = leni;
else
{
- for (ptrdiff_t i = nmapped - 1; i > 0; i--)
+ for (ptrdiff_t i = leni - 1; i > 0; i--)
args[i + i] = args[i];
for (ptrdiff_t i = 1; i < nargs; i += 2)
@@ -3262,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'. */)
@@ -3526,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);
@@ -3789,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.
@@ -3800,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;
@@ -3827,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 ();
@@ -3860,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;
@@ -3880,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)
@@ -3897,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;
@@ -3928,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;
@@ -3943,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;
@@ -3962,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;
@@ -3970,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 == '=')
{
@@ -4004,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;
@@ -4012,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;
@@ -4951,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)
@@ -4965,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.c b/src/font.c
index 8acedb9bf8..6e720bc285 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1836,296 +1836,6 @@ font_parse_family_registry (Lisp_Object family,
Lisp_Object registry, Lisp_Objec
}
-/* This part (through the next ^L) is still experimental and not
- tested much. We may drastically change codes. */
-
-/* OTF handler. */
-
-#if 0
-
-#define LGSTRING_HEADER_SIZE 6
-#define LGSTRING_GLYPH_SIZE 8
-
-static int
-check_gstring (Lisp_Object gstring)
-{
- Lisp_Object val;
- ptrdiff_t i;
- int j;
-
- CHECK_VECTOR (gstring);
- val = AREF (gstring, 0);
- CHECK_VECTOR (val);
- if (ASIZE (val) < LGSTRING_HEADER_SIZE)
- goto err;
- CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
- if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
- CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
- if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
- CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
- if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
- CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
- if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
- CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
- if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
- CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
-
- for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
- {
- val = LGSTRING_GLYPH (gstring, i);
- CHECK_VECTOR (val);
- if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
- goto err;
- if (NILP (AREF (val, LGLYPH_IX_CHAR)))
- break;
- CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
- CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
- CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
- if (!NILP (AREF (val, LGLYPH_IX_CODE)))
- CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
- if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
- CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
- if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
- {
- val = AREF (val, LGLYPH_IX_ADJUSTMENT);
- CHECK_VECTOR (val);
- if (ASIZE (val) < 3)
- goto err;
- for (j = 0; j < 3; j++)
- CHECK_FIXNUM (AREF (val, j));
- }
- }
- return i;
- err:
- error ("Invalid glyph-string format");
- return -1;
-}
-
-static void
-check_otf_features (Lisp_Object otf_features)
-{
- Lisp_Object val;
-
- CHECK_CONS (otf_features);
- CHECK_SYMBOL (XCAR (otf_features));
- otf_features = XCDR (otf_features);
- CHECK_CONS (otf_features);
- CHECK_SYMBOL (XCAR (otf_features));
- otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
- {
- CHECK_SYMBOL (XCAR (val));
- if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
- error ("Invalid OTF GSUB feature: %s",
- SDATA (SYMBOL_NAME (XCAR (val))));
- }
- otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
- {
- CHECK_SYMBOL (XCAR (val));
- if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
- error ("Invalid OTF GPOS feature: %s",
- SDATA (SYMBOL_NAME (XCAR (val))));
- }
-}
-
-#ifdef HAVE_LIBOTF
-#include <otf.h>
-
-Lisp_Object otf_list;
-
-static Lisp_Object
-otf_tag_symbol (OTF_Tag tag)
-{
- char name[5];
-
- OTF_tag_name (tag, name);
- return Fintern (make_unibyte_string (name, 4), Qnil);
-}
-
-static OTF *
-otf_open (Lisp_Object file)
-{
- Lisp_Object val = Fassoc (file, otf_list, Qnil);
- OTF *otf;
-
- if (! NILP (val))
- otf = xmint_pointer (XCDR (val));
- else
- {
- otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
- val = make_mint_ptr (otf);
- otf_list = Fcons (Fcons (file, val), otf_list);
- }
- return otf;
-}
-
-
-/* Return a list describing which scripts/languages FONT supports by
- which GSUB/GPOS features of OpenType tables. See the comment of
- (struct font_driver).otf_capability. */
-
-Lisp_Object
-font_otf_capability (struct font *font)
-{
- OTF *otf;
- Lisp_Object capability = Fcons (Qnil, Qnil);
- int i;
-
- otf = otf_open (font->props[FONT_FILE_INDEX]);
- if (! otf)
- return Qnil;
- for (i = 0; i < 2; i++)
- {
- OTF_GSUB_GPOS *gsub_gpos;
- Lisp_Object script_list = Qnil;
- int j;
-
- if (OTF_get_features (otf, i == 0) < 0)
- continue;
- gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
- for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
- {
- OTF_Script *script = gsub_gpos->ScriptList.Script + j;
- Lisp_Object langsys_list = Qnil;
- Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
- int k;
-
- for (k = script->LangSysCount; k >= 0; k--)
- {
- OTF_LangSys *langsys;
- Lisp_Object feature_list = Qnil;
- Lisp_Object langsys_tag;
- int l;
-
- if (k == script->LangSysCount)
- {
- langsys = &script->DefaultLangSys;
- langsys_tag = Qnil;
- }
- else
- {
- langsys = script->LangSys + k;
- langsys_tag
- = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
- }
- for (l = langsys->FeatureCount - 1; l >= 0; l--)
- {
- OTF_Feature *feature
- = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
- Lisp_Object feature_tag
- = otf_tag_symbol (feature->FeatureTag);
-
- feature_list = Fcons (feature_tag, feature_list);
- }
- langsys_list = Fcons (Fcons (langsys_tag, feature_list),
- langsys_list);
- }
- script_list = Fcons (Fcons (script_tag, langsys_list),
- script_list);
- }
-
- if (i == 0)
- XSETCAR (capability, script_list);
- else
- XSETCDR (capability, script_list);
- }
-
- return capability;
-}
-
-/* Parse OTF features in SPEC and write a proper features spec string
- in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
- assured that the sufficient memory has already allocated for
- FEATURES. */
-
-static void
-generate_otf_features (Lisp_Object spec, char *features)
-{
- Lisp_Object val;
- char *p;
- bool asterisk;
-
- p = features;
- *p = '\0';
- for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
- {
- val = XCAR (spec);
- CHECK_SYMBOL (val);
- if (p > features)
- *p++ = ',';
- if (SREF (SYMBOL_NAME (val), 0) == '*')
- {
- asterisk = 1;
- *p++ = '*';
- }
- else if (! asterisk)
- {
- val = SYMBOL_NAME (val);
- p += esprintf (p, "%s", SDATA (val));
- }
- else
- {
- val = SYMBOL_NAME (val);
- p += esprintf (p, "~%s", SDATA (val));
- }
- }
- if (CONSP (spec))
- error ("OTF spec too long");
-}
-
-Lisp_Object
-font_otf_DeviceTable (OTF_DeviceTable *device_table)
-{
- int len = device_table->StartSize - device_table->EndSize + 1;
-
- return Fcons (make_fixnum (len),
- make_unibyte_string (device_table->DeltaValue, len));
-}
-
-Lisp_Object
-font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
-{
- Lisp_Object val = make_nil_vector (8);
-
- if (value_format & OTF_XPlacement)
- ASET (val, 0, make_fixnum (value_record->XPlacement));
- if (value_format & OTF_YPlacement)
- ASET (val, 1, make_fixnum (value_record->YPlacement));
- if (value_format & OTF_XAdvance)
- ASET (val, 2, make_fixnum (value_record->XAdvance));
- if (value_format & OTF_YAdvance)
- ASET (val, 3, make_fixnum (value_record->YAdvance));
- if (value_format & OTF_XPlaDevice)
- ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
- if (value_format & OTF_YPlaDevice)
- ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
- if (value_format & OTF_XAdvDevice)
- ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
- if (value_format & OTF_YAdvDevice)
- ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
- return val;
-}
-
-Lisp_Object
-font_otf_Anchor (OTF_Anchor *anchor)
-{
- Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
- ASET (val, 0, make_fixnum (anchor->XCoordinate));
- ASET (val, 1, make_fixnum (anchor->YCoordinate));
- if (anchor->AnchorFormat == 2)
- ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
- else
- {
- ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
- ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
- }
- return val;
-}
-#endif /* HAVE_LIBOTF */
-#endif /* 0 */
-
-
/* Font sorting. */
static double
@@ -4041,7 +3751,7 @@ which kind of font it is. It must be one of `font-spec',
`font-entity',
return (FONT_ENTITY_P (object) ? Qt : Qnil);
if (EQ (extra_type, Qfont_object))
return (FONT_OBJECT_P (object) ? Qt : Qnil);
- wrong_type_argument (intern ("font-extra-type"), extra_type);
+ wrong_type_argument (Qfont_extra_type, extra_type); ;
}
DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
@@ -4678,6 +4388,7 @@ GSTRING. */)
from = LGLYPH_FROM (glyph);
to = LGLYPH_TO (glyph);
}
+ composition_gstring_adjust_zero_width (gstring);
return composition_gstring_put_cache (gstring, XFIXNUM (n));
shaper_error:
@@ -4694,131 +4405,424 @@ where
GLYPH-ID is a glyph code of the corresponding variation glyph, an integer.
*/)
(Lisp_Object font_object, Lisp_Object character)
{
- unsigned variations[256];
- struct font *font;
- int i, n;
- Lisp_Object val;
+ unsigned variations[256];
+ struct font *font;
+ int i, n;
+ Lisp_Object val;
+
+ CHECK_FONT_OBJECT (font_object);
+ CHECK_CHARACTER (character);
+ font = XFONT_OBJECT (font_object);
+ if (! font->driver->get_variation_glyphs)
+ return Qnil;
+ n = font->driver->get_variation_glyphs (font, XFIXNUM (character),
variations);
+ if (! n)
+ return Qnil;
+ val = Qnil;
+ for (i = 0; i < 255; i++)
+ if (variations[i])
+ {
+ int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
+ Lisp_Object code = INT_TO_INTEGER (variations[i]);
+ val = Fcons (Fcons (make_fixnum (vs), code), val);
+ }
+ return val;
+}
+
+/* Return a description of the font at POSITION in the current buffer.
+ If the 2nd optional arg CH is non-nil, it is a character to check
+ the font instead of the character at POSITION.
+
+ For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
+ FONT-OBJECT is the font for the character at POSITION in the current
+ buffer. This is computed from all the text properties and overlays
+ that apply to POSITION. POSITION may be nil, in which case,
+ FONT-SPEC is the font for displaying the character CH with the
+ default face. GLYPH-CODE is the glyph code in the font to use for
+ the character, it is a fixnum, if it is small enough, otherwise a
+ bignum.
+
+ For a text terminal, return a nonnegative integer glyph code for
+ the character, or a negative integer if the character is not
+ displayable. Terminal glyph codes are system-dependent integers
+ that represent displayable characters: for example, on a Linux x86
+ console they represent VGA code points.
+
+ It returns nil in the following cases:
+
+ (1) The window system doesn't have a font for the character (thus
+ it is displayed by an empty box).
+
+ (2) The character code is invalid.
+
+ (3) If POSITION is not nil, and the current buffer is not displayed
+ in any window.
+
+ (4) For a text terminal, the terminal does not report glyph codes.
+
+ In addition, the returned font name may not take into account of
+ such redisplay engine hooks as what used in jit-lock-mode if
+ POSITION is currently not visible. */
+
+
+DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
+ doc: /* For internal use only. */)
+ (Lisp_Object position, Lisp_Object ch)
+{
+ ptrdiff_t pos, pos_byte, dummy;
+ int face_id;
+ int c;
+ struct frame *f;
+
+ if (NILP (position))
+ {
+ CHECK_CHARACTER (ch);
+ c = XFIXNUM (ch);
+ f = XFRAME (selected_frame);
+ face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
+ pos = -1;
+ }
+ else
+ {
+ Lisp_Object window;
+ struct window *w;
+
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
+ args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
+ pos = fixed_pos;
+ pos_byte = CHAR_TO_BYTE (pos);
+ if (NILP (ch))
+ c = FETCH_CHAR (pos_byte);
+ else
+ {
+ CHECK_FIXNAT (ch);
+ c = XFIXNUM (ch);
+ }
+ window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
+ if (NILP (window))
+ return Qnil;
+ w = XWINDOW (window);
+ f = XFRAME (w->frame);
+ face_id = face_at_buffer_position (w, pos, &dummy,
+ pos + 100, false, -1, 0);
+ }
+ if (! CHAR_VALID_P (c))
+ return Qnil;
+
+ if (! FRAME_WINDOW_P (f))
+ return terminal_glyph_code (FRAME_TERMINAL (f), c);
+
+ /* We need the basic faces to be valid below, so recompute them if
+ some code just happened to clear the face cache. */
+ if (FRAME_FACE_CACHE (f)->used == 0)
+ recompute_basic_faces (f);
+
+ face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
+ struct face *face = FACE_FROM_ID (f, face_id);
+ if (! face->font)
+ return Qnil;
+ unsigned code = face->font->driver->encode_char (face->font, c);
+ if (code == FONT_INVALID_CODE)
+ return Qnil;
+ Lisp_Object font_object;
+ XSETFONT (font_object, face->font);
+ return Fcons (font_object, INT_TO_INTEGER (code));
+}
+
+
+/* This part (through the next ^L) is still experimental and not
+ tested much. We may drastically change codes. */
+
+/* This code implements support for extracting OTF features of a font
+ and exposing them to Lisp, including application of those features
+ to arbitrary stretches of text. FIXME: it would be good to finish
+ this work and have this in Emacs. */
+
+/* OTF handler. */
+
+#if 0
+
+#define LGSTRING_HEADER_SIZE 6
+#define LGSTRING_GLYPH_SIZE 8
+
+static int
+check_gstring (Lisp_Object gstring)
+{
+ Lisp_Object val;
+ ptrdiff_t i;
+ int j;
+
+ CHECK_VECTOR (gstring);
+ val = AREF (gstring, 0);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_HEADER_SIZE)
+ goto err;
+ CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
+ CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+
+ for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+ {
+ val = LGSTRING_GLYPH (gstring, i);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
+ goto err;
+ if (NILP (AREF (val, LGLYPH_IX_CHAR)))
+ break;
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
+ CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
+ if (!NILP (AREF (val, LGLYPH_IX_CODE)))
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
+ if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
+ if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
+ {
+ val = AREF (val, LGLYPH_IX_ADJUSTMENT);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < 3)
+ goto err;
+ for (j = 0; j < 3; j++)
+ CHECK_FIXNUM (AREF (val, j));
+ }
+ }
+ return i;
+ err:
+ error ("Invalid glyph-string format");
+ return -1;
+}
+
+static void
+check_otf_features (Lisp_Object otf_features)
+{
+ Lisp_Object val;
+
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+ {
+ CHECK_SYMBOL (XCAR (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GSUB feature: %s",
+ SDATA (SYMBOL_NAME (XCAR (val))));
+ }
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+ {
+ CHECK_SYMBOL (XCAR (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GPOS feature: %s",
+ SDATA (SYMBOL_NAME (XCAR (val))));
+ }
+}
+
+#ifdef HAVE_LIBOTF
+#include <otf.h>
+
+Lisp_Object otf_list;
+
+static Lisp_Object
+otf_tag_symbol (OTF_Tag tag)
+{
+ char name[5];
+
+ OTF_tag_name (tag, name);
+ return Fintern (make_unibyte_string (name, 4), Qnil);
+}
+
+static OTF *
+otf_open (Lisp_Object file)
+{
+ Lisp_Object val = Fassoc (file, otf_list, Qnil);
+ OTF *otf;
- CHECK_FONT_OBJECT (font_object);
- CHECK_CHARACTER (character);
- font = XFONT_OBJECT (font_object);
- if (! font->driver->get_variation_glyphs)
- return Qnil;
- n = font->driver->get_variation_glyphs (font, XFIXNUM (character),
variations);
- if (! n)
- return Qnil;
- val = Qnil;
- for (i = 0; i < 255; i++)
- if (variations[i])
- {
- int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
- Lisp_Object code = INT_TO_INTEGER (variations[i]);
- val = Fcons (Fcons (make_fixnum (vs), code), val);
- }
- return val;
+ if (! NILP (val))
+ otf = xmint_pointer (XCDR (val));
+ else
+ {
+ otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
+ val = make_mint_ptr (otf);
+ otf_list = Fcons (Fcons (file, val), otf_list);
+ }
+ return otf;
}
-/* Return a description of the font at POSITION in the current buffer.
- If the 2nd optional arg CH is non-nil, it is a character to check
- the font instead of the character at POSITION.
- For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
- FONT-OBJECT is the font for the character at POSITION in the current
- buffer. This is computed from all the text properties and overlays
- that apply to POSITION. POSITION may be nil, in which case,
- FONT-SPEC is the font for displaying the character CH with the
- default face. GLYPH-CODE is the glyph code in the font to use for
- the character, as an integer.
+/* Return a list describing which scripts/languages FONT supports by
+ which GSUB/GPOS features of OpenType tables. See the comment of
+ (struct font_driver).otf_capability. */
- For a text terminal, return a nonnegative integer glyph code for
- the character, or a negative integer if the character is not
- displayable. Terminal glyph codes are system-dependent integers
- that represent displayable characters: for example, on a Linux x86
- console they represent VGA code points.
+Lisp_Object
+font_otf_capability (struct font *font)
+{
+ OTF *otf;
+ Lisp_Object capability = Fcons (Qnil, Qnil);
+ int i;
- It returns nil in the following cases:
+ otf = otf_open (font->props[FONT_FILE_INDEX]);
+ if (! otf)
+ return Qnil;
+ for (i = 0; i < 2; i++)
+ {
+ OTF_GSUB_GPOS *gsub_gpos;
+ Lisp_Object script_list = Qnil;
+ int j;
- (1) The window system doesn't have a font for the character (thus
- it is displayed by an empty box).
+ if (OTF_get_features (otf, i == 0) < 0)
+ continue;
+ gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
+ for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
+ {
+ OTF_Script *script = gsub_gpos->ScriptList.Script + j;
+ Lisp_Object langsys_list = Qnil;
+ Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
+ int k;
- (2) The character code is invalid.
+ for (k = script->LangSysCount; k >= 0; k--)
+ {
+ OTF_LangSys *langsys;
+ Lisp_Object feature_list = Qnil;
+ Lisp_Object langsys_tag;
+ int l;
- (3) If POSITION is not nil, and the current buffer is not displayed
- in any window.
+ if (k == script->LangSysCount)
+ {
+ langsys = &script->DefaultLangSys;
+ langsys_tag = Qnil;
+ }
+ else
+ {
+ langsys = script->LangSys + k;
+ langsys_tag
+ = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
+ }
+ for (l = langsys->FeatureCount - 1; l >= 0; l--)
+ {
+ OTF_Feature *feature
+ = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
+ Lisp_Object feature_tag
+ = otf_tag_symbol (feature->FeatureTag);
- (4) For a text terminal, the terminal does not report glyph codes.
+ feature_list = Fcons (feature_tag, feature_list);
+ }
+ langsys_list = Fcons (Fcons (langsys_tag, feature_list),
+ langsys_list);
+ }
+ script_list = Fcons (Fcons (script_tag, langsys_list),
+ script_list);
+ }
- In addition, the returned font name may not take into account of
- such redisplay engine hooks as what used in jit-lock-mode if
- POSITION is currently not visible. */
+ if (i == 0)
+ XSETCAR (capability, script_list);
+ else
+ XSETCDR (capability, script_list);
+ }
+ return capability;
+}
-DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
- doc: /* For internal use only. */)
- (Lisp_Object position, Lisp_Object ch)
+/* Parse OTF features in SPEC and write a proper features spec string
+ in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
+ assured that the sufficient memory has already allocated for
+ FEATURES. */
+
+static void
+generate_otf_features (Lisp_Object spec, char *features)
{
- ptrdiff_t pos, pos_byte, dummy;
- int face_id;
- int c;
- struct frame *f;
+ Lisp_Object val;
+ char *p;
+ bool asterisk;
- if (NILP (position))
- {
- CHECK_CHARACTER (ch);
- c = XFIXNUM (ch);
- f = XFRAME (selected_frame);
- face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
- pos = -1;
- }
- else
+ p = features;
+ *p = '\0';
+ for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
- Lisp_Object window;
- struct window *w;
-
- EMACS_INT fixed_pos = fix_position (position);
- if (! (BEGV <= fixed_pos && fixed_pos < ZV))
- args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = fixed_pos;
- pos_byte = CHAR_TO_BYTE (pos);
- if (NILP (ch))
- c = FETCH_CHAR (pos_byte);
+ val = XCAR (spec);
+ CHECK_SYMBOL (val);
+ if (p > features)
+ *p++ = ',';
+ if (SREF (SYMBOL_NAME (val), 0) == '*')
+ {
+ asterisk = 1;
+ *p++ = '*';
+ }
+ else if (! asterisk)
+ {
+ val = SYMBOL_NAME (val);
+ p += esprintf (p, "%s", SDATA (val));
+ }
else
{
- CHECK_FIXNAT (ch);
- c = XFIXNUM (ch);
+ val = SYMBOL_NAME (val);
+ p += esprintf (p, "~%s", SDATA (val));
}
- window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
- if (NILP (window))
- return Qnil;
- w = XWINDOW (window);
- f = XFRAME (w->frame);
- face_id = face_at_buffer_position (w, pos, &dummy,
- pos + 100, false, -1, 0);
}
- if (! CHAR_VALID_P (c))
- return Qnil;
+ if (CONSP (spec))
+ error ("OTF spec too long");
+}
- if (! FRAME_WINDOW_P (f))
- return terminal_glyph_code (FRAME_TERMINAL (f), c);
+Lisp_Object
+font_otf_DeviceTable (OTF_DeviceTable *device_table)
+{
+ int len = device_table->StartSize - device_table->EndSize + 1;
- /* We need the basic faces to be valid below, so recompute them if
- some code just happened to clear the face cache. */
- if (FRAME_FACE_CACHE (f)->used == 0)
- recompute_basic_faces (f);
+ return Fcons (make_fixnum (len),
+ make_unibyte_string (device_table->DeltaValue, len));
+}
- face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
- struct face *face = FACE_FROM_ID (f, face_id);
- if (! face->font)
- return Qnil;
- unsigned code = face->font->driver->encode_char (face->font, c);
- if (code == FONT_INVALID_CODE)
- return Qnil;
- Lisp_Object font_object;
- XSETFONT (font_object, face->font);
- return Fcons (font_object, INT_TO_INTEGER (code));
+Lisp_Object
+font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
+{
+ Lisp_Object val = make_nil_vector (8);
+
+ if (value_format & OTF_XPlacement)
+ ASET (val, 0, make_fixnum (value_record->XPlacement));
+ if (value_format & OTF_YPlacement)
+ ASET (val, 1, make_fixnum (value_record->YPlacement));
+ if (value_format & OTF_XAdvance)
+ ASET (val, 2, make_fixnum (value_record->XAdvance));
+ if (value_format & OTF_YAdvance)
+ ASET (val, 3, make_fixnum (value_record->YAdvance));
+ if (value_format & OTF_XPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
+ if (value_format & OTF_YPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
+ if (value_format & OTF_XAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
+ if (value_format & OTF_YAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
+ return val;
}
-#if 0
+Lisp_Object
+font_otf_Anchor (OTF_Anchor *anchor)
+{
+ Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
+ ASET (val, 0, make_fixnum (anchor->XCoordinate));
+ ASET (val, 1, make_fixnum (anchor->YCoordinate));
+ if (anchor->AnchorFormat == 2)
+ ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
+ else
+ {
+ ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
+ ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
+ }
+ return val;
+}
+#endif /* HAVE_LIBOTF */
DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
doc: /* Apply OpenType features on glyph-string GSTRING-IN.
@@ -4938,6 +4942,7 @@ corresponding character. */)
}
#endif /* 0 */
+
#ifdef FONT_DEBUG
DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
@@ -5555,6 +5560,10 @@ syms_of_font (void)
DEFSYM (Qopentype, "opentype");
+ /* Currently used by hbfont.c, which has no syms_of_hbfont function
+ of its own. */
+ DEFSYM (Qcanonical_combining_class, "canonical-combining-class");
+
/* Important character set symbols. */
DEFSYM (Qascii_0, "ascii-0");
DEFSYM (Qiso8859_1, "iso8859-1");
@@ -5594,6 +5603,7 @@ syms_of_font (void)
DEFSYM (QL2R, "L2R");
DEFSYM (QR2L, "R2L");
+ DEFSYM (Qfont_extra_type, "font-extra-type");
DEFSYM (Qfont_driver_superseded_by, "font-driver-superseded-by");
scratch_font_spec = Ffont_spec (0, NULL);
diff --git a/src/font.h b/src/font.h
index 06bd297ccb..3475189206 100644
--- a/src/font.h
+++ b/src/font.h
@@ -660,7 +660,7 @@ struct font_driver
/* Optional.
Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ position of frame S->f with S->face and S->gc. If WITH_BACKGROUND,
fill the background in advance. It is assured that WITH_BACKGROUND
is false when (FROM > 0 || TO < S->nchars). */
int (*draw) (struct glyph_string *s, int from, int to,
diff --git a/src/fontset.c b/src/fontset.c
index 1793715450..4b91eff2ef 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -922,8 +922,6 @@ face_for_char (struct frame *f, struct face *face, int c,
int face_id;
int id;
- eassert (fontset_id_valid_p (face->fontset));
-
if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
return face->ascii_face->id;
@@ -969,6 +967,7 @@ face_for_char (struct frame *f, struct face *face, int c,
#endif
}
+ eassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
eassert (!BASE_FONTSET_P (fontset));
diff --git a/src/frame.c b/src/frame.c
index 25d71e0769..f076a5ba54 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))
@@ -6243,7 +6247,7 @@ You can also use a floating number between 0.0 and 1.0.
*/);
#endif
DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,
- doc: /* Alist of default values for frame creation.
+ doc: /* Alist of default values of frame parameters for frame creation.
These may be set in your init file, like this:
(setq default-frame-alist \\='((width . 80) (height . 55) (menu-bar-lines .
1)))
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index e089f9dea8..dc765e5aee 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -233,6 +233,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int
pixel_size)
cairo_glyph_t stack_glyph;
font->min_width = font->max_width = 0;
font->average_width = font->space_width = 0;
+ int n = 0;
for (char c = 32; c < 127; c++)
{
cairo_glyph_t *glyphs = &stack_glyph;
@@ -252,17 +253,20 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int
pixel_size)
stack_glyph.index = 0;
}
int this_width = ftcrfont_glyph_extents (font, stack_glyph.index, NULL);
- if (this_width > 0
- && (! font->min_width
- || font->min_width > this_width))
- font->min_width = this_width;
- if (this_width > font->max_width)
- font->max_width = this_width;
- if (c == 32)
- font->space_width = this_width;
- font->average_width += this_width;
+ if (this_width > 0)
+ {
+ if (! font->min_width || font->min_width > this_width)
+ font->min_width = this_width;
+ if (this_width > font->max_width)
+ font->max_width = this_width;
+ if (c == 32)
+ font->space_width = this_width;
+ font->average_width += this_width;
+ n++;
+ }
}
- font->average_width /= 95;
+ if (n)
+ font->average_width /= n;
cairo_scaled_font_extents (ftcrfont_info->cr_scaled_font, &extents);
font->ascent = lround (extents.ascent);
@@ -679,8 +683,12 @@ ftcrhbfont_begin_hb_font (struct font *font, double
*position_unit)
hb_font_t *hb_font = fthbfont_begin_hb_font (font, position_unit);
/* HarfBuzz 5 correctly scales bitmap-only fonts without position
unit adjustment.
- (https://github.com/harfbuzz/harfbuzz/issues/489) */
- if (!hb_version_atleast (5, 0, 0)
+ (https://github.com/harfbuzz/harfbuzz/issues/489)
+
+ Update: HarfBuzz 5.2.0 no longer does this for an hb_font_t font
+ object created from a given FT_Face.
+ (https://github.com/harfbuzz/harfbuzz/issues/3788) */
+ if ((hb_version_atleast (5, 2, 0) || !hb_version_atleast (5, 0, 0))
&& ftcrfont_info->bitmap_position_unit)
*position_unit = ftcrfont_info->bitmap_position_unit;
diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc
index d824cc59ae..9a2492c9a1 100644
--- a/src/haiku_font_support.cc
+++ b/src/haiku_font_support.cc
@@ -21,6 +21,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <Font.h>
#include <Rect.h>
#include <AffineTransform.h>
+#include <FindDirectory.h>
+#include <Path.h>
+#include <File.h>
+#include <Message.h>
+#include <OS.h>
+#include <Locker.h>
+#include <NodeMonitor.h>
+#include <Looper.h>
#include <cstring>
#include <cmath>
@@ -39,15 +47,57 @@ struct font_object_cache_bucket
static struct font_object_cache_bucket *font_object_cache[2048];
+/* The current global monospace family and style. */
+static char *fixed_family, *fixed_style;
+
+/* The current global variable-width family and style. */
+static char *default_family, *default_style;
+
+/* The sizes of each of those fonts. */
+static float default_size, fixed_size;
+
+/* The locker controlling access to those variables. */
+static BLocker default_locker;
+
/* Haiku doesn't expose font language data in BFont objects. Thus, we
select a few representative characters for each supported `:lang'
(currently Chinese, Korean and Japanese,) and test for those
instead. */
static int language_code_points[MAX_LANGUAGE][3] =
- {{20154, 20754, 22996}, /* Chinese. */
- {51312, 49440, 44544}, /* Korean. */
- {26085, 26412, 12371}, /* Japanese. */};
+ {
+ {20154, 20754, 22996}, /* Chinese. */
+ {51312, 49440, 44544}, /* Korean. */
+ {26085, 26412, 12371}, /* Japanese. */
+ };
+
+static void be_send_font_settings (void);
+
+/* Looper used to track changes to system-wide font settings. */
+class EmacsFontMonitorLooper : public BLooper
+{
+ void
+ MessageReceived (BMessage *msg)
+ {
+ int32 opcode;
+
+ if (msg->what != B_NODE_MONITOR)
+ return;
+
+ if (msg->FindInt32 ("opcode", &opcode) != B_OK)
+ return;
+
+ if (opcode != B_STAT_CHANGED)
+ return;
+
+ /* Wait a little for any message to be completely written after
+ the file's modification time changes. */
+ snooze (10000);
+
+ /* Read and apply font settings. */
+ be_send_font_settings ();
+ }
+};
static unsigned int
hash_string (const char *name_or_style)
@@ -288,12 +338,15 @@ BFont_nchar_bounds (void *font, const char *mb_str, int
*advance,
}
static void
-font_style_to_flags (char *st, struct haiku_font_pattern *pattern)
+font_style_to_flags (const char *style_string,
+ struct haiku_font_pattern *pattern)
{
- char *style = strdup (st);
+ char *style;
char *token;
int tok = 0;
+ style = strdup (style_string);
+
if (!style)
return;
@@ -385,7 +438,8 @@ font_style_to_flags (char *st, struct haiku_font_pattern
*pattern)
pattern->specified &= ~FSPEC_WEIGHT;
pattern->specified &= ~FSPEC_WIDTH;
pattern->specified |= FSPEC_STYLE;
- std::strncpy ((char *) &pattern->style, st,
+ std::strncpy ((char *) &pattern->style,
+ style_string,
sizeof pattern->style - 1);
pattern->style[sizeof pattern->style - 1] = '\0';
}
@@ -887,7 +941,7 @@ be_evict_font_cache (void)
}
void
-be_font_style_to_flags (char *style, struct haiku_font_pattern *pattern)
+be_font_style_to_flags (const char *style, struct haiku_font_pattern *pattern)
{
pattern->specified = 0;
@@ -939,3 +993,217 @@ be_set_font_antialiasing (void *font, bool antialias_p)
? B_FORCE_ANTIALIASING
: B_DISABLE_ANTIALIASING);
}
+
+static void
+be_send_font_settings (void)
+{
+ struct haiku_font_change_event rq;
+ BFile file;
+ BPath path;
+ status_t rc;
+ BMessage message;
+ font_family family;
+ font_style style;
+ const char *new_family, *new_style;
+ float new_size;
+
+ rc = find_directory (B_USER_SETTINGS_DIRECTORY, &path);
+
+ if (rc < B_OK)
+ return;
+
+ rc = path.Append ("system/app_server/fonts");
+
+ if (rc < B_OK)
+ return;
+
+ if (file.SetTo (path.Path (), B_READ_ONLY) != B_OK)
+ return;
+
+ if (message.Unflatten (&file) != B_OK)
+ return;
+
+ /* Now, populate with new values. */
+ if (!default_locker.Lock ())
+ gui_abort ("Failed to lock font data locker");
+
+ /* Obtain default values. */
+ be_fixed_font->GetFamilyAndStyle (&family, &style);
+ default_size = be_fixed_font->Size ();
+
+ /* And the new values. */
+ new_family = message.GetString ("fixed family", family);
+ new_style = message.GetString ("fixed style", style);
+ new_size = message.GetFloat ("fixed size", default_size);
+
+ /* If it turns out the fixed family changed, send the new family and
+ style. */
+
+ if (!fixed_family || !fixed_style
+ || new_size != fixed_size
+ || strcmp (new_family, fixed_family)
+ || strcmp (new_style, fixed_style))
+ {
+ memset (&rq, 0, sizeof rq);
+ strncpy (rq.new_family, (char *) new_family,
+ sizeof rq.new_family - 1);
+ strncpy (rq.new_style, (char *) new_style,
+ sizeof rq.new_style - 1);
+ rq.new_size = new_size;
+ rq.what = FIXED_FAMILY;
+
+ haiku_write (FONT_CHANGE_EVENT, &rq);
+ }
+
+ if (fixed_family)
+ free (fixed_family);
+
+ if (fixed_style)
+ free (fixed_style);
+
+ fixed_family = strdup (new_family);
+ fixed_style = strdup (new_style);
+ fixed_size = new_size;
+
+ /* Obtain default values. */
+ be_plain_font->GetFamilyAndStyle (&family, &style);
+ default_size = be_plain_font->Size ();
+
+ /* And the new values. */
+ new_family = message.GetString ("plain family", family);
+ new_style = message.GetString ("plain style", style);
+ new_size = message.GetFloat ("plain style", default_size);
+
+ if (!default_family || !default_style
+ || new_size != default_size
+ || strcmp (new_family, default_family)
+ || strcmp (new_style, default_style))
+ {
+ memset (&rq, 0, sizeof rq);
+ strncpy (rq.new_family, (char *) new_family,
+ sizeof rq.new_family - 1);
+ strncpy (rq.new_style, (char *) new_style,
+ sizeof rq.new_style - 1);
+ rq.new_size = new_size;
+ rq.what = DEFAULT_FAMILY;
+
+ haiku_write (FONT_CHANGE_EVENT, &rq);
+ }
+
+ if (default_family)
+ free (default_family);
+
+ if (default_style)
+ free (default_style);
+
+ default_family = strdup (new_family);
+ default_style = strdup (new_style);
+ default_size = new_size;
+
+ default_locker.Unlock ();
+}
+
+/* Begin listening to font settings changes, by installing a node
+ watcher. This relies on the settings file already being present
+ and has several inherent race conditions, but users shouldn't be
+ changing font settings very quickly. */
+
+void
+be_listen_font_settings (void)
+{
+ BPath path;
+ status_t rc;
+ BNode node;
+ node_ref node_ref;
+ EmacsFontMonitorLooper *looper;
+ font_family family;
+ font_style style;
+
+ /* Set up initial values. */
+ be_fixed_font->GetFamilyAndStyle (&family, &style);
+ fixed_family = strdup (family);
+ fixed_style = strdup (style);
+ fixed_size = be_fixed_font->Size ();
+
+ be_plain_font->GetFamilyAndStyle (&family, &style);
+ default_family = strdup (family);
+ default_style = strdup (style);
+ default_size = be_plain_font->Size ();
+
+ rc = find_directory (B_USER_SETTINGS_DIRECTORY, &path);
+
+ if (rc < B_OK)
+ return;
+
+ rc = path.Append ("system/app_server/fonts");
+
+ if (rc < B_OK)
+ return;
+
+ rc = node.SetTo (path.Path ());
+
+ if (rc < B_OK)
+ return;
+
+ if (node.GetNodeRef (&node_ref) < B_OK)
+ return;
+
+ looper = new EmacsFontMonitorLooper;
+
+ if (watch_node (&node_ref, B_WATCH_STAT, looper) < B_OK)
+ {
+ delete looper;
+ return;
+ }
+
+ looper->Run ();
+}
+
+bool
+be_lock_font_defaults (void)
+{
+ return default_locker.Lock ();
+}
+
+void
+be_unlock_font_defaults (void)
+{
+ return default_locker.Unlock ();
+}
+
+const char *
+be_get_font_default (enum haiku_what_font what)
+{
+ switch (what)
+ {
+ case FIXED_FAMILY:
+ return fixed_family;
+
+ case FIXED_STYLE:
+ return fixed_style;
+
+ case DEFAULT_FAMILY:
+ return default_family;
+
+ case DEFAULT_STYLE:
+ return default_style;
+ }
+
+ return NULL;
+}
+
+int
+be_get_font_size (enum haiku_what_font what)
+{
+ switch (what)
+ {
+ case FIXED_FAMILY:
+ return fixed_size;
+
+ case DEFAULT_FAMILY:
+ return default_size;
+
+ default:
+ return 0;
+ }
+}
diff --git a/src/haiku_io.c b/src/haiku_io.c
index 5cc70f6f71..6ef6f2ebd0 100644
--- a/src/haiku_io.c
+++ b/src/haiku_io.c
@@ -109,6 +109,8 @@ haiku_len (enum haiku_event_type type)
return sizeof (struct haiku_screen_changed_event);
case CLIPBOARD_CHANGED_EVENT:
return sizeof (struct haiku_clipboard_changed_event);
+ case FONT_CHANGE_EVENT:
+ return sizeof (struct haiku_font_change_event);
}
emacs_abort ();
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 983928442a..0f8e26d0db 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -54,12 +54,14 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <game/WindowScreen.h>
#include <game/DirectWindow.h>
+#include <storage/FindDirectory.h>
#include <storage/Entry.h>
#include <storage/Path.h>
#include <storage/FilePanel.h>
#include <storage/AppFileInfo.h>
#include <storage/Path.h>
#include <storage/PathFinder.h>
+#include <storage/Node.h>
#include <support/Beep.h>
#include <support/DataIO.h>
@@ -5501,3 +5503,54 @@ be_set_use_frame_synchronization (void *view, bool sync)
vw = (EmacsView *) view;
vw->SetFrameSynchronization (sync);
}
+
+status_t
+be_write_node_message (const char *path, const char *name, void *message)
+{
+ BNode node (path);
+ status_t rc;
+ ssize_t flat, result;
+ char *buffer;
+ BMessage *msg;
+
+ rc = node.InitCheck ();
+ msg = (BMessage *) message;
+
+ if (rc < B_OK)
+ return rc;
+
+ flat = msg->FlattenedSize ();
+ if (flat < B_OK)
+ return flat;
+
+ buffer = new (std::nothrow) char[flat];
+ if (!buffer)
+ return B_NO_MEMORY;
+
+ rc = msg->Flatten (buffer, flat);
+ if (rc < B_OK)
+ {
+ delete[] buffer;
+ return rc;
+ }
+
+ result = node.WriteAttr (name, B_MIME_TYPE, 0,
+ buffer, flat);
+ delete[] buffer;
+
+ if (result < B_OK)
+ return result;
+
+ if (result != flat)
+ return B_ERROR;
+
+ return B_OK;
+}
+
+void
+be_send_message (const char *app_id, void *message)
+{
+ BMessenger messenger (app_id);
+
+ messenger.SendMessage ((BMessage *) message);
+}
diff --git a/src/haiku_support.h b/src/haiku_support.h
index ca1808556a..e940e69bf1 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -115,6 +115,7 @@ enum haiku_event_type
SCREEN_CHANGED_EVENT,
MENU_BAR_LEFT,
CLIPBOARD_CHANGED_EVENT,
+ FONT_CHANGE_EVENT,
};
struct haiku_clipboard_changed_event
@@ -442,6 +443,27 @@ struct haiku_menu_bar_state_event
void *window;
};
+enum haiku_what_font
+ {
+ FIXED_FAMILY,
+ FIXED_STYLE,
+ DEFAULT_FAMILY,
+ DEFAULT_STYLE,
+ };
+
+struct haiku_font_change_event
+{
+ /* New family, style and size of the font. */
+ haiku_font_family_or_style new_family;
+ haiku_font_family_or_style new_style;
+ int new_size;
+
+ /* What changed. FIXED_FAMILY means this is the new fixed font.
+ DEFAULT_FAMILY means this is the new plain font. The other enums
+ have no meaning. */
+ enum haiku_what_font what;
+};
+
struct haiku_session_manager_reply
{
bool quit_reply;
@@ -697,7 +719,7 @@ extern int be_get_display_screens (void);
extern bool be_use_subpixel_antialiasing (void);
extern const char *be_find_setting (const char *);
extern haiku_font_family_or_style *be_list_font_families (size_t *);
-extern void be_font_style_to_flags (char *, struct haiku_font_pattern *);
+extern void be_font_style_to_flags (const char *, struct haiku_font_pattern *);
extern void *be_open_font_at_index (int, int, float);
extern void be_set_font_antialiasing (void *, bool);
extern int be_get_ui_color (const char *, uint32_t *);
@@ -724,11 +746,21 @@ extern void be_get_window_decorator_frame (void *, int *,
int *, int *, int *);
extern void be_send_move_frame_event (void *);
extern void be_set_window_fullscreen_mode (void *, enum haiku_fullscreen_mode);
+extern status_t be_write_node_message (const char *, const char *, void *);
+extern void be_send_message (const char *, void *);
+
extern void be_lock_window (void *);
extern void be_unlock_window (void *);
extern bool be_get_explicit_workarea (int *, int *, int *, int *);
extern void be_clear_grab_view (void);
extern void be_set_use_frame_synchronization (void *, bool);
+
+extern void be_listen_font_settings (void);
+
+extern bool be_lock_font_defaults (void);
+extern const char *be_get_font_default (enum haiku_what_font);
+extern int be_get_font_size (enum haiku_what_font);
+extern void be_unlock_font_defaults (void);
#ifdef __cplusplus
}
diff --git a/src/haikufns.c b/src/haikufns.c
index aaa4e86622..711202c5df 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -2636,8 +2636,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
start_timer:
/* Let the tip disappear after timeout seconds. */
- tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
- intern ("x-hide-tip"));
+ tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip);
return unbind_to (count, Qnil);
}
@@ -3149,6 +3148,9 @@ syms_of_haikufns (void)
DEFSYM (Qcancel_timer, "cancel-timer");
DEFSYM (Qassq_delete_all, "assq-delete-all");
+ DEFSYM (Qrun_at_time, "run-at-time");
+ DEFSYM (Qx_hide_tip, "x-hide-tip");
+
DEFSYM (Qalways, "always");
DEFSYM (Qnot_useful, "not-useful");
DEFSYM (Qwhen_mapped, "when-mapped");
diff --git a/src/haikufont.c b/src/haikufont.c
index 3e7f6f86dc..335c312ceb 100644
--- a/src/haikufont.c
+++ b/src/haikufont.c
@@ -370,7 +370,7 @@ haikufont_maybe_handle_special_family (Lisp_Object family,
BFont_populate_fixed_family (ptn);
return 1;
}
- else if (EQ (family, intern ("Sans Serif")))
+ else if (EQ (family, QSans_Serif))
{
BFont_populate_plain_family (ptn);
return 1;
@@ -1311,6 +1311,98 @@ in the font selection dialog. */)
QCsize, lsize);
}
+DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font,
+ Sfont_get_system_normal_font, 0, 0, 0,
+ doc: /* SKIP: real doc in xsettings.c. */)
+ (void)
+{
+ Lisp_Object value;
+ const char *name, *style;
+ struct haiku_font_pattern pattern;
+ Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle;
+ int size;
+
+ if (!be_lock_font_defaults ())
+ return Qnil;
+
+ name = be_get_font_default (DEFAULT_FAMILY);
+ style = be_get_font_default (DEFAULT_STYLE);
+ size = be_get_font_size (DEFAULT_FAMILY);
+
+ be_font_style_to_flags (style, &pattern);
+
+ lfamily = build_string_from_utf8 (name);
+ lweight = (pattern.specified & FSPEC_WEIGHT
+ ? haikufont_weight_to_lisp (pattern.weight) : Qnil);
+ lslant = (pattern.specified & FSPEC_SLANT
+ ? haikufont_slant_to_lisp (pattern.slant) : Qnil);
+ lwidth = (pattern.specified & FSPEC_WIDTH
+ ? haikufont_width_to_lisp (pattern.width) : Qnil);
+ ladstyle = (pattern.specified & FSPEC_STYLE
+ ? intern (pattern.style) : Qnil);
+
+ value = CALLN (Ffont_spec, QCfamily, lfamily,
+ QCweight, lweight, QCslant, lslant,
+ QCwidth, lwidth, QCadstyle, ladstyle,
+ QCsize, make_fixnum (size));
+ be_unlock_font_defaults ();
+
+ return value;
+}
+
+DEFUN ("font-get-system-font", Ffont_get_system_font,
+ Sfont_get_system_font, 0, 0, 0,
+ doc: /* SKIP: real doc in xsettings.c. */)
+ (void)
+{
+ Lisp_Object value;
+ const char *name, *style;
+ struct haiku_font_pattern pattern;
+ Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle;
+ int size;
+
+ if (!be_lock_font_defaults ())
+ return Qnil;
+
+ name = be_get_font_default (FIXED_FAMILY);
+ style = be_get_font_default (FIXED_STYLE);
+ size = be_get_font_size (FIXED_FAMILY);
+
+ be_font_style_to_flags (style, &pattern);
+
+ lfamily = build_string_from_utf8 (name);
+ lweight = (pattern.specified & FSPEC_WEIGHT
+ ? haikufont_weight_to_lisp (pattern.weight) : Qnil);
+ lslant = (pattern.specified & FSPEC_SLANT
+ ? haikufont_slant_to_lisp (pattern.slant) : Qnil);
+ lwidth = (pattern.specified & FSPEC_WIDTH
+ ? haikufont_width_to_lisp (pattern.width) : Qnil);
+ ladstyle = (pattern.specified & FSPEC_STYLE
+ ? intern (pattern.style) : Qnil);
+
+ value = CALLN (Ffont_spec, QCfamily, lfamily,
+ QCweight, lweight, QCslant, lslant,
+ QCwidth, lwidth, QCadstyle, ladstyle,
+ QCsize, make_fixnum (size));
+ be_unlock_font_defaults ();
+
+ return value;
+}
+
+void
+haiku_handle_font_change_event (struct haiku_font_change_event *event,
+ struct input_event *ie)
+{
+ ie->kind = CONFIG_CHANGED_EVENT;
+
+ /* This is the name of the display. */
+ ie->frame_or_window = XCAR (x_display_list->name_list_element);
+
+ /* And this is the font that changed. */
+ ie->arg = (event->what == FIXED_FAMILY
+ ? Qmonospace_font_name : Qfont_name);
+}
+
static void
syms_of_haikufont_for_pdumper (void)
{
@@ -1320,6 +1412,7 @@ syms_of_haikufont_for_pdumper (void)
void
syms_of_haikufont (void)
{
+ DEFSYM (QSans_Serif, "Sans Serif");
DEFSYM (Qfontsize, "fontsize");
DEFSYM (Qfixed, "fixed");
DEFSYM (Qplain, "plain");
@@ -1343,6 +1436,14 @@ syms_of_haikufont (void)
DEFSYM (QCindices, ":indices");
+ DEFSYM (Qmonospace_font_name, "monospace-font-name");
+ DEFSYM (Qfont_name, "font-name");
+ DEFSYM (Qdynamic_setting, "dynamic-setting");
+
+ DEFVAR_BOOL ("font-use-system-font", use_system_font,
+ doc: /* SKIP: real doc in xsettings.c. */);
+ use_system_font = false;
+
#ifdef USE_BE_CAIRO
Fput (Qhaiku, Qfont_driver_superseded_by, Qftcr);
#endif
@@ -1352,6 +1453,12 @@ syms_of_haikufont (void)
staticpro (&font_cache);
defsubr (&Sx_select_font);
+ defsubr (&Sfont_get_system_normal_font);
+ defsubr (&Sfont_get_system_font);
be_init_font_data ();
+
+ /* This tells loadup to load dynamic-setting.el, which handles
+ config-changed events. */
+ Fprovide (Qdynamic_setting, Qnil);
}
diff --git a/src/haikuselect.c b/src/haikuselect.c
index 7eb93a2754..bd004f4900 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -325,6 +325,15 @@ haiku_message_to_lisp (void *message)
t1 = make_float (*(float *) buf);
break;
+ case 'CSTR':
+ /* Is this even possible? */
+ if (!buf_size)
+ buf_size = 1;
+
+ t1 = make_uninit_string (buf_size - 1);
+ memcpy (SDATA (t1), buf, buf_size - 1);
+ break;
+
default:
t1 = make_uninit_string (buf_size);
memcpy (SDATA (t1), buf, buf_size);
@@ -747,6 +756,21 @@ haiku_lisp_to_message (Lisp_Object obj, void *message)
signal_error ("Failed to add bool", data);
break;
+ case 'CSTR':
+ /* C strings must be handled specially, since they
+ include a trailing NULL byte. */
+ CHECK_STRING (data);
+
+ block_input ();
+ rc = be_add_message_data (message, SSDATA (name),
+ type_code, SDATA (data),
+ SBYTES (data) + 1);
+ unblock_input ();
+
+ if (rc)
+ signal_error ("Failed to add", data);
+ break;
+
default:
decode_normally:
CHECK_STRING (data);
@@ -779,6 +803,49 @@ haiku_unwind_drag_message (void *message)
BMessage_delete (message);
}
+static void
+haiku_report_system_error (status_t code, const char *format)
+{
+ switch (code)
+ {
+ case B_BAD_VALUE:
+ error (format, "Bad value");
+ break;
+
+ case B_ENTRY_NOT_FOUND:
+ error (format, "File not found");
+ break;
+
+ case B_PERMISSION_DENIED:
+ error (format, "Permission denied");
+ break;
+
+ case B_LINK_LIMIT:
+ error (format, "Link limit reached");
+ break;
+
+ case B_BUSY:
+ error (format, "Device busy");
+ break;
+
+ case B_NO_MORE_FDS:
+ error (format, "No more file descriptors");
+ break;
+
+ case B_FILE_ERROR:
+ error (format, "File error");
+ break;
+
+ case B_NO_MEMORY:
+ memory_full (SIZE_MAX);
+ break;
+
+ default:
+ error (format, "Unknown error");
+ break;
+ }
+}
+
DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message,
2, 4, 0,
doc: /* Begin dragging MESSAGE from FRAME.
@@ -958,6 +1025,66 @@ after it starts. */)
return SAFE_FREE_UNBIND_TO (depth, Qnil);
}
+DEFUN ("haiku-write-node-attribute", Fhaiku_write_node_attribute,
+ Shaiku_write_node_attribute, 3, 3, 0,
+ doc: /* Write a message as a file-system attribute of NODE.
+FILE should be a file name of a file on a Be File System volume, NAME
+should be a string describing the name of the attribute that will be
+written, and MESSAGE will be the attribute written to FILE, as a
+system message in the format accepted by `haiku-drag-message', which
+see. */)
+ (Lisp_Object file, Lisp_Object name, Lisp_Object message)
+{
+ void *be_message;
+ status_t rc;
+ specpdl_ref count;
+
+ CHECK_STRING (file);
+ CHECK_STRING (name);
+
+ file = ENCODE_FILE (file);
+ name = ENCODE_SYSTEM (name);
+
+ be_message = be_create_simple_message ();
+ count = SPECPDL_INDEX ();
+
+ record_unwind_protect_ptr (BMessage_delete, be_message);
+ haiku_lisp_to_message (message, be_message);
+ rc = be_write_node_message (SSDATA (file), SSDATA (name),
+ be_message);
+
+ if (rc < B_OK)
+ haiku_report_system_error (rc, "Failed to set attribute: %s");
+
+ return unbind_to (count, Qnil);
+}
+
+DEFUN ("haiku-send-message", Fhaiku_send_message, Shaiku_send_message,
+ 2, 2, 0,
+ doc: /* Send a system message to PROGRAM.
+PROGRAM must be the name of the application to which the message will
+be sent. MESSAGE is the system message, serialized in the format
+accepted by `haiku-drag-message', that will be sent to the application
+specified by PROGRAM. There is no guarantee that the message will
+arrive after this function is called. */)
+ (Lisp_Object program, Lisp_Object message)
+{
+ specpdl_ref count;
+ void *be_message;
+
+ CHECK_STRING (program);
+ program = ENCODE_SYSTEM (program);
+
+ be_message = be_create_simple_message ();
+ count = SPECPDL_INDEX ();
+
+ record_unwind_protect_ptr (BMessage_delete, be_message);
+ haiku_lisp_to_message (message, be_message);
+ be_send_message (SSDATA (program), be_message);
+
+ return unbind_to (count, Qnil);
+}
+
static void
haiku_dnd_compute_tip_xy (int *root_x, int *root_y)
{
@@ -1191,6 +1318,8 @@ keyboard modifiers currently held down. */);
defsubr (&Shaiku_selection_owner_p);
defsubr (&Shaiku_drag_message);
defsubr (&Shaiku_roster_launch);
+ defsubr (&Shaiku_write_node_attribute);
+ defsubr (&Shaiku_send_message);
haiku_dnd_frame = NULL;
}
diff --git a/src/haikuterm.c b/src/haikuterm.c
index c2d4e34ba2..4e32b74716 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));
@@ -1252,6 +1257,8 @@ haiku_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
? CHAR_TABLE_REF (Vglyphless_char_display,
glyph->u.glyphless.ch)
: XCHAR_TABLE (Vglyphless_char_display)->extras[0]);
+ if (CONSP (acronym))
+ acronym = XCAR (acronym);
if (STRINGP (acronym))
str = SSDATA (acronym);
}
@@ -1434,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
@@ -2957,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));
}
@@ -2986,18 +3000,11 @@ haiku_default_font_parameter (struct frame *f,
Lisp_Object parms)
font_param = Qnil;
if (NILP (font_param))
- {
- /* System font should take precedence over X resources. We suggest this
- regardless of font-use-system-font because .emacs may not have been
- read yet. */
- struct haiku_font_pattern ptn;
- ptn.specified = 0;
-
- BFont_populate_fixed_family (&ptn);
-
- if (ptn.specified & FSPEC_FAMILY)
- font = font_open_by_name (f, build_unibyte_string (ptn.family));
- }
+ /* System font should take precedence over X resources. We
+ suggest this regardless of font-use-system-font because .emacs
+ may not have been read yet. Returning a font-spec is Haiku
+ specific behavior. */
+ font = font_open_by_spec (f, Ffont_get_system_font ());
if (NILP (font))
font = !NILP (font_param) ? font_param
@@ -3091,10 +3098,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
@@ -3140,6 +3152,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;
@@ -3257,9 +3270,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;
@@ -4025,6 +4042,11 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
inev.kind = SAVE_SESSION_EVENT;
inev.arg = Qt;
break;
+ case FONT_CHANGE_EVENT:
+ /* This generates CONFIG_CHANGED_EVENTs, which are then
+ handled in Lisp. */
+ haiku_handle_font_change_event (buf, &inev);
+ break;
case KEY_UP:
case DUMMY_EVENT:
default:
@@ -4347,7 +4369,7 @@ haiku_term_init (void)
emacs_abort ();
color_file = Fexpand_file_name (build_string ("rgb.txt"),
- Fsymbol_value (intern ("data-directory")));
+ Fsymbol_value (Qdata_directory));
color_map = Fx_load_color_file (color_file);
if (NILP (color_map))
@@ -4415,6 +4437,9 @@ haiku_term_init (void)
dpyinfo->default_name = build_string ("GNU Emacs");
haiku_start_watching_selections ();
+
+ /* Start listening for font configuration changes. */
+ be_listen_font_settings ();
unblock_input ();
return dpyinfo;
@@ -4632,6 +4657,8 @@ syms_of_haikuterm (void)
DEFSYM (Qoption, "option");
DEFSYM (Qcommand, "command");
+ DEFSYM (Qdata_directory, "data-directory");
+
DEFVAR_LISP ("haiku-meta-keysym", Vhaiku_meta_keysym,
doc: /* Which key Emacs uses as the meta modifier.
This is either one of the symbols `shift', `control', `command', and
diff --git a/src/haikuterm.h b/src/haikuterm.h
index b603c0a482..70e8cf948b 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -34,6 +34,9 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#define HAVE_CHAR_CACHE_MAX 65535
+/* This is really defined in haiku_support.h. */
+struct haiku_font_change_event;
+
extern int popup_activated_p;
struct haikufont_info
@@ -171,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. */
@@ -272,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)
@@ -361,4 +369,7 @@ extern void haiku_merge_cursor_foreground (struct
glyph_string *, unsigned long
unsigned long *);
extern void haiku_handle_selection_clear (struct input_event *);
extern void haiku_start_watching_selections (void);
+extern void haiku_handle_font_change_event (struct haiku_font_change_event *,
+ struct input_event *);
+
#endif /* _HAIKU_TERM_H_ */
diff --git a/src/hbfont.c b/src/hbfont.c
index 2721a66120..476e08020e 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -249,7 +249,7 @@ uni_combining (hb_unicode_funcs_t *funcs, hb_codepoint_t
ch, void *user_data)
if (!combining_class_loaded)
{
canonical_combining_class_table =
- uniprop_table (intern ("canonical-combining-class"));
+ uniprop_table (Qcanonical_combining_class);
if (NILP (canonical_combining_class_table))
emacs_abort ();
staticpro (&canonical_combining_class_table);
diff --git a/src/image.c b/src/image.c
index f5004c2c4c..1e323ba66a 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1,6 +1,6 @@
/* Functions for image support on window system.
-Copyright (C) 1989, 1992-2022 Free Software Foundation, Inc.
+Copyright (C) 1989-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -10907,7 +10907,7 @@ DEF_DLL_FN (int, gdk_pixbuf_get_bits_per_sample, (const
GdkPixbuf *));
DEF_DLL_FN (void, g_type_init, (void));
# endif
DEF_DLL_FN (void, g_object_unref, (gpointer));
-DEF_DLL_FN (void, g_clear_error, (GError **));
+DEF_DLL_FN (void, g_error_free, (GError *));
static bool
init_svg_functions (void)
@@ -10967,7 +10967,7 @@ init_svg_functions (void)
LOAD_DLL_FN (gobject, g_type_init);
# endif
LOAD_DLL_FN (gobject, g_object_unref);
- LOAD_DLL_FN (glib, g_clear_error);
+ LOAD_DLL_FN (glib, g_error_free);
return 1;
}
@@ -10983,7 +10983,7 @@ init_svg_functions (void)
# undef gdk_pixbuf_get_pixels
# undef gdk_pixbuf_get_rowstride
# undef gdk_pixbuf_get_width
-# undef g_clear_error
+# undef g_error_free
# undef g_object_unref
# undef g_type_init
# if LIBRSVG_CHECK_VERSION (2, 52, 1)
@@ -11019,7 +11019,7 @@ init_svg_functions (void)
# define gdk_pixbuf_get_pixels fn_gdk_pixbuf_get_pixels
# define gdk_pixbuf_get_rowstride fn_gdk_pixbuf_get_rowstride
# define gdk_pixbuf_get_width fn_gdk_pixbuf_get_width
-# define g_clear_error fn_g_clear_error
+# define g_error_free fn_g_error_free
# define g_object_unref fn_g_object_unref
# if ! GLIB_CHECK_VERSION (2, 36, 0)
# define g_type_init fn_g_type_init
@@ -11183,6 +11183,10 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
char *wrapped_contents = NULL;
ptrdiff_t wrapped_size;
+ bool empty_errmsg = true;
+ const char *errmsg = "";
+ ptrdiff_t errlen = 0;
+
#if LIBRSVG_CHECK_VERSION (2, 48, 0)
char *css = NULL;
#endif
@@ -11353,7 +11357,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
if (! check_image_size (f, width, height))
{
image_size_error ();
- goto rsvg_error;
+ goto done_error;
}
/* We are now done with the unmodified data. */
@@ -11491,7 +11495,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0))
{
g_object_unref (pixbuf);
- return 0;
+ return false;
}
init_color_table ();
@@ -11536,9 +11540,30 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
image_put_x_image (f, img, ximg, 0);
}
- return 1;
+ eassume (err == NULL);
+ return true;
rsvg_error:
+ if (err && err->message[0])
+ {
+ errmsg = err->message;
+ errlen = strlen (errmsg);
+ /* Remove trailing whitespace from the error message text. It
+ has a newline at the end, and perhaps more whitespace. */
+ while (errlen && c_isspace (errmsg[errlen - 1]))
+ errlen--;
+ empty_errmsg = errlen == 0;
+ }
+
+ if (empty_errmsg)
+ image_error ("Error parsing SVG image");
+ else
+ image_error ("Error parsing SVG image: %s", make_string (errmsg, errlen));
+
+ if (err)
+ g_error_free (err);
+
+ done_error:
if (rsvg_handle)
g_object_unref (rsvg_handle);
if (wrapped_contents)
@@ -11547,11 +11572,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
if (css && !STRINGP (lcss))
xfree (css);
#endif
- /* FIXME: Use error->message so the user knows what is the actual
- problem with the image. */
- image_error ("Error parsing SVG image");
- g_clear_error (&err);
- return 0;
+ return false;
}
#endif /* defined (HAVE_RSVG) */
@@ -11817,9 +11838,6 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f)
/***********************************************************************
Tests
***********************************************************************/
-
-#ifdef GLYPH_DEBUG
-
DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
doc: /* Value is non-nil if SPEC is a valid image specification. */)
(Lisp_Object spec)
@@ -11827,6 +11845,7 @@ DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
return valid_image_p (spec) ? Qt : Qnil;
}
+#ifdef GLYPH_DEBUG
DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0,
doc: /* */)
@@ -12219,9 +12238,9 @@ non-numeric, there is no explicit limit on the size of
images. */);
defsubr (&Simage_mask_p);
defsubr (&Simage_metadata);
defsubr (&Simage_cache_size);
+ defsubr (&Simagep);
#ifdef GLYPH_DEBUG
- defsubr (&Simagep);
defsubr (&Slookup_image);
#endif
@@ -12264,5 +12283,4 @@ The options are:
/* MagickExportImagePixels is in 6.4.6-9, but not 6.4.4-10. */
imagemagick_render_type = 0;
#endif
-
}
diff --git a/src/indent.c b/src/indent.c
index cb368024d9..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);
@@ -577,12 +574,15 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
if (!NILP (BVAR (current_buffer, truncate_lines)))
lines_truncated = true;
- else if (w && FIXNUMP (Vtruncate_partial_width_windows))
- lines_truncated =
- w->total_cols < XFIXNAT (Vtruncate_partial_width_windows);
- else if (w && !NILP (Vtruncate_partial_width_windows))
- lines_truncated =
- w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w)));
+ else if (!NILP (Vtruncate_partial_width_windows) && w
+ && w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w))))
+ {
+ if (FIXNUMP (Vtruncate_partial_width_windows))
+ lines_truncated =
+ w->total_cols < XFIXNAT (Vtruncate_partial_width_windows);
+ else
+ lines_truncated = true;
+ }
/* Special optimization for buffers with long and truncated
lines: assumes that each character is a single column. */
if (lines_truncated)
@@ -634,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
@@ -1355,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 38d5fbda00..6d56a76c77 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -284,7 +284,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;
@@ -300,8 +299,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)
@@ -310,15 +307,6 @@ 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 point for an insertion of NBYTES bytes, which are NCHARS characters.
diff --git a/src/intervals.c b/src/intervals.c
index 85152c58a5..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;
@@ -2171,8 +2171,8 @@ get_property_and_range (ptrdiff_t pos, Lisp_Object prop,
Lisp_Object *val,
/* Return the proper local keymap TYPE for position POSITION in
BUFFER; TYPE should be one of `keymap' or `local-map'. Use the map
- specified by the PROP property, if any. Otherwise, if TYPE is
- `local-map' use BUFFER's local map. */
+ specified by the TYPE property, if any. Otherwise, if TYPE is
+ `local-map', use BUFFER's local map. */
Lisp_Object
get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type)
diff --git a/src/itree.c b/src/itree.c
new file mode 100644
index 0000000000..3b10802ff0
--- /dev/null
+++ b/src/itree.c
@@ -0,0 +1,1432 @@
+/* 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 postions.
+
+ 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 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
+ * +=======================================================================+ */
+
+typedef uintptr_t nodeptr_and_flag;
+
+static inline nodeptr_and_flag
+make_nav (struct itree_node *ptr, bool flag)
+{
+ uintptr_t v = (uintptr_t) ptr;
+ /* We assume alignment imposes the LSB is clear for us to use it. */
+ eassert (!(v & 1));
+ return v | !!flag;
+}
+
+static inline struct itree_node *
+nav_nodeptr (nodeptr_and_flag nav)
+{
+ return (struct itree_node *) (nav & (~(uintptr_t)1));
+}
+
+static inline bool
+nav_flag (nodeptr_and_flag nav)
+{
+ return (bool) (nav & 1);
+}
+
+/* Simple dynamic array. */
+struct interval_stack
+{
+ nodeptr_and_flag *nodes;
+ size_t size;
+ size_t length;
+};
+
+/* This is just a simple dynamic array with stack semantics. */
+
+static struct interval_stack*
+interval_stack_create (intmax_t initial_size)
+{
+ struct interval_stack *stack = xmalloc (sizeof (struct interval_stack));
+ stack->size = max (0, initial_size);
+ stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*));
+ stack->length = 0;
+ return stack;
+}
+
+static void
+interval_stack_destroy (struct interval_stack *stack)
+{
+ if (! stack)
+ return;
+ if (stack->nodes)
+ xfree (stack->nodes);
+ xfree (stack);
+}
+
+static void
+interval_stack_clear (struct interval_stack *stack)
+{
+ stack->length = 0;
+}
+
+static inline void
+interval_stack_ensure_space (struct interval_stack *stack, intmax_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
+interval_stack_push_flagged (struct interval_stack *stack,
+ struct itree_node *node, bool flag)
+{
+ eassert (node && node != NULL);
+
+ /* FIXME: While the stack used in the iterator is bounded by the tree
+ depth and could be easily pre-allocated to a large enough size to avoid
+ this "ensure" check, `interval_stack_push` is also used elsewhere to
+ simply collect some subset of the overlays, where it's only bounded by
+ the total number of overlays in the buffer (which can be large and thus
+ preferably not pre-allocated needlessly). */
+ interval_stack_ensure_space (stack, stack->length + 1);
+
+ stack->nodes[stack->length] = make_nav (node, flag);
+ stack->length++;
+}
+
+static inline void
+interval_stack_push (struct interval_stack *stack, struct itree_node *node)
+{
+ interval_stack_push_flagged (stack, node, false);
+}
+
+static inline nodeptr_and_flag
+interval_stack_pop (struct interval_stack *stack)
+{
+ if (stack->length == 0)
+ return make_nav (NULL, false);
+ return stack->nodes[--stack->length];
+}
+
+
+/* +-----------------------------------------------------------------------+ */
+
+/* State used when iterating interval. */
+struct itree_iterator
+{
+ struct interval_stack *stack;
+ ptrdiff_t begin;
+ ptrdiff_t end;
+
+ /* A copy of the tree's `otick`. */
+ uintmax_t otick;
+ enum itree_order order;
+ bool running;
+ const char *file;
+ int line;
+};
+
+/* Ideally, every iteration would use its own `iter` object, so we could
+ have several iterations active at the same time. In practice, iterations
+ are limited by the fact we don't allow modifying the tree at the same
+ time, making the use of nested iterations quite rare anyway.
+ So we just use a single global iterator instead for now. */
+static struct itree_iterator *iter;
+
+static int
+interval_tree_max_height (const struct itree_tree *tree)
+{
+ return 2 * log (tree->size + 1) / log (2) + 0.5;
+}
+
+/* Allocate a new iterator for TREE. */
+
+static struct itree_iterator *
+itree_iterator_create (struct itree_tree *tree)
+{
+ struct itree_iterator *g = xmalloc (sizeof *g);
+ /* 19 here just avoids starting with a silly-small stack.
+ FIXME: Since this stack only needs to be about 2*max_depth
+ in the worst case, we could completely pre-allocate it to something
+ like word-bit-size * 2 and then never worry about growing it. */
+ const int size = (tree ? interval_tree_max_height (tree) : 19) + 1;
+
+ g->stack = interval_stack_create (size);
+ g->running = false;
+ g->begin = 0;
+ g->end = 0;
+ g->file = NULL;
+ g->line = 0;
+ return g;
+}
+
+static void
+itree_init (void)
+{
+ iter = itree_iterator_create (NULL);
+}
+
+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 interval_tree_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
+interval_tree_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
+interval_tree_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
+interval_tree_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*
+interval_tree_validate (struct itree_tree *tree, struct itree_node *node)
+{
+
+ if (tree->otick == node->otick || node == NULL)
+ return node;
+ if (node != tree->root)
+ interval_tree_validate (tree, node->parent);
+
+ interval_tree_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)
+{
+ interval_tree_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)
+{
+ interval_tree_validate (tree, node);
+ return node->end;
+}
+
+/* Allocate an interval_tree. Free with interval_tree_destroy. */
+
+struct itree_tree *
+itree_create (void)
+{
+ /* FIXME? Maybe avoid the initialization of itree_null in the same
+ way that is used to call mem_init in alloc.c? It's not really
+ important though. */
+ itree_init ();
+
+ 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
+interval_tree_init (struct interval_tree *tree)
+{
+ interval_tree_clear (tree);
+ /* tree->iter = itree_iterator_create (tree); */
+}
+#endif
+
+/* Release a tree, freeing its allocated memory. */
+void
+itree_destroy (struct itree_tree *tree)
+{
+ eassert (tree->root == NULL);
+ /* if (tree->iter)
+ * itree_iterator_destroy (tree->iter); */
+ 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
+interval_tree_rotate_left (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (node->right != NULL);
+
+ struct itree_node *right = node->right;
+
+ interval_tree_inherit_offset (tree->otick, node);
+ interval_tree_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. */
+ interval_tree_update_limit (node);
+ interval_tree_update_limit (right);
+}
+
+/* Perform the familiar right-rotation on node NODE. */
+
+static void
+interval_tree_rotate_right (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (tree && node && node->left != NULL);
+
+ struct itree_node *left = node->left;
+
+ interval_tree_inherit_offset (tree->otick, node);
+ interval_tree_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;
+
+ interval_tree_update_limit (left);
+ interval_tree_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
+interval_tree_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;
+ interval_tree_rotate_left (tree, node);
+ }
+ /* case 3.a */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ interval_tree_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;
+ interval_tree_rotate_right (tree, node);
+ }
+ /* case 3.b */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ interval_tree_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 behaviour. */
+
+static void
+interval_tree_insert (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (node->begin <= node->end && node != NULL);
+ /* FIXME: The assertion below fails because `delete_all_overlays`
+ doesn't set left/right/parent to NULL. */
+ /* 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 responsability 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)
+ {
+ interval_tree_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. */
+ interval_tree_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;
+ interval_tree_insert (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)
+{
+ interval_tree_validate (tree, node);
+ if (begin != node->begin)
+ {
+ itree_remove (tree, node);
+ node->begin = min (begin, PTRDIFF_MAX - 1);
+ node->end = max (node->begin, end);
+ interval_tree_insert (tree, node);
+ }
+ else if (end != node->end)
+ {
+ node->end = max (node->begin, end);
+ eassert (node != NULL);
+ interval_tree_propagate_limit (node);
+ }
+}
+
+/* Return true, if NODE is a member of TREE. */
+
+static bool
+interval_tree_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)
+ {
+ ITREE_FOREACH_ABORT ();
+ 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*
+interval_tree_subtree_min (uintmax_t otick, struct itree_node *node)
+{
+ if (node == NULL)
+ return node;
+ while ((interval_tree_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
+interval_tree_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;
+ interval_tree_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;
+ interval_tree_rotate_right (tree, other);
+ other = parent->right;
+ }
+ other->red = parent->red; /* 4.a */
+ parent->red = false;
+ other->right->red = false;
+ interval_tree_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;
+ interval_tree_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;
+ interval_tree_rotate_left (tree, other);
+ other = parent->left;
+ }
+
+ other->red = parent->red; /* 4.b */
+ parent->red = false;
+ other->left->red = false;
+ interval_tree_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
+interval_tree_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
+interval_tree_transplant (struct itree_tree *tree,
+ struct itree_node *source,
+ struct itree_node *dest)
+{
+ interval_tree_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 (interval_tree_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`. */
+ interval_tree_inherit_offset (tree->otick, node);
+ struct itree_node *splice
+ = (node->left == NULL || node->right == NULL)
+ ? node
+ : interval_tree_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. */
+ interval_tree_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)
+ {
+ interval_tree_transplant (tree, splice, node);
+ interval_tree_propagate_limit (subtree_parent);
+ if (splice != subtree_parent)
+ interval_tree_update_limit (splice);
+ }
+ interval_tree_propagate_limit (splice->parent);
+
+ --tree->size;
+
+ /* Fix any black height violation caused by removing a black node. */
+ if (removed_black)
+ interval_tree_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;
+}
+
+bool
+itree_iterator_busy_p (void)
+{
+ return (iter && iter->running);
+}
+
+/* Start a iterator enumerating all intervals in [BEGIN,END) in the
+ given ORDER. Only one iterator per tree can be running at any time. */
+
+struct itree_iterator *
+itree_iterator_start (struct itree_tree *tree, ptrdiff_t begin,
+ ptrdiff_t end, enum itree_order order,
+ const char *file, int line)
+{
+ /* struct itree_iterator *iter = tree->iter; */
+ if (iter->running)
+ {
+ fprintf (stderr,
+ "Detected nested iteration!\nOuter: %s:%d\nInner: %s:%d\n",
+ iter->file, iter->line, file, line);
+ emacs_abort ();
+ }
+ iter->begin = begin;
+ iter->end = end;
+ iter->otick = tree->otick;
+ iter->order = order;
+ interval_stack_clear (iter->stack);
+ if (begin <= end && tree->root != NULL)
+ interval_stack_push_flagged (iter->stack, tree->root, false);
+ iter->file = file;
+ iter->line = line;
+ iter->running = true;
+ /* interval_stack_ensure_space (iter->stack,
+ 2 * interval_tree_max_height (tree)); */
+ return iter;
+}
+
+/* Stop using the iterator. */
+
+void
+itree_iterator_finish (struct itree_iterator *iter)
+{
+ eassert (iter->running);
+ iter->running = false;
+}
+
+
+/* +=======================================================================+
+ * | 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. */
+
+void
+itree_insert_gap (struct itree_tree *tree,
+ ptrdiff_t pos, ptrdiff_t length)
+{
+ if (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. */
+ struct interval_stack *saved = interval_stack_create (0);
+ struct itree_node *node = NULL;
+ ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER)
+ {
+ if (node->begin == pos && node->front_advance
+ && (node->begin != node->end || node->rear_advance))
+ interval_stack_push (saved, node);
+ }
+ for (int i = 0; i < saved->length; ++i)
+ itree_remove (tree, nav_nodeptr (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 = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ interval_stack_push (stack, tree->root);
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (stack),
+ node = nav_nodeptr (nav)))
+ {
+ /* Process in pre-order. */
+ interval_tree_inherit_offset (tree->otick, node);
+ if (node->right != NULL)
+ {
+ if (node->begin > pos)
+ {
+ /* All nodes in this subtree are shifted by length. */
+ node->right->offset += length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != NULL
+ && pos <= node->left->limit + node->left->offset)
+ interval_stack_push (stack, node->left);
+
+ /* node->begin == pos implies no front-advance. */
+ if (node->begin > pos)
+ node->begin += length;
+ if (node->end > pos || (node->end == pos && node->rear_advance))
+ {
+ node->end += length;
+ eassert (node != NULL);
+ interval_tree_propagate_limit (node);
+ }
+ }
+ interval_stack_destroy (stack);
+ }
+
+ /* Reinsert nodes starting at POS having front-advance. */
+ uintmax_t notick = tree->otick;
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (saved),
+ node = nav_nodeptr (nav)))
+ {
+ eassert (node->otick == ootick);
+ node->begin += length;
+ if (node->end != pos || node->rear_advance)
+ node->end += length;
+ node->otick = notick;
+ interval_tree_insert (tree, node);
+ }
+
+ interval_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 (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 = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ struct itree_node *node;
+
+ interval_stack_push (stack, tree->root);
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (stack)))
+ {
+ node = nav_nodeptr (nav);
+ interval_tree_inherit_offset (tree->otick, node);
+ if (node->right != NULL)
+ {
+ if (node->begin > pos + length)
+ {
+ /* Shift right subtree to the left. */
+ node->right->offset -= length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != NULL
+ && pos <= node->left->limit + node->left->offset)
+ interval_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);
+ interval_tree_propagate_limit (node);
+ }
+ }
+ interval_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
+interval_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 of the iterator in the order given when it was
+ started; or NULL if there are no more nodes. */
+
+struct itree_node *
+itree_iterator_next (struct itree_iterator *g)
+{
+ eassert (g->running);
+
+ struct itree_node *const null = NULL;
+ struct itree_node *node;
+
+ /* The `visited` flag stored in each node is used here (and only here):
+ We keep a "workstack" of nodes we need to consider. This stack
+ consist of nodes of two types: nodes that we have decided
+ should be returned by the iterator, and nodes which we may
+ need to consider (including checking their children).
+ We start an iteration with a stack containing just the root
+ node marked as "not visited" which means that it (and its children)
+ needs to be considered but we haven't yet decided whether it's included
+ in the iterator's output. */
+
+ do
+ {
+ nodeptr_and_flag nav;
+ bool visited;
+ while ((nav = interval_stack_pop (g->stack),
+ node = nav_nodeptr (nav),
+ visited = nav_flag (nav),
+ node && !visited))
+ {
+ struct itree_node *const left = node->left;
+ struct itree_node *const right = node->right;
+
+ interval_tree_inherit_offset (g->otick, node);
+ eassert (itree_limit_is_stable (node));
+ switch (g->order)
+ {
+ case ITREE_ASCENDING:
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ /* Node's children may still be off-set and we need to add it. */
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ break;
+ case ITREE_DESCENDING:
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ break;
+ case ITREE_PRE_ORDER:
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ break;
+ }
+ }
+ /* Node may have been invalidated by itree_iterator_narrow
+ after it was pushed: Check if it still intersects. */
+ } while (node && ! interval_node_intersects (node, g->begin, g->end));
+
+ 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->running);
+ 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..c6b68d3667
--- /dev/null
+++ b/src/itree.h
@@ -0,0 +1,182 @@
+/* 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,
+ };
+
+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);
+extern void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
+
+/* Iteration functions. Almost all code should use ITREE_FOREACH
+ instead. */
+extern bool itree_iterator_busy_p (void);
+extern struct itree_iterator *itree_iterator_start (struct itree_tree *,
+ ptrdiff_t,
+ ptrdiff_t,
+ enum itree_order,
+ const char *, int);
+extern void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t,
+ ptrdiff_t);
+extern void itree_iterator_finish (struct itree_iterator *);
+extern struct itree_node *itree_iterator_next (struct itree_iterator *);
+
+/* Iterate over the intervals between BEG and END in the tree T.
+ N will hold successive nodes. ORDER can be one of : `ASCENDING`,
+ `DESCENDING`, 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 a pure.
+ - Only a single iteration can happen at a time, so make sure none of the
+ code within the loop can start another tree iteration, i.e. it shouldn't
+ be able to run ELisp code, nor GC since GC can run ELisp by way
+ of `post-gc-hook`.
+ - If you need to exit the loop early, you *have* to call `ITREE_ABORT`
+ just before exiting (e.g. with `break` or `return`).
+ - Non-local exits are not supported within the body of the loop.
+ - Don't modify the tree during the iteration.
+ */
+#define ITREE_FOREACH(n, t, beg, end, order) \
+ /* FIXME: We'd want to declare `x` 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_iter_ \
+ = itree_iterator_start (t, beg, end, ITREE_##order, \
+ __FILE__, __LINE__); \
+ ((n = itree_iterator_next (itree_iter_)) \
+ || (itree_iterator_finish (itree_iter_), false));)
+
+#define ITREE_FOREACH_ABORT() \
+ itree_iterator_finish (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 4948ea40e4..d8796569cd 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -499,27 +499,18 @@ echo_add_key (Lisp_Object c)
STRING_MULTIBYTE (name), 1);
}
+ Lisp_Object new_string = make_string (buffer, ptr - buffer);
if ((NILP (echo_string) || SCHARS (echo_string) == 0)
&& help_char_p (c))
{
- static const char text[] = " (Type ? for further options)";
- int len = sizeof text - 1;
-
- if (size - (ptr - buffer) < len)
- {
- ptrdiff_t offset = ptr - buffer;
- size += len;
- buffer = SAFE_ALLOCA (size);
- ptr = buffer + offset;
- }
-
- memcpy (ptr, text, len);
- ptr += len;
+ AUTO_STRING (str, " (Type ? for further options)");
+ AUTO_LIST2 (props, Qface, Qhelp_key_binding);
+ Fadd_text_properties (make_fixnum (7), make_fixnum (8), props, str);
+ new_string = concat2 (new_string, str);
}
- kset_echo_string
- (current_kboard,
- concat2 (echo_string, make_string (buffer, ptr - buffer)));
+ kset_echo_string (current_kboard,
+ concat2 (echo_string, new_string));
SAFE_FREE ();
}
@@ -1277,7 +1268,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);
@@ -1467,8 +1457,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);
@@ -1624,9 +1612,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)
@@ -1708,8 +1695,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)))
{
@@ -1827,21 +1814,15 @@ adjust_point_for_property (ptrdiff_t last_pt, bool
modified)
}
}
-/* Subroutine for safe_run_hooks: run the hook, which is ARGS[1]. */
+/* Subroutine for safe_run_hooks: run the hook's function.
+ ARGS[0] holds the name of the hook, which we don't need here (we only use
+ it in the failure case of the internal_condition_case_n). */
static Lisp_Object
safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
{
- eassert (nargs >= 2 && nargs <= 4);
- switch (nargs)
- {
- case 2:
- return call0 (args[1]);
- case 3:
- return call1 (args[1], args[2]);
- default:
- return call2 (args[1], args[2], args[3]);
- }
+ eassert (nargs >= 2);
+ return Ffuncall (nargs - 1, args + 1);
}
/* Subroutine for safe_run_hooks: handle an error by clearing out the function
@@ -1850,7 +1831,7 @@ safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
static Lisp_Object
safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
{
- eassert (nargs >= 2 && nargs <= 4);
+ eassert (nargs >= 2);
AUTO_STRING (format, "Error in %s (%S): %S");
Lisp_Object hook = args[0];
Lisp_Object fun = args[1];
@@ -1886,27 +1867,22 @@ safe_run_hooks_error (Lisp_Object error, ptrdiff_t
nargs, Lisp_Object *args)
static Lisp_Object
safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
{
- eassert (nargs >= 2 && nargs <= 4);
- /* Yes, run_hook_with_args works with args in the other order. */
- switch (nargs)
- {
- case 2:
- internal_condition_case_n (safe_run_hooks_1,
- 2, ((Lisp_Object []) {args[1], args[0]}),
- Qt, safe_run_hooks_error);
- break;
- case 3:
- internal_condition_case_n (safe_run_hooks_1,
- 3, ((Lisp_Object []) {args[1], args[0],
args[2]}),
- Qt, safe_run_hooks_error);
- break;
- default:
- internal_condition_case_n (safe_run_hooks_1,
- 4, ((Lisp_Object [])
- {args[1], args[0], args[2], args[3]}),
- Qt, safe_run_hooks_error);
- break;
- }
+ /* We need to swap args[0] and args[1] here or in `safe_run_hooks_1`.
+ It's more convenient to do it here. */
+ eassert (nargs >= 2);
+ Lisp_Object fun = args[0], hook = args[1];
+ /* The `nargs` array cannot be mutated safely here because it is
+ reused by our caller `run_hook_with_args`.
+ We could arguably change it temporarily if we set it back
+ to its original state before returning, but it's too ugly. */
+ USE_SAFE_ALLOCA;
+ Lisp_Object *newargs;
+ SAFE_ALLOCA_LISP (newargs, nargs);
+ newargs[0] = hook, newargs[1] = fun;
+ memcpy (newargs + 2, args + 2, (nargs - 2) * word_size);
+ internal_condition_case_n (safe_run_hooks_1, nargs, newargs,
+ Qt, safe_run_hooks_error);
+ SAFE_FREE ();
return Qnil;
}
@@ -1920,7 +1896,8 @@ safe_run_hooks (Lisp_Object hook)
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
- run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
safe_run_hook_funcall);
+ run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
+ safe_run_hook_funcall);
unbind_to (count, Qnil);
}
@@ -1936,7 +1913,8 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct
window *w)
make_fixnum (get_narrowed_zv (w, PT)),
hook);
- run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
safe_run_hook_funcall);
+ run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
+ safe_run_hook_funcall);
unbind_to (count, Qnil);
}
@@ -11806,6 +11784,9 @@ DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point,
0, 2, 0,
doc: /* Return position information for buffer position POS in WINDOW.
POS defaults to point in WINDOW; WINDOW defaults to the selected window.
+If POS is in invisible text or is hidden by `display' properties,
+this function may report on buffer positions before or after POS.
+
Return nil if POS is not visible in WINDOW. Otherwise,
the return value is similar to that returned by `event-start' for
a mouse click at the upper left corner of the glyph corresponding
@@ -12258,6 +12239,8 @@ syms_of_keyboard (void)
DEFSYM (Qhelp_form_show, "help-form-show");
+ DEFSYM (Qhelp_key_binding, "help-key-binding");
+
DEFSYM (Qecho_keystrokes, "echo-keystrokes");
Fset (Qinput_method_exit_on_first_char, Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index 896406b6a0..6416785683 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.
@@ -245,7 +244,8 @@ DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
DEFINE_GDB_SYMBOL_END (VALMASK)
/* Ignore 'alignas' on compilers lacking it. */
-#if !defined alignas && !defined __alignas_is_defined
+#if (!defined alignas && !defined __alignas_is_defined \
+ && __STDC_VERSION__ < 202311 && __cplusplus < 201103)
# define alignas(a)
#endif
@@ -642,10 +642,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. */
@@ -1574,10 +1572,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;
@@ -2602,10 +2605,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
@@ -3181,10 +3183,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
@@ -4416,7 +4419,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);
@@ -4786,7 +4788,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;
diff --git a/src/lread.c b/src/lread.c
index ccccd79cd7..dfa4d9afb5 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1423,6 +1423,7 @@ Return t if the file exists and loads successfully. */)
struct stat s1, s2;
int result;
+ struct timespec epoch_timespec = {(time_t)0, 0}; /* 1970-01-01T00:00
UTC */
if (version < 0 && !(version = safe_to_load_version (file, fd)))
error ("File `%s' was not compiled in Emacs", SDATA (found));
@@ -1451,7 +1452,12 @@ Return t if the file exists and loads successfully. */)
newer = 1;
/* If we won't print another message, mention this anyway.
*/
- if (!NILP (nomessage) && !force_load_messages)
+ if (!NILP (nomessage) && !force_load_messages
+ /* We don't want this message during
+ bootstrapping for the "compile-first" .elc
+ files, which have had their timestamps set to
+ the epoch. See bug #58224. */
+ && timespec_cmp (get_stat_mtime (&s1), epoch_timespec))
{
Lisp_Object msg_file;
msg_file = Fsubstring (found, make_fixnum (0),
make_fixnum (-1));
@@ -2905,31 +2911,26 @@ digit_to_number (int character, int base)
return digit < base ? digit : -1;
}
-/* Size of the fixed-size buffer used during reading.
- It should be at least big enough for `invalid_radix_integer' but
- can usefully be much bigger than that. */
-enum { stackbufsize = 1024 };
-
static void
-invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS
(stackbufsize)],
- Lisp_Object readcharfun)
+invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun)
{
- int n = snprintf (stackbuf, stackbufsize, "integer, radix %"pI"d", radix);
- eassert (n < stackbufsize);
- invalid_syntax (stackbuf, readcharfun);
+ char buf[64];
+ int n = snprintf (buf, sizeof buf, "integer, radix %"pI"d", radix);
+ eassert (n < sizeof buf);
+ invalid_syntax (buf, readcharfun);
}
/* Read an integer in radix RADIX using READCHARFUN to read
- characters. RADIX must be in the interval [2..36]. Use STACKBUF
- for temporary storage as needed. Value is the integer read.
+ characters. RADIX must be in the interval [2..36].
+ Value is the integer read.
Signal an error if encountering invalid read syntax. */
static Lisp_Object
-read_integer (Lisp_Object readcharfun, int radix,
- char stackbuf[VLA_ELEMS (stackbufsize)])
+read_integer (Lisp_Object readcharfun, int radix)
{
+ char stackbuf[20];
char *read_buffer = stackbuf;
- ptrdiff_t read_buffer_size = stackbufsize;
+ ptrdiff_t read_buffer_size = sizeof stackbuf;
char *p = read_buffer;
char *heapbuf = NULL;
int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
@@ -2976,7 +2977,7 @@ read_integer (Lisp_Object readcharfun, int radix,
UNREAD (c);
if (valid != 1)
- invalid_radix_integer (radix, stackbuf, readcharfun);
+ invalid_radix_integer (radix, readcharfun);
*p = '\0';
return unbind_to (count, string_to_number (read_buffer, radix, NULL));
@@ -3030,11 +3031,11 @@ read_char_literal (Lisp_Object readcharfun)
/* Read a string literal (preceded by '"'). */
static Lisp_Object
-read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)],
- Lisp_Object readcharfun)
+read_string_literal (Lisp_Object readcharfun)
{
+ char stackbuf[1024];
char *read_buffer = stackbuf;
- ptrdiff_t read_buffer_size = stackbufsize;
+ ptrdiff_t read_buffer_size = sizeof stackbuf;
specpdl_ref count = SPECPDL_INDEX ();
char *heapbuf = NULL;
char *p = read_buffer;
@@ -3357,8 +3358,7 @@ string_props_from_rev_list (Lisp_Object elems,
Lisp_Object readcharfun)
/* Read a bool vector (preceded by "#&"). */
static Lisp_Object
-read_bool_vector (char stackbuf[VLA_ELEMS (stackbufsize)],
- Lisp_Object readcharfun)
+read_bool_vector (Lisp_Object readcharfun)
{
ptrdiff_t length = 0;
for (;;)
@@ -3376,7 +3376,7 @@ read_bool_vector (char stackbuf[VLA_ELEMS (stackbufsize)],
}
ptrdiff_t size_in_chars = bool_vector_bytes (length);
- Lisp_Object str = read_string_literal (stackbuf, readcharfun);
+ Lisp_Object str = read_string_literal (readcharfun);
if (STRING_MULTIBYTE (str)
|| !(size_in_chars == SCHARS (str)
/* We used to print 1 char too many when the number of bits
@@ -3686,19 +3686,28 @@ read_stack_push (struct read_stack_entry e)
rdstack.stack[rdstack.sp++] = e;
}
+static void
+read_stack_reset (intmax_t sp)
+{
+ eassert (sp <= rdstack.sp);
+ rdstack.sp = sp;
+}
/* Read a Lisp object.
If LOCATE_SYMS is true, symbols are read with position. */
static Lisp_Object
read0 (Lisp_Object readcharfun, bool locate_syms)
{
- char stackbuf[stackbufsize];
+ char stackbuf[64];
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
char *heapbuf = NULL;
- specpdl_ref count = SPECPDL_INDEX ();
+ specpdl_ref base_pdl = SPECPDL_INDEX ();
ptrdiff_t base_sp = rdstack.sp;
+ record_unwind_protect_intmax (read_stack_reset, base_sp);
+
+ specpdl_ref count = SPECPDL_INDEX ();
bool uninterned_symbol;
bool skip_shorthand;
@@ -3886,7 +3895,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
case '&':
/* #&N"..." -- bool-vector */
- obj = read_bool_vector (stackbuf, readcharfun);
+ obj = read_bool_vector (readcharfun);
break;
case '!':
@@ -3902,17 +3911,17 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
case 'x':
case 'X':
- obj = read_integer (readcharfun, 16, stackbuf);
+ obj = read_integer (readcharfun, 16);
break;
case 'o':
case 'O':
- obj = read_integer (readcharfun, 8, stackbuf);
+ obj = read_integer (readcharfun, 8);
break;
case 'b':
case 'B':
- obj = read_integer (readcharfun, 2, stackbuf);
+ obj = read_integer (readcharfun, 2);
break;
case '@':
@@ -3980,8 +3989,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
{
/* #NrDIGITS -- radix-N number */
if (n < 0 || n > 36)
- invalid_radix_integer (n, stackbuf, readcharfun);
- obj = read_integer (readcharfun, n, stackbuf);
+ invalid_radix_integer (n, readcharfun);
+ obj = read_integer (readcharfun, n);
break;
}
else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
@@ -4036,7 +4045,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
break;
case '"':
- obj = read_string_literal (stackbuf, readcharfun);
+ obj = read_string_literal (readcharfun);
break;
case '\'':
@@ -4347,7 +4356,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
}
}
- return unbind_to (count, obj);
+ return unbind_to (base_pdl, obj);
}
diff --git a/src/macuvs.h b/src/macuvs.h
index 4c08415698..7b8c77f017 100644
--- a/src/macuvs.h
+++ b/src/macuvs.h
@@ -8,29 +8,29 @@
static const unsigned char mac_uvs_table_adobe_japan1_bytes[] =
{
- 0x00, 0x0e, 0x00, 0x01, 0x1f, 0xb2, 0x00, 0x00,
+ 0x00, 0x0e, 0x00, 0x01, 0x1f, 0xb7, 0x00, 0x00,
0x00, 0x0f, 0x0e, 0x01, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xaf, 0x0e, 0x01, 0x01,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x04, 0xae,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x04, 0xb3,
0x0e, 0x01, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x01, 0x1c, 0x45, 0x0e, 0x01, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x01, 0x1e, 0xc4, 0x0e, 0x01,
+ 0x01, 0x1c, 0x4a, 0x0e, 0x01, 0x03, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x01, 0x1e, 0xc9, 0x0e, 0x01,
0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f,
- 0x1d, 0x0e, 0x01, 0x05, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x01, 0x1f, 0x3f, 0x0e, 0x01, 0x06, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0x57, 0x0e,
+ 0x22, 0x0e, 0x01, 0x05, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x01, 0x1f, 0x44, 0x0e, 0x01, 0x06, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0x5c, 0x0e,
0x01, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01,
- 0x1f, 0x65, 0x0e, 0x01, 0x08, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x01, 0x1f, 0x73, 0x0e, 0x01, 0x09,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0x7c,
+ 0x1f, 0x6a, 0x0e, 0x01, 0x08, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x01, 0x1f, 0x78, 0x0e, 0x01, 0x09,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0x81,
0x0e, 0x01, 0x0a, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x01, 0x1f, 0x85, 0x0e, 0x01, 0x0b, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x01, 0x1f, 0x8e, 0x0e, 0x01,
+ 0x01, 0x1f, 0x8a, 0x0e, 0x01, 0x0b, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x01, 0x1f, 0x93, 0x0e, 0x01,
0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f,
- 0x97, 0x0e, 0x01, 0x0d, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x01, 0x1f, 0xa0, 0x0e, 0x01, 0x0e, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0xa9, 0x00,
- 0x00, 0x33, 0xff, 0x00, 0x34, 0x02, 0x35, 0x82,
+ 0x9c, 0x0e, 0x01, 0x0d, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x01, 0x1f, 0xa5, 0x0e, 0x01, 0x0e, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x01, 0x1f, 0xae, 0x00,
+ 0x00, 0x34, 0x00, 0x00, 0x34, 0x02, 0x35, 0x82,
0x00, 0x34, 0x05, 0x3c, 0x1b, 0x00, 0x34, 0x06,
0x43, 0x5a, 0x00, 0x34, 0x27, 0x36, 0x56, 0x00,
0x34, 0x2c, 0x43, 0x5e, 0x00, 0x34, 0x2e, 0x37,
@@ -8349,870 +8349,870 @@ static const unsigned char
mac_uvs_table_adobe_japan1_bytes[] =
0x02, 0xb8, 0x17, 0x4f, 0x24, 0x02, 0xb8, 0x1a,
0x37, 0xc6, 0x02, 0xd5, 0x44, 0x36, 0x0a, 0x02,
0xe2, 0x78, 0x37, 0x6b, 0x02, 0xe5, 0x69, 0x36,
- 0x27, 0x02, 0xe6, 0xea, 0x37, 0x92, 0x00, 0x00,
- 0x04, 0xb7, 0x00, 0x34, 0x02, 0x35, 0x81, 0x00,
- 0x4e, 0x08, 0x34, 0x97, 0x00, 0x4e, 0x0e, 0x4e,
- 0x69, 0x00, 0x4e, 0x19, 0x36, 0xb9, 0x00, 0x4e,
- 0x26, 0x4e, 0x6a, 0x00, 0x4e, 0x30, 0x3c, 0x1a,
- 0x00, 0x4e, 0x39, 0x36, 0x5a, 0x00, 0x4e, 0x3b,
- 0x35, 0xf4, 0x00, 0x4e, 0x73, 0x36, 0x90, 0x00,
- 0x4e, 0xa1, 0x36, 0xcf, 0x00, 0x4e, 0xa4, 0x34,
- 0x7f, 0x00, 0x4e, 0xca, 0x35, 0xd4, 0x00, 0x4f,
- 0x34, 0x36, 0xa0, 0x00, 0x4f, 0x4f, 0x35, 0xfc,
- 0x00, 0x4f, 0x60, 0x3c, 0x1c, 0x00, 0x4f, 0x73,
- 0x4e, 0x6c, 0x00, 0x4f, 0x75, 0x34, 0x47, 0x00,
- 0x4f, 0x7f, 0x34, 0x8a, 0x00, 0x4f, 0xae, 0x34,
- 0x46, 0x00, 0x4f, 0xb5, 0x36, 0x1b, 0x00, 0x4f,
- 0xbf, 0x34, 0xc2, 0x00, 0x50, 0x24, 0x36, 0x5f,
- 0x00, 0x50, 0x26, 0x1d, 0xfa, 0x00, 0x50, 0x49,
- 0x34, 0x61, 0x00, 0x50, 0x4f, 0x36, 0xbe, 0x00,
- 0x50, 0x56, 0x4e, 0x6d, 0x00, 0x50, 0x65, 0x34,
- 0x7b, 0x00, 0x50, 0x85, 0x34, 0xd0, 0x00, 0x50,
- 0x91, 0x34, 0x79, 0x00, 0x50, 0xc5, 0x1d, 0xee,
- 0x00, 0x50, 0xca, 0x1f, 0x2e, 0x00, 0x50, 0xcf,
- 0x34, 0xa2, 0x00, 0x50, 0xe7, 0x34, 0x30, 0x00,
- 0x50, 0xed, 0x4e, 0x6e, 0x00, 0x50, 0xf2, 0x52,
- 0xac, 0x00, 0x51, 0x1a, 0x37, 0x16, 0x00, 0x51,
- 0x32, 0x1e, 0x76, 0x00, 0x51, 0x46, 0x34, 0xa5,
- 0x00, 0x51, 0x4d, 0x34, 0x4d, 0x00, 0x51, 0x4e,
- 0x36, 0x7d, 0x00, 0x51, 0x54, 0x10, 0x74, 0x00,
- 0x51, 0x68, 0x36, 0x42, 0x00, 0x51, 0x6b, 0x4e,
- 0x6f, 0x00, 0x51, 0x6c, 0x34, 0x80, 0x00, 0x51,
- 0x77, 0x35, 0xa5, 0x00, 0x51, 0x7c, 0x35, 0xb4,
- 0x00, 0x51, 0x89, 0x1e, 0x87, 0x00, 0x51, 0x8d,
- 0x08, 0x36, 0x00, 0x51, 0x92, 0x36, 0xd6, 0x00,
- 0x51, 0x93, 0x34, 0xd1, 0x00, 0x51, 0x95, 0x10,
- 0x82, 0x00, 0x51, 0xa4, 0x1e, 0x89, 0x00, 0x51,
- 0xac, 0x0c, 0x59, 0x00, 0x51, 0xb4, 0x34, 0x5c,
- 0x00, 0x51, 0xcb, 0x1e, 0x3e, 0x00, 0x51, 0xdb,
- 0x34, 0xd2, 0x00, 0x51, 0xde, 0x4f, 0x53, 0x00,
- 0x51, 0xe1, 0x36, 0xd9, 0x00, 0x51, 0xfd, 0x4e,
- 0x72, 0x00, 0x52, 0x03, 0x36, 0x22, 0x00, 0x52,
- 0x06, 0x34, 0xbb, 0x00, 0x52, 0x24, 0x36, 0xa1,
- 0x00, 0x52, 0x38, 0x35, 0xb5, 0x00, 0x52, 0x4a,
- 0x35, 0xdd, 0x00, 0x52, 0x4d, 0x36, 0x41, 0x00,
- 0x52, 0x64, 0x4e, 0x74, 0x00, 0x52, 0x71, 0x4e,
- 0x75, 0x00, 0x52, 0x72, 0x05, 0xc2, 0x00, 0x52,
- 0x75, 0x1e, 0x2b, 0x00, 0x52, 0x8d, 0x37, 0x1a,
- 0x00, 0x52, 0xc7, 0x36, 0xf6, 0x00, 0x52, 0xc9,
- 0x0e, 0x29, 0x00, 0x52, 0xd7, 0x37, 0x1b, 0x00,
- 0x52, 0xdd, 0x36, 0x05, 0x00, 0x52, 0xe2, 0x36,
- 0x2a, 0x00, 0x52, 0xe4, 0x34, 0x1a, 0x00, 0x52,
- 0xfa, 0x09, 0x07, 0x00, 0x53, 0x00, 0x37, 0xcf,
- 0x00, 0x53, 0x05, 0x36, 0xc3, 0x00, 0x53, 0x07,
- 0x20, 0xd4, 0x00, 0x53, 0x15, 0x1f, 0x2f, 0x00,
- 0x53, 0x16, 0x35, 0x61, 0x00, 0x53, 0x39, 0x36,
- 0xaa, 0x00, 0x53, 0x3f, 0x4e, 0x77, 0x00, 0x53,
- 0x40, 0x34, 0xd4, 0x00, 0x53, 0x4a, 0x36, 0xa2,
- 0x00, 0x53, 0x51, 0x0d, 0x70, 0x00, 0x53, 0x5a,
- 0x36, 0x98, 0x00, 0x53, 0x65, 0x52, 0xf3, 0x00,
- 0x53, 0x71, 0x35, 0x80, 0x00, 0x53, 0x78, 0x35,
- 0x5f, 0x00, 0x53, 0x7f, 0x06, 0xa2, 0x00, 0x53,
- 0xa9, 0x1d, 0xd8, 0x00, 0x53, 0xc9, 0x4f, 0x39,
- 0x00, 0x53, 0xca, 0x35, 0x8e, 0x00, 0x53, 0xce,
- 0x34, 0x8f, 0x00, 0x53, 0xd7, 0x35, 0xf5, 0x00,
- 0x53, 0xdb, 0x1f, 0x2a, 0x00, 0x53, 0xdf, 0x37,
- 0x1f, 0x00, 0x53, 0xe0, 0x53, 0x00, 0x00, 0x53,
- 0xf1, 0x1e, 0x0c, 0x00, 0x53, 0xf2, 0x34, 0x8b,
- 0x00, 0x54, 0x0f, 0x34, 0xc9, 0x00, 0x54, 0x38,
- 0x35, 0x8f, 0x00, 0x54, 0x40, 0x4e, 0x79, 0x00,
- 0x54, 0x48, 0x36, 0x76, 0x00, 0x54, 0x68, 0x09,
- 0x2a, 0x00, 0x54, 0xac, 0x4f, 0x35, 0x00, 0x54,
- 0xb2, 0x35, 0xdc, 0x00, 0x54, 0xe8, 0x1e, 0x17,
- 0x00, 0x55, 0x10, 0x36, 0x83, 0x00, 0x55, 0x33,
- 0x1e, 0x8b, 0x00, 0x55, 0x39, 0x1e, 0x8a, 0x00,
- 0x55, 0x44, 0x1e, 0x32, 0x00, 0x55, 0x46, 0x36,
- 0x06, 0x00, 0x55, 0x53, 0x35, 0xaa, 0x00, 0x55,
- 0x61, 0x38, 0x39, 0x00, 0x55, 0x84, 0x4e, 0x5e,
- 0x00, 0x55, 0x9c, 0x4e, 0x7b, 0x00, 0x55, 0x9d,
- 0x1d, 0xe3, 0x00, 0x55, 0xa9, 0x1f, 0x30, 0x00,
- 0x55, 0xab, 0x35, 0x8b, 0x00, 0x55, 0xb0, 0x1d,
- 0xf0, 0x00, 0x55, 0xe4, 0x1e, 0x8c, 0x00, 0x56,
- 0x05, 0x53, 0x2d, 0x00, 0x56, 0x06, 0x0b, 0x70,
- 0x00, 0x56, 0x09, 0x4e, 0x7d, 0x00, 0x56, 0x32,
- 0x1e, 0x8d, 0x00, 0x56, 0x42, 0x1d, 0xda, 0x00,
- 0x56, 0x4c, 0x1e, 0x29, 0x00, 0x56, 0x68, 0x34,
- 0x15, 0x00, 0x56, 0x74, 0x34, 0xbc, 0x00, 0x56,
- 0x78, 0x1e, 0x52, 0x00, 0x56, 0xa5, 0x1e, 0x8e,
- 0x00, 0x56, 0xae, 0x1f, 0x31, 0x00, 0x56, 0xc0,
- 0x37, 0x24, 0x00, 0x56, 0xc1, 0x34, 0xd7, 0x00,
- 0x56, 0xce, 0x4e, 0x82, 0x00, 0x56, 0xee, 0x4e,
- 0x83, 0x00, 0x57, 0x0d, 0x34, 0xd8, 0x00, 0x57,
- 0x47, 0x34, 0x78, 0x00, 0x57, 0x6a, 0x36, 0x74,
- 0x00, 0x57, 0xce, 0x09, 0xd3, 0x00, 0x57, 0xd6,
- 0x4e, 0x84, 0x00, 0x57, 0xf4, 0x34, 0x98, 0x00,
- 0x58, 0x0b, 0x1e, 0x8f, 0x00, 0x58, 0x19, 0x1f,
- 0x32, 0x00, 0x58, 0x35, 0x1e, 0x49, 0x00, 0x58,
- 0x3d, 0x4e, 0x85, 0x00, 0x58, 0x40, 0x34, 0x48,
- 0x00, 0x58, 0x58, 0x1e, 0x4d, 0x00, 0x58, 0x59,
- 0x4e, 0x86, 0x00, 0x58, 0x5a, 0x1e, 0x42, 0x00,
- 0x58, 0x9c, 0x36, 0x71, 0x00, 0x58, 0xa8, 0x0e,
- 0x7d, 0x00, 0x58, 0xab, 0x34, 0xd9, 0x00, 0x59,
- 0x06, 0x53, 0x7b, 0x00, 0x59, 0x1b, 0x1f, 0x33,
- 0x00, 0x59, 0x27, 0x36, 0x55, 0x00, 0x59, 0x4f,
- 0x4e, 0x87, 0x00, 0x59, 0x51, 0x35, 0xab, 0x00,
- 0x59, 0x53, 0x37, 0xd1, 0x00, 0x59, 0x60, 0x4e,
- 0x89, 0x00, 0x59, 0x62, 0x4e, 0x8a, 0x00, 0x59,
- 0x73, 0x36, 0x04, 0x00, 0x59, 0x84, 0x36, 0xe7,
- 0x00, 0x59, 0xa5, 0x36, 0x4f, 0x00, 0x59, 0xc9,
- 0x34, 0x8c, 0x00, 0x59, 0xda, 0x34, 0xda, 0x00,
- 0x59, 0xec, 0x36, 0xae, 0x00, 0x59, 0xff, 0x35,
- 0xe0, 0x00, 0x5a, 0x1c, 0x37, 0x26, 0x00, 0x5a,
- 0x29, 0x1e, 0x6f, 0x00, 0x5a, 0x36, 0x34, 0xdb,
- 0x00, 0x5a, 0x66, 0x36, 0xb2, 0x00, 0x5a, 0x9b,
- 0x1e, 0x68, 0x00, 0x5a, 0xbe, 0x1e, 0x90, 0x00,
- 0x5a, 0xc2, 0x37, 0x27, 0x00, 0x5a, 0xcc, 0x1d,
- 0xfb, 0x00, 0x5a, 0xda, 0x4e, 0x8b, 0x00, 0x5b,
- 0x5a, 0x4e, 0x8c, 0x00, 0x5b, 0x73, 0x4e, 0x8d,
- 0x00, 0x5b, 0x7c, 0x4e, 0x8e, 0x00, 0x5b, 0xb3,
- 0x34, 0x6d, 0x00, 0x5b, 0xb5, 0x36, 0x07, 0x00,
- 0x5b, 0xc3, 0x37, 0x29, 0x00, 0x5b, 0xd2, 0x35,
- 0x78, 0x00, 0x5b, 0xdb, 0x20, 0xf4, 0x00, 0x5b,
- 0xe7, 0x0c, 0xe1, 0x00, 0x5b, 0xe8, 0x37, 0x42,
- 0x00, 0x5c, 0x06, 0x09, 0x95, 0x00, 0x5c, 0x0a,
- 0x36, 0x4d, 0x00, 0x5c, 0x0b, 0x36, 0x23, 0x00,
- 0x5c, 0x0e, 0x36, 0x8a, 0x00, 0x5c, 0x0f, 0x36,
- 0x09, 0x00, 0x5c, 0x28, 0x1f, 0x34, 0x00, 0x5c,
- 0x51, 0x1d, 0xf2, 0x00, 0x5c, 0x60, 0x1e, 0x4a,
- 0x00, 0x5c, 0x64, 0x34, 0x31, 0x00, 0x5c, 0x6e,
- 0x12, 0x32, 0x00, 0x5d, 0x29, 0x36, 0xc4, 0x00,
- 0x5d, 0x4e, 0x34, 0xdd, 0x00, 0x5d, 0x87, 0x34,
- 0xde, 0x00, 0x5d, 0xb2, 0x3c, 0x2d, 0x00, 0x5d,
- 0xc9, 0x34, 0xdf, 0x00, 0x5d, 0xcc, 0x34, 0x73,
- 0x00, 0x5d, 0xd3, 0x34, 0xe0, 0x00, 0x5d, 0xe1,
- 0x35, 0xff, 0x00, 0x5d, 0xe5, 0x35, 0xc3, 0x00,
- 0x5d, 0xe8, 0x35, 0x92, 0x00, 0x5d, 0xf7, 0x1d,
- 0xff, 0x00, 0x5d, 0xfd, 0x0b, 0x65, 0x00, 0x5e,
- 0x06, 0x36, 0xa3, 0x00, 0x5e, 0x1d, 0x36, 0x77,
- 0x00, 0x5e, 0x30, 0x34, 0x75, 0x00, 0x5e, 0x3d,
- 0x36, 0xd0, 0x00, 0x5e, 0x43, 0x4e, 0x91, 0x00,
- 0x5e, 0x54, 0x37, 0x2d, 0x00, 0x5e, 0x63, 0x36,
- 0xba, 0x00, 0x5e, 0x64, 0x1e, 0x93, 0x00, 0x5e,
- 0x73, 0x36, 0xbb, 0x00, 0x5e, 0x7e, 0x35, 0x84,
- 0x00, 0x5e, 0x96, 0x1e, 0x70, 0x00, 0x5e, 0xa7,
- 0x4e, 0x92, 0x00, 0x5e, 0xad, 0x34, 0xa9, 0x00,
- 0x5e, 0xc9, 0x0f, 0xbf, 0x00, 0x5e, 0xca, 0x4f,
- 0x4f, 0x00, 0x5e, 0xcb, 0x38, 0xae, 0x00, 0x5e,
- 0xcf, 0x1f, 0x36, 0x00, 0x5e, 0xd0, 0x1f, 0x35,
- 0x00, 0x5e, 0xdf, 0x1e, 0x6a, 0x00, 0x5e, 0xe0,
- 0x1e, 0x18, 0x00, 0x5e, 0xe3, 0x37, 0x2f, 0x00,
- 0x5e, 0xf6, 0x34, 0x67, 0x00, 0x5e, 0xf7, 0x34,
- 0xaa, 0x00, 0x5e, 0xfa, 0x34, 0x7c, 0x00, 0x5e,
- 0xfb, 0x35, 0x69, 0x00, 0x5f, 0x0a, 0x36, 0xbc,
- 0x00, 0x5f, 0x2d, 0x34, 0xe1, 0x00, 0x5f, 0x31,
- 0x35, 0xf3, 0x00, 0x5f, 0x38, 0x4e, 0x94, 0x00,
- 0x5f, 0x45, 0x37, 0xce, 0x00, 0x5f, 0x50, 0x3c,
- 0x1f, 0x00, 0x5f, 0x62, 0x4e, 0x5f, 0x00, 0x5f,
- 0x69, 0x35, 0xd7, 0x00, 0x5f, 0x6b, 0x36, 0x68,
- 0x00, 0x5f, 0x80, 0x35, 0x5d, 0x00, 0x5f, 0x98,
- 0x34, 0xe2, 0x00, 0x5f, 0xa1, 0x4e, 0x95, 0x00,
- 0x5f, 0xae, 0x36, 0xa8, 0x00, 0x5f, 0xb5, 0x36,
- 0x69, 0x00, 0x5f, 0xbd, 0x1d, 0xea, 0x00, 0x5f,
- 0xcd, 0x36, 0x91, 0x00, 0x5f, 0xd8, 0x36, 0xd1,
- 0x00, 0x5f, 0xd9, 0x36, 0xd2, 0x00, 0x5f, 0xdd,
- 0x4e, 0x96, 0x00, 0x60, 0x25, 0x35, 0x90, 0x00,
- 0x60, 0x50, 0x35, 0x99, 0x00, 0x60, 0x62, 0x1d,
- 0xe0, 0x00, 0x60, 0x65, 0x34, 0xa4, 0x00, 0x60,
- 0x75, 0x35, 0xac, 0x00, 0x60, 0x94, 0x05, 0x79,
- 0x00, 0x60, 0x97, 0x1e, 0x94, 0x00, 0x60, 0x9e,
- 0x54, 0x36, 0x00, 0x60, 0xa4, 0x3c, 0x20, 0x00,
- 0x60, 0xb2, 0x34, 0xb3, 0x00, 0x60, 0xc5, 0x36,
- 0x12, 0x00, 0x60, 0xd8, 0x34, 0xe3, 0x00, 0x61,
- 0x08, 0x1e, 0x7a, 0x00, 0x61, 0x09, 0x36, 0xf3,
- 0x00, 0x61, 0x0f, 0x35, 0x47, 0x00, 0x61, 0x3d,
- 0x34, 0xe4, 0x00, 0x61, 0x48, 0x4e, 0x60, 0x00,
- 0x61, 0x4c, 0x35, 0xc4, 0x00, 0x61, 0x4e, 0x34,
- 0x2c, 0x00, 0x61, 0x62, 0x4e, 0x97, 0x00, 0x61,
- 0x67, 0x1d, 0xf5, 0x00, 0x61, 0x68, 0x34, 0x10,
- 0x00, 0x61, 0x8e, 0x0b, 0x00, 0x00, 0x61, 0x90,
- 0x37, 0x10, 0x00, 0x61, 0xa4, 0x34, 0xbd, 0x00,
- 0x61, 0xb2, 0x35, 0xb6, 0x00, 0x61, 0xf2, 0x34,
- 0x39, 0x00, 0x61, 0xf8, 0x4e, 0x99, 0x00, 0x61,
- 0xfe, 0x34, 0xe5, 0x00, 0x62, 0x10, 0x36, 0x2b,
- 0x00, 0x62, 0x3b, 0x36, 0xeb, 0x00, 0x62, 0x3f,
- 0x36, 0xd3, 0x00, 0x62, 0x40, 0x36, 0x02, 0x00,
- 0x62, 0x41, 0x1f, 0x37, 0x00, 0x62, 0x47, 0x36,
- 0x3b, 0x00, 0x62, 0x48, 0x1e, 0xc2, 0x00, 0x62,
- 0x49, 0x1e, 0x63, 0x00, 0x62, 0x68, 0x34, 0xe6,
- 0x00, 0x62, 0x71, 0x35, 0x45, 0x00, 0x62, 0xb1,
- 0x36, 0xc5, 0x00, 0x62, 0xcc, 0x37, 0x32, 0x00,
- 0x62, 0xcf, 0x34, 0xe7, 0x00, 0x62, 0xd0, 0x1d,
- 0xe1, 0x00, 0x62, 0xd2, 0x35, 0x93, 0x00, 0x62,
- 0xd4, 0x13, 0x5d, 0x00, 0x62, 0xf3, 0x1f, 0x21,
- 0x00, 0x62, 0xf7, 0x34, 0x88, 0x00, 0x63, 0x3a,
- 0x4f, 0x3e, 0x00, 0x63, 0x3d, 0x1e, 0x62, 0x00,
- 0x63, 0x4c, 0x34, 0x5d, 0x00, 0x63, 0x57, 0x1e,
- 0x3f, 0x00, 0x63, 0x67, 0x34, 0xc3, 0x00, 0x63,
- 0x68, 0x35, 0xec, 0x00, 0x63, 0x69, 0x1e, 0x95,
- 0x00, 0x63, 0x6e, 0x34, 0x9d, 0x00, 0x63, 0x72,
- 0x1d, 0xfc, 0x00, 0x63, 0x83, 0x36, 0x43, 0x00,
- 0x63, 0x88, 0x35, 0xf6, 0x00, 0x63, 0x92, 0x34,
- 0xaf, 0x00, 0x63, 0xa1, 0x35, 0xd8, 0x00, 0x63,
- 0xa7, 0x35, 0xc6, 0x00, 0x63, 0xc3, 0x1f, 0x27,
- 0x00, 0x63, 0xc6, 0x37, 0x34, 0x00, 0x63, 0xf4,
- 0x35, 0x57, 0x00, 0x64, 0x06, 0x1e, 0x96, 0x00,
- 0x64, 0x0f, 0x34, 0xe9, 0x00, 0x64, 0x1c, 0x37,
- 0x33, 0x00, 0x64, 0x28, 0x37, 0x35, 0x00, 0x64,
- 0x42, 0x34, 0x9e, 0x00, 0x64, 0x69, 0x36, 0xd7,
- 0x00, 0x64, 0x6f, 0x4f, 0x28, 0x00, 0x64, 0x7a,
- 0x1e, 0x21, 0x00, 0x64, 0xb0, 0x1e, 0x24, 0x00,
- 0x64, 0xe2, 0x1e, 0x45, 0x00, 0x64, 0xf2, 0x34,
- 0xea, 0x00, 0x64, 0xf6, 0x4e, 0x9e, 0x00, 0x65,
- 0x1d, 0x34, 0xe8, 0x00, 0x65, 0x4f, 0x0d, 0xc4,
- 0x00, 0x65, 0x5d, 0x34, 0xeb, 0x00, 0x65, 0x5e,
- 0x4e, 0xa1, 0x00, 0x65, 0x62, 0x34, 0x71, 0x00,
- 0x65, 0x77, 0x36, 0xb3, 0x00, 0x65, 0x83, 0x1e,
- 0x98, 0x00, 0x65, 0x87, 0x4e, 0xa3, 0x00, 0x65,
- 0x89, 0x4e, 0xa4, 0x00, 0x65, 0x8e, 0x4e, 0xa6,
- 0x00, 0x65, 0x90, 0x34, 0xb5, 0x00, 0x65, 0x9c,
- 0x35, 0xed, 0x00, 0x65, 0xa7, 0x4f, 0x41, 0x00,
- 0x65, 0xbc, 0x35, 0x5c, 0x00, 0x65, 0xc5, 0x37,
- 0x08, 0x00, 0x65, 0xdf, 0x54, 0xbe, 0x00, 0x65,
- 0xe1, 0x4e, 0xa9, 0x00, 0x65, 0xe2, 0x06, 0x37,
- 0x00, 0x66, 0x0e, 0x36, 0xe4, 0x00, 0x66, 0x1e,
- 0x21, 0x1c, 0x00, 0x66, 0x5f, 0x34, 0xec, 0x00,
- 0x66, 0x66, 0x1d, 0xe2, 0x00, 0x66, 0x67, 0x4e,
- 0xaa, 0x00, 0x66, 0x69, 0x36, 0xa5, 0x00, 0x66,
- 0x6e, 0x4e, 0xab, 0x00, 0x66, 0x74, 0x0a, 0x56,
- 0x00, 0x66, 0x77, 0x39, 0x11, 0x00, 0x66, 0x81,
- 0x35, 0xa0, 0x00, 0x66, 0x91, 0x34, 0x28, 0x00,
- 0x66, 0x96, 0x36, 0x5e, 0x00, 0x66, 0x97, 0x35,
- 0x46, 0x00, 0x66, 0xb5, 0x54, 0xda, 0x00, 0x66,
- 0xc1, 0x1f, 0x38, 0x00, 0x66, 0xd9, 0x1e, 0x13,
- 0x00, 0x66, 0xdc, 0x36, 0xfd, 0x00, 0x66, 0xf4,
- 0x34, 0x81, 0x00, 0x66, 0xf5, 0x37, 0x3b, 0x00,
- 0x66, 0xf8, 0x36, 0x03, 0x00, 0x66, 0xfb, 0x37,
- 0xcd, 0x00, 0x66, 0xfc, 0x37, 0x20, 0x00, 0x67,
- 0x00, 0x4e, 0xaf, 0x00, 0x67, 0x08, 0x35, 0xb2,
- 0x00, 0x67, 0x09, 0x36, 0xf7, 0x00, 0x67, 0x0b,
- 0x36, 0xc6, 0x00, 0x67, 0x0d, 0x36, 0xb7, 0x00,
- 0x67, 0x15, 0x36, 0x6f, 0x00, 0x67, 0x17, 0x0f,
- 0xd5, 0x00, 0x67, 0x1b, 0x36, 0xd4, 0x00, 0x67,
- 0x1d, 0x36, 0x6b, 0x00, 0x67, 0x1f, 0x35, 0x86,
- 0x00, 0x67, 0x53, 0x1e, 0x0f, 0x00, 0x67, 0x56,
- 0x4f, 0x3a, 0x00, 0x67, 0x5e, 0x37, 0x3c, 0x00,
- 0x67, 0x61, 0x4e, 0xb0, 0x00, 0x67, 0x7e, 0x34,
- 0x95, 0x00, 0x67, 0xa6, 0x1e, 0x99, 0x00, 0x67,
- 0xa9, 0x34, 0xed, 0x00, 0x67, 0xc4, 0x4e, 0xb1,
- 0x00, 0x67, 0xca, 0x1e, 0x65, 0x00, 0x67, 0xd4,
- 0x34, 0x91, 0x00, 0x67, 0xe7, 0x34, 0xee, 0x00,
- 0x67, 0xf1, 0x36, 0x65, 0x00, 0x68, 0x01, 0x21,
- 0x2e, 0x00, 0x68, 0x02, 0x4e, 0xb2, 0x00, 0x68,
- 0x13, 0x1e, 0x25, 0x00, 0x68, 0x1f, 0x4e, 0x61,
- 0x00, 0x68, 0x21, 0x34, 0x82, 0x00, 0x68, 0x43,
- 0x34, 0xac, 0x00, 0x68, 0x52, 0x21, 0x2c, 0x00,
- 0x68, 0x5d, 0x34, 0xc5, 0x00, 0x68, 0x7a, 0x36,
- 0xf0, 0x00, 0x68, 0x81, 0x37, 0x09, 0x00, 0x68,
- 0x85, 0x0d, 0x15, 0x00, 0x68, 0x8d, 0x37, 0x3e,
- 0x00, 0x68, 0x97, 0x4f, 0x37, 0x00, 0x68, 0x9b,
- 0x1e, 0x9b, 0x00, 0x68, 0x9d, 0x37, 0x3d, 0x00,
- 0x68, 0xa2, 0x1e, 0x19, 0x00, 0x68, 0xc8, 0x37,
- 0xcc, 0x00, 0x68, 0xda, 0x1e, 0x38, 0x00, 0x69,
- 0x0d, 0x34, 0x99, 0x00, 0x69, 0x30, 0x34, 0xf0,
- 0x00, 0x69, 0x3d, 0x4e, 0xb3, 0x00, 0x69, 0x5e,
- 0x4e, 0xb4, 0x00, 0x69, 0x62, 0x1e, 0x58, 0x00,
- 0x69, 0x6b, 0x34, 0xef, 0x00, 0x69, 0x6f, 0x34,
- 0x94, 0x00, 0x69, 0x82, 0x34, 0x5b, 0x00, 0x69,
- 0x8a, 0x1e, 0x06, 0x00, 0x69, 0x94, 0x1e, 0x84,
- 0x00, 0x69, 0xa7, 0x34, 0xf1, 0x00, 0x69, 0xbb,
- 0x37, 0x43, 0x00, 0x69, 0xc1, 0x35, 0x9a, 0x00,
- 0x69, 0xcb, 0x35, 0xc7, 0x00, 0x69, 0xcc, 0x1e,
- 0x40, 0x00, 0x69, 0xd9, 0x36, 0xdd, 0x00, 0x69,
- 0xea, 0x35, 0x6f, 0x00, 0x69, 0xfe, 0x55, 0x1f,
- 0x00, 0x6a, 0x0b, 0x1e, 0x64, 0x00, 0x6a, 0x3d,
- 0x1e, 0x3a, 0x00, 0x6a, 0x44, 0x34, 0xf2, 0x00,
- 0x6a, 0x55, 0x55, 0x25, 0x00, 0x6a, 0x5f, 0x35,
- 0x87, 0x00, 0x6a, 0x73, 0x37, 0xd4, 0x00, 0x6a,
- 0x8e, 0x34, 0x7e, 0x00, 0x6a, 0x90, 0x34, 0xf3,
- 0x00, 0x6a, 0x9c, 0x4e, 0xb6, 0x00, 0x6a, 0xdb,
- 0x06, 0xf3, 0x00, 0x6b, 0x04, 0x0f, 0x5d, 0x00,
- 0x6b, 0x1d, 0x1d, 0xd7, 0x00, 0x6b, 0x21, 0x35,
- 0xe7, 0x00, 0x6b, 0x24, 0x3c, 0x22, 0x00, 0x6b,
- 0x4e, 0x36, 0x5b, 0x00, 0x6b, 0x96, 0x36, 0x16,
- 0x00, 0x6b, 0xba, 0x08, 0x74, 0x00, 0x6b, 0xbb,
- 0x34, 0x70, 0x00, 0x6c, 0x08, 0x1f, 0x39, 0x00,
- 0x6c, 0x13, 0x34, 0xf5, 0x00, 0x6c, 0x38, 0x4e,
- 0xba, 0x00, 0x6c, 0x3a, 0x39, 0x62, 0x00, 0x6c,
- 0x72, 0x1f, 0x1e, 0x00, 0x6c, 0xaa, 0x37, 0x48,
- 0x00, 0x6c, 0xbf, 0x05, 0x0a, 0x00, 0x6c, 0xe1,
- 0x1e, 0x71, 0x00, 0x6c, 0xe8, 0x36, 0x66, 0x00,
- 0x6d, 0x3e, 0x34, 0xae, 0x00, 0x6d, 0x69, 0x35,
- 0xc8, 0x00, 0x6d, 0x6e, 0x36, 0xb4, 0x00, 0x6d,
- 0x77, 0x05, 0x82, 0x00, 0x6d, 0x78, 0x36, 0x1d,
- 0x00, 0x6d, 0x88, 0x36, 0x0c, 0x00, 0x6d, 0xe4,
- 0x4e, 0xbd, 0x00, 0x6d, 0xeb, 0x1d, 0xd5, 0x00,
- 0x6d, 0xfb, 0x36, 0x7c, 0x00, 0x6e, 0x08, 0x4e,
- 0xbf, 0x00, 0x6e, 0x1a, 0x09, 0x77, 0x00, 0x6e,
- 0x23, 0x1f, 0x3a, 0x00, 0x6e, 0x2f, 0x35, 0xc9,
- 0x00, 0x6e, 0x6e, 0x1e, 0x9d, 0x00, 0x6e, 0x72,
- 0x4e, 0xc0, 0x00, 0x6e, 0x7e, 0x34, 0xcf, 0x00,
- 0x6e, 0x9d, 0x1e, 0x01, 0x00, 0x6e, 0xa2, 0x1d,
- 0xd3, 0x00, 0x6e, 0xba, 0x1e, 0x46, 0x00, 0x6e,
- 0xcb, 0x35, 0xe9, 0x00, 0x6e, 0xd5, 0x4e, 0xc2,
- 0x00, 0x6e, 0xdb, 0x4e, 0xc3, 0x00, 0x6e, 0xec,
- 0x1f, 0x3b, 0x00, 0x6e, 0xfe, 0x34, 0xf8, 0x00,
- 0x6f, 0x11, 0x34, 0xf7, 0x00, 0x6f, 0x22, 0x34,
- 0x14, 0x00, 0x6f, 0x23, 0x0f, 0xc2, 0x00, 0x6f,
- 0x3e, 0x34, 0xf9, 0x00, 0x6f, 0x51, 0x36, 0x9e,
- 0x00, 0x6f, 0x54, 0x35, 0xb0, 0x00, 0x6f, 0x5b,
- 0x4e, 0xc4, 0x00, 0x6f, 0x64, 0x4e, 0xc6, 0x00,
- 0x6f, 0x6e, 0x0b, 0xc8, 0x00, 0x6f, 0x74, 0x4e,
- 0xc7, 0x00, 0x6f, 0x98, 0x37, 0x47, 0x00, 0x6f,
- 0xef, 0x1e, 0x33, 0x00, 0x6f, 0xf9, 0x39, 0x95,
- 0x00, 0x70, 0x15, 0x1e, 0x6b, 0x00, 0x70, 0x1b,
- 0x37, 0x4a, 0x00, 0x70, 0x1e, 0x1e, 0x51, 0x00,
- 0x70, 0x26, 0x1e, 0x3d, 0x00, 0x70, 0x27, 0x36,
- 0x57, 0x00, 0x70, 0x4a, 0x39, 0x98, 0x00, 0x70,
- 0x58, 0x1e, 0x57, 0x00, 0x70, 0x70, 0x35, 0x6a,
- 0x00, 0x70, 0x78, 0x4f, 0x2e, 0x00, 0x70, 0x7c,
- 0x1e, 0x10, 0x00, 0x70, 0xad, 0x36, 0x5c, 0x00,
- 0x71, 0x49, 0x0f, 0xc3, 0x00, 0x71, 0x4e, 0x1e,
- 0x26, 0x00, 0x71, 0x52, 0x55, 0xad, 0x00, 0x71,
- 0x59, 0x35, 0x59, 0x00, 0x71, 0x62, 0x37, 0x4b,
- 0x00, 0x71, 0x6e, 0x08, 0xfd, 0x00, 0x71, 0x7d,
- 0x1e, 0x27, 0x00, 0x71, 0x94, 0x1e, 0x7d, 0x00,
- 0x71, 0xb3, 0x39, 0xae, 0x00, 0x71, 0xd0, 0x37,
- 0x0a, 0x00, 0x71, 0xff, 0x34, 0xfa, 0x00, 0x72,
- 0x28, 0x15, 0xdf, 0x00, 0x72, 0x2b, 0x3c, 0x26,
- 0x00, 0x72, 0x35, 0x09, 0x0b, 0x00, 0x72, 0x36,
- 0x34, 0xb9, 0x00, 0x72, 0x3a, 0x4f, 0x46, 0x00,
- 0x72, 0x3b, 0x37, 0x4c, 0x00, 0x72, 0x3e, 0x4e,
- 0xc9, 0x00, 0x72, 0x4c, 0x1e, 0x5b, 0x00, 0x72,
- 0x59, 0x1f, 0x1d, 0x00, 0x72, 0xe1, 0x4f, 0x36,
- 0x00, 0x73, 0x1c, 0x37, 0x4e, 0x00, 0x73, 0x2a,
- 0x0b, 0xb4, 0x00, 0x73, 0x36, 0x36, 0xf8, 0x00,
- 0x73, 0x37, 0x1e, 0x7c, 0x00, 0x73, 0x87, 0x37,
- 0x05, 0x00, 0x73, 0x8b, 0x35, 0xa1, 0x00, 0x73,
- 0xca, 0x1e, 0x0b, 0x00, 0x73, 0xce, 0x1e, 0xa0,
- 0x00, 0x73, 0xe5, 0x34, 0xfb, 0x00, 0x73, 0xed,
- 0x34, 0xb1, 0x00, 0x74, 0x22, 0x0b, 0x56, 0x00,
- 0x74, 0x32, 0x34, 0xfc, 0x00, 0x74, 0x5f, 0x34,
- 0xfd, 0x00, 0x74, 0x62, 0x21, 0x71, 0x00, 0x74,
- 0xb0, 0x35, 0x79, 0x00, 0x74, 0xbd, 0x4e, 0xcd,
- 0x00, 0x74, 0xca, 0x37, 0x4f, 0x00, 0x74, 0xd8,
- 0x55, 0xf6, 0x00, 0x74, 0xdc, 0x35, 0x50, 0x00,
- 0x74, 0xe0, 0x34, 0xfe, 0x00, 0x74, 0xef, 0x55,
- 0xfa, 0x00, 0x75, 0x04, 0x1e, 0xa1, 0x00, 0x75,
- 0x0c, 0x34, 0xff, 0x00, 0x75, 0x0d, 0x1e, 0xa2,
- 0x00, 0x75, 0x11, 0x1e, 0x04, 0x00, 0x75, 0x15,
- 0x1e, 0xa3, 0x00, 0x75, 0x26, 0x4f, 0x3b, 0x00,
- 0x75, 0x54, 0x36, 0xa4, 0x00, 0x75, 0x5d, 0x4e,
- 0xce, 0x00, 0x75, 0xbc, 0x4e, 0xcf, 0x00, 0x75,
- 0xc5, 0x36, 0xb1, 0x00, 0x76, 0x08, 0x4e, 0xd1,
- 0x00, 0x76, 0x26, 0x1e, 0x2d, 0x00, 0x76, 0x52,
- 0x1e, 0x7b, 0x00, 0x76, 0x64, 0x4e, 0xd2, 0x00,
- 0x76, 0x69, 0x4e, 0xd3, 0x00, 0x76, 0x72, 0x35,
- 0x00, 0x00, 0x76, 0x84, 0x36, 0x79, 0x00, 0x76,
- 0x93, 0x1e, 0xa4, 0x00, 0x76, 0xc6, 0x34, 0xc4,
- 0x00, 0x76, 0xca, 0x21, 0x7b, 0x00, 0x76, 0xd4,
- 0x56, 0x1d, 0x00, 0x76, 0xdb, 0x36, 0x2c, 0x00,
- 0x76, 0xdf, 0x36, 0xe5, 0x00, 0x76, 0xf2, 0x36,
- 0xe9, 0x00, 0x76, 0xf4, 0x36, 0x6e, 0x00, 0x77,
- 0x1e, 0x16, 0xb8, 0x00, 0x77, 0x1f, 0x36, 0x1e,
- 0x00, 0x77, 0x37, 0x4e, 0xd5, 0x00, 0x77, 0x3a,
- 0x34, 0xa6, 0x00, 0x77, 0x7e, 0x4e, 0xd6, 0x00,
- 0x77, 0x8d, 0x56, 0x2e, 0x00, 0x77, 0xa2, 0x56,
- 0x2f, 0x00, 0x77, 0xa5, 0x1e, 0x6e, 0x00, 0x77,
- 0xac, 0x34, 0x92, 0x00, 0x77, 0xe9, 0x35, 0xa4,
- 0x00, 0x78, 0x32, 0x36, 0xc7, 0x00, 0x78, 0x3a,
- 0x36, 0x7f, 0x00, 0x78, 0x5d, 0x36, 0x0d, 0x00,
- 0x78, 0x6c, 0x34, 0x83, 0x00, 0x78, 0x7c, 0x1e,
- 0xa5, 0x00, 0x78, 0x91, 0x0d, 0x7e, 0x00, 0x78,
- 0xd4, 0x35, 0x02, 0x00, 0x78, 0xe8, 0x36, 0xda,
- 0x00, 0x78, 0xef, 0x35, 0x4b, 0x00, 0x79, 0x2a,
- 0x35, 0x01, 0x00, 0x79, 0x34, 0x3a, 0x38, 0x00,
- 0x79, 0x3a, 0x08, 0xd4, 0x00, 0x79, 0x3c, 0x21,
- 0x83, 0x00, 0x79, 0x3e, 0x34, 0x24, 0x00, 0x79,
- 0x40, 0x37, 0x57, 0x00, 0x79, 0x41, 0x1d, 0xf4,
- 0x00, 0x79, 0x47, 0x1d, 0xeb, 0x00, 0x79, 0x48,
- 0x06, 0x41, 0x00, 0x79, 0x49, 0x34, 0x21, 0x00,
- 0x79, 0x50, 0x0f, 0x1e, 0x00, 0x79, 0x53, 0x37,
- 0x58, 0x00, 0x79, 0x56, 0x34, 0x2f, 0x00, 0x79,
- 0x5d, 0x09, 0x55, 0x00, 0x79, 0x5e, 0x0a, 0x06,
- 0x00, 0x79, 0x62, 0x1f, 0x29, 0x00, 0x79, 0x65,
- 0x09, 0xb5, 0x00, 0x79, 0x8d, 0x05, 0x52, 0x00,
- 0x79, 0x8e, 0x34, 0x3b, 0x00, 0x79, 0x8f, 0x21,
- 0x87, 0x00, 0x79, 0xa7, 0x4e, 0xd7, 0x00, 0x79,
- 0xae, 0x37, 0x5b, 0x00, 0x79, 0xb0, 0x1e, 0x59,
- 0x00, 0x79, 0xb1, 0x4e, 0xd8, 0x00, 0x79, 0xba,
- 0x35, 0x03, 0x00, 0x79, 0xe4, 0x1e, 0x5d, 0x00,
- 0x7a, 0x0b, 0x36, 0x78, 0x00, 0x7a, 0x17, 0x1e,
- 0x66, 0x00, 0x7a, 0x19, 0x35, 0x04, 0x00, 0x7a,
- 0x31, 0x1e, 0xa6, 0x00, 0x7a, 0x40, 0x08, 0x04,
- 0x00, 0x7a, 0x60, 0x3a, 0x4e, 0x00, 0x7a, 0x74,
- 0x34, 0x7a, 0x00, 0x7a, 0x7a, 0x35, 0xa7, 0x00,
- 0x7a, 0x7f, 0x1f, 0x25, 0x00, 0x7a, 0x81, 0x34,
- 0x3d, 0x00, 0x7a, 0x95, 0x35, 0x05, 0x00, 0x7a,
- 0x97, 0x1f, 0x3c, 0x00, 0x7a, 0xae, 0x34, 0x77,
- 0x00, 0x7a, 0xbe, 0x4e, 0xd9, 0x00, 0x7a, 0xc6,
- 0x3c, 0x27, 0x00, 0x7a, 0xc8, 0x4f, 0x3d, 0x00,
- 0x7b, 0x08, 0x1f, 0x1f, 0x00, 0x7b, 0x51, 0x36,
- 0x63, 0x00, 0x7b, 0x75, 0x4f, 0x2a, 0x00, 0x7b,
- 0x99, 0x1e, 0xa8, 0x00, 0x7b, 0xad, 0x1f, 0x26,
- 0x00, 0x7b, 0xb8, 0x1e, 0x5f, 0x00, 0x7b, 0xc0,
- 0x34, 0x2e, 0x00, 0x7b, 0xc7, 0x1f, 0x2b, 0x00,
- 0x7b, 0xc9, 0x36, 0x61, 0x00, 0x7b, 0xdd, 0x1f,
- 0x3d, 0x00, 0x7b, 0xe0, 0x4e, 0xda, 0x00, 0x7c,
- 0x14, 0x37, 0x5f, 0x00, 0x7c, 0x3e, 0x1f, 0x2d,
- 0x00, 0x7c, 0x3f, 0x36, 0xc2, 0x00, 0x7c, 0x4d,
- 0x36, 0x36, 0x00, 0x7c, 0x50, 0x37, 0x61, 0x00,
- 0x7c, 0x58, 0x37, 0x62, 0x00, 0x7c, 0x69, 0x56,
- 0xaa, 0x00, 0x7c, 0x7e, 0x1e, 0x78, 0x00, 0x7c,
- 0x82, 0x4f, 0x30, 0x00, 0x7c, 0x89, 0x34, 0xbe,
- 0x00, 0x7c, 0x90, 0x1e, 0xa9, 0x00, 0x7c, 0xae,
- 0x1e, 0xaa, 0x00, 0x7c, 0xbe, 0x0a, 0x5e, 0x00,
- 0x7c, 0xd6, 0x0c, 0x76, 0x00, 0x7c, 0xf2, 0x35,
- 0x06, 0x00, 0x7d, 0x04, 0x36, 0xee, 0x00, 0x7d,
- 0x09, 0x4e, 0xdc, 0x00, 0x7d, 0x0b, 0x36, 0xec,
- 0x00, 0x7d, 0x0d, 0x36, 0x94, 0x00, 0x7d, 0x1a,
- 0x35, 0x91, 0x00, 0x7d, 0x1b, 0x34, 0xbf, 0x00,
- 0x7d, 0x42, 0x35, 0xf8, 0x00, 0x7d, 0x46, 0x37,
- 0x63, 0x00, 0x7d, 0x5c, 0x21, 0x90, 0x00, 0x7d,
- 0x5e, 0x34, 0x84, 0x00, 0x7d, 0x63, 0x37, 0x64,
- 0x00, 0x7d, 0x73, 0x35, 0x07, 0x00, 0x7d, 0x9b,
- 0x1e, 0xab, 0x00, 0x7d, 0x9f, 0x1e, 0xad, 0x00,
- 0x7d, 0xae, 0x1e, 0xac, 0x00, 0x7d, 0xb2, 0x4e,
- 0xdd, 0x00, 0x7d, 0xcb, 0x34, 0xb6, 0x00, 0x7d,
- 0xcf, 0x34, 0xa0, 0x00, 0x7d, 0xdd, 0x35, 0x08,
- 0x00, 0x7d, 0xe8, 0x36, 0xbf, 0x00, 0x7d, 0xe9,
- 0x35, 0x7a, 0x00, 0x7d, 0xef, 0x34, 0x62, 0x00,
- 0x7d, 0xf4, 0x0f, 0xc5, 0x00, 0x7e, 0x09, 0x47,
- 0xbe, 0x00, 0x7e, 0x1b, 0x36, 0x9b, 0x00, 0x7e,
- 0x22, 0x37, 0x65, 0x00, 0x7e, 0x2b, 0x36, 0xc8,
- 0x00, 0x7e, 0x35, 0x35, 0x09, 0x00, 0x7e, 0x41,
- 0x34, 0x40, 0x00, 0x7e, 0x43, 0x37, 0x69, 0x00,
- 0x7e, 0x6d, 0x36, 0xe1, 0x00, 0x7e, 0x8c, 0x37,
- 0x6a, 0x00, 0x7f, 0x3e, 0x4e, 0xdf, 0x00, 0x7f,
- 0x50, 0x37, 0x6b, 0x00, 0x7f, 0x61, 0x3c, 0x28,
- 0x00, 0x7f, 0x6a, 0x34, 0x89, 0x00, 0x7f, 0x6e,
- 0x36, 0x60, 0x00, 0x7f, 0x72, 0x09, 0x7a, 0x00,
- 0x7f, 0x80, 0x56, 0xda, 0x00, 0x7f, 0x8a, 0x0f,
- 0x3d, 0x00, 0x7f, 0xa1, 0x36, 0x3d, 0x00, 0x7f,
- 0xae, 0x35, 0x0a, 0x00, 0x7f, 0xbd, 0x04, 0xcb,
- 0x00, 0x7f, 0xc1, 0x34, 0x6a, 0x00, 0x7f, 0xc5,
- 0x37, 0x6f, 0x00, 0x7f, 0xc6, 0x37, 0x70, 0x00,
- 0x7f, 0xcc, 0x37, 0x01, 0x00, 0x7f, 0xd2, 0x35,
- 0xf9, 0x00, 0x7f, 0xd4, 0x1e, 0xae, 0x00, 0x7f,
- 0xe0, 0x1e, 0x20, 0x00, 0x7f, 0xe1, 0x35, 0x0b,
- 0x00, 0x7f, 0xe9, 0x1f, 0x3e, 0x00, 0x7f, 0xeb,
- 0x1d, 0xe9, 0x00, 0x7f, 0xf0, 0x1d, 0xe8, 0x00,
- 0x7f, 0xfb, 0x36, 0xd8, 0x00, 0x7f, 0xfc, 0x34,
- 0xc8, 0x00, 0x80, 0x00, 0x1e, 0x7e, 0x00, 0x80,
- 0x03, 0x34, 0x85, 0x00, 0x80, 0x05, 0x34, 0x25,
- 0x00, 0x80, 0x12, 0x4e, 0xe1, 0x00, 0x80, 0x15,
- 0x35, 0xca, 0x00, 0x80, 0x17, 0x36, 0xea, 0x00,
- 0x80, 0x36, 0x34, 0xc7, 0x00, 0x80, 0x56, 0x36,
- 0x2d, 0x00, 0x80, 0x5a, 0x35, 0x0c, 0x00, 0x80,
- 0x5f, 0x35, 0x0d, 0x00, 0x80, 0x61, 0x34, 0xa1,
- 0x00, 0x80, 0x6f, 0x34, 0xcd, 0x00, 0x80, 0x70,
- 0x35, 0x0f, 0x00, 0x80, 0x71, 0x3c, 0x29, 0x00,
- 0x80, 0x73, 0x35, 0x0e, 0x00, 0x80, 0x74, 0x34,
- 0xa7, 0x00, 0x80, 0x76, 0x35, 0x10, 0x00, 0x80,
- 0x77, 0x34, 0x9a, 0x00, 0x80, 0x7e, 0x34, 0xce,
- 0x00, 0x80, 0x87, 0x36, 0x9c, 0x00, 0x80, 0x89,
- 0x36, 0x8f, 0x00, 0x80, 0x96, 0x36, 0x0e, 0x00,
- 0x80, 0x9e, 0x3c, 0x2a, 0x00, 0x80, 0xa9, 0x35,
- 0xb8, 0x00, 0x80, 0xba, 0x36, 0x97, 0x00, 0x80,
- 0xd6, 0x4e, 0xe3, 0x00, 0x80, 0xde, 0x36, 0xc9,
- 0x00, 0x81, 0x06, 0x36, 0x34, 0x00, 0x81, 0x08,
- 0x34, 0xc6, 0x00, 0x81, 0x09, 0x4e, 0xe4, 0x00,
- 0x81, 0x29, 0x4e, 0xe5, 0x00, 0x81, 0x53, 0x35,
- 0x11, 0x00, 0x81, 0x54, 0x35, 0xcb, 0x00, 0x81,
- 0x70, 0x35, 0xd1, 0x00, 0x81, 0x71, 0x4f, 0x33,
- 0x00, 0x81, 0x7f, 0x1e, 0x30, 0x00, 0x81, 0x8a,
- 0x35, 0x12, 0x00, 0x81, 0xb5, 0x35, 0x13, 0x00,
- 0x81, 0xcd, 0x35, 0x14, 0x00, 0x81, 0xed, 0x34,
- 0x26, 0x00, 0x82, 0x00, 0x57, 0x0f, 0x00, 0x82,
- 0x0c, 0x4e, 0xe6, 0x00, 0x82, 0x18, 0x35, 0x7f,
- 0x00, 0x82, 0x1b, 0x4e, 0xe7, 0x00, 0x82, 0x1c,
- 0x34, 0x93, 0x00, 0x82, 0x1f, 0x35, 0xb3, 0x00,
- 0x82, 0x2e, 0x1e, 0xaf, 0x00, 0x82, 0x39, 0x34,
- 0x9f, 0x00, 0x82, 0x40, 0x4e, 0xe8, 0x00, 0x82,
- 0x47, 0x34, 0xab, 0x00, 0x82, 0x58, 0x37, 0x74,
- 0x00, 0x82, 0x79, 0x37, 0x77, 0x00, 0x82, 0x8d,
- 0x1e, 0xb0, 0x00, 0x82, 0x92, 0x4f, 0x44, 0x00,
- 0x82, 0xa6, 0x1f, 0x19, 0x00, 0x82, 0xb1, 0x35,
- 0x62, 0x00, 0x82, 0xbd, 0x05, 0x6a, 0x00, 0x82,
- 0xc5, 0x35, 0x77, 0x00, 0x82, 0xd2, 0x1e, 0xb1,
- 0x00, 0x82, 0xe3, 0x37, 0x78, 0x00, 0x83, 0x23,
- 0x1e, 0xb2, 0x00, 0x83, 0x28, 0x1f, 0x1a, 0x00,
- 0x83, 0x52, 0x35, 0xcc, 0x00, 0x83, 0x75, 0x1e,
- 0xb3, 0x00, 0x83, 0xbd, 0x37, 0x7c, 0x00, 0x83,
- 0xd3, 0x35, 0x63, 0x00, 0x83, 0xd4, 0x4e, 0xea,
- 0x00, 0x83, 0xdc, 0x35, 0xda, 0x00, 0x83, 0xdf,
- 0x1e, 0x4b, 0x00, 0x83, 0xf2, 0x35, 0x15, 0x00,
- 0x84, 0x0c, 0x36, 0xca, 0x00, 0x84, 0x0f, 0x4e,
- 0xeb, 0x00, 0x84, 0x20, 0x37, 0x7b, 0x00, 0x84,
- 0x22, 0x1f, 0x3f, 0x00, 0x84, 0x57, 0x34, 0x37,
- 0x00, 0x84, 0x5b, 0x1d, 0xe4, 0x00, 0x84, 0x5c,
- 0x57, 0x45, 0x00, 0x84, 0x7a, 0x34, 0xba, 0x00,
- 0x84, 0xea, 0x4e, 0xed, 0x00, 0x84, 0xec, 0x1e,
- 0x72, 0x00, 0x84, 0xee, 0x0f, 0xc7, 0x00, 0x84,
- 0xf4, 0x37, 0x7d, 0x00, 0x85, 0x11, 0x36, 0xbd,
- 0x00, 0x85, 0x17, 0x1e, 0xb4, 0x00, 0x85, 0x3d,
- 0x1e, 0x6d, 0x00, 0x85, 0x43, 0x36, 0xa6, 0x00,
- 0x85, 0x51, 0x4e, 0xef, 0x00, 0x85, 0x55, 0x35,
- 0x16, 0x00, 0x85, 0x5d, 0x57, 0x64, 0x00, 0x85,
- 0x63, 0x4e, 0xf0, 0x00, 0x85, 0x84, 0x36, 0x99,
- 0x00, 0x85, 0x87, 0x37, 0x7f, 0x00, 0x85, 0xa9,
- 0x1e, 0x08, 0x00, 0x85, 0xaf, 0x1e, 0x15, 0x00,
- 0x85, 0xcf, 0x4e, 0xf1, 0x00, 0x85, 0xd5, 0x35,
- 0x17, 0x00, 0x85, 0xe4, 0x36, 0x85, 0x00, 0x85,
- 0xf7, 0x1e, 0x16, 0x00, 0x86, 0x12, 0x21, 0xa4,
- 0x00, 0x86, 0x2d, 0x37, 0x04, 0x00, 0x86, 0x4e,
- 0x4e, 0xf2, 0x00, 0x86, 0x50, 0x35, 0x8c, 0x00,
- 0x86, 0x54, 0x4f, 0x32, 0x00, 0x86, 0x5c, 0x0f,
- 0x82, 0x00, 0x86, 0x5e, 0x35, 0xa6, 0x00, 0x86,
- 0x62, 0x4e, 0xf3, 0x00, 0x86, 0x8a, 0x4e, 0xf4,
- 0x00, 0x86, 0xdb, 0x34, 0x5e, 0x00, 0x86, 0xf8,
- 0x1e, 0x35, 0x00, 0x87, 0x03, 0x4f, 0x48, 0x00,
- 0x87, 0x1a, 0x35, 0x18, 0x00, 0x87, 0x37, 0x37,
- 0x82, 0x00, 0x87, 0x3b, 0x37, 0x83, 0x00, 0x87,
- 0x55, 0x1e, 0x1d, 0x00, 0x87, 0x59, 0x1f, 0x40,
- 0x00, 0x87, 0x82, 0x1e, 0xb6, 0x00, 0x87, 0xa3,
- 0x57, 0xaa, 0x00, 0x87, 0xbd, 0x37, 0x85, 0x00,
- 0x87, 0xd2, 0x1e, 0xb7, 0x00, 0x88, 0x03, 0x3b,
- 0x03, 0x00, 0x88, 0x05, 0x37, 0x84, 0x00, 0x88,
- 0x0e, 0x1f, 0x41, 0x00, 0x88, 0x36, 0x35, 0x19,
- 0x00, 0x88, 0x42, 0x4e, 0xf5, 0x00, 0x88, 0x46,
- 0x35, 0xfa, 0x00, 0x88, 0x4b, 0x57, 0xc3, 0x00,
- 0x88, 0x53, 0x35, 0xfd, 0x00, 0x88, 0x5b, 0x34,
- 0x66, 0x00, 0x88, 0x5e, 0x35, 0x53, 0x00, 0x88,
- 0x63, 0x35, 0x48, 0x00, 0x88, 0x70, 0x36, 0x27,
- 0x00, 0x88, 0x77, 0x4e, 0xf6, 0x00, 0x88, 0x9e,
- 0x35, 0x1a, 0x00, 0x88, 0xd8, 0x35, 0x1b, 0x00,
- 0x88, 0xf4, 0x35, 0x1c, 0x00, 0x89, 0x0a, 0x1e,
- 0xb8, 0x00, 0x89, 0x10, 0x34, 0x13, 0x00, 0x89,
- 0x1c, 0x37, 0xcb, 0x00, 0x89, 0x2b, 0x35, 0x1d,
- 0x00, 0x89, 0x3b, 0x35, 0x1e, 0x00, 0x89, 0x41,
- 0x4e, 0xf7, 0x00, 0x89, 0x56, 0x1d, 0xdd, 0x00,
- 0x89, 0x6a, 0x35, 0x1f, 0x00, 0x89, 0x6f, 0x35,
- 0x20, 0x00, 0x89, 0x81, 0x36, 0xff, 0x00, 0x89,
- 0x86, 0x36, 0xb8, 0x00, 0x89, 0x87, 0x36, 0x95,
- 0x00, 0x89, 0x96, 0x34, 0x22, 0x00, 0x89, 0xaa,
- 0x34, 0x9b, 0x00, 0x89, 0xaf, 0x1e, 0xb9, 0x00,
- 0x89, 0xbd, 0x37, 0x8a, 0x00, 0x89, 0xd2, 0x05,
- 0xaf, 0x00, 0x8a, 0x0a, 0x36, 0x24, 0x00, 0x8a,
- 0x12, 0x37, 0xd7, 0x00, 0x8a, 0x1d, 0x35, 0x21,
- 0x00, 0x8a, 0x1f, 0x34, 0x96, 0x00, 0x8a, 0x3b,
- 0x1e, 0x3c, 0x00, 0x8a, 0x55, 0x36, 0xaf, 0x00,
- 0x8a, 0x6e, 0x1e, 0x28, 0x00, 0x8a, 0x8d, 0x36,
- 0x92, 0x00, 0x8a, 0x95, 0x34, 0xa3, 0x00, 0x8a,
- 0xa0, 0x36, 0x2f, 0x00, 0x8a, 0xa4, 0x35, 0xc2,
- 0x00, 0x8a, 0xb9, 0x34, 0xb7, 0x00, 0x8a, 0xbf,
- 0x36, 0x6d, 0x00, 0x8a, 0xcb, 0x36, 0x30, 0x00,
- 0x8a, 0xdb, 0x37, 0x8b, 0x00, 0x8a, 0xde, 0x1e,
- 0xba, 0x00, 0x8a, 0xed, 0x0f, 0x0b, 0x00, 0x8a,
- 0xee, 0x35, 0xe3, 0x00, 0x8a, 0xf8, 0x09, 0x7e,
- 0x00, 0x8a, 0xfa, 0x1d, 0xfe, 0x00, 0x8b, 0x01,
- 0x04, 0xfc, 0x00, 0x8b, 0x04, 0x36, 0x86, 0x00,
- 0x8b, 0x0e, 0x1e, 0x56, 0x00, 0x8b, 0x19, 0x35,
- 0xb9, 0x00, 0x8b, 0x1b, 0x35, 0xcd, 0x00, 0x8b,
- 0x1d, 0x34, 0x8d, 0x00, 0x8b, 0x2c, 0x1e, 0x69,
- 0x00, 0x8b, 0x39, 0x06, 0xd8, 0x00, 0x8b, 0x3e,
- 0x37, 0x8c, 0x00, 0x8b, 0x41, 0x1e, 0xbb, 0x00,
- 0x8b, 0x56, 0x4e, 0xf8, 0x00, 0x8b, 0x5a, 0x37,
- 0x8d, 0x00, 0x8b, 0x5c, 0x4e, 0xfa, 0x00, 0x8b,
- 0x7f, 0x52, 0x52, 0x00, 0x8c, 0x6a, 0x4e, 0xfd,
- 0x00, 0x8c, 0x79, 0x4e, 0xfe, 0x00, 0x8c, 0x9b,
- 0x58, 0x37, 0x00, 0x8c, 0xa0, 0x36, 0xb5, 0x00,
- 0x8c, 0xa7, 0x34, 0xb8, 0x00, 0x8c, 0xa8, 0x35,
- 0x64, 0x00, 0x8c, 0xab, 0x34, 0x72, 0x00, 0x8c,
- 0xc7, 0x35, 0xe5, 0x00, 0x8c, 0xca, 0x36, 0x4c,
- 0x00, 0x8c, 0xd3, 0x0d, 0xc2, 0x00, 0x8c, 0xed,
- 0x1e, 0x4c, 0x00, 0x8c, 0xfc, 0x34, 0x86, 0x00,
- 0x8d, 0x05, 0x35, 0x22, 0x00, 0x8d, 0x08, 0x34,
- 0x34, 0x00, 0x8d, 0x0f, 0x35, 0x23, 0x00, 0x8d,
- 0x67, 0x4f, 0x00, 0x00, 0x8d, 0x70, 0x36, 0x46,
- 0x00, 0x8d, 0x73, 0x37, 0x8e, 0x00, 0x8d, 0x77,
- 0x35, 0x88, 0x00, 0x8d, 0x99, 0x37, 0x8f, 0x00,
- 0x8d, 0xda, 0x1e, 0xbc, 0x00, 0x8d, 0xdd, 0x35,
- 0x94, 0x00, 0x8d, 0xf3, 0x34, 0xa8, 0x00, 0x8e,
- 0x09, 0x1e, 0xbd, 0x00, 0x8e, 0x34, 0x37, 0x91,
- 0x00, 0x8e, 0x4a, 0x37, 0x92, 0x00, 0x8e, 0x8d,
- 0x36, 0xef, 0x00, 0x8e, 0x91, 0x35, 0x25, 0x00,
- 0x8e, 0xa1, 0x35, 0x26, 0x00, 0x8e, 0xcc, 0x34,
- 0x76, 0x00, 0x8e, 0xd4, 0x3b, 0x4a, 0x00, 0x8f,
- 0x03, 0x4f, 0x02, 0x00, 0x8f, 0x13, 0x1e, 0xbe,
- 0x00, 0x8f, 0x29, 0x34, 0xb0, 0x00, 0x8f, 0x2f,
- 0x34, 0x90, 0x00, 0x8f, 0x38, 0x36, 0xf5, 0x00,
- 0x8f, 0x44, 0x35, 0x75, 0x00, 0x8f, 0xb6, 0x3c,
- 0x2b, 0x00, 0x8f, 0xbb, 0x20, 0x4b, 0x00, 0x8f,
- 0xbc, 0x35, 0xd3, 0x00, 0x8f, 0xbf, 0x1e, 0x37,
- 0x00, 0x8f, 0xc2, 0x1d, 0xd6, 0x00, 0x8f, 0xc4,
- 0x1f, 0x2c, 0x00, 0x8f, 0xc5, 0x36, 0x26, 0x00,
- 0x8f, 0xc6, 0x3b, 0x51, 0x00, 0x8f, 0xce, 0x35,
- 0xae, 0x00, 0x8f, 0xd1, 0x35, 0xa2, 0x00, 0x8f,
- 0xd4, 0x36, 0xc0, 0x00, 0x8f, 0xe6, 0x1d, 0xdf,
- 0x00, 0x8f, 0xe9, 0x1e, 0xc0, 0x00, 0x8f, 0xea,
- 0x1e, 0xbf, 0x00, 0x8f, 0xeb, 0x36, 0x9a, 0x00,
- 0x8f, 0xed, 0x36, 0x7b, 0x00, 0x8f, 0xef, 0x37,
- 0x93, 0x00, 0x8f, 0xf0, 0x35, 0xfe, 0x00, 0x8f,
- 0xf6, 0x4f, 0x06, 0x00, 0x8f, 0xf7, 0x36, 0xe6,
- 0x00, 0x8f, 0xfa, 0x37, 0x95, 0x00, 0x8f, 0xfd,
- 0x36, 0x72, 0x00, 0x90, 0x00, 0x36, 0x51, 0x00,
- 0x90, 0x01, 0x36, 0x47, 0x00, 0x90, 0x03, 0x34,
- 0xad, 0x00, 0x90, 0x06, 0x35, 0x8d, 0x00, 0x90,
- 0x0e, 0x35, 0x28, 0x00, 0x90, 0x0f, 0x36, 0x88,
- 0x00, 0x90, 0x10, 0x36, 0x64, 0x00, 0x90, 0x14,
- 0x36, 0x7e, 0x00, 0x90, 0x17, 0x1e, 0x1f, 0x00,
- 0x90, 0x19, 0x1e, 0x5c, 0x00, 0x90, 0x1a, 0x36,
- 0x73, 0x00, 0x90, 0x1d, 0x1e, 0x22, 0x00, 0x90,
- 0x1e, 0x37, 0x96, 0x00, 0x90, 0x1f, 0x36, 0x4b,
- 0x00, 0x90, 0x20, 0x36, 0x49, 0x00, 0x90, 0x22,
- 0x20, 0x4a, 0x00, 0x90, 0x23, 0x0f, 0xc8, 0x00,
- 0x90, 0x2e, 0x36, 0x52, 0x00, 0x90, 0x31, 0x35,
- 0xfb, 0x00, 0x90, 0x32, 0x36, 0x1f, 0x00, 0x90,
- 0x35, 0x37, 0x97, 0x00, 0x90, 0x38, 0x34, 0x08,
- 0x00, 0x90, 0x39, 0x36, 0x58, 0x00, 0x90, 0x3c,
- 0x1e, 0x67, 0x00, 0x90, 0x41, 0x1e, 0x53, 0x00,
- 0x90, 0x42, 0x34, 0x9c, 0x00, 0x90, 0x47, 0x35,
- 0xa8, 0x00, 0x90, 0x4a, 0x36, 0xfc, 0x00, 0x90,
- 0x4b, 0x35, 0x51, 0x00, 0x90, 0x4d, 0x36, 0xc1,
- 0x00, 0x90, 0x4e, 0x35, 0x65, 0x00, 0x90, 0x50,
- 0x37, 0x98, 0x00, 0x90, 0x52, 0x35, 0x27, 0x00,
- 0x90, 0x53, 0x36, 0x8b, 0x00, 0x90, 0x54, 0x36,
- 0x58, 0x00, 0x90, 0x55, 0x34, 0x63, 0x00, 0x90,
- 0x58, 0x1e, 0xc1, 0x00, 0x90, 0x5c, 0x1e, 0x2e,
- 0x00, 0x90, 0x60, 0x35, 0x5a, 0x00, 0x90, 0x61,
- 0x1e, 0x2a, 0x00, 0x90, 0x63, 0x35, 0xba, 0x00,
- 0x90, 0x69, 0x36, 0x7a, 0x00, 0x90, 0x6d, 0x36,
- 0x48, 0x00, 0x90, 0x6e, 0x1e, 0x0e, 0x00, 0x90,
- 0x75, 0x36, 0x00, 0x00, 0x90, 0x77, 0x36, 0x40,
- 0x00, 0x90, 0x78, 0x36, 0x3f, 0x00, 0x90, 0x7a,
- 0x35, 0x4a, 0x00, 0x90, 0x7c, 0x1e, 0x80, 0x00,
- 0x90, 0x7f, 0x36, 0xa7, 0x00, 0x90, 0x81, 0x37,
- 0x9a, 0x00, 0x90, 0x83, 0x37, 0x5c, 0x00, 0x90,
- 0x84, 0x35, 0x7c, 0x00, 0x90, 0x87, 0x37, 0x94,
- 0x00, 0x90, 0x89, 0x34, 0x5f, 0x00, 0x90, 0x8a,
- 0x37, 0x9b, 0x00, 0x90, 0xa3, 0x1e, 0x55, 0x00,
- 0x90, 0xa6, 0x36, 0xcb, 0x00, 0x90, 0xa8, 0x4f,
- 0x0b, 0x00, 0x90, 0xaa, 0x34, 0x8e, 0x00, 0x90,
- 0xf7, 0x35, 0x9d, 0x00, 0x90, 0xfd, 0x0c, 0x4e,
- 0x00, 0x91, 0x2d, 0x1e, 0x44, 0x00, 0x91, 0x30,
- 0x35, 0x29, 0x00, 0x91, 0x4b, 0x1e, 0x12, 0x00,
- 0x91, 0x4c, 0x35, 0xf2, 0x00, 0x91, 0x4d, 0x4f,
- 0x0c, 0x00, 0x91, 0x56, 0x35, 0x2a, 0x00, 0x91,
- 0x58, 0x35, 0x2b, 0x00, 0x91, 0x65, 0x35, 0x2c,
- 0x00, 0x91, 0x72, 0x35, 0x2e, 0x00, 0x91, 0x73,
- 0x35, 0x2d, 0x00, 0x91, 0x77, 0x35, 0xd0, 0x00,
- 0x91, 0xa2, 0x35, 0x2f, 0x00, 0x91, 0xaa, 0x35,
- 0x31, 0x00, 0x91, 0xaf, 0x35, 0x30, 0x00, 0x91,
- 0xb1, 0x36, 0x9f, 0x00, 0x91, 0xb4, 0x35, 0x32,
- 0x00, 0x91, 0xba, 0x35, 0x33, 0x00, 0x91, 0xc1,
- 0x1e, 0xc3, 0x00, 0x91, 0xc7, 0x1e, 0x05, 0x00,
- 0x91, 0xdc, 0x4f, 0x42, 0x00, 0x91, 0xe3, 0x36,
- 0x75, 0x00, 0x91, 0xfc, 0x3c, 0x2c, 0x00, 0x92,
- 0x37, 0x34, 0x7d, 0x00, 0x92, 0x5b, 0x34, 0x69,
- 0x00, 0x92, 0xe9, 0x4f, 0x0d, 0x00, 0x93, 0x06,
- 0x1e, 0x0a, 0x00, 0x93, 0x35, 0x4f, 0x0e, 0x00,
- 0x93, 0x65, 0x3b, 0x86, 0x00, 0x93, 0x75, 0x4f,
- 0x34, 0x00, 0x93, 0x8b, 0x4f, 0x0f, 0x00, 0x93,
- 0x8c, 0x35, 0x76, 0x00, 0x93, 0x96, 0x35, 0xd5,
- 0x00, 0x93, 0x9a, 0x1e, 0x41, 0x00, 0x93, 0xa1,
- 0x59, 0x04, 0x00, 0x93, 0xae, 0x34, 0x3a, 0x00,
- 0x93, 0xdd, 0x37, 0xae, 0x00, 0x94, 0x3a, 0x4f,
- 0x10, 0x00, 0x94, 0x53, 0x1e, 0x79, 0x00, 0x94,
- 0x77, 0x35, 0x34, 0x00, 0x95, 0x92, 0x35, 0x7d,
- 0x00, 0x95, 0xab, 0x3b, 0x9a, 0x00, 0x95, 0xbb,
- 0x1e, 0xc4, 0x00, 0x95, 0xbc, 0x37, 0xaf, 0x00,
- 0x95, 0xcd, 0x4f, 0x11, 0x00, 0x96, 0x2a, 0x4f,
- 0x12, 0x00, 0x96, 0x4d, 0x34, 0x87, 0x00, 0x96,
- 0x86, 0x34, 0x51, 0x00, 0x96, 0x8a, 0x36, 0x53,
- 0x00, 0x96, 0x94, 0x35, 0x73, 0x00, 0x96, 0x98,
- 0x35, 0x35, 0x00, 0x96, 0x99, 0x4f, 0x31, 0x00,
- 0x96, 0xa3, 0x34, 0xca, 0x00, 0x96, 0xa7, 0x4f,
- 0x14, 0x00, 0x96, 0xb2, 0x37, 0xb1, 0x00, 0x96,
- 0xbb, 0x36, 0x35, 0x00, 0x96, 0xc5, 0x34, 0x6c,
- 0x00, 0x96, 0xc7, 0x35, 0xbe, 0x00, 0x96, 0xd9,
- 0x34, 0xd5, 0x00, 0x96, 0xda, 0x59, 0x3b, 0x00,
- 0x96, 0xe3, 0x0c, 0xc9, 0x00, 0x96, 0xe8, 0x35,
- 0x4d, 0x00, 0x96, 0xea, 0x36, 0x39, 0x00, 0x96,
- 0xf0, 0x34, 0xc0, 0x00, 0x97, 0x21, 0x59, 0x41,
- 0x00, 0x97, 0x24, 0x1e, 0xc6, 0x00, 0x97, 0x3d,
- 0x35, 0x36, 0x00, 0x97, 0x55, 0x21, 0xf8, 0x00,
- 0x97, 0x56, 0x21, 0x8b, 0x00, 0x97, 0x59, 0x37,
- 0xb2, 0x00, 0x97, 0x5c, 0x36, 0x31, 0x00, 0x97,
- 0x60, 0x1e, 0xc7, 0x00, 0x97, 0x6d, 0x1e, 0xc8,
- 0x00, 0x97, 0x71, 0x1e, 0x1e, 0x00, 0x97, 0x74,
- 0x1d, 0xf3, 0x00, 0x97, 0x84, 0x1d, 0xe5, 0x00,
- 0x97, 0x98, 0x1e, 0x1c, 0x00, 0x97, 0xad, 0x4f,
- 0x43, 0x00, 0x97, 0xd3, 0x35, 0x7e, 0x00, 0x97,
- 0xde, 0x3c, 0x2e, 0x00, 0x97, 0xf3, 0x35, 0x60,
- 0x00, 0x97, 0xff, 0x34, 0x19, 0x00, 0x98, 0x0c,
- 0x35, 0x39, 0x00, 0x98, 0x11, 0x34, 0x74, 0x00,
- 0x98, 0x12, 0x34, 0xb2, 0x00, 0x98, 0x13, 0x1e,
- 0x54, 0x00, 0x98, 0x24, 0x1e, 0xc9, 0x00, 0x98,
- 0x3b, 0x0d, 0xc3, 0x00, 0x98, 0x5e, 0x0f, 0xa8,
- 0x00, 0x98, 0x67, 0x35, 0xbf, 0x00, 0x98, 0x73,
- 0x35, 0x3a, 0x00, 0x98, 0xc3, 0x35, 0x3b, 0x00,
- 0x98, 0xdf, 0x36, 0x17, 0x00, 0x98, 0xe2, 0x35,
- 0x89, 0x00, 0x98, 0xeb, 0x37, 0xb4, 0x00, 0x98,
- 0xef, 0x0d, 0x67, 0x00, 0x98, 0xf4, 0x1d, 0xd2,
- 0x00, 0x98, 0xfc, 0x21, 0xfc, 0x00, 0x98, 0xfd,
- 0x36, 0xcd, 0x00, 0x98, 0xfe, 0x36, 0x14, 0x00,
- 0x99, 0x03, 0x37, 0xb5, 0x00, 0x99, 0x05, 0x1e,
- 0x77, 0x00, 0x99, 0x09, 0x37, 0xb6, 0x00, 0x99,
- 0x0a, 0x37, 0x00, 0x00, 0x99, 0x0c, 0x1d, 0xdb,
- 0x00, 0x99, 0x10, 0x1f, 0x22, 0x00, 0x99, 0x13,
- 0x35, 0x68, 0x00, 0x99, 0x21, 0x4f, 0x18, 0x00,
- 0x99, 0x28, 0x21, 0xfe, 0x00, 0x99, 0x45, 0x37,
- 0xb7, 0x00, 0x99, 0x4b, 0x37, 0xb9, 0x00, 0x99,
- 0x57, 0x1f, 0x20, 0x00, 0x99, 0xc1, 0x4f, 0x40,
- 0x00, 0x99, 0xd0, 0x36, 0x67, 0x00, 0x9a, 0x19,
- 0x1f, 0x43, 0x00, 0x9a, 0x30, 0x36, 0x89, 0x00,
- 0x9a, 0x45, 0x35, 0x3c, 0x00, 0x9a, 0x4a, 0x59,
- 0x88, 0x00, 0x9a, 0x5f, 0x37, 0xbb, 0x00, 0x9a,
- 0x65, 0x37, 0xbc, 0x00, 0x9a, 0xef, 0x37, 0xbd,
- 0x00, 0x9b, 0x18, 0x37, 0xbe, 0x00, 0x9b, 0x2d,
- 0x34, 0x3c, 0x00, 0x9b, 0x2e, 0x1e, 0xca, 0x00,
- 0x9b, 0x35, 0x59, 0xa4, 0x00, 0x9b, 0x4d, 0x35,
- 0x3d, 0x00, 0x9b, 0x54, 0x36, 0xdb, 0x00, 0x9b,
- 0x58, 0x35, 0x3e, 0x00, 0x9b, 0x97, 0x1e, 0xcb,
- 0x00, 0x9b, 0xa8, 0x4f, 0x1a, 0x00, 0x9b, 0xab,
- 0x4f, 0x38, 0x00, 0x9b, 0xae, 0x4f, 0x1b, 0x00,
- 0x9b, 0xb9, 0x4f, 0x1c, 0x00, 0x9b, 0xc6, 0x35,
- 0x3f, 0x00, 0x9b, 0xd6, 0x1e, 0x09, 0x00, 0x9b,
- 0xdb, 0x36, 0x54, 0x00, 0x9b, 0xe1, 0x35, 0x40,
- 0x00, 0x9b, 0xf1, 0x35, 0x41, 0x00, 0x9b, 0xf2,
- 0x1e, 0xcc, 0x00, 0x9c, 0x08, 0x4f, 0x1d, 0x00,
- 0x9c, 0x24, 0x4f, 0x1e, 0x00, 0x9c, 0x2f, 0x1d,
- 0xd4, 0x00, 0x9c, 0x3b, 0x4f, 0x1f, 0x00, 0x9c,
- 0x48, 0x1e, 0x39, 0x00, 0x9c, 0x52, 0x1e, 0x74,
- 0x00, 0x9c, 0x57, 0x37, 0x0c, 0x00, 0x9c, 0xe6,
- 0x4f, 0x21, 0x00, 0x9d, 0x07, 0x1e, 0x4f, 0x00,
- 0x9d, 0x08, 0x37, 0xc1, 0x00, 0x9d, 0x09, 0x37,
- 0xc0, 0x00, 0x9d, 0x48, 0x35, 0x42, 0x00, 0x9d,
- 0x60, 0x1e, 0x03, 0x00, 0x9d, 0x6c, 0x36, 0xce,
- 0x00, 0x9d, 0xb4, 0x0b, 0xfd, 0x00, 0x9d, 0xbf,
- 0x59, 0xde, 0x00, 0x9d, 0xc0, 0x4f, 0x22, 0x00,
- 0x9d, 0xc2, 0x4f, 0x23, 0x00, 0x9d, 0xcf, 0x35,
- 0x43, 0x00, 0x9e, 0x97, 0x34, 0xcc, 0x00, 0x9e,
- 0x9f, 0x34, 0xcb, 0x00, 0x9e, 0xa5, 0x37, 0xc2,
- 0x00, 0x9e, 0xaa, 0x1e, 0xcd, 0x00, 0x9e, 0xad,
- 0x1f, 0x44, 0x00, 0x9e, 0xbb, 0x36, 0xdc, 0x00,
- 0x9e, 0xbf, 0x36, 0xe2, 0x00, 0x9e, 0xcc, 0x37,
- 0xc3, 0x00, 0x9e, 0xdb, 0x1e, 0x31, 0x00, 0x9f,
- 0x08, 0x35, 0x44, 0x00, 0x9f, 0x3b, 0x36, 0xa9,
- 0x00, 0x9f, 0x4a, 0x37, 0xc5, 0x00, 0x9f, 0x4b,
- 0x37, 0x5a, 0x00, 0x9f, 0x4e, 0x35, 0x24, 0x00,
- 0x9f, 0x67, 0x37, 0xc7, 0x00, 0x9f, 0x8d, 0x37,
- 0x06, 0x00, 0x9f, 0x9c, 0x1e, 0xce, 0x00, 0x9f,
- 0x9d, 0x1e, 0xa7, 0x00, 0xfa, 0x11, 0x20, 0xfb,
- 0x00, 0xfa, 0x24, 0x21, 0xb8, 0x02, 0x35, 0xc4,
- 0x3c, 0x44, 0x02, 0x36, 0x3a, 0x35, 0x9b, 0x02,
- 0x38, 0x3d, 0x4f, 0x26, 0x02, 0x42, 0xee, 0x37,
- 0xc9, 0x02, 0x62, 0x70, 0x37, 0x6e, 0x02, 0x9d,
- 0x4b, 0x35, 0x96, 0x02, 0x9e, 0x3d, 0x3c, 0x4d,
- 0x02, 0xa6, 0x1a, 0x37, 0xc8, 0x00, 0x00, 0x00,
- 0x7f, 0x00, 0x34, 0x02, 0x35, 0x83, 0x00, 0x50,
- 0x91, 0x35, 0xaf, 0x00, 0x50, 0xca, 0x37, 0x15,
- 0x00, 0x51, 0x54, 0x37, 0x17, 0x00, 0x51, 0x95,
- 0x37, 0x18, 0x00, 0x51, 0xb4, 0x35, 0xdb, 0x00,
- 0x51, 0xde, 0x38, 0x10, 0x00, 0x52, 0x72, 0x4e,
- 0x76, 0x00, 0x53, 0x7f, 0x1d, 0xed, 0x00, 0x53,
- 0xa9, 0x1f, 0x1c, 0x00, 0x55, 0x33, 0x37, 0x21,
- 0x00, 0x55, 0xa9, 0x34, 0xd6, 0x00, 0x55, 0xab,
- 0x4e, 0x7c, 0x00, 0x55, 0xe4, 0x37, 0x22, 0x00,
- 0x56, 0xae, 0x4e, 0x7e, 0x00, 0x57, 0xf4, 0x36,
- 0x13, 0x00, 0x58, 0x5a, 0x20, 0xe6, 0x00, 0x59,
- 0x51, 0x4e, 0x88, 0x00, 0x59, 0xff, 0x35, 0xe1,
- 0x00, 0x5a, 0xbe, 0x34, 0xdc, 0x00, 0x5b, 0xb3,
- 0x35, 0x6b, 0x00, 0x5c, 0x0a, 0x36, 0x4e, 0x00,
- 0x5c, 0x0f, 0x36, 0x0a, 0x00, 0x5e, 0xca, 0x34,
- 0x59, 0x00, 0x5e, 0xe3, 0x4e, 0x93, 0x00, 0x5e,
- 0xf6, 0x35, 0x56, 0x00, 0x60, 0x62, 0x4f, 0x2d,
- 0x00, 0x60, 0x97, 0x37, 0x30, 0x00, 0x61, 0x67,
- 0x35, 0xad, 0x00, 0x61, 0x68, 0x34, 0x6e, 0x00,
- 0x61, 0xb2, 0x4e, 0x98, 0x00, 0x61, 0xf2, 0x36,
- 0x6a, 0x00, 0x62, 0x49, 0x34, 0xb4, 0x00, 0x66,
- 0x5f, 0x37, 0x38, 0x00, 0x66, 0xc1, 0x4e, 0xac,
- 0x00, 0x67, 0x15, 0x36, 0x70, 0x00, 0x67, 0x17,
- 0x21, 0x29, 0x00, 0x67, 0x1b, 0x36, 0xd5, 0x00,
- 0x68, 0x5d, 0x36, 0xde, 0x00, 0x68, 0x7a, 0x36,
- 0xf1, 0x00, 0x69, 0x0d, 0x36, 0x15, 0x00, 0x69,
- 0x82, 0x34, 0x6f, 0x00, 0x6a, 0xdb, 0x35, 0xa9,
- 0x00, 0x6b, 0x21, 0x35, 0xe8, 0x00, 0x6c, 0x08,
- 0x34, 0xf4, 0x00, 0x6c, 0xaa, 0x4e, 0xbb, 0x00,
- 0x6c, 0xbf, 0x34, 0x68, 0x00, 0x6c, 0xe8, 0x32,
- 0x45, 0x00, 0x6d, 0x3e, 0x36, 0x96, 0x00, 0x6e,
- 0x23, 0x34, 0xf6, 0x00, 0x6e, 0xa2, 0x52, 0x4f,
- 0x00, 0x6e, 0xcb, 0x4e, 0xc1, 0x00, 0x6f, 0x11,
- 0x37, 0x45, 0x00, 0x6f, 0x5b, 0x4e, 0xc5, 0x00,
- 0x71, 0x7d, 0x1f, 0x24, 0x00, 0x72, 0x35, 0x35,
- 0xf0, 0x00, 0x73, 0x36, 0x36, 0xf9, 0x00, 0x73,
- 0x37, 0x36, 0xfa, 0x00, 0x73, 0xca, 0x4e, 0xcc,
- 0x00, 0x75, 0x11, 0x35, 0xd2, 0x00, 0x75, 0x15,
- 0x4f, 0x2b, 0x00, 0x79, 0x53, 0x37, 0x59, 0x00,
- 0x7a, 0x74, 0x35, 0xb1, 0x00, 0x7b, 0x08, 0x4f,
- 0x27, 0x00, 0x7b, 0xc0, 0x36, 0x37, 0x00, 0x7c,
- 0x3e, 0x4f, 0x29, 0x00, 0x7c, 0x50, 0x4e, 0xdb,
- 0x00, 0x7c, 0x7e, 0x4f, 0x45, 0x00, 0x7d, 0xb2,
- 0x4e, 0xde, 0x00, 0x7e, 0x22, 0x37, 0x66, 0x00,
- 0x7e, 0x35, 0x37, 0x68, 0x00, 0x7f, 0xc1, 0x35,
- 0x5e, 0x00, 0x7f, 0xe1, 0x4e, 0xe0, 0x00, 0x7f,
- 0xe9, 0x37, 0x71, 0x00, 0x7f, 0xfc, 0x37, 0x02,
- 0x00, 0x81, 0x08, 0x36, 0xe3, 0x00, 0x82, 0x39,
- 0x36, 0x3e, 0x00, 0x82, 0x79, 0x37, 0x76, 0x00,
- 0x82, 0xbd, 0x34, 0x6b, 0x00, 0x83, 0xdf, 0x1f,
- 0x28, 0x00, 0x85, 0x3d, 0x34, 0xc1, 0x00, 0x86,
- 0x12, 0x52, 0x51, 0x00, 0x87, 0xd2, 0x1f, 0x42,
- 0x00, 0x88, 0x05, 0x4f, 0x47, 0x00, 0x88, 0x36,
- 0x37, 0x87, 0x00, 0x8a, 0x0a, 0x36, 0x25, 0x00,
- 0x8a, 0x1d, 0x4f, 0x2c, 0x00, 0x8a, 0x95, 0x36,
- 0x5d, 0x00, 0x8a, 0xee, 0x35, 0xe4, 0x00, 0x8b,
- 0x56, 0x4e, 0xf9, 0x00, 0x8c, 0xa0, 0x36, 0xb6,
- 0x00, 0x8c, 0xc7, 0x35, 0xe6, 0x00, 0x8c, 0xca,
- 0x4e, 0xff, 0x00, 0x8c, 0xfc, 0x35, 0xce, 0x00,
- 0x8f, 0x44, 0x4f, 0x03, 0x00, 0x8f, 0xc5, 0x4f,
- 0x04, 0x00, 0x8f, 0xd4, 0x4f, 0x05, 0x00, 0x90,
- 0x03, 0x36, 0x87, 0x00, 0x90, 0x22, 0x34, 0x60,
- 0x00, 0x90, 0x38, 0x21, 0xb9, 0x00, 0x90, 0x41,
- 0x4f, 0x3f, 0x00, 0x90, 0x42, 0x36, 0x28, 0x00,
- 0x90, 0x55, 0x35, 0x49, 0x00, 0x90, 0x75, 0x36,
- 0x01, 0x00, 0x90, 0x77, 0x4f, 0x07, 0x00, 0x90,
- 0x89, 0x37, 0xa1, 0x00, 0x90, 0x8a, 0x37, 0x9c,
- 0x00, 0x90, 0xa6, 0x36, 0xcc, 0x00, 0x90, 0xaa,
- 0x35, 0xee, 0x00, 0x92, 0x5b, 0x35, 0x5b, 0x00,
- 0x96, 0x86, 0x21, 0xee, 0x00, 0x96, 0x98, 0x4f,
- 0x13, 0x00, 0x96, 0xa3, 0x37, 0x0b, 0x00, 0x96,
- 0xc5, 0x35, 0x67, 0x00, 0x97, 0x5c, 0x36, 0x32,
- 0x00, 0x97, 0x60, 0x35, 0x37, 0x00, 0x97, 0x6d,
- 0x1f, 0x23, 0x00, 0x97, 0x71, 0x35, 0x38, 0x00,
- 0x97, 0xff, 0x35, 0x9e, 0x00, 0x98, 0xef, 0x4f,
- 0x25, 0x00, 0x99, 0x0c, 0x34, 0x65, 0x00, 0x99,
- 0x45, 0x37, 0xb8, 0x00, 0x99, 0x57, 0x35, 0x9f,
- 0x00, 0x9e, 0x9f, 0x37, 0x0d, 0x00, 0x9f, 0x08,
- 0x37, 0xc4, 0x00, 0x9f, 0x8d, 0x37, 0x07, 0x02,
- 0x36, 0x3a, 0x35, 0x9c, 0x00, 0x00, 0x00, 0x11,
- 0x00, 0x51, 0xde, 0x4e, 0x71, 0x00, 0x53, 0xa9,
- 0x34, 0x64, 0x00, 0x56, 0xae, 0x4e, 0x7f, 0x00,
- 0x5b, 0xb3, 0x4e, 0x8f, 0x00, 0x61, 0x68, 0x35,
- 0x6c, 0x00, 0x61, 0xf2, 0x52, 0x50, 0x00, 0x66,
- 0x5f, 0x37, 0x39, 0x00, 0x67, 0x17, 0x37, 0x12,
- 0x00, 0x69, 0x82, 0x35, 0x70, 0x00, 0x75, 0x11,
- 0x4f, 0x3c, 0x00, 0x83, 0xdf, 0x4e, 0xe9, 0x00,
- 0x90, 0x77, 0x4f, 0x08, 0x00, 0x90, 0x89, 0x37,
- 0xa2, 0x00, 0x90, 0x8a, 0x37, 0x9d, 0x00, 0x97,
- 0xff, 0x4f, 0x15, 0x00, 0x99, 0x0c, 0x35, 0x52,
- 0x00, 0x99, 0x57, 0x4f, 0x19, 0x00, 0x00, 0x00,
- 0x06, 0x00, 0x51, 0xde, 0x21, 0x5e, 0x00, 0x53,
- 0xa9, 0x35, 0x4f, 0x00, 0x61, 0x68, 0x35, 0x6d,
- 0x00, 0x90, 0x89, 0x37, 0xa3, 0x00, 0x90, 0x8a,
- 0x37, 0x9e, 0x00, 0x97, 0xff, 0x4f, 0x16, 0x00,
- 0x00, 0x00, 0x04, 0x00, 0x53, 0xa9, 0x4f, 0x2f,
- 0x00, 0x61, 0x68, 0x35, 0x6e, 0x00, 0x90, 0x89,
- 0x37, 0xa4, 0x00, 0x90, 0x8a, 0x37, 0x9f, 0x00,
- 0x00, 0x00, 0x02, 0x00, 0x90, 0x89, 0x37, 0xa5,
- 0x00, 0x90, 0x8a, 0x37, 0xa0, 0x00, 0x00, 0x00,
- 0x02, 0x00, 0x90, 0x89, 0x37, 0xa6, 0x00, 0x90,
- 0x8a, 0x4f, 0x0a, 0x00, 0x00, 0x00, 0x01, 0x00,
- 0x90, 0x89, 0x37, 0xa7, 0x00, 0x00, 0x00, 0x01,
- 0x00, 0x90, 0x89, 0x37, 0xa8, 0x00, 0x00, 0x00,
- 0x01, 0x00, 0x90, 0x89, 0x37, 0xa9, 0x00, 0x00,
- 0x00, 0x01, 0x00, 0x90, 0x89, 0x37, 0xaa, 0x00,
- 0x00, 0x00, 0x01, 0x00, 0x90, 0x89, 0x37, 0xab,
+ 0x27, 0x02, 0xe6, 0xea, 0x37, 0x92, 0x03, 0x13,
+ 0x50, 0x4a, 0xba, 0x00, 0x00, 0x04, 0xb7, 0x00,
+ 0x34, 0x02, 0x35, 0x81, 0x00, 0x4e, 0x08, 0x34,
+ 0x97, 0x00, 0x4e, 0x0e, 0x4e, 0x69, 0x00, 0x4e,
+ 0x19, 0x36, 0xb9, 0x00, 0x4e, 0x26, 0x4e, 0x6a,
+ 0x00, 0x4e, 0x30, 0x3c, 0x1a, 0x00, 0x4e, 0x39,
+ 0x36, 0x5a, 0x00, 0x4e, 0x3b, 0x35, 0xf4, 0x00,
+ 0x4e, 0x73, 0x36, 0x90, 0x00, 0x4e, 0xa1, 0x36,
+ 0xcf, 0x00, 0x4e, 0xa4, 0x34, 0x7f, 0x00, 0x4e,
+ 0xca, 0x35, 0xd4, 0x00, 0x4f, 0x34, 0x36, 0xa0,
+ 0x00, 0x4f, 0x4f, 0x35, 0xfc, 0x00, 0x4f, 0x60,
+ 0x3c, 0x1c, 0x00, 0x4f, 0x73, 0x4e, 0x6c, 0x00,
+ 0x4f, 0x75, 0x34, 0x47, 0x00, 0x4f, 0x7f, 0x34,
+ 0x8a, 0x00, 0x4f, 0xae, 0x34, 0x46, 0x00, 0x4f,
+ 0xb5, 0x36, 0x1b, 0x00, 0x4f, 0xbf, 0x34, 0xc2,
+ 0x00, 0x50, 0x24, 0x36, 0x5f, 0x00, 0x50, 0x26,
+ 0x1d, 0xfa, 0x00, 0x50, 0x49, 0x34, 0x61, 0x00,
+ 0x50, 0x4f, 0x36, 0xbe, 0x00, 0x50, 0x56, 0x4e,
+ 0x6d, 0x00, 0x50, 0x65, 0x34, 0x7b, 0x00, 0x50,
+ 0x85, 0x34, 0xd0, 0x00, 0x50, 0x91, 0x34, 0x79,
+ 0x00, 0x50, 0xc5, 0x1d, 0xee, 0x00, 0x50, 0xca,
+ 0x1f, 0x2e, 0x00, 0x50, 0xcf, 0x34, 0xa2, 0x00,
+ 0x50, 0xe7, 0x34, 0x30, 0x00, 0x50, 0xed, 0x4e,
+ 0x6e, 0x00, 0x50, 0xf2, 0x52, 0xac, 0x00, 0x51,
+ 0x1a, 0x37, 0x16, 0x00, 0x51, 0x32, 0x1e, 0x76,
+ 0x00, 0x51, 0x46, 0x34, 0xa5, 0x00, 0x51, 0x4d,
+ 0x34, 0x4d, 0x00, 0x51, 0x4e, 0x36, 0x7d, 0x00,
+ 0x51, 0x54, 0x10, 0x74, 0x00, 0x51, 0x68, 0x36,
+ 0x42, 0x00, 0x51, 0x6b, 0x4e, 0x6f, 0x00, 0x51,
+ 0x6c, 0x34, 0x80, 0x00, 0x51, 0x77, 0x35, 0xa5,
+ 0x00, 0x51, 0x7c, 0x35, 0xb4, 0x00, 0x51, 0x89,
+ 0x1e, 0x87, 0x00, 0x51, 0x8d, 0x08, 0x36, 0x00,
+ 0x51, 0x92, 0x36, 0xd6, 0x00, 0x51, 0x93, 0x34,
+ 0xd1, 0x00, 0x51, 0x95, 0x10, 0x82, 0x00, 0x51,
+ 0xa4, 0x1e, 0x89, 0x00, 0x51, 0xac, 0x0c, 0x59,
+ 0x00, 0x51, 0xb4, 0x34, 0x5c, 0x00, 0x51, 0xcb,
+ 0x1e, 0x3e, 0x00, 0x51, 0xdb, 0x34, 0xd2, 0x00,
+ 0x51, 0xde, 0x4f, 0x53, 0x00, 0x51, 0xe1, 0x36,
+ 0xd9, 0x00, 0x51, 0xfd, 0x4e, 0x72, 0x00, 0x52,
+ 0x03, 0x36, 0x22, 0x00, 0x52, 0x06, 0x34, 0xbb,
+ 0x00, 0x52, 0x24, 0x36, 0xa1, 0x00, 0x52, 0x38,
+ 0x35, 0xb5, 0x00, 0x52, 0x4a, 0x35, 0xdd, 0x00,
+ 0x52, 0x4d, 0x36, 0x41, 0x00, 0x52, 0x64, 0x4e,
+ 0x74, 0x00, 0x52, 0x71, 0x4e, 0x75, 0x00, 0x52,
+ 0x72, 0x05, 0xc2, 0x00, 0x52, 0x75, 0x1e, 0x2b,
+ 0x00, 0x52, 0x8d, 0x37, 0x1a, 0x00, 0x52, 0xc7,
+ 0x36, 0xf6, 0x00, 0x52, 0xc9, 0x0e, 0x29, 0x00,
+ 0x52, 0xd7, 0x37, 0x1b, 0x00, 0x52, 0xdd, 0x36,
+ 0x05, 0x00, 0x52, 0xe2, 0x36, 0x2a, 0x00, 0x52,
+ 0xe4, 0x34, 0x1a, 0x00, 0x52, 0xfa, 0x09, 0x07,
+ 0x00, 0x53, 0x00, 0x37, 0xcf, 0x00, 0x53, 0x05,
+ 0x36, 0xc3, 0x00, 0x53, 0x07, 0x20, 0xd4, 0x00,
+ 0x53, 0x15, 0x1f, 0x2f, 0x00, 0x53, 0x16, 0x35,
+ 0x61, 0x00, 0x53, 0x39, 0x36, 0xaa, 0x00, 0x53,
+ 0x3f, 0x4e, 0x77, 0x00, 0x53, 0x40, 0x34, 0xd4,
+ 0x00, 0x53, 0x4a, 0x36, 0xa2, 0x00, 0x53, 0x51,
+ 0x0d, 0x70, 0x00, 0x53, 0x5a, 0x36, 0x98, 0x00,
+ 0x53, 0x65, 0x52, 0xf3, 0x00, 0x53, 0x71, 0x35,
+ 0x80, 0x00, 0x53, 0x78, 0x35, 0x5f, 0x00, 0x53,
+ 0x7f, 0x06, 0xa2, 0x00, 0x53, 0xa9, 0x1d, 0xd8,
+ 0x00, 0x53, 0xc9, 0x4f, 0x39, 0x00, 0x53, 0xca,
+ 0x35, 0x8e, 0x00, 0x53, 0xce, 0x34, 0x8f, 0x00,
+ 0x53, 0xd7, 0x35, 0xf5, 0x00, 0x53, 0xdb, 0x1f,
+ 0x2a, 0x00, 0x53, 0xdf, 0x37, 0x1f, 0x00, 0x53,
+ 0xe0, 0x53, 0x00, 0x00, 0x53, 0xf1, 0x1e, 0x0c,
+ 0x00, 0x53, 0xf2, 0x34, 0x8b, 0x00, 0x54, 0x0f,
+ 0x34, 0xc9, 0x00, 0x54, 0x38, 0x35, 0x8f, 0x00,
+ 0x54, 0x40, 0x4e, 0x79, 0x00, 0x54, 0x48, 0x36,
+ 0x76, 0x00, 0x54, 0x68, 0x09, 0x2a, 0x00, 0x54,
+ 0xac, 0x4f, 0x35, 0x00, 0x54, 0xb2, 0x35, 0xdc,
+ 0x00, 0x54, 0xe8, 0x1e, 0x17, 0x00, 0x55, 0x10,
+ 0x36, 0x83, 0x00, 0x55, 0x33, 0x1e, 0x8b, 0x00,
+ 0x55, 0x39, 0x1e, 0x8a, 0x00, 0x55, 0x44, 0x1e,
+ 0x32, 0x00, 0x55, 0x46, 0x36, 0x06, 0x00, 0x55,
+ 0x53, 0x35, 0xaa, 0x00, 0x55, 0x61, 0x38, 0x39,
+ 0x00, 0x55, 0x84, 0x4e, 0x5e, 0x00, 0x55, 0x9c,
+ 0x4e, 0x7b, 0x00, 0x55, 0x9d, 0x1d, 0xe3, 0x00,
+ 0x55, 0xa9, 0x1f, 0x30, 0x00, 0x55, 0xab, 0x35,
+ 0x8b, 0x00, 0x55, 0xb0, 0x1d, 0xf0, 0x00, 0x55,
+ 0xe4, 0x1e, 0x8c, 0x00, 0x56, 0x05, 0x53, 0x2d,
+ 0x00, 0x56, 0x06, 0x0b, 0x70, 0x00, 0x56, 0x09,
+ 0x4e, 0x7d, 0x00, 0x56, 0x32, 0x1e, 0x8d, 0x00,
+ 0x56, 0x42, 0x1d, 0xda, 0x00, 0x56, 0x4c, 0x1e,
+ 0x29, 0x00, 0x56, 0x68, 0x34, 0x15, 0x00, 0x56,
+ 0x74, 0x34, 0xbc, 0x00, 0x56, 0x78, 0x1e, 0x52,
+ 0x00, 0x56, 0xa5, 0x1e, 0x8e, 0x00, 0x56, 0xae,
+ 0x1f, 0x31, 0x00, 0x56, 0xc0, 0x37, 0x24, 0x00,
+ 0x56, 0xc1, 0x34, 0xd7, 0x00, 0x56, 0xce, 0x4e,
+ 0x82, 0x00, 0x56, 0xee, 0x4e, 0x83, 0x00, 0x57,
+ 0x0d, 0x34, 0xd8, 0x00, 0x57, 0x47, 0x34, 0x78,
+ 0x00, 0x57, 0x6a, 0x36, 0x74, 0x00, 0x57, 0xce,
+ 0x09, 0xd3, 0x00, 0x57, 0xd6, 0x4e, 0x84, 0x00,
+ 0x57, 0xf4, 0x34, 0x98, 0x00, 0x58, 0x0b, 0x1e,
+ 0x8f, 0x00, 0x58, 0x19, 0x1f, 0x32, 0x00, 0x58,
+ 0x35, 0x1e, 0x49, 0x00, 0x58, 0x3d, 0x4e, 0x85,
+ 0x00, 0x58, 0x40, 0x34, 0x48, 0x00, 0x58, 0x58,
+ 0x1e, 0x4d, 0x00, 0x58, 0x59, 0x4e, 0x86, 0x00,
+ 0x58, 0x5a, 0x1e, 0x42, 0x00, 0x58, 0x9c, 0x36,
+ 0x71, 0x00, 0x58, 0xa8, 0x0e, 0x7d, 0x00, 0x58,
+ 0xab, 0x34, 0xd9, 0x00, 0x59, 0x06, 0x53, 0x7b,
+ 0x00, 0x59, 0x1b, 0x1f, 0x33, 0x00, 0x59, 0x27,
+ 0x36, 0x55, 0x00, 0x59, 0x4f, 0x4e, 0x87, 0x00,
+ 0x59, 0x51, 0x35, 0xab, 0x00, 0x59, 0x53, 0x37,
+ 0xd1, 0x00, 0x59, 0x60, 0x4e, 0x89, 0x00, 0x59,
+ 0x62, 0x4e, 0x8a, 0x00, 0x59, 0x73, 0x36, 0x04,
+ 0x00, 0x59, 0x84, 0x36, 0xe7, 0x00, 0x59, 0xa5,
+ 0x36, 0x4f, 0x00, 0x59, 0xc9, 0x34, 0x8c, 0x00,
+ 0x59, 0xda, 0x34, 0xda, 0x00, 0x59, 0xec, 0x36,
+ 0xae, 0x00, 0x59, 0xff, 0x35, 0xe0, 0x00, 0x5a,
+ 0x1c, 0x37, 0x26, 0x00, 0x5a, 0x29, 0x1e, 0x6f,
+ 0x00, 0x5a, 0x36, 0x34, 0xdb, 0x00, 0x5a, 0x66,
+ 0x36, 0xb2, 0x00, 0x5a, 0x9b, 0x1e, 0x68, 0x00,
+ 0x5a, 0xbe, 0x1e, 0x90, 0x00, 0x5a, 0xc2, 0x37,
+ 0x27, 0x00, 0x5a, 0xcc, 0x1d, 0xfb, 0x00, 0x5a,
+ 0xda, 0x4e, 0x8b, 0x00, 0x5b, 0x5a, 0x4e, 0x8c,
+ 0x00, 0x5b, 0x73, 0x4e, 0x8d, 0x00, 0x5b, 0x7c,
+ 0x4e, 0x8e, 0x00, 0x5b, 0xb3, 0x34, 0x6d, 0x00,
+ 0x5b, 0xb5, 0x36, 0x07, 0x00, 0x5b, 0xc3, 0x37,
+ 0x29, 0x00, 0x5b, 0xd2, 0x35, 0x78, 0x00, 0x5b,
+ 0xdb, 0x20, 0xf4, 0x00, 0x5b, 0xe7, 0x0c, 0xe1,
+ 0x00, 0x5b, 0xe8, 0x37, 0x42, 0x00, 0x5c, 0x06,
+ 0x09, 0x95, 0x00, 0x5c, 0x0a, 0x36, 0x4d, 0x00,
+ 0x5c, 0x0b, 0x36, 0x23, 0x00, 0x5c, 0x0e, 0x36,
+ 0x8a, 0x00, 0x5c, 0x0f, 0x36, 0x09, 0x00, 0x5c,
+ 0x28, 0x1f, 0x34, 0x00, 0x5c, 0x51, 0x1d, 0xf2,
+ 0x00, 0x5c, 0x60, 0x1e, 0x4a, 0x00, 0x5c, 0x64,
+ 0x34, 0x31, 0x00, 0x5c, 0x6e, 0x12, 0x32, 0x00,
+ 0x5d, 0x29, 0x36, 0xc4, 0x00, 0x5d, 0x4e, 0x34,
+ 0xdd, 0x00, 0x5d, 0x87, 0x34, 0xde, 0x00, 0x5d,
+ 0xb2, 0x3c, 0x2d, 0x00, 0x5d, 0xc9, 0x34, 0xdf,
+ 0x00, 0x5d, 0xcc, 0x34, 0x73, 0x00, 0x5d, 0xd3,
+ 0x34, 0xe0, 0x00, 0x5d, 0xe1, 0x35, 0xff, 0x00,
+ 0x5d, 0xe5, 0x35, 0xc3, 0x00, 0x5d, 0xe8, 0x35,
+ 0x92, 0x00, 0x5d, 0xf7, 0x1d, 0xff, 0x00, 0x5d,
+ 0xfd, 0x0b, 0x65, 0x00, 0x5e, 0x06, 0x36, 0xa3,
+ 0x00, 0x5e, 0x1d, 0x36, 0x77, 0x00, 0x5e, 0x30,
+ 0x34, 0x75, 0x00, 0x5e, 0x3d, 0x36, 0xd0, 0x00,
+ 0x5e, 0x43, 0x4e, 0x91, 0x00, 0x5e, 0x54, 0x37,
+ 0x2d, 0x00, 0x5e, 0x63, 0x36, 0xba, 0x00, 0x5e,
+ 0x64, 0x1e, 0x93, 0x00, 0x5e, 0x73, 0x36, 0xbb,
+ 0x00, 0x5e, 0x7e, 0x35, 0x84, 0x00, 0x5e, 0x96,
+ 0x1e, 0x70, 0x00, 0x5e, 0xa7, 0x4e, 0x92, 0x00,
+ 0x5e, 0xad, 0x34, 0xa9, 0x00, 0x5e, 0xc9, 0x0f,
+ 0xbf, 0x00, 0x5e, 0xca, 0x4f, 0x4f, 0x00, 0x5e,
+ 0xcb, 0x38, 0xae, 0x00, 0x5e, 0xcf, 0x1f, 0x36,
+ 0x00, 0x5e, 0xd0, 0x1f, 0x35, 0x00, 0x5e, 0xdf,
+ 0x1e, 0x6a, 0x00, 0x5e, 0xe0, 0x1e, 0x18, 0x00,
+ 0x5e, 0xe3, 0x37, 0x2f, 0x00, 0x5e, 0xf6, 0x34,
+ 0x67, 0x00, 0x5e, 0xf7, 0x34, 0xaa, 0x00, 0x5e,
+ 0xfa, 0x34, 0x7c, 0x00, 0x5e, 0xfb, 0x35, 0x69,
+ 0x00, 0x5f, 0x0a, 0x36, 0xbc, 0x00, 0x5f, 0x2d,
+ 0x34, 0xe1, 0x00, 0x5f, 0x31, 0x35, 0xf3, 0x00,
+ 0x5f, 0x38, 0x4e, 0x94, 0x00, 0x5f, 0x45, 0x37,
+ 0xce, 0x00, 0x5f, 0x50, 0x3c, 0x1f, 0x00, 0x5f,
+ 0x62, 0x4e, 0x5f, 0x00, 0x5f, 0x69, 0x35, 0xd7,
+ 0x00, 0x5f, 0x6b, 0x36, 0x68, 0x00, 0x5f, 0x80,
+ 0x35, 0x5d, 0x00, 0x5f, 0x98, 0x34, 0xe2, 0x00,
+ 0x5f, 0xa1, 0x4e, 0x95, 0x00, 0x5f, 0xae, 0x36,
+ 0xa8, 0x00, 0x5f, 0xb5, 0x36, 0x69, 0x00, 0x5f,
+ 0xbd, 0x1d, 0xea, 0x00, 0x5f, 0xcd, 0x36, 0x91,
+ 0x00, 0x5f, 0xd8, 0x36, 0xd1, 0x00, 0x5f, 0xd9,
+ 0x36, 0xd2, 0x00, 0x5f, 0xdd, 0x4e, 0x96, 0x00,
+ 0x60, 0x25, 0x35, 0x90, 0x00, 0x60, 0x50, 0x35,
+ 0x99, 0x00, 0x60, 0x62, 0x1d, 0xe0, 0x00, 0x60,
+ 0x65, 0x34, 0xa4, 0x00, 0x60, 0x75, 0x35, 0xac,
+ 0x00, 0x60, 0x94, 0x05, 0x79, 0x00, 0x60, 0x97,
+ 0x1e, 0x94, 0x00, 0x60, 0x9e, 0x54, 0x36, 0x00,
+ 0x60, 0xa4, 0x3c, 0x20, 0x00, 0x60, 0xb2, 0x34,
+ 0xb3, 0x00, 0x60, 0xc5, 0x36, 0x12, 0x00, 0x60,
+ 0xd8, 0x34, 0xe3, 0x00, 0x61, 0x08, 0x1e, 0x7a,
+ 0x00, 0x61, 0x09, 0x36, 0xf3, 0x00, 0x61, 0x0f,
+ 0x35, 0x47, 0x00, 0x61, 0x3d, 0x34, 0xe4, 0x00,
+ 0x61, 0x48, 0x4e, 0x60, 0x00, 0x61, 0x4c, 0x35,
+ 0xc4, 0x00, 0x61, 0x4e, 0x34, 0x2c, 0x00, 0x61,
+ 0x62, 0x4e, 0x97, 0x00, 0x61, 0x67, 0x1d, 0xf5,
+ 0x00, 0x61, 0x68, 0x34, 0x10, 0x00, 0x61, 0x8e,
+ 0x0b, 0x00, 0x00, 0x61, 0x90, 0x37, 0x10, 0x00,
+ 0x61, 0xa4, 0x34, 0xbd, 0x00, 0x61, 0xb2, 0x35,
+ 0xb6, 0x00, 0x61, 0xf2, 0x34, 0x39, 0x00, 0x61,
+ 0xf8, 0x4e, 0x99, 0x00, 0x61, 0xfe, 0x34, 0xe5,
+ 0x00, 0x62, 0x10, 0x36, 0x2b, 0x00, 0x62, 0x3b,
+ 0x36, 0xeb, 0x00, 0x62, 0x3f, 0x36, 0xd3, 0x00,
+ 0x62, 0x40, 0x36, 0x02, 0x00, 0x62, 0x41, 0x1f,
+ 0x37, 0x00, 0x62, 0x47, 0x36, 0x3b, 0x00, 0x62,
+ 0x48, 0x1e, 0xc2, 0x00, 0x62, 0x49, 0x1e, 0x63,
+ 0x00, 0x62, 0x68, 0x34, 0xe6, 0x00, 0x62, 0x71,
+ 0x35, 0x45, 0x00, 0x62, 0xb1, 0x36, 0xc5, 0x00,
+ 0x62, 0xcc, 0x37, 0x32, 0x00, 0x62, 0xcf, 0x34,
+ 0xe7, 0x00, 0x62, 0xd0, 0x1d, 0xe1, 0x00, 0x62,
+ 0xd2, 0x35, 0x93, 0x00, 0x62, 0xd4, 0x13, 0x5d,
+ 0x00, 0x62, 0xf3, 0x1f, 0x21, 0x00, 0x62, 0xf7,
+ 0x34, 0x88, 0x00, 0x63, 0x3a, 0x4f, 0x3e, 0x00,
+ 0x63, 0x3d, 0x1e, 0x62, 0x00, 0x63, 0x4c, 0x34,
+ 0x5d, 0x00, 0x63, 0x57, 0x1e, 0x3f, 0x00, 0x63,
+ 0x67, 0x34, 0xc3, 0x00, 0x63, 0x68, 0x35, 0xec,
+ 0x00, 0x63, 0x69, 0x1e, 0x95, 0x00, 0x63, 0x6e,
+ 0x34, 0x9d, 0x00, 0x63, 0x72, 0x1d, 0xfc, 0x00,
+ 0x63, 0x83, 0x36, 0x43, 0x00, 0x63, 0x88, 0x35,
+ 0xf6, 0x00, 0x63, 0x92, 0x34, 0xaf, 0x00, 0x63,
+ 0xa1, 0x35, 0xd8, 0x00, 0x63, 0xa7, 0x35, 0xc6,
+ 0x00, 0x63, 0xc3, 0x1f, 0x27, 0x00, 0x63, 0xc6,
+ 0x37, 0x34, 0x00, 0x63, 0xf4, 0x35, 0x57, 0x00,
+ 0x64, 0x06, 0x1e, 0x96, 0x00, 0x64, 0x0f, 0x34,
+ 0xe9, 0x00, 0x64, 0x1c, 0x37, 0x33, 0x00, 0x64,
+ 0x28, 0x37, 0x35, 0x00, 0x64, 0x42, 0x34, 0x9e,
+ 0x00, 0x64, 0x69, 0x36, 0xd7, 0x00, 0x64, 0x6f,
+ 0x4f, 0x28, 0x00, 0x64, 0x7a, 0x1e, 0x21, 0x00,
+ 0x64, 0xb0, 0x1e, 0x24, 0x00, 0x64, 0xe2, 0x1e,
+ 0x45, 0x00, 0x64, 0xf2, 0x34, 0xea, 0x00, 0x64,
+ 0xf6, 0x4e, 0x9e, 0x00, 0x65, 0x1d, 0x34, 0xe8,
+ 0x00, 0x65, 0x4f, 0x0d, 0xc4, 0x00, 0x65, 0x5d,
+ 0x34, 0xeb, 0x00, 0x65, 0x5e, 0x4e, 0xa1, 0x00,
+ 0x65, 0x62, 0x34, 0x71, 0x00, 0x65, 0x77, 0x36,
+ 0xb3, 0x00, 0x65, 0x83, 0x1e, 0x98, 0x00, 0x65,
+ 0x87, 0x4e, 0xa3, 0x00, 0x65, 0x89, 0x4e, 0xa4,
+ 0x00, 0x65, 0x8e, 0x4e, 0xa6, 0x00, 0x65, 0x90,
+ 0x34, 0xb5, 0x00, 0x65, 0x9c, 0x35, 0xed, 0x00,
+ 0x65, 0xa7, 0x4f, 0x41, 0x00, 0x65, 0xbc, 0x35,
+ 0x5c, 0x00, 0x65, 0xc5, 0x37, 0x08, 0x00, 0x65,
+ 0xdf, 0x54, 0xbe, 0x00, 0x65, 0xe1, 0x4e, 0xa9,
+ 0x00, 0x65, 0xe2, 0x06, 0x37, 0x00, 0x66, 0x0e,
+ 0x36, 0xe4, 0x00, 0x66, 0x1e, 0x21, 0x1c, 0x00,
+ 0x66, 0x5f, 0x34, 0xec, 0x00, 0x66, 0x66, 0x1d,
+ 0xe2, 0x00, 0x66, 0x67, 0x4e, 0xaa, 0x00, 0x66,
+ 0x69, 0x36, 0xa5, 0x00, 0x66, 0x6e, 0x4e, 0xab,
+ 0x00, 0x66, 0x74, 0x0a, 0x56, 0x00, 0x66, 0x77,
+ 0x39, 0x11, 0x00, 0x66, 0x81, 0x35, 0xa0, 0x00,
+ 0x66, 0x91, 0x34, 0x28, 0x00, 0x66, 0x96, 0x36,
+ 0x5e, 0x00, 0x66, 0x97, 0x35, 0x46, 0x00, 0x66,
+ 0xb5, 0x54, 0xda, 0x00, 0x66, 0xc1, 0x1f, 0x38,
+ 0x00, 0x66, 0xd9, 0x1e, 0x13, 0x00, 0x66, 0xdc,
+ 0x36, 0xfd, 0x00, 0x66, 0xf4, 0x34, 0x81, 0x00,
+ 0x66, 0xf5, 0x37, 0x3b, 0x00, 0x66, 0xf8, 0x36,
+ 0x03, 0x00, 0x66, 0xfb, 0x37, 0xcd, 0x00, 0x66,
+ 0xfc, 0x37, 0x20, 0x00, 0x67, 0x00, 0x4e, 0xaf,
+ 0x00, 0x67, 0x08, 0x35, 0xb2, 0x00, 0x67, 0x09,
+ 0x36, 0xf7, 0x00, 0x67, 0x0b, 0x36, 0xc6, 0x00,
+ 0x67, 0x0d, 0x36, 0xb7, 0x00, 0x67, 0x15, 0x36,
+ 0x6f, 0x00, 0x67, 0x17, 0x0f, 0xd5, 0x00, 0x67,
+ 0x1b, 0x36, 0xd4, 0x00, 0x67, 0x1d, 0x36, 0x6b,
+ 0x00, 0x67, 0x1f, 0x35, 0x86, 0x00, 0x67, 0x53,
+ 0x1e, 0x0f, 0x00, 0x67, 0x56, 0x4f, 0x3a, 0x00,
+ 0x67, 0x5e, 0x37, 0x3c, 0x00, 0x67, 0x61, 0x4e,
+ 0xb0, 0x00, 0x67, 0x7e, 0x34, 0x95, 0x00, 0x67,
+ 0xa6, 0x1e, 0x99, 0x00, 0x67, 0xa9, 0x34, 0xed,
+ 0x00, 0x67, 0xc4, 0x4e, 0xb1, 0x00, 0x67, 0xca,
+ 0x1e, 0x65, 0x00, 0x67, 0xd4, 0x34, 0x91, 0x00,
+ 0x67, 0xe7, 0x34, 0xee, 0x00, 0x67, 0xf1, 0x36,
+ 0x65, 0x00, 0x68, 0x01, 0x21, 0x2e, 0x00, 0x68,
+ 0x02, 0x4e, 0xb2, 0x00, 0x68, 0x13, 0x1e, 0x25,
+ 0x00, 0x68, 0x1f, 0x4e, 0x61, 0x00, 0x68, 0x21,
+ 0x34, 0x82, 0x00, 0x68, 0x43, 0x34, 0xac, 0x00,
+ 0x68, 0x52, 0x21, 0x2c, 0x00, 0x68, 0x5d, 0x34,
+ 0xc5, 0x00, 0x68, 0x7a, 0x36, 0xf0, 0x00, 0x68,
+ 0x81, 0x37, 0x09, 0x00, 0x68, 0x85, 0x0d, 0x15,
+ 0x00, 0x68, 0x8d, 0x37, 0x3e, 0x00, 0x68, 0x97,
+ 0x4f, 0x37, 0x00, 0x68, 0x9b, 0x1e, 0x9b, 0x00,
+ 0x68, 0x9d, 0x37, 0x3d, 0x00, 0x68, 0xa2, 0x1e,
+ 0x19, 0x00, 0x68, 0xc8, 0x37, 0xcc, 0x00, 0x68,
+ 0xda, 0x1e, 0x38, 0x00, 0x69, 0x0d, 0x34, 0x99,
+ 0x00, 0x69, 0x30, 0x34, 0xf0, 0x00, 0x69, 0x3d,
+ 0x4e, 0xb3, 0x00, 0x69, 0x5e, 0x4e, 0xb4, 0x00,
+ 0x69, 0x62, 0x1e, 0x58, 0x00, 0x69, 0x6b, 0x34,
+ 0xef, 0x00, 0x69, 0x6f, 0x34, 0x94, 0x00, 0x69,
+ 0x82, 0x34, 0x5b, 0x00, 0x69, 0x8a, 0x1e, 0x06,
+ 0x00, 0x69, 0x94, 0x1e, 0x84, 0x00, 0x69, 0xa7,
+ 0x34, 0xf1, 0x00, 0x69, 0xbb, 0x37, 0x43, 0x00,
+ 0x69, 0xc1, 0x35, 0x9a, 0x00, 0x69, 0xcb, 0x35,
+ 0xc7, 0x00, 0x69, 0xcc, 0x1e, 0x40, 0x00, 0x69,
+ 0xd9, 0x36, 0xdd, 0x00, 0x69, 0xea, 0x35, 0x6f,
+ 0x00, 0x69, 0xfe, 0x55, 0x1f, 0x00, 0x6a, 0x0b,
+ 0x1e, 0x64, 0x00, 0x6a, 0x3d, 0x1e, 0x3a, 0x00,
+ 0x6a, 0x44, 0x34, 0xf2, 0x00, 0x6a, 0x55, 0x55,
+ 0x25, 0x00, 0x6a, 0x5f, 0x35, 0x87, 0x00, 0x6a,
+ 0x73, 0x37, 0xd4, 0x00, 0x6a, 0x8e, 0x34, 0x7e,
+ 0x00, 0x6a, 0x90, 0x34, 0xf3, 0x00, 0x6a, 0x9c,
+ 0x4e, 0xb6, 0x00, 0x6a, 0xdb, 0x06, 0xf3, 0x00,
+ 0x6b, 0x04, 0x0f, 0x5d, 0x00, 0x6b, 0x1d, 0x1d,
+ 0xd7, 0x00, 0x6b, 0x21, 0x35, 0xe7, 0x00, 0x6b,
+ 0x24, 0x3c, 0x22, 0x00, 0x6b, 0x4e, 0x36, 0x5b,
+ 0x00, 0x6b, 0x96, 0x36, 0x16, 0x00, 0x6b, 0xba,
+ 0x08, 0x74, 0x00, 0x6b, 0xbb, 0x34, 0x70, 0x00,
+ 0x6c, 0x08, 0x1f, 0x39, 0x00, 0x6c, 0x13, 0x34,
+ 0xf5, 0x00, 0x6c, 0x38, 0x4e, 0xba, 0x00, 0x6c,
+ 0x3a, 0x39, 0x62, 0x00, 0x6c, 0x72, 0x1f, 0x1e,
+ 0x00, 0x6c, 0xaa, 0x37, 0x48, 0x00, 0x6c, 0xbf,
+ 0x05, 0x0a, 0x00, 0x6c, 0xe1, 0x1e, 0x71, 0x00,
+ 0x6c, 0xe8, 0x36, 0x66, 0x00, 0x6d, 0x3e, 0x34,
+ 0xae, 0x00, 0x6d, 0x69, 0x35, 0xc8, 0x00, 0x6d,
+ 0x6e, 0x36, 0xb4, 0x00, 0x6d, 0x77, 0x05, 0x82,
+ 0x00, 0x6d, 0x78, 0x36, 0x1d, 0x00, 0x6d, 0x88,
+ 0x36, 0x0c, 0x00, 0x6d, 0xe4, 0x4e, 0xbd, 0x00,
+ 0x6d, 0xeb, 0x1d, 0xd5, 0x00, 0x6d, 0xfb, 0x36,
+ 0x7c, 0x00, 0x6e, 0x08, 0x4e, 0xbf, 0x00, 0x6e,
+ 0x1a, 0x09, 0x77, 0x00, 0x6e, 0x23, 0x1f, 0x3a,
+ 0x00, 0x6e, 0x2f, 0x35, 0xc9, 0x00, 0x6e, 0x6e,
+ 0x1e, 0x9d, 0x00, 0x6e, 0x72, 0x4e, 0xc0, 0x00,
+ 0x6e, 0x7e, 0x34, 0xcf, 0x00, 0x6e, 0x9d, 0x1e,
+ 0x01, 0x00, 0x6e, 0xa2, 0x1d, 0xd3, 0x00, 0x6e,
+ 0xba, 0x1e, 0x46, 0x00, 0x6e, 0xcb, 0x35, 0xe9,
+ 0x00, 0x6e, 0xd5, 0x4e, 0xc2, 0x00, 0x6e, 0xdb,
+ 0x4e, 0xc3, 0x00, 0x6e, 0xec, 0x1f, 0x3b, 0x00,
+ 0x6e, 0xfe, 0x34, 0xf8, 0x00, 0x6f, 0x11, 0x34,
+ 0xf7, 0x00, 0x6f, 0x22, 0x34, 0x14, 0x00, 0x6f,
+ 0x23, 0x0f, 0xc2, 0x00, 0x6f, 0x3e, 0x34, 0xf9,
+ 0x00, 0x6f, 0x51, 0x36, 0x9e, 0x00, 0x6f, 0x54,
+ 0x35, 0xb0, 0x00, 0x6f, 0x5b, 0x4e, 0xc4, 0x00,
+ 0x6f, 0x64, 0x4e, 0xc6, 0x00, 0x6f, 0x6e, 0x0b,
+ 0xc8, 0x00, 0x6f, 0x74, 0x4e, 0xc7, 0x00, 0x6f,
+ 0x98, 0x37, 0x47, 0x00, 0x6f, 0xef, 0x1e, 0x33,
+ 0x00, 0x6f, 0xf9, 0x39, 0x95, 0x00, 0x70, 0x15,
+ 0x1e, 0x6b, 0x00, 0x70, 0x1b, 0x37, 0x4a, 0x00,
+ 0x70, 0x1e, 0x1e, 0x51, 0x00, 0x70, 0x26, 0x1e,
+ 0x3d, 0x00, 0x70, 0x27, 0x36, 0x57, 0x00, 0x70,
+ 0x4a, 0x39, 0x98, 0x00, 0x70, 0x58, 0x1e, 0x57,
+ 0x00, 0x70, 0x70, 0x35, 0x6a, 0x00, 0x70, 0x78,
+ 0x4f, 0x2e, 0x00, 0x70, 0x7c, 0x1e, 0x10, 0x00,
+ 0x70, 0xad, 0x36, 0x5c, 0x00, 0x71, 0x49, 0x0f,
+ 0xc3, 0x00, 0x71, 0x4e, 0x1e, 0x26, 0x00, 0x71,
+ 0x52, 0x55, 0xad, 0x00, 0x71, 0x59, 0x35, 0x59,
+ 0x00, 0x71, 0x62, 0x37, 0x4b, 0x00, 0x71, 0x6e,
+ 0x08, 0xfd, 0x00, 0x71, 0x7d, 0x1e, 0x27, 0x00,
+ 0x71, 0x94, 0x1e, 0x7d, 0x00, 0x71, 0xb3, 0x39,
+ 0xae, 0x00, 0x71, 0xd0, 0x37, 0x0a, 0x00, 0x71,
+ 0xff, 0x34, 0xfa, 0x00, 0x72, 0x28, 0x15, 0xdf,
+ 0x00, 0x72, 0x2b, 0x3c, 0x26, 0x00, 0x72, 0x35,
+ 0x09, 0x0b, 0x00, 0x72, 0x36, 0x34, 0xb9, 0x00,
+ 0x72, 0x3a, 0x4f, 0x46, 0x00, 0x72, 0x3b, 0x37,
+ 0x4c, 0x00, 0x72, 0x3e, 0x4e, 0xc9, 0x00, 0x72,
+ 0x4c, 0x1e, 0x5b, 0x00, 0x72, 0x59, 0x1f, 0x1d,
+ 0x00, 0x72, 0xe1, 0x4f, 0x36, 0x00, 0x73, 0x1c,
+ 0x37, 0x4e, 0x00, 0x73, 0x2a, 0x0b, 0xb4, 0x00,
+ 0x73, 0x36, 0x36, 0xf8, 0x00, 0x73, 0x37, 0x1e,
+ 0x7c, 0x00, 0x73, 0x87, 0x37, 0x05, 0x00, 0x73,
+ 0x8b, 0x35, 0xa1, 0x00, 0x73, 0xca, 0x1e, 0x0b,
+ 0x00, 0x73, 0xce, 0x1e, 0xa0, 0x00, 0x73, 0xe5,
+ 0x34, 0xfb, 0x00, 0x73, 0xed, 0x34, 0xb1, 0x00,
+ 0x74, 0x22, 0x0b, 0x56, 0x00, 0x74, 0x32, 0x34,
+ 0xfc, 0x00, 0x74, 0x5f, 0x34, 0xfd, 0x00, 0x74,
+ 0x62, 0x21, 0x71, 0x00, 0x74, 0xb0, 0x35, 0x79,
+ 0x00, 0x74, 0xbd, 0x4e, 0xcd, 0x00, 0x74, 0xca,
+ 0x37, 0x4f, 0x00, 0x74, 0xd8, 0x55, 0xf6, 0x00,
+ 0x74, 0xdc, 0x35, 0x50, 0x00, 0x74, 0xe0, 0x34,
+ 0xfe, 0x00, 0x74, 0xef, 0x55, 0xfa, 0x00, 0x75,
+ 0x04, 0x1e, 0xa1, 0x00, 0x75, 0x0c, 0x34, 0xff,
+ 0x00, 0x75, 0x0d, 0x1e, 0xa2, 0x00, 0x75, 0x11,
+ 0x1e, 0x04, 0x00, 0x75, 0x15, 0x1e, 0xa3, 0x00,
+ 0x75, 0x26, 0x4f, 0x3b, 0x00, 0x75, 0x54, 0x36,
+ 0xa4, 0x00, 0x75, 0x5d, 0x4e, 0xce, 0x00, 0x75,
+ 0xbc, 0x4e, 0xcf, 0x00, 0x75, 0xc5, 0x36, 0xb1,
+ 0x00, 0x76, 0x08, 0x4e, 0xd1, 0x00, 0x76, 0x26,
+ 0x1e, 0x2d, 0x00, 0x76, 0x52, 0x1e, 0x7b, 0x00,
+ 0x76, 0x64, 0x4e, 0xd2, 0x00, 0x76, 0x69, 0x4e,
+ 0xd3, 0x00, 0x76, 0x72, 0x35, 0x00, 0x00, 0x76,
+ 0x84, 0x36, 0x79, 0x00, 0x76, 0x93, 0x1e, 0xa4,
+ 0x00, 0x76, 0xc6, 0x34, 0xc4, 0x00, 0x76, 0xca,
+ 0x21, 0x7b, 0x00, 0x76, 0xd4, 0x56, 0x1d, 0x00,
+ 0x76, 0xdb, 0x36, 0x2c, 0x00, 0x76, 0xdf, 0x36,
+ 0xe5, 0x00, 0x76, 0xf2, 0x36, 0xe9, 0x00, 0x76,
+ 0xf4, 0x36, 0x6e, 0x00, 0x77, 0x1e, 0x16, 0xb8,
+ 0x00, 0x77, 0x1f, 0x36, 0x1e, 0x00, 0x77, 0x37,
+ 0x4e, 0xd5, 0x00, 0x77, 0x3a, 0x34, 0xa6, 0x00,
+ 0x77, 0x7e, 0x4e, 0xd6, 0x00, 0x77, 0x8d, 0x56,
+ 0x2e, 0x00, 0x77, 0xa2, 0x56, 0x2f, 0x00, 0x77,
+ 0xa5, 0x1e, 0x6e, 0x00, 0x77, 0xac, 0x34, 0x92,
+ 0x00, 0x77, 0xe9, 0x35, 0xa4, 0x00, 0x78, 0x32,
+ 0x36, 0xc7, 0x00, 0x78, 0x3a, 0x36, 0x7f, 0x00,
+ 0x78, 0x5d, 0x36, 0x0d, 0x00, 0x78, 0x6c, 0x34,
+ 0x83, 0x00, 0x78, 0x7c, 0x1e, 0xa5, 0x00, 0x78,
+ 0x91, 0x0d, 0x7e, 0x00, 0x78, 0xd4, 0x35, 0x02,
+ 0x00, 0x78, 0xe8, 0x36, 0xda, 0x00, 0x78, 0xef,
+ 0x35, 0x4b, 0x00, 0x79, 0x2a, 0x35, 0x01, 0x00,
+ 0x79, 0x34, 0x3a, 0x38, 0x00, 0x79, 0x3a, 0x08,
+ 0xd4, 0x00, 0x79, 0x3c, 0x21, 0x83, 0x00, 0x79,
+ 0x3e, 0x34, 0x24, 0x00, 0x79, 0x40, 0x37, 0x57,
+ 0x00, 0x79, 0x41, 0x1d, 0xf4, 0x00, 0x79, 0x47,
+ 0x1d, 0xeb, 0x00, 0x79, 0x48, 0x06, 0x41, 0x00,
+ 0x79, 0x49, 0x34, 0x21, 0x00, 0x79, 0x50, 0x0f,
+ 0x1e, 0x00, 0x79, 0x53, 0x37, 0x58, 0x00, 0x79,
+ 0x56, 0x34, 0x2f, 0x00, 0x79, 0x5d, 0x09, 0x55,
+ 0x00, 0x79, 0x5e, 0x0a, 0x06, 0x00, 0x79, 0x62,
+ 0x1f, 0x29, 0x00, 0x79, 0x65, 0x09, 0xb5, 0x00,
+ 0x79, 0x8d, 0x05, 0x52, 0x00, 0x79, 0x8e, 0x34,
+ 0x3b, 0x00, 0x79, 0x8f, 0x21, 0x87, 0x00, 0x79,
+ 0xa7, 0x4e, 0xd7, 0x00, 0x79, 0xae, 0x37, 0x5b,
+ 0x00, 0x79, 0xb0, 0x1e, 0x59, 0x00, 0x79, 0xb1,
+ 0x4e, 0xd8, 0x00, 0x79, 0xba, 0x35, 0x03, 0x00,
+ 0x79, 0xe4, 0x1e, 0x5d, 0x00, 0x7a, 0x0b, 0x36,
+ 0x78, 0x00, 0x7a, 0x17, 0x1e, 0x66, 0x00, 0x7a,
+ 0x19, 0x35, 0x04, 0x00, 0x7a, 0x31, 0x1e, 0xa6,
+ 0x00, 0x7a, 0x40, 0x08, 0x04, 0x00, 0x7a, 0x60,
+ 0x3a, 0x4e, 0x00, 0x7a, 0x74, 0x34, 0x7a, 0x00,
+ 0x7a, 0x7a, 0x35, 0xa7, 0x00, 0x7a, 0x7f, 0x1f,
+ 0x25, 0x00, 0x7a, 0x81, 0x34, 0x3d, 0x00, 0x7a,
+ 0x95, 0x35, 0x05, 0x00, 0x7a, 0x97, 0x1f, 0x3c,
+ 0x00, 0x7a, 0xae, 0x34, 0x77, 0x00, 0x7a, 0xbe,
+ 0x4e, 0xd9, 0x00, 0x7a, 0xc6, 0x3c, 0x27, 0x00,
+ 0x7a, 0xc8, 0x4f, 0x3d, 0x00, 0x7b, 0x08, 0x1f,
+ 0x1f, 0x00, 0x7b, 0x51, 0x36, 0x63, 0x00, 0x7b,
+ 0x75, 0x4f, 0x2a, 0x00, 0x7b, 0x99, 0x1e, 0xa8,
+ 0x00, 0x7b, 0xad, 0x1f, 0x26, 0x00, 0x7b, 0xb8,
+ 0x1e, 0x5f, 0x00, 0x7b, 0xc0, 0x34, 0x2e, 0x00,
+ 0x7b, 0xc7, 0x1f, 0x2b, 0x00, 0x7b, 0xc9, 0x36,
+ 0x61, 0x00, 0x7b, 0xdd, 0x1f, 0x3d, 0x00, 0x7b,
+ 0xe0, 0x4e, 0xda, 0x00, 0x7c, 0x14, 0x37, 0x5f,
+ 0x00, 0x7c, 0x3e, 0x1f, 0x2d, 0x00, 0x7c, 0x3f,
+ 0x36, 0xc2, 0x00, 0x7c, 0x4d, 0x36, 0x36, 0x00,
+ 0x7c, 0x50, 0x37, 0x61, 0x00, 0x7c, 0x58, 0x37,
+ 0x62, 0x00, 0x7c, 0x69, 0x56, 0xaa, 0x00, 0x7c,
+ 0x7e, 0x1e, 0x78, 0x00, 0x7c, 0x82, 0x4f, 0x30,
+ 0x00, 0x7c, 0x89, 0x34, 0xbe, 0x00, 0x7c, 0x90,
+ 0x1e, 0xa9, 0x00, 0x7c, 0xae, 0x1e, 0xaa, 0x00,
+ 0x7c, 0xbe, 0x0a, 0x5e, 0x00, 0x7c, 0xd6, 0x0c,
+ 0x76, 0x00, 0x7c, 0xf2, 0x35, 0x06, 0x00, 0x7d,
+ 0x04, 0x36, 0xee, 0x00, 0x7d, 0x09, 0x4e, 0xdc,
+ 0x00, 0x7d, 0x0b, 0x36, 0xec, 0x00, 0x7d, 0x0d,
+ 0x36, 0x94, 0x00, 0x7d, 0x1a, 0x35, 0x91, 0x00,
+ 0x7d, 0x1b, 0x34, 0xbf, 0x00, 0x7d, 0x42, 0x35,
+ 0xf8, 0x00, 0x7d, 0x46, 0x37, 0x63, 0x00, 0x7d,
+ 0x5c, 0x21, 0x90, 0x00, 0x7d, 0x5e, 0x34, 0x84,
+ 0x00, 0x7d, 0x63, 0x37, 0x64, 0x00, 0x7d, 0x73,
+ 0x35, 0x07, 0x00, 0x7d, 0x9b, 0x1e, 0xab, 0x00,
+ 0x7d, 0x9f, 0x1e, 0xad, 0x00, 0x7d, 0xae, 0x1e,
+ 0xac, 0x00, 0x7d, 0xb2, 0x4e, 0xdd, 0x00, 0x7d,
+ 0xcb, 0x34, 0xb6, 0x00, 0x7d, 0xcf, 0x34, 0xa0,
+ 0x00, 0x7d, 0xdd, 0x35, 0x08, 0x00, 0x7d, 0xe8,
+ 0x36, 0xbf, 0x00, 0x7d, 0xe9, 0x35, 0x7a, 0x00,
+ 0x7d, 0xef, 0x34, 0x62, 0x00, 0x7d, 0xf4, 0x0f,
+ 0xc5, 0x00, 0x7e, 0x09, 0x47, 0xbe, 0x00, 0x7e,
+ 0x1b, 0x36, 0x9b, 0x00, 0x7e, 0x22, 0x37, 0x65,
+ 0x00, 0x7e, 0x2b, 0x36, 0xc8, 0x00, 0x7e, 0x35,
+ 0x35, 0x09, 0x00, 0x7e, 0x41, 0x34, 0x40, 0x00,
+ 0x7e, 0x43, 0x37, 0x69, 0x00, 0x7e, 0x6d, 0x36,
+ 0xe1, 0x00, 0x7e, 0x8c, 0x37, 0x6a, 0x00, 0x7f,
+ 0x3e, 0x4e, 0xdf, 0x00, 0x7f, 0x50, 0x37, 0x6b,
+ 0x00, 0x7f, 0x61, 0x3c, 0x28, 0x00, 0x7f, 0x6a,
+ 0x34, 0x89, 0x00, 0x7f, 0x6e, 0x36, 0x60, 0x00,
+ 0x7f, 0x72, 0x09, 0x7a, 0x00, 0x7f, 0x80, 0x56,
+ 0xda, 0x00, 0x7f, 0x8a, 0x0f, 0x3d, 0x00, 0x7f,
+ 0xa1, 0x36, 0x3d, 0x00, 0x7f, 0xae, 0x35, 0x0a,
+ 0x00, 0x7f, 0xbd, 0x04, 0xcb, 0x00, 0x7f, 0xc1,
+ 0x34, 0x6a, 0x00, 0x7f, 0xc5, 0x37, 0x6f, 0x00,
+ 0x7f, 0xc6, 0x37, 0x70, 0x00, 0x7f, 0xcc, 0x37,
+ 0x01, 0x00, 0x7f, 0xd2, 0x35, 0xf9, 0x00, 0x7f,
+ 0xd4, 0x1e, 0xae, 0x00, 0x7f, 0xe0, 0x1e, 0x20,
+ 0x00, 0x7f, 0xe1, 0x35, 0x0b, 0x00, 0x7f, 0xe9,
+ 0x1f, 0x3e, 0x00, 0x7f, 0xeb, 0x1d, 0xe9, 0x00,
+ 0x7f, 0xf0, 0x1d, 0xe8, 0x00, 0x7f, 0xfb, 0x36,
+ 0xd8, 0x00, 0x7f, 0xfc, 0x34, 0xc8, 0x00, 0x80,
+ 0x00, 0x1e, 0x7e, 0x00, 0x80, 0x03, 0x34, 0x85,
+ 0x00, 0x80, 0x05, 0x34, 0x25, 0x00, 0x80, 0x12,
+ 0x4e, 0xe1, 0x00, 0x80, 0x15, 0x35, 0xca, 0x00,
+ 0x80, 0x17, 0x36, 0xea, 0x00, 0x80, 0x36, 0x34,
+ 0xc7, 0x00, 0x80, 0x56, 0x36, 0x2d, 0x00, 0x80,
+ 0x5a, 0x35, 0x0c, 0x00, 0x80, 0x5f, 0x35, 0x0d,
+ 0x00, 0x80, 0x61, 0x34, 0xa1, 0x00, 0x80, 0x6f,
+ 0x34, 0xcd, 0x00, 0x80, 0x70, 0x35, 0x0f, 0x00,
+ 0x80, 0x71, 0x3c, 0x29, 0x00, 0x80, 0x73, 0x35,
+ 0x0e, 0x00, 0x80, 0x74, 0x34, 0xa7, 0x00, 0x80,
+ 0x76, 0x35, 0x10, 0x00, 0x80, 0x77, 0x34, 0x9a,
+ 0x00, 0x80, 0x7e, 0x34, 0xce, 0x00, 0x80, 0x87,
+ 0x36, 0x9c, 0x00, 0x80, 0x89, 0x36, 0x8f, 0x00,
+ 0x80, 0x96, 0x36, 0x0e, 0x00, 0x80, 0x9e, 0x3c,
+ 0x2a, 0x00, 0x80, 0xa9, 0x35, 0xb8, 0x00, 0x80,
+ 0xba, 0x36, 0x97, 0x00, 0x80, 0xd6, 0x4e, 0xe3,
+ 0x00, 0x80, 0xde, 0x36, 0xc9, 0x00, 0x81, 0x06,
+ 0x36, 0x34, 0x00, 0x81, 0x08, 0x34, 0xc6, 0x00,
+ 0x81, 0x09, 0x4e, 0xe4, 0x00, 0x81, 0x29, 0x4e,
+ 0xe5, 0x00, 0x81, 0x53, 0x35, 0x11, 0x00, 0x81,
+ 0x54, 0x35, 0xcb, 0x00, 0x81, 0x70, 0x35, 0xd1,
+ 0x00, 0x81, 0x71, 0x4f, 0x33, 0x00, 0x81, 0x7f,
+ 0x1e, 0x30, 0x00, 0x81, 0x8a, 0x35, 0x12, 0x00,
+ 0x81, 0xb5, 0x35, 0x13, 0x00, 0x81, 0xcd, 0x35,
+ 0x14, 0x00, 0x81, 0xed, 0x34, 0x26, 0x00, 0x82,
+ 0x00, 0x57, 0x0f, 0x00, 0x82, 0x0c, 0x4e, 0xe6,
+ 0x00, 0x82, 0x18, 0x35, 0x7f, 0x00, 0x82, 0x1b,
+ 0x4e, 0xe7, 0x00, 0x82, 0x1c, 0x34, 0x93, 0x00,
+ 0x82, 0x1f, 0x35, 0xb3, 0x00, 0x82, 0x2e, 0x1e,
+ 0xaf, 0x00, 0x82, 0x39, 0x34, 0x9f, 0x00, 0x82,
+ 0x40, 0x4e, 0xe8, 0x00, 0x82, 0x47, 0x34, 0xab,
+ 0x00, 0x82, 0x58, 0x37, 0x74, 0x00, 0x82, 0x79,
+ 0x37, 0x77, 0x00, 0x82, 0x8d, 0x1e, 0xb0, 0x00,
+ 0x82, 0x92, 0x4f, 0x44, 0x00, 0x82, 0xa6, 0x1f,
+ 0x19, 0x00, 0x82, 0xb1, 0x35, 0x62, 0x00, 0x82,
+ 0xbd, 0x05, 0x6a, 0x00, 0x82, 0xc5, 0x35, 0x77,
+ 0x00, 0x82, 0xd2, 0x1e, 0xb1, 0x00, 0x82, 0xe3,
+ 0x37, 0x78, 0x00, 0x83, 0x23, 0x1e, 0xb2, 0x00,
+ 0x83, 0x28, 0x1f, 0x1a, 0x00, 0x83, 0x52, 0x35,
+ 0xcc, 0x00, 0x83, 0x75, 0x1e, 0xb3, 0x00, 0x83,
+ 0xbd, 0x37, 0x7c, 0x00, 0x83, 0xd3, 0x35, 0x63,
+ 0x00, 0x83, 0xd4, 0x4e, 0xea, 0x00, 0x83, 0xdc,
+ 0x35, 0xda, 0x00, 0x83, 0xdf, 0x1e, 0x4b, 0x00,
+ 0x83, 0xf2, 0x35, 0x15, 0x00, 0x84, 0x0c, 0x36,
+ 0xca, 0x00, 0x84, 0x0f, 0x4e, 0xeb, 0x00, 0x84,
+ 0x20, 0x37, 0x7b, 0x00, 0x84, 0x22, 0x1f, 0x3f,
+ 0x00, 0x84, 0x57, 0x34, 0x37, 0x00, 0x84, 0x5b,
+ 0x1d, 0xe4, 0x00, 0x84, 0x5c, 0x57, 0x45, 0x00,
+ 0x84, 0x7a, 0x34, 0xba, 0x00, 0x84, 0xea, 0x4e,
+ 0xed, 0x00, 0x84, 0xec, 0x1e, 0x72, 0x00, 0x84,
+ 0xee, 0x0f, 0xc7, 0x00, 0x84, 0xf4, 0x37, 0x7d,
+ 0x00, 0x85, 0x11, 0x36, 0xbd, 0x00, 0x85, 0x17,
+ 0x1e, 0xb4, 0x00, 0x85, 0x3d, 0x1e, 0x6d, 0x00,
+ 0x85, 0x43, 0x36, 0xa6, 0x00, 0x85, 0x51, 0x4e,
+ 0xef, 0x00, 0x85, 0x55, 0x35, 0x16, 0x00, 0x85,
+ 0x5d, 0x57, 0x64, 0x00, 0x85, 0x63, 0x4e, 0xf0,
+ 0x00, 0x85, 0x84, 0x36, 0x99, 0x00, 0x85, 0x87,
+ 0x37, 0x7f, 0x00, 0x85, 0xa9, 0x1e, 0x08, 0x00,
+ 0x85, 0xaf, 0x1e, 0x15, 0x00, 0x85, 0xcf, 0x4e,
+ 0xf1, 0x00, 0x85, 0xd5, 0x35, 0x17, 0x00, 0x85,
+ 0xe4, 0x36, 0x85, 0x00, 0x85, 0xf7, 0x1e, 0x16,
+ 0x00, 0x86, 0x12, 0x21, 0xa4, 0x00, 0x86, 0x2d,
+ 0x37, 0x04, 0x00, 0x86, 0x4e, 0x4e, 0xf2, 0x00,
+ 0x86, 0x50, 0x35, 0x8c, 0x00, 0x86, 0x54, 0x4f,
+ 0x32, 0x00, 0x86, 0x5c, 0x0f, 0x82, 0x00, 0x86,
+ 0x5e, 0x35, 0xa6, 0x00, 0x86, 0x62, 0x4e, 0xf3,
+ 0x00, 0x86, 0x8a, 0x4e, 0xf4, 0x00, 0x86, 0xdb,
+ 0x34, 0x5e, 0x00, 0x86, 0xf8, 0x1e, 0x35, 0x00,
+ 0x87, 0x03, 0x4f, 0x48, 0x00, 0x87, 0x1a, 0x35,
+ 0x18, 0x00, 0x87, 0x37, 0x37, 0x82, 0x00, 0x87,
+ 0x3b, 0x37, 0x83, 0x00, 0x87, 0x55, 0x1e, 0x1d,
+ 0x00, 0x87, 0x59, 0x1f, 0x40, 0x00, 0x87, 0x82,
+ 0x1e, 0xb6, 0x00, 0x87, 0xa3, 0x57, 0xaa, 0x00,
+ 0x87, 0xbd, 0x37, 0x85, 0x00, 0x87, 0xd2, 0x1e,
+ 0xb7, 0x00, 0x88, 0x03, 0x3b, 0x03, 0x00, 0x88,
+ 0x05, 0x37, 0x84, 0x00, 0x88, 0x0e, 0x1f, 0x41,
+ 0x00, 0x88, 0x36, 0x35, 0x19, 0x00, 0x88, 0x42,
+ 0x4e, 0xf5, 0x00, 0x88, 0x46, 0x35, 0xfa, 0x00,
+ 0x88, 0x4b, 0x57, 0xc3, 0x00, 0x88, 0x53, 0x35,
+ 0xfd, 0x00, 0x88, 0x5b, 0x34, 0x66, 0x00, 0x88,
+ 0x5e, 0x35, 0x53, 0x00, 0x88, 0x63, 0x35, 0x48,
+ 0x00, 0x88, 0x70, 0x36, 0x27, 0x00, 0x88, 0x77,
+ 0x4e, 0xf6, 0x00, 0x88, 0x9e, 0x35, 0x1a, 0x00,
+ 0x88, 0xd8, 0x35, 0x1b, 0x00, 0x88, 0xf4, 0x35,
+ 0x1c, 0x00, 0x89, 0x0a, 0x1e, 0xb8, 0x00, 0x89,
+ 0x10, 0x34, 0x13, 0x00, 0x89, 0x1c, 0x37, 0xcb,
+ 0x00, 0x89, 0x2b, 0x35, 0x1d, 0x00, 0x89, 0x3b,
+ 0x35, 0x1e, 0x00, 0x89, 0x41, 0x4e, 0xf7, 0x00,
+ 0x89, 0x56, 0x1d, 0xdd, 0x00, 0x89, 0x6a, 0x35,
+ 0x1f, 0x00, 0x89, 0x6f, 0x35, 0x20, 0x00, 0x89,
+ 0x81, 0x36, 0xff, 0x00, 0x89, 0x86, 0x36, 0xb8,
+ 0x00, 0x89, 0x87, 0x36, 0x95, 0x00, 0x89, 0x96,
+ 0x34, 0x22, 0x00, 0x89, 0xaa, 0x34, 0x9b, 0x00,
+ 0x89, 0xaf, 0x1e, 0xb9, 0x00, 0x89, 0xbd, 0x37,
+ 0x8a, 0x00, 0x89, 0xd2, 0x05, 0xaf, 0x00, 0x8a,
+ 0x0a, 0x36, 0x24, 0x00, 0x8a, 0x12, 0x37, 0xd7,
+ 0x00, 0x8a, 0x1d, 0x35, 0x21, 0x00, 0x8a, 0x1f,
+ 0x34, 0x96, 0x00, 0x8a, 0x3b, 0x1e, 0x3c, 0x00,
+ 0x8a, 0x55, 0x36, 0xaf, 0x00, 0x8a, 0x6e, 0x1e,
+ 0x28, 0x00, 0x8a, 0x8d, 0x36, 0x92, 0x00, 0x8a,
+ 0x95, 0x34, 0xa3, 0x00, 0x8a, 0xa0, 0x36, 0x2f,
+ 0x00, 0x8a, 0xa4, 0x35, 0xc2, 0x00, 0x8a, 0xb9,
+ 0x34, 0xb7, 0x00, 0x8a, 0xbf, 0x36, 0x6d, 0x00,
+ 0x8a, 0xcb, 0x36, 0x30, 0x00, 0x8a, 0xdb, 0x37,
+ 0x8b, 0x00, 0x8a, 0xde, 0x1e, 0xba, 0x00, 0x8a,
+ 0xed, 0x0f, 0x0b, 0x00, 0x8a, 0xee, 0x35, 0xe3,
+ 0x00, 0x8a, 0xf8, 0x09, 0x7e, 0x00, 0x8a, 0xfa,
+ 0x1d, 0xfe, 0x00, 0x8b, 0x01, 0x04, 0xfc, 0x00,
+ 0x8b, 0x04, 0x36, 0x86, 0x00, 0x8b, 0x0e, 0x1e,
+ 0x56, 0x00, 0x8b, 0x19, 0x35, 0xb9, 0x00, 0x8b,
+ 0x1b, 0x35, 0xcd, 0x00, 0x8b, 0x1d, 0x34, 0x8d,
+ 0x00, 0x8b, 0x2c, 0x1e, 0x69, 0x00, 0x8b, 0x39,
+ 0x06, 0xd8, 0x00, 0x8b, 0x3e, 0x37, 0x8c, 0x00,
+ 0x8b, 0x41, 0x1e, 0xbb, 0x00, 0x8b, 0x56, 0x4e,
+ 0xf8, 0x00, 0x8b, 0x5a, 0x37, 0x8d, 0x00, 0x8b,
+ 0x5c, 0x4e, 0xfa, 0x00, 0x8b, 0x7f, 0x52, 0x52,
+ 0x00, 0x8c, 0x6a, 0x4e, 0xfd, 0x00, 0x8c, 0x79,
+ 0x4e, 0xfe, 0x00, 0x8c, 0x9b, 0x58, 0x37, 0x00,
+ 0x8c, 0xa0, 0x36, 0xb5, 0x00, 0x8c, 0xa7, 0x34,
+ 0xb8, 0x00, 0x8c, 0xa8, 0x35, 0x64, 0x00, 0x8c,
+ 0xab, 0x34, 0x72, 0x00, 0x8c, 0xc7, 0x35, 0xe5,
+ 0x00, 0x8c, 0xca, 0x36, 0x4c, 0x00, 0x8c, 0xd3,
+ 0x0d, 0xc2, 0x00, 0x8c, 0xed, 0x1e, 0x4c, 0x00,
+ 0x8c, 0xfc, 0x34, 0x86, 0x00, 0x8d, 0x05, 0x35,
+ 0x22, 0x00, 0x8d, 0x08, 0x34, 0x34, 0x00, 0x8d,
+ 0x0f, 0x35, 0x23, 0x00, 0x8d, 0x67, 0x4f, 0x00,
+ 0x00, 0x8d, 0x70, 0x36, 0x46, 0x00, 0x8d, 0x73,
+ 0x37, 0x8e, 0x00, 0x8d, 0x77, 0x35, 0x88, 0x00,
+ 0x8d, 0x99, 0x37, 0x8f, 0x00, 0x8d, 0xda, 0x1e,
+ 0xbc, 0x00, 0x8d, 0xdd, 0x35, 0x94, 0x00, 0x8d,
+ 0xf3, 0x34, 0xa8, 0x00, 0x8e, 0x09, 0x1e, 0xbd,
+ 0x00, 0x8e, 0x34, 0x37, 0x91, 0x00, 0x8e, 0x4a,
+ 0x37, 0x92, 0x00, 0x8e, 0x8d, 0x36, 0xef, 0x00,
+ 0x8e, 0x91, 0x35, 0x25, 0x00, 0x8e, 0xa1, 0x35,
+ 0x26, 0x00, 0x8e, 0xcc, 0x34, 0x76, 0x00, 0x8e,
+ 0xd4, 0x3b, 0x4a, 0x00, 0x8f, 0x03, 0x4f, 0x02,
+ 0x00, 0x8f, 0x13, 0x1e, 0xbe, 0x00, 0x8f, 0x29,
+ 0x34, 0xb0, 0x00, 0x8f, 0x2f, 0x34, 0x90, 0x00,
+ 0x8f, 0x38, 0x36, 0xf5, 0x00, 0x8f, 0x44, 0x35,
+ 0x75, 0x00, 0x8f, 0xb6, 0x3c, 0x2b, 0x00, 0x8f,
+ 0xbb, 0x20, 0x4b, 0x00, 0x8f, 0xbc, 0x35, 0xd3,
+ 0x00, 0x8f, 0xbf, 0x1e, 0x37, 0x00, 0x8f, 0xc2,
+ 0x1d, 0xd6, 0x00, 0x8f, 0xc4, 0x1f, 0x2c, 0x00,
+ 0x8f, 0xc5, 0x36, 0x26, 0x00, 0x8f, 0xc6, 0x3b,
+ 0x51, 0x00, 0x8f, 0xce, 0x35, 0xae, 0x00, 0x8f,
+ 0xd1, 0x35, 0xa2, 0x00, 0x8f, 0xd4, 0x36, 0xc0,
+ 0x00, 0x8f, 0xe6, 0x1d, 0xdf, 0x00, 0x8f, 0xe9,
+ 0x1e, 0xc0, 0x00, 0x8f, 0xea, 0x1e, 0xbf, 0x00,
+ 0x8f, 0xeb, 0x36, 0x9a, 0x00, 0x8f, 0xed, 0x36,
+ 0x7b, 0x00, 0x8f, 0xef, 0x37, 0x93, 0x00, 0x8f,
+ 0xf0, 0x35, 0xfe, 0x00, 0x8f, 0xf6, 0x4f, 0x06,
+ 0x00, 0x8f, 0xf7, 0x36, 0xe6, 0x00, 0x8f, 0xfa,
+ 0x37, 0x95, 0x00, 0x8f, 0xfd, 0x36, 0x72, 0x00,
+ 0x90, 0x00, 0x36, 0x51, 0x00, 0x90, 0x01, 0x36,
+ 0x47, 0x00, 0x90, 0x03, 0x34, 0xad, 0x00, 0x90,
+ 0x06, 0x35, 0x8d, 0x00, 0x90, 0x0e, 0x35, 0x28,
+ 0x00, 0x90, 0x0f, 0x36, 0x88, 0x00, 0x90, 0x10,
+ 0x36, 0x64, 0x00, 0x90, 0x14, 0x36, 0x7e, 0x00,
+ 0x90, 0x17, 0x1e, 0x1f, 0x00, 0x90, 0x19, 0x1e,
+ 0x5c, 0x00, 0x90, 0x1a, 0x36, 0x73, 0x00, 0x90,
+ 0x1d, 0x1e, 0x22, 0x00, 0x90, 0x1e, 0x37, 0x96,
+ 0x00, 0x90, 0x1f, 0x36, 0x4b, 0x00, 0x90, 0x20,
+ 0x36, 0x49, 0x00, 0x90, 0x22, 0x20, 0x4a, 0x00,
+ 0x90, 0x23, 0x0f, 0xc8, 0x00, 0x90, 0x2e, 0x36,
+ 0x52, 0x00, 0x90, 0x31, 0x35, 0xfb, 0x00, 0x90,
+ 0x32, 0x36, 0x1f, 0x00, 0x90, 0x35, 0x37, 0x97,
+ 0x00, 0x90, 0x38, 0x34, 0x08, 0x00, 0x90, 0x39,
+ 0x36, 0x58, 0x00, 0x90, 0x3c, 0x1e, 0x67, 0x00,
+ 0x90, 0x41, 0x1e, 0x53, 0x00, 0x90, 0x42, 0x34,
+ 0x9c, 0x00, 0x90, 0x47, 0x35, 0xa8, 0x00, 0x90,
+ 0x4a, 0x36, 0xfc, 0x00, 0x90, 0x4b, 0x35, 0x51,
+ 0x00, 0x90, 0x4d, 0x36, 0xc1, 0x00, 0x90, 0x4e,
+ 0x35, 0x65, 0x00, 0x90, 0x50, 0x37, 0x98, 0x00,
+ 0x90, 0x52, 0x35, 0x27, 0x00, 0x90, 0x53, 0x36,
+ 0x8b, 0x00, 0x90, 0x54, 0x36, 0x58, 0x00, 0x90,
+ 0x55, 0x34, 0x63, 0x00, 0x90, 0x58, 0x1e, 0xc1,
+ 0x00, 0x90, 0x5c, 0x1e, 0x2e, 0x00, 0x90, 0x60,
+ 0x35, 0x5a, 0x00, 0x90, 0x61, 0x1e, 0x2a, 0x00,
+ 0x90, 0x63, 0x35, 0xba, 0x00, 0x90, 0x69, 0x36,
+ 0x7a, 0x00, 0x90, 0x6d, 0x36, 0x48, 0x00, 0x90,
+ 0x6e, 0x1e, 0x0e, 0x00, 0x90, 0x75, 0x36, 0x00,
+ 0x00, 0x90, 0x77, 0x36, 0x40, 0x00, 0x90, 0x78,
+ 0x36, 0x3f, 0x00, 0x90, 0x7a, 0x35, 0x4a, 0x00,
+ 0x90, 0x7c, 0x1e, 0x80, 0x00, 0x90, 0x7f, 0x36,
+ 0xa7, 0x00, 0x90, 0x81, 0x37, 0x9a, 0x00, 0x90,
+ 0x83, 0x37, 0x5c, 0x00, 0x90, 0x84, 0x35, 0x7c,
+ 0x00, 0x90, 0x87, 0x37, 0x94, 0x00, 0x90, 0x89,
+ 0x34, 0x5f, 0x00, 0x90, 0x8a, 0x37, 0x9b, 0x00,
+ 0x90, 0xa3, 0x1e, 0x55, 0x00, 0x90, 0xa6, 0x36,
+ 0xcb, 0x00, 0x90, 0xa8, 0x4f, 0x0b, 0x00, 0x90,
+ 0xaa, 0x34, 0x8e, 0x00, 0x90, 0xf7, 0x35, 0x9d,
+ 0x00, 0x90, 0xfd, 0x0c, 0x4e, 0x00, 0x91, 0x2d,
+ 0x1e, 0x44, 0x00, 0x91, 0x30, 0x35, 0x29, 0x00,
+ 0x91, 0x4b, 0x1e, 0x12, 0x00, 0x91, 0x4c, 0x35,
+ 0xf2, 0x00, 0x91, 0x4d, 0x4f, 0x0c, 0x00, 0x91,
+ 0x56, 0x35, 0x2a, 0x00, 0x91, 0x58, 0x35, 0x2b,
+ 0x00, 0x91, 0x65, 0x35, 0x2c, 0x00, 0x91, 0x72,
+ 0x35, 0x2e, 0x00, 0x91, 0x73, 0x35, 0x2d, 0x00,
+ 0x91, 0x77, 0x35, 0xd0, 0x00, 0x91, 0xa2, 0x35,
+ 0x2f, 0x00, 0x91, 0xaa, 0x35, 0x31, 0x00, 0x91,
+ 0xaf, 0x35, 0x30, 0x00, 0x91, 0xb1, 0x36, 0x9f,
+ 0x00, 0x91, 0xb4, 0x35, 0x32, 0x00, 0x91, 0xba,
+ 0x35, 0x33, 0x00, 0x91, 0xc1, 0x1e, 0xc3, 0x00,
+ 0x91, 0xc7, 0x1e, 0x05, 0x00, 0x91, 0xdc, 0x4f,
+ 0x42, 0x00, 0x91, 0xe3, 0x36, 0x75, 0x00, 0x91,
+ 0xfc, 0x3c, 0x2c, 0x00, 0x92, 0x37, 0x34, 0x7d,
+ 0x00, 0x92, 0x5b, 0x34, 0x69, 0x00, 0x92, 0xe9,
+ 0x4f, 0x0d, 0x00, 0x93, 0x06, 0x1e, 0x0a, 0x00,
+ 0x93, 0x35, 0x4f, 0x0e, 0x00, 0x93, 0x65, 0x3b,
+ 0x86, 0x00, 0x93, 0x75, 0x4f, 0x34, 0x00, 0x93,
+ 0x8b, 0x4f, 0x0f, 0x00, 0x93, 0x8c, 0x35, 0x76,
+ 0x00, 0x93, 0x96, 0x35, 0xd5, 0x00, 0x93, 0x9a,
+ 0x1e, 0x41, 0x00, 0x93, 0xa1, 0x59, 0x04, 0x00,
+ 0x93, 0xae, 0x34, 0x3a, 0x00, 0x93, 0xdd, 0x37,
+ 0xae, 0x00, 0x94, 0x3a, 0x4f, 0x10, 0x00, 0x94,
+ 0x53, 0x1e, 0x79, 0x00, 0x94, 0x77, 0x35, 0x34,
+ 0x00, 0x95, 0x92, 0x35, 0x7d, 0x00, 0x95, 0xab,
+ 0x3b, 0x9a, 0x00, 0x95, 0xbb, 0x1e, 0xc4, 0x00,
+ 0x95, 0xbc, 0x37, 0xaf, 0x00, 0x95, 0xcd, 0x4f,
+ 0x11, 0x00, 0x96, 0x2a, 0x4f, 0x12, 0x00, 0x96,
+ 0x4d, 0x34, 0x87, 0x00, 0x96, 0x86, 0x34, 0x51,
+ 0x00, 0x96, 0x8a, 0x36, 0x53, 0x00, 0x96, 0x94,
+ 0x35, 0x73, 0x00, 0x96, 0x98, 0x35, 0x35, 0x00,
+ 0x96, 0x99, 0x4f, 0x31, 0x00, 0x96, 0xa3, 0x34,
+ 0xca, 0x00, 0x96, 0xa7, 0x4f, 0x14, 0x00, 0x96,
+ 0xb2, 0x37, 0xb1, 0x00, 0x96, 0xbb, 0x36, 0x35,
+ 0x00, 0x96, 0xc5, 0x34, 0x6c, 0x00, 0x96, 0xc7,
+ 0x35, 0xbe, 0x00, 0x96, 0xd9, 0x34, 0xd5, 0x00,
+ 0x96, 0xda, 0x59, 0x3b, 0x00, 0x96, 0xe3, 0x0c,
+ 0xc9, 0x00, 0x96, 0xe8, 0x35, 0x4d, 0x00, 0x96,
+ 0xea, 0x36, 0x39, 0x00, 0x96, 0xf0, 0x34, 0xc0,
+ 0x00, 0x97, 0x21, 0x59, 0x41, 0x00, 0x97, 0x24,
+ 0x1e, 0xc6, 0x00, 0x97, 0x3d, 0x35, 0x36, 0x00,
+ 0x97, 0x55, 0x21, 0xf8, 0x00, 0x97, 0x56, 0x21,
+ 0x8b, 0x00, 0x97, 0x59, 0x37, 0xb2, 0x00, 0x97,
+ 0x5c, 0x36, 0x31, 0x00, 0x97, 0x60, 0x1e, 0xc7,
+ 0x00, 0x97, 0x6d, 0x1e, 0xc8, 0x00, 0x97, 0x71,
+ 0x1e, 0x1e, 0x00, 0x97, 0x74, 0x1d, 0xf3, 0x00,
+ 0x97, 0x84, 0x1d, 0xe5, 0x00, 0x97, 0x98, 0x1e,
+ 0x1c, 0x00, 0x97, 0xad, 0x4f, 0x43, 0x00, 0x97,
+ 0xd3, 0x35, 0x7e, 0x00, 0x97, 0xde, 0x3c, 0x2e,
+ 0x00, 0x97, 0xf3, 0x35, 0x60, 0x00, 0x97, 0xff,
+ 0x34, 0x19, 0x00, 0x98, 0x0c, 0x35, 0x39, 0x00,
+ 0x98, 0x11, 0x34, 0x74, 0x00, 0x98, 0x12, 0x34,
+ 0xb2, 0x00, 0x98, 0x13, 0x1e, 0x54, 0x00, 0x98,
+ 0x24, 0x1e, 0xc9, 0x00, 0x98, 0x3b, 0x0d, 0xc3,
+ 0x00, 0x98, 0x5e, 0x0f, 0xa8, 0x00, 0x98, 0x67,
+ 0x35, 0xbf, 0x00, 0x98, 0x73, 0x35, 0x3a, 0x00,
+ 0x98, 0xc3, 0x35, 0x3b, 0x00, 0x98, 0xdf, 0x36,
+ 0x17, 0x00, 0x98, 0xe2, 0x35, 0x89, 0x00, 0x98,
+ 0xeb, 0x37, 0xb4, 0x00, 0x98, 0xef, 0x0d, 0x67,
+ 0x00, 0x98, 0xf4, 0x1d, 0xd2, 0x00, 0x98, 0xfc,
+ 0x21, 0xfc, 0x00, 0x98, 0xfd, 0x36, 0xcd, 0x00,
+ 0x98, 0xfe, 0x36, 0x14, 0x00, 0x99, 0x03, 0x37,
+ 0xb5, 0x00, 0x99, 0x05, 0x1e, 0x77, 0x00, 0x99,
+ 0x09, 0x37, 0xb6, 0x00, 0x99, 0x0a, 0x37, 0x00,
+ 0x00, 0x99, 0x0c, 0x1d, 0xdb, 0x00, 0x99, 0x10,
+ 0x1f, 0x22, 0x00, 0x99, 0x13, 0x35, 0x68, 0x00,
+ 0x99, 0x21, 0x4f, 0x18, 0x00, 0x99, 0x28, 0x21,
+ 0xfe, 0x00, 0x99, 0x45, 0x37, 0xb7, 0x00, 0x99,
+ 0x4b, 0x37, 0xb9, 0x00, 0x99, 0x57, 0x1f, 0x20,
+ 0x00, 0x99, 0xc1, 0x4f, 0x40, 0x00, 0x99, 0xd0,
+ 0x36, 0x67, 0x00, 0x9a, 0x19, 0x1f, 0x43, 0x00,
+ 0x9a, 0x30, 0x36, 0x89, 0x00, 0x9a, 0x45, 0x35,
+ 0x3c, 0x00, 0x9a, 0x4a, 0x59, 0x88, 0x00, 0x9a,
+ 0x5f, 0x37, 0xbb, 0x00, 0x9a, 0x65, 0x37, 0xbc,
+ 0x00, 0x9a, 0xef, 0x37, 0xbd, 0x00, 0x9b, 0x18,
+ 0x37, 0xbe, 0x00, 0x9b, 0x2d, 0x34, 0x3c, 0x00,
+ 0x9b, 0x2e, 0x1e, 0xca, 0x00, 0x9b, 0x35, 0x59,
+ 0xa4, 0x00, 0x9b, 0x4d, 0x35, 0x3d, 0x00, 0x9b,
+ 0x54, 0x36, 0xdb, 0x00, 0x9b, 0x58, 0x35, 0x3e,
+ 0x00, 0x9b, 0x97, 0x1e, 0xcb, 0x00, 0x9b, 0xa8,
+ 0x4f, 0x1a, 0x00, 0x9b, 0xab, 0x4f, 0x38, 0x00,
+ 0x9b, 0xae, 0x4f, 0x1b, 0x00, 0x9b, 0xb9, 0x4f,
+ 0x1c, 0x00, 0x9b, 0xc6, 0x35, 0x3f, 0x00, 0x9b,
+ 0xd6, 0x1e, 0x09, 0x00, 0x9b, 0xdb, 0x36, 0x54,
+ 0x00, 0x9b, 0xe1, 0x35, 0x40, 0x00, 0x9b, 0xf1,
+ 0x35, 0x41, 0x00, 0x9b, 0xf2, 0x1e, 0xcc, 0x00,
+ 0x9c, 0x08, 0x4f, 0x1d, 0x00, 0x9c, 0x24, 0x4f,
+ 0x1e, 0x00, 0x9c, 0x2f, 0x1d, 0xd4, 0x00, 0x9c,
+ 0x3b, 0x4f, 0x1f, 0x00, 0x9c, 0x48, 0x1e, 0x39,
+ 0x00, 0x9c, 0x52, 0x1e, 0x74, 0x00, 0x9c, 0x57,
+ 0x37, 0x0c, 0x00, 0x9c, 0xe6, 0x4f, 0x21, 0x00,
+ 0x9d, 0x07, 0x1e, 0x4f, 0x00, 0x9d, 0x08, 0x37,
+ 0xc1, 0x00, 0x9d, 0x09, 0x37, 0xc0, 0x00, 0x9d,
+ 0x48, 0x35, 0x42, 0x00, 0x9d, 0x60, 0x1e, 0x03,
+ 0x00, 0x9d, 0x6c, 0x36, 0xce, 0x00, 0x9d, 0xb4,
+ 0x0b, 0xfd, 0x00, 0x9d, 0xbf, 0x59, 0xde, 0x00,
+ 0x9d, 0xc0, 0x4f, 0x22, 0x00, 0x9d, 0xc2, 0x4f,
+ 0x23, 0x00, 0x9d, 0xcf, 0x35, 0x43, 0x00, 0x9e,
+ 0x97, 0x34, 0xcc, 0x00, 0x9e, 0x9f, 0x34, 0xcb,
+ 0x00, 0x9e, 0xa5, 0x37, 0xc2, 0x00, 0x9e, 0xaa,
+ 0x1e, 0xcd, 0x00, 0x9e, 0xad, 0x1f, 0x44, 0x00,
+ 0x9e, 0xbb, 0x36, 0xdc, 0x00, 0x9e, 0xbf, 0x36,
+ 0xe2, 0x00, 0x9e, 0xcc, 0x37, 0xc3, 0x00, 0x9e,
+ 0xdb, 0x1e, 0x31, 0x00, 0x9f, 0x08, 0x35, 0x44,
+ 0x00, 0x9f, 0x3b, 0x36, 0xa9, 0x00, 0x9f, 0x4a,
+ 0x37, 0xc5, 0x00, 0x9f, 0x4b, 0x37, 0x5a, 0x00,
+ 0x9f, 0x4e, 0x35, 0x24, 0x00, 0x9f, 0x67, 0x37,
+ 0xc7, 0x00, 0x9f, 0x8d, 0x37, 0x06, 0x00, 0x9f,
+ 0x9c, 0x1e, 0xce, 0x00, 0x9f, 0x9d, 0x1e, 0xa7,
+ 0x00, 0xfa, 0x11, 0x20, 0xfb, 0x00, 0xfa, 0x24,
+ 0x21, 0xb8, 0x02, 0x35, 0xc4, 0x3c, 0x44, 0x02,
+ 0x36, 0x3a, 0x35, 0x9b, 0x02, 0x38, 0x3d, 0x4f,
+ 0x26, 0x02, 0x42, 0xee, 0x37, 0xc9, 0x02, 0x62,
+ 0x70, 0x37, 0x6e, 0x02, 0x9d, 0x4b, 0x35, 0x96,
+ 0x02, 0x9e, 0x3d, 0x3c, 0x4d, 0x02, 0xa6, 0x1a,
+ 0x37, 0xc8, 0x00, 0x00, 0x00, 0x7f, 0x00, 0x34,
+ 0x02, 0x35, 0x83, 0x00, 0x50, 0x91, 0x35, 0xaf,
+ 0x00, 0x50, 0xca, 0x37, 0x15, 0x00, 0x51, 0x54,
+ 0x37, 0x17, 0x00, 0x51, 0x95, 0x37, 0x18, 0x00,
+ 0x51, 0xb4, 0x35, 0xdb, 0x00, 0x51, 0xde, 0x38,
+ 0x10, 0x00, 0x52, 0x72, 0x4e, 0x76, 0x00, 0x53,
+ 0x7f, 0x1d, 0xed, 0x00, 0x53, 0xa9, 0x1f, 0x1c,
+ 0x00, 0x55, 0x33, 0x37, 0x21, 0x00, 0x55, 0xa9,
+ 0x34, 0xd6, 0x00, 0x55, 0xab, 0x4e, 0x7c, 0x00,
+ 0x55, 0xe4, 0x37, 0x22, 0x00, 0x56, 0xae, 0x4e,
+ 0x7e, 0x00, 0x57, 0xf4, 0x36, 0x13, 0x00, 0x58,
+ 0x5a, 0x20, 0xe6, 0x00, 0x59, 0x51, 0x4e, 0x88,
+ 0x00, 0x59, 0xff, 0x35, 0xe1, 0x00, 0x5a, 0xbe,
+ 0x34, 0xdc, 0x00, 0x5b, 0xb3, 0x35, 0x6b, 0x00,
+ 0x5c, 0x0a, 0x36, 0x4e, 0x00, 0x5c, 0x0f, 0x36,
+ 0x0a, 0x00, 0x5e, 0xca, 0x34, 0x59, 0x00, 0x5e,
+ 0xe3, 0x4e, 0x93, 0x00, 0x5e, 0xf6, 0x35, 0x56,
+ 0x00, 0x60, 0x62, 0x4f, 0x2d, 0x00, 0x60, 0x97,
+ 0x37, 0x30, 0x00, 0x61, 0x67, 0x35, 0xad, 0x00,
+ 0x61, 0x68, 0x34, 0x6e, 0x00, 0x61, 0xb2, 0x4e,
+ 0x98, 0x00, 0x61, 0xf2, 0x36, 0x6a, 0x00, 0x62,
+ 0x49, 0x34, 0xb4, 0x00, 0x66, 0x5f, 0x37, 0x38,
+ 0x00, 0x66, 0xc1, 0x4e, 0xac, 0x00, 0x67, 0x15,
+ 0x36, 0x70, 0x00, 0x67, 0x17, 0x21, 0x29, 0x00,
+ 0x67, 0x1b, 0x36, 0xd5, 0x00, 0x68, 0x5d, 0x36,
+ 0xde, 0x00, 0x68, 0x7a, 0x36, 0xf1, 0x00, 0x69,
+ 0x0d, 0x36, 0x15, 0x00, 0x69, 0x82, 0x34, 0x6f,
+ 0x00, 0x6a, 0xdb, 0x35, 0xa9, 0x00, 0x6b, 0x21,
+ 0x35, 0xe8, 0x00, 0x6c, 0x08, 0x34, 0xf4, 0x00,
+ 0x6c, 0xaa, 0x4e, 0xbb, 0x00, 0x6c, 0xbf, 0x34,
+ 0x68, 0x00, 0x6c, 0xe8, 0x32, 0x45, 0x00, 0x6d,
+ 0x3e, 0x36, 0x96, 0x00, 0x6e, 0x23, 0x34, 0xf6,
+ 0x00, 0x6e, 0xa2, 0x52, 0x4f, 0x00, 0x6e, 0xcb,
+ 0x4e, 0xc1, 0x00, 0x6f, 0x11, 0x37, 0x45, 0x00,
+ 0x6f, 0x5b, 0x4e, 0xc5, 0x00, 0x71, 0x7d, 0x1f,
+ 0x24, 0x00, 0x72, 0x35, 0x35, 0xf0, 0x00, 0x73,
+ 0x36, 0x36, 0xf9, 0x00, 0x73, 0x37, 0x36, 0xfa,
+ 0x00, 0x73, 0xca, 0x4e, 0xcc, 0x00, 0x75, 0x11,
+ 0x35, 0xd2, 0x00, 0x75, 0x15, 0x4f, 0x2b, 0x00,
+ 0x79, 0x53, 0x37, 0x59, 0x00, 0x7a, 0x74, 0x35,
+ 0xb1, 0x00, 0x7b, 0x08, 0x4f, 0x27, 0x00, 0x7b,
+ 0xc0, 0x36, 0x37, 0x00, 0x7c, 0x3e, 0x4f, 0x29,
+ 0x00, 0x7c, 0x50, 0x4e, 0xdb, 0x00, 0x7c, 0x7e,
+ 0x4f, 0x45, 0x00, 0x7d, 0xb2, 0x4e, 0xde, 0x00,
+ 0x7e, 0x22, 0x37, 0x66, 0x00, 0x7e, 0x35, 0x37,
+ 0x68, 0x00, 0x7f, 0xc1, 0x35, 0x5e, 0x00, 0x7f,
+ 0xe1, 0x4e, 0xe0, 0x00, 0x7f, 0xe9, 0x37, 0x71,
+ 0x00, 0x7f, 0xfc, 0x37, 0x02, 0x00, 0x81, 0x08,
+ 0x36, 0xe3, 0x00, 0x82, 0x39, 0x36, 0x3e, 0x00,
+ 0x82, 0x79, 0x37, 0x76, 0x00, 0x82, 0xbd, 0x34,
+ 0x6b, 0x00, 0x83, 0xdf, 0x1f, 0x28, 0x00, 0x85,
+ 0x3d, 0x34, 0xc1, 0x00, 0x86, 0x12, 0x52, 0x51,
+ 0x00, 0x87, 0xd2, 0x1f, 0x42, 0x00, 0x88, 0x05,
+ 0x4f, 0x47, 0x00, 0x88, 0x36, 0x37, 0x87, 0x00,
+ 0x8a, 0x0a, 0x36, 0x25, 0x00, 0x8a, 0x1d, 0x4f,
+ 0x2c, 0x00, 0x8a, 0x95, 0x36, 0x5d, 0x00, 0x8a,
+ 0xee, 0x35, 0xe4, 0x00, 0x8b, 0x56, 0x4e, 0xf9,
+ 0x00, 0x8c, 0xa0, 0x36, 0xb6, 0x00, 0x8c, 0xc7,
+ 0x35, 0xe6, 0x00, 0x8c, 0xca, 0x4e, 0xff, 0x00,
+ 0x8c, 0xfc, 0x35, 0xce, 0x00, 0x8f, 0x44, 0x4f,
+ 0x03, 0x00, 0x8f, 0xc5, 0x4f, 0x04, 0x00, 0x8f,
+ 0xd4, 0x4f, 0x05, 0x00, 0x90, 0x03, 0x36, 0x87,
+ 0x00, 0x90, 0x22, 0x34, 0x60, 0x00, 0x90, 0x38,
+ 0x21, 0xb9, 0x00, 0x90, 0x41, 0x4f, 0x3f, 0x00,
+ 0x90, 0x42, 0x36, 0x28, 0x00, 0x90, 0x55, 0x35,
+ 0x49, 0x00, 0x90, 0x75, 0x36, 0x01, 0x00, 0x90,
+ 0x77, 0x4f, 0x07, 0x00, 0x90, 0x89, 0x37, 0xa1,
+ 0x00, 0x90, 0x8a, 0x37, 0x9c, 0x00, 0x90, 0xa6,
+ 0x36, 0xcc, 0x00, 0x90, 0xaa, 0x35, 0xee, 0x00,
+ 0x92, 0x5b, 0x35, 0x5b, 0x00, 0x96, 0x86, 0x21,
+ 0xee, 0x00, 0x96, 0x98, 0x4f, 0x13, 0x00, 0x96,
+ 0xa3, 0x37, 0x0b, 0x00, 0x96, 0xc5, 0x35, 0x67,
+ 0x00, 0x97, 0x5c, 0x36, 0x32, 0x00, 0x97, 0x60,
+ 0x35, 0x37, 0x00, 0x97, 0x6d, 0x1f, 0x23, 0x00,
+ 0x97, 0x71, 0x35, 0x38, 0x00, 0x97, 0xff, 0x35,
+ 0x9e, 0x00, 0x98, 0xef, 0x4f, 0x25, 0x00, 0x99,
+ 0x0c, 0x34, 0x65, 0x00, 0x99, 0x45, 0x37, 0xb8,
+ 0x00, 0x99, 0x57, 0x35, 0x9f, 0x00, 0x9e, 0x9f,
+ 0x37, 0x0d, 0x00, 0x9f, 0x08, 0x37, 0xc4, 0x00,
+ 0x9f, 0x8d, 0x37, 0x07, 0x02, 0x36, 0x3a, 0x35,
+ 0x9c, 0x00, 0x00, 0x00, 0x11, 0x00, 0x51, 0xde,
+ 0x4e, 0x71, 0x00, 0x53, 0xa9, 0x34, 0x64, 0x00,
+ 0x56, 0xae, 0x4e, 0x7f, 0x00, 0x5b, 0xb3, 0x4e,
+ 0x8f, 0x00, 0x61, 0x68, 0x35, 0x6c, 0x00, 0x61,
+ 0xf2, 0x52, 0x50, 0x00, 0x66, 0x5f, 0x37, 0x39,
+ 0x00, 0x67, 0x17, 0x37, 0x12, 0x00, 0x69, 0x82,
+ 0x35, 0x70, 0x00, 0x75, 0x11, 0x4f, 0x3c, 0x00,
+ 0x83, 0xdf, 0x4e, 0xe9, 0x00, 0x90, 0x77, 0x4f,
+ 0x08, 0x00, 0x90, 0x89, 0x37, 0xa2, 0x00, 0x90,
+ 0x8a, 0x37, 0x9d, 0x00, 0x97, 0xff, 0x4f, 0x15,
+ 0x00, 0x99, 0x0c, 0x35, 0x52, 0x00, 0x99, 0x57,
+ 0x4f, 0x19, 0x00, 0x00, 0x00, 0x06, 0x00, 0x51,
+ 0xde, 0x21, 0x5e, 0x00, 0x53, 0xa9, 0x35, 0x4f,
+ 0x00, 0x61, 0x68, 0x35, 0x6d, 0x00, 0x90, 0x89,
+ 0x37, 0xa3, 0x00, 0x90, 0x8a, 0x37, 0x9e, 0x00,
+ 0x97, 0xff, 0x4f, 0x16, 0x00, 0x00, 0x00, 0x04,
+ 0x00, 0x53, 0xa9, 0x4f, 0x2f, 0x00, 0x61, 0x68,
+ 0x35, 0x6e, 0x00, 0x90, 0x89, 0x37, 0xa4, 0x00,
+ 0x90, 0x8a, 0x37, 0x9f, 0x00, 0x00, 0x00, 0x02,
+ 0x00, 0x90, 0x89, 0x37, 0xa5, 0x00, 0x90, 0x8a,
+ 0x37, 0xa0, 0x00, 0x00, 0x00, 0x02, 0x00, 0x90,
+ 0x89, 0x37, 0xa6, 0x00, 0x90, 0x8a, 0x4f, 0x0a,
0x00, 0x00, 0x00, 0x01, 0x00, 0x90, 0x89, 0x37,
- 0xac, 0x00, 0x00, 0x00, 0x01, 0x00, 0x90, 0x89,
- 0x4f, 0x09
+ 0xa7, 0x00, 0x00, 0x00, 0x01, 0x00, 0x90, 0x89,
+ 0x37, 0xa8, 0x00, 0x00, 0x00, 0x01, 0x00, 0x90,
+ 0x89, 0x37, 0xa9, 0x00, 0x00, 0x00, 0x01, 0x00,
+ 0x90, 0x89, 0x37, 0xaa, 0x00, 0x00, 0x00, 0x01,
+ 0x00, 0x90, 0x89, 0x37, 0xab, 0x00, 0x00, 0x00,
+ 0x01, 0x00, 0x90, 0x89, 0x37, 0xac, 0x00, 0x00,
+ 0x00, 0x01, 0x00, 0x90, 0x89, 0x4f, 0x09
};
diff --git a/src/marker.c b/src/marker.c
index 9727586f42..0ed1e55ddc 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -759,23 +759,6 @@ If TYPE is nil, it means the marker stays behind when you
insert text at it. */
return type;
}
-DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
- 1, 1, 0,
- doc: /* Return t if there are markers pointing at POSITION in the
current buffer. */)
- (Lisp_Object position)
-{
- register struct Lisp_Marker *tail;
- register ptrdiff_t charpos;
-
- charpos = clip_to_bounds (BEG, XFIXNUM (position), Z);
-
- for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
- if (tail->charpos == charpos)
- return Qt;
-
- return Qnil;
-}
-
#ifdef MARKER_DEBUG
/* For debugging -- count the markers in buffer BUF. */
@@ -821,5 +804,4 @@ syms_of_marker (void)
defsubr (&Scopy_marker);
defsubr (&Smarker_insertion_type);
defsubr (&Sset_marker_insertion_type);
- defsubr (&Sbuffer_has_markers_at);
}
diff --git a/src/menu.c b/src/menu.c
index eeb0c9a7e5..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"
@@ -32,10 +33,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "buffer.h"
-#ifdef USE_X_TOOLKIT
-#include "../lwlib/lwlib.h"
-#endif
-
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
@@ -1395,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.c b/src/msdos.c
index 1608245904..1d3fdd528d 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -1794,7 +1794,6 @@ internal_terminal_init (void)
}
Vinitial_window_system = Qpc;
- Vwindow_system_version = make_fixnum (29); /* RE Emacs version */
tty->terminal->type = output_msdos_raw;
/* If Emacs was dumped on DOS/V machine, forget the stale VRAM
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/nsfont.m b/src/nsfont.m
index b54118afe5..d072b5ce77 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -324,106 +324,98 @@ ns_get_family (Lisp_Object font_spec)
static NSFontDescriptor *
ns_spec_to_descriptor (Lisp_Object font_spec)
{
- NSFontDescriptor *fdesc;
- NSMutableDictionary *fdAttrs = [NSMutableDictionary new];
- NSString *family = ns_get_family (font_spec);
- NSMutableDictionary *tdict = [NSMutableDictionary new];
+ NSFontDescriptor *fdesc;
+ NSMutableDictionary *fdAttrs = [NSMutableDictionary new];
+ NSString *family = ns_get_family (font_spec);
+ NSMutableDictionary *tdict = [NSMutableDictionary new];
- Lisp_Object tem;
+ Lisp_Object tem;
- tem = FONT_SLANT_SYMBOLIC (font_spec);
- if (!NILP (tem))
- {
- if (EQ (tem, Qitalic) || EQ (tem, Qoblique))
- [tdict setObject: [NSNumber numberWithFloat: 1.0]
- forKey: NSFontSlantTrait];
- else if (EQ (tem, intern ("reverse-italic")) ||
- EQ (tem, intern ("reverse-oblique")))
- [tdict setObject: [NSNumber numberWithFloat: -1.0]
- forKey: NSFontSlantTrait];
- else
- [tdict setObject: [NSNumber numberWithFloat: 0.0]
- forKey: NSFontSlantTrait];
- }
+ tem = FONT_SLANT_SYMBOLIC (font_spec);
+ if (!NILP (tem))
+ {
+ if (EQ (tem, Qitalic) || EQ (tem, Qoblique))
+ [tdict setObject: [NSNumber numberWithFloat: 1.0]
+ forKey: NSFontSlantTrait];
+ else if (EQ (tem, intern ("reverse-italic"))
+ || EQ (tem, intern ("reverse-oblique")))
+ [tdict setObject: [NSNumber numberWithFloat: -1.0]
+ forKey: NSFontSlantTrait];
+ else
+ [tdict setObject: [NSNumber numberWithFloat: 0.0]
+ forKey: NSFontSlantTrait];
+ }
- tem = FONT_WIDTH_SYMBOLIC (font_spec);
- if (!NILP (tem))
- {
- if (EQ (tem, Qcondensed))
- [tdict setObject: [NSNumber numberWithFloat: -1.0]
- forKey: NSFontWidthTrait];
- else if (EQ (tem, Qexpanded))
- [tdict setObject: [NSNumber numberWithFloat: 1.0]
- forKey: NSFontWidthTrait];
- else
- [tdict setObject: [NSNumber numberWithFloat: 0.0]
- forKey: NSFontWidthTrait];
- }
+ tem = FONT_WIDTH_SYMBOLIC (font_spec);
+ if (!NILP (tem))
+ {
+ if (EQ (tem, Qcondensed))
+ [tdict setObject: [NSNumber numberWithFloat: -1.0]
+ forKey: NSFontWidthTrait];
+ else if (EQ (tem, Qexpanded))
+ [tdict setObject: [NSNumber numberWithFloat: 1.0]
+ forKey: NSFontWidthTrait];
+ else
+ [tdict setObject: [NSNumber numberWithFloat: 0.0]
+ forKey: NSFontWidthTrait];
+ }
- tem = FONT_WEIGHT_SYMBOLIC (font_spec);
+ tem = FONT_WEIGHT_SYMBOLIC (font_spec);
- if (!NILP (tem))
- {
- if (EQ (tem, Qbold))
- {
- [tdict setObject: [NSNumber numberWithFloat: 1.0]
- forKey: NSFontWeightTrait];
- }
- else if (EQ (tem, Qlight))
- {
- [tdict setObject: [NSNumber numberWithFloat: -1.0]
- forKey: NSFontWeightTrait];
- }
- else
- {
- [tdict setObject: [NSNumber numberWithFloat: 0.0]
- forKey: NSFontWeightTrait];
- }
- }
+ if (!NILP (tem))
+ {
+ if (EQ (tem, Qbold))
+ {
+ [tdict setObject: [NSNumber numberWithFloat: 1.0]
+ forKey: NSFontWeightTrait];
+ }
+ else if (EQ (tem, Qlight))
+ {
+ [tdict setObject: [NSNumber numberWithFloat: -1.0]
+ forKey: NSFontWeightTrait];
+ }
+ else
+ {
+ [tdict setObject: [NSNumber numberWithFloat: 0.0]
+ forKey: NSFontWeightTrait];
+ }
+ }
- tem = AREF (font_spec, FONT_SPACING_INDEX);
+ tem = AREF (font_spec, FONT_SPACING_INDEX);
- if (family != nil)
- {
- [fdAttrs setObject: family
- forKey: NSFontFamilyAttribute];
- }
+ if (family != nil)
+ [fdAttrs setObject: family
+ forKey: NSFontFamilyAttribute];
- if (FIXNUMP (tem))
- {
- if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL)
- {
- [fdAttrs setObject: [NSNumber numberWithBool:YES]
- forKey: NSFontFixedAdvanceAttribute];
- }
- else
- {
- [fdAttrs setObject: [NSNumber numberWithBool:NO]
- forKey: NSFontFixedAdvanceAttribute];
- }
- }
+ if (FIXNUMP (tem))
+ {
+ if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL)
+ [fdAttrs setObject: [NSNumber numberWithBool: YES]
+ forKey: NSFontFixedAdvanceAttribute];
+ else
+ [fdAttrs setObject: [NSNumber numberWithBool: NO]
+ forKey: NSFontFixedAdvanceAttribute];
+ }
- /* Handle special families such as ``fixed'' or ``Sans Serif''. */
+ /* Handle special families such as ``fixed'', ``monospace'' or
+ ``Sans Serif''. */
- if ([family isEqualToString: @"fixed"])
- {
- [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName]
- forKey: NSFontFamilyAttribute];
- }
- else if ([family isEqualToString: @"Sans Serif"])
- {
- [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName]
- forKey: NSFontFamilyAttribute];
- }
+ if ([family isEqualToString: @"fixed"]
+ || [family isEqualToString: @"monospace"])
+ [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName]
+ forKey: NSFontFamilyAttribute];
+ else if ([family isEqualToString: @"Sans Serif"])
+ [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName]
+ forKey: NSFontFamilyAttribute];
- [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute];
+ [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute];
- fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs]
- retain] autorelease];
+ fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs]
+ retain] autorelease];
- [tdict release];
- [fdAttrs release];
- return fdesc;
+ [tdict release];
+ [fdAttrs release];
+ return fdesc;
}
@@ -477,7 +469,7 @@ ns_descriptor_to_entity (NSFontDescriptor *desc,
ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0));
ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0));
ASET (font_entity, FONT_SPACING_INDEX,
- make_fixnum ((data.specified & GS_SPECIFIED_WIDTH && data.monospace_p)
+ make_fixnum ((data.specified & GS_SPECIFIED_SPACING && data.monospace_p)
? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL));
ASET (font_entity, FONT_EXTRA_INDEX, extra);
@@ -792,53 +784,53 @@ static NSSet
static Lisp_Object
ns_findfonts (Lisp_Object font_spec, BOOL isMatch)
{
- Lisp_Object tem, list = Qnil;
- NSFontDescriptor *fdesc;
- NSArray *all_descs;
- GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator];
+ Lisp_Object tem, list = Qnil;
+ NSFontDescriptor *fdesc;
+ NSArray *all_descs;
+ GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator];
- NSSet *cFamilies;
+ NSSet *cFamilies;
- block_input ();
- if (NSFONT_TRACE)
- {
- fprintf (stderr, "nsfont: %s for fontspec:\n ",
- (isMatch ? "match" : "list"));
- debug_print (font_spec);
- }
+ block_input ();
+ if (NSFONT_TRACE)
+ {
+ fprintf (stderr, "nsfont: %s for fontspec:\n ",
+ (isMatch ? "match" : "list"));
+ debug_print (font_spec);
+ }
- cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90);
+ cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90);
- fdesc = ns_spec_to_descriptor (font_spec);
- all_descs = [enumerator availableFontDescriptors];
+ fdesc = ns_spec_to_descriptor (font_spec);
+ all_descs = [enumerator availableFontDescriptors];
- for (NSFontDescriptor *desc in all_descs)
- {
- if (![cFamilies containsObject:
- [desc objectForKey: NSFontFamilyAttribute]])
- continue;
- if (!ns_font_descs_match_p (fdesc, desc))
- continue;
-
- tem = ns_descriptor_to_entity (desc,
- AREF (font_spec, FONT_EXTRA_INDEX),
- NULL);
- if (isMatch)
- return tem;
- list = Fcons (tem, list);
- }
+ for (NSFontDescriptor *desc in all_descs)
+ {
+ if (![cFamilies containsObject:
+ [desc objectForKey: NSFontFamilyAttribute]])
+ continue;
+ if (!ns_font_descs_match_p (fdesc, desc))
+ continue;
+
+ tem = ns_descriptor_to_entity (desc,
+ AREF (font_spec, FONT_EXTRA_INDEX),
+ NULL);
+ if (isMatch)
+ return tem;
+ list = Fcons (tem, list);
+ }
- unblock_input ();
+ unblock_input ();
- /* Return something if was a match and nothing found. */
- if (isMatch)
- return ns_fallback_entity ();
+ /* Return something if was a match and nothing found. */
+ if (isMatch)
+ return ns_fallback_entity ();
- if (NSFONT_TRACE)
- fprintf (stderr, " Returning %"pD"d entities.\n",
- list_length (list));
+ if (NSFONT_TRACE)
+ fprintf (stderr, " Returning %"pD"d entities.\n",
+ list_length (list));
- return list;
+ return list;
}
diff --git a/src/nsmenu.m b/src/nsmenu.m
index ae795a0d22..b06f737bac 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1551,7 +1551,6 @@ pop_down_menu (void *arg)
#ifdef NS_IMPL_COCOA
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
#endif
- discard_menu_items ();
}
}
@@ -1599,6 +1598,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
if (error_name)
{
+ unbind_to (specpdl_count, Qnil);
discard_menu_items ();
[dialog close];
error ("%s", error_name);
@@ -1608,6 +1608,9 @@ ns_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
popup_activated_flag = 1;
tem = [dialog runDialogAt: p];
unbind_to (specpdl_count, Qnil);
+
+ /* This must come *after* unuse_menu_items. */
+ discard_menu_items ();
return tem;
}
diff --git a/src/nsterm.m b/src/nsterm.m
index e3f47eb905..17f40dc7e3 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -37,7 +37,6 @@ GNUstep port and post-20 update by Adrian Robert
(arobert@cogsci.ucsd.edu)
#include <time.h>
#include <signal.h>
#include <unistd.h>
-#include <stdbool.h>
#include <c-ctype.h>
#include <c-strcase.h>
@@ -2480,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;
}
@@ -3996,6 +3995,7 @@ static void
ns_draw_stretch_glyph_string (struct glyph_string *s)
{
struct face *face;
+ NSColor *fg_color;
if (s->hl == DRAW_CURSOR
&& !x_stretch_cursor_p)
@@ -4092,8 +4092,20 @@ ns_draw_stretch_glyph_string (struct glyph_string *s)
NSRectFill (NSMakeRect (x, s->y, background_width, s->height));
}
}
-}
+ /* Draw overlining, etc. on the stretch glyph (or the part of the
+ stretch glyph after the cursor). If the glyph has a box, then
+ decorations will be drawn after drawing the box in
+ ns_draw_glyph_string, in order to prevent them from being
+ overwritten by the box. */
+ if (s->face->box == FACE_NO_BOX)
+ {
+ fg_color = [NSColor colorWithUnsignedLong:
+ NS_FACE_FOREGROUND (s->face)];
+ ns_draw_text_decoration (s, s->face, fg_color,
+ s->background_width, s->x);
+ }
+}
static void
ns_draw_glyph_string_foreground (struct glyph_string *s)
@@ -4225,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;
@@ -4241,6 +4258,8 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
? CHAR_TABLE_REF (Vglyphless_char_display,
glyph->u.glyphless.ch)
: XCHAR_TABLE (Vglyphless_char_display)->extras[0]);
+ if (CONSP (acronym))
+ acronym = XCAR (acronym);
if (STRINGP (acronym))
str = SSDATA (acronym);
}
@@ -4249,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;
}
@@ -4409,7 +4428,8 @@ ns_draw_glyph_string (struct glyph_string *s)
{
NSColor *fg_color;
- fg_color = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (s->face)];
+ fg_color = [NSColor colorWithUnsignedLong: NS_FACE_FOREGROUND (s->face)];
+
ns_draw_text_decoration (s, s->face, fg_color,
s->background_width, s->x);
}
@@ -5605,17 +5625,6 @@ ns_term_init (Lisp_Object display_name)
NSTRACE_MSG ("Versions");
- {
-#ifdef NS_IMPL_GNUSTEP
- Vwindow_system_version = build_string (gnustep_base_version);
-#else
- /* PSnextrelease (128, c); */
- char c[DBL_BUFSIZE_BOUND];
- int len = dtoastr (c, sizeof c, 0, 0, NSAppKitVersionNumber);
- Vwindow_system_version = make_unibyte_string (c, len);
-#endif
- }
-
delete_keyboard_wait_descriptor (0);
ns_app_name = [[NSProcessInfo processInfo] processName];
@@ -6112,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
@@ -7915,17 +7927,24 @@ ns_create_font_panel_buttons (id target, SEL select,
SEL cancel_action)
if (!emacsframe->output_data.ns)
return;
+
if (screen != nil)
{
- emacsframe->left_pos = NSMinX (r) - NS_PARENT_WINDOW_LEFT_POS
(emacsframe);
- emacsframe->top_pos = NS_PARENT_WINDOW_TOP_POS (emacsframe) - NSMaxY (r);
+ emacsframe->left_pos = (NSMinX (r)
+ - NS_PARENT_WINDOW_LEFT_POS (emacsframe));
+ emacsframe->top_pos = (NS_PARENT_WINDOW_TOP_POS (emacsframe)
+ - NSMaxY (r));
- // FIXME: after event part below didExitFullScreen is not received
- // if (emacs_event)
- // {
- // emacs_event->kind = MOVE_FRAME_EVENT;
- // EV_TRAILER ((id)nil);
- // }
+ if (emacs_event)
+ {
+ struct input_event ie;
+ EVENT_INIT (ie);
+ ie.kind = MOVE_FRAME_EVENT;
+ XSETFRAME (ie.frame_or_window, emacsframe);
+ XSETINT (ie.x, emacsframe->left_pos);
+ XSETINT (ie.y, emacsframe->top_pos);
+ kbd_buffer_store_event (&ie);
+ }
}
}
@@ -8582,7 +8601,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));
@@ -9144,6 +9163,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 . */
diff --git a/src/pdumper.c b/src/pdumper.c
index 903298f17d..d6ae57afb2 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_interval_node_5765524F7E)
+# error "interval_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_1CD4249AEC)
# 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_F0F08347A5
# 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 beaf28f69d..9473e14f5c 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -164,8 +164,6 @@ pgtk_display_info_for_name (Lisp_Object name)
if (dpyinfo == 0)
error ("Cannot connect to display server %s", SDATA (name));
- XSETFASTINT (Vwindow_system_version, 11);
-
return dpyinfo;
}
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index b283cef7cd..491ba33882 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -1584,6 +1584,8 @@ pgtk_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
? CHAR_TABLE_REF (Vglyphless_char_display,
glyph->u.glyphless.ch)
: XCHAR_TABLE (Vglyphless_char_display)->extras[0]);
+ if (CONSP (acronym))
+ acronym = XCAR (acronym);
if (STRINGP (acronym))
str = SSDATA (acronym);
}
diff --git a/src/print.c b/src/print.c
index 1c96ec14b8..65218084a4 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.
@@ -594,8 +593,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);
@@ -1745,15 +1743,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);
diff --git a/src/process.c b/src/process.c
index 7a133cda00..358899cded 100644
--- a/src/process.c
+++ b/src/process.c
@@ -7391,7 +7391,8 @@ child_signal_notify (void)
}
/* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
- its own SIGCHLD handling. On POSIXish systems, glib needs this to
+ its own SIGCHLD handling. On POSIXish systems lacking
+ pidfd_open+waitid or using Glib 2.73.1-, Glib needs this to
keep track of its own children. GNUstep is similar. */
static void dummy_handler (int sig) {}
@@ -8358,7 +8359,7 @@ DEFUN ("signal-names", Fsignal_names, Ssignal_names, 0,
0, 0,
#ifdef subprocesses
/* Arrange to catch SIGCHLD if this hasn't already been arranged.
- Invoke this after init_process_emacs, and after glib and/or GNUstep
+ Invoke this after init_process_emacs, and after Glib and/or GNUstep
futz with the SIGCHLD handler, but before Emacs forks any children.
This function's caller should block SIGCHLD. */
@@ -8423,26 +8424,35 @@ init_process_emacs (int sockfd)
if (!will_dump_with_unexec_p ())
{
#if defined HAVE_GLIB && !defined WINDOWSNT
- /* Tickle glib's child-handling code. Ask glib to install a
+ /* Tickle Glib's child-handling code. Ask Glib to install a
watch source for Emacs itself which will initialize glib's
private SIGCHLD handler, allowing catch_child_signal to copy
- it into lib_child_handler.
+ it into lib_child_handler. This is a hacky workaround to get
+ glib's g_unix_signal_handler into lib_child_handler.
- Unfortunately in glib commit 2e471acf, the behavior changed to
+ In Glib 2.37.5 (2013), commit 2e471acf changed Glib to
always install a signal handler when g_child_watch_source_new
- is called and not just the first time it's called. Glib also
- now resets signal handlers to SIG_DFL when it no longer has a
- watcher on that signal. This is a hackey work around to get
- glib's g_unix_signal_handler into lib_child_handler. */
+ is called and not just the first time it's called, and to
+ reset signal handlers to SIG_DFL when it no longer has a
+ watcher on that signal. Arrange for Emacs's signal handler
+ to be reinstalled even if this happens.
+
+ In Glib 2.73.2 (2022), commit f615eef4 changed Glib again,
+ to not install a signal handler if the system supports
+ pidfd_open and waitid (as in Linux kernel 5.3+). The hacky
+ workaround is not needed in this case. */
GSource *source = g_child_watch_source_new (getpid ());
catch_child_signal ();
g_source_unref (source);
- eassert (lib_child_handler != dummy_handler);
- signal_handler_t lib_child_handler_glib = lib_child_handler;
- catch_child_signal ();
- eassert (lib_child_handler == dummy_handler);
- lib_child_handler = lib_child_handler_glib;
+ if (lib_child_handler != dummy_handler)
+ {
+ /* The hacky workaround is needed on this platform. */
+ signal_handler_t lib_child_handler_glib = lib_child_handler;
+ catch_child_signal ();
+ eassert (lib_child_handler == dummy_handler);
+ lib_child_handler = lib_child_handler_glib;
+ }
#else
catch_child_signal ();
#endif
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/sqlite.c b/src/sqlite.c
index 54bfb7b6c6..08bf696b8c 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -50,7 +50,9 @@ 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*));
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
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 +89,9 @@ 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
+# undef sqlite3_errstr
# undef sqlite3_step
# undef sqlite3_changes
# undef sqlite3_column_count
@@ -111,7 +115,9 @@ 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
+# define sqlite3_errstr fn_sqlite3_errstr
# define sqlite3_step fn_sqlite3_step
# define sqlite3_changes fn_sqlite3_changes
# define sqlite3_column_count fn_sqlite3_column_count
@@ -138,7 +144,9 @@ 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);
+ LOAD_DLL_FN (library, sqlite3_errstr);
LOAD_DLL_FN (library, sqlite3_step);
LOAD_DLL_FN (library, sqlite3_changes);
LOAD_DLL_FN (library, sqlite3_column_count);
@@ -229,13 +237,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 +263,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 +276,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 +346,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 +381,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 +425,93 @@ row_to_value (sqlite3_stmt *stmt)
return Fnreverse (values);
}
+static Lisp_Object
+sqlite_prepare_errdata (int code, sqlite3 *sdb)
+{
+ Lisp_Object errstr = build_string (sqlite3_errstr (code));
+ Lisp_Object errcode = make_fixnum (code);
+ /* More details about what went wrong. */
+ Lisp_Object ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
+ const char *errmsg = sqlite3_errmsg (sdb);
+ return list4 (errstr, errmsg ? build_string (errmsg) : Qnil,
+ 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 +528,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 +544,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 +557,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 +568,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 +582,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 +592,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 +679,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 +699,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 +798,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 efd9638b07..736723bdf3 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1304,7 +1304,10 @@ init_sys_modes (struct tty_display_info *tty_out)
}
#endif /* F_GETOWN */
- setvbuf (tty_out->output, NULL, _IOFBF, BUFSIZ);
+ const size_t buffer_size = (tty_out->output_buffer_size
+ ? tty_out->output_buffer_size
+ : BUFSIZ);
+ setvbuf (tty_out->output, NULL, _IOFBF, buffer_size);
if (tty_out->terminal->set_terminal_modes_hook)
tty_out->terminal->set_terminal_modes_hook (tty_out->terminal);
@@ -2429,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/systhread.h b/src/systhread.h
index bf4e0306cd..10d6237f27 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -19,8 +19,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifndef SYSTHREAD_H
#define SYSTHREAD_H
-#include <stdbool.h>
-
#include <attribute.h>
#ifdef THREADS_ENABLED
diff --git a/src/term.c b/src/term.c
index 3bea621dbd..f8104e0304 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1862,12 +1862,24 @@ produce_glyphless_glyph (struct it *it, Lisp_Object
acronym)
acronym = CHAR_TABLE_REF (Vglyphless_char_display, it->c);
if (CONSP (acronym))
acronym = XCDR (acronym);
- buf[0] = '[';
str = STRINGP (acronym) ? SSDATA (acronym) : "";
- for (len = 0; len < 6 && str[len] && ASCII_CHAR_P (str[len]); len++)
- buf[1 + len] = str[len];
- buf[1 + len] = ']';
- len += 2;
+ /* A special kludgey feature for single-character acronyms:
+ don't put them in a box, effectively treating them as a
+ replacement character. */
+ if (STRINGP (acronym) && SCHARS (acronym) == 1)
+ {
+ buf[0] = str[0];
+ len = 1;
+ }
+ else
+ {
+ buf[0] = '[';
+ for (len = 0;
+ len < 6 && str[len] && ASCII_CHAR_P (str[len]); len++)
+ buf[1 + len] = str[len];
+ buf[1 + len] = ']';
+ len += 2;
+ }
}
else
{
@@ -2388,6 +2400,44 @@ frame's terminal). */)
return Qnil;
}
+DEFUN ("tty--set-output-buffer-size", Ftty__set_output_buffer_size,
+ Stty__set_output_buffer_size, 1, 2, 0, doc:
+ /* Set the output buffer size for a TTY.
+
+SIZE zero means use the system's default value. If SIZE is
+non-zero, this also avoids flushing the output stream.
+
+TTY may be a terminal object, a frame, or nil (meaning the selected
+frame's terminal).
+
+This function temporarily suspends and resumes the terminal
+device. */)
+ (Lisp_Object size, Lisp_Object tty)
+{
+ if (!TYPE_RANGED_FIXNUMP (size_t, size))
+ error ("Invalid output buffer size");
+ Fsuspend_tty (tty);
+ struct terminal *terminal = decode_tty_terminal (tty);
+ terminal->display_info.tty->output_buffer_size = XFIXNUM (size);
+ return Fresume_tty (tty);
+}
+
+DEFUN ("tty--output-buffer-size", Ftty__output_buffer_size,
+ Stty__output_buffer_size, 0, 1, 0, doc:
+ /* Return the output buffer size of TTY.
+
+TTY may be a terminal object, a frame, or nil (meaning the selected
+frame's terminal).
+
+A value of zero means TTY uses the system's default value. */)
+ (Lisp_Object tty)
+{
+ struct terminal *terminal = decode_tty_terminal (tty);
+ if (terminal)
+ return make_fixnum (terminal->display_info.tty->output_buffer_size);
+ error ("Not a tty terminal");
+}
+
/***********************************************************************
Mouse
@@ -4544,6 +4594,8 @@ trigger redisplay. */);
defsubr (&Stty_top_frame);
defsubr (&Ssuspend_tty);
defsubr (&Sresume_tty);
+ defsubr (&Stty__set_output_buffer_size);
+ defsubr (&Stty__output_buffer_size);
#ifdef HAVE_GPM
defsubr (&Sgpm_mouse_start);
defsubr (&Sgpm_mouse_stop);
diff --git a/src/termchar.h b/src/termchar.h
index 49560dbc2a..0f17246411 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -53,6 +53,11 @@ struct tty_display_info
FILE *output; /* The stream to be used for terminal output.
NULL if the terminal is suspended. */
+ /* Size of output buffer. A value of zero means use the default of
+ BUFIZE. If non-zero, also minimize writes to the tty by avoiding
+ calls to flush. */
+ size_t output_buffer_size;
+
FILE *termscript; /* If nonzero, send all terminal output
characters to this stream also. */
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/w32.c b/src/w32.c
index cbcfcdd4f6..9c7d536ada 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -5992,12 +5992,22 @@ sys_umask (int mode)
#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY
#define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1
#endif
+#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
+#define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2
+#endif
int
symlink (char const *filename, char const *linkname)
{
char linkfn[MAX_UTF8_PATH], *tgtfn;
- DWORD flags = 0;
+ /* The SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE flag is
+ supported from Windows 10 build 14972. It is only supported if
+ Developer Mode is enabled, and is ignored if it isn't. */
+ DWORD flags =
+ (os_subtype == OS_SUBTYPE_NT
+ && (w32_major_version > 10
+ || (w32_major_version == 10 && w32_build_number >= 14972)))
+ ? SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE : 0;
int dir_access, filename_ends_in_slash;
/* Diagnostics follows Posix as much as possible. */
@@ -6055,7 +6065,7 @@ symlink (char const *filename, char const *linkname)
directory. */
filename_ends_in_slash = IS_DIRECTORY_SEP (filename[strlen (filename) - 1]);
if (dir_access == 0 || filename_ends_in_slash)
- flags = SYMBOLIC_LINK_FLAG_DIRECTORY;
+ flags |= SYMBOLIC_LINK_FLAG_DIRECTORY;
tgtfn = (char *)map_w32_filename (filename, NULL);
if (filename_ends_in_slash)
@@ -6470,6 +6480,17 @@ chase_symlinks (const char *file)
return target;
}
+/* Return non-zero if FILE's filesystem supports symlinks. */
+bool
+symlinks_supported (const char *file)
+{
+ if (is_windows_9x () != TRUE
+ && get_volume_info (file, NULL)
+ && (volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0)
+ return true;
+ return false;
+}
+
/* Posix ACL emulation. */
diff --git a/src/w32.h b/src/w32.h
index dc91c595c4..b914aa9baf 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -228,6 +228,8 @@ extern int sys_link (const char *, const char *);
extern int openat (int, const char *, int, int);
extern int fchmodat (int, char const *, mode_t, int);
extern int lchmod (char const *, mode_t);
+extern bool symlinks_supported (const char *);
+
/* Return total and free memory info. */
extern int w32_memory_info (unsigned long long *, unsigned long long *,
diff --git a/src/w32fns.c b/src/w32fns.c
index 28d13a68d4..93b7f80f26 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2734,8 +2734,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);
@@ -6699,8 +6698,6 @@ w32_display_info_for_name (Lisp_Object name)
if (dpyinfo == 0)
error ("Cannot connect to server %s", SDATA (name));
- XSETFASTINT (Vwindow_system_version, w32_major_version);
-
return dpyinfo;
}
@@ -6781,7 +6778,6 @@ DEFUN ("x-open-connection", Fx_open_connection,
Sx_open_connection,
error ("Cannot connect to server %s", SDATA (display));
}
- XSETFASTINT (Vwindow_system_version, w32_major_version);
return Qnil;
}
@@ -10450,6 +10446,66 @@ w32_get_resource (const char *key, const char *name,
LPDWORD lpdwtype)
return (NULL);
}
+#ifdef WINDOWSNT
+
+/***********************************************************************
+ Wallpaper
+ ***********************************************************************/
+
+typedef BOOL (WINAPI * SystemParametersInfoW_Proc) (UINT,UINT,PVOID,UINT);
+SystemParametersInfoW_Proc system_parameters_info_w_fn = NULL;
+
+DEFUN ("w32-set-wallpaper", Fw32_set_wallpaper, Sw32_set_wallpaper, 1, 1, 0,
+ doc: /* Set the desktop wallpaper image to IMAGE-FILE. */)
+ (Lisp_Object image_file)
+{
+ Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (image_file, Qnil));
+ char *fname = SSDATA (encoded);
+ BOOL result = false;
+ DWORD err = 0;
+
+ /* UNICOWS.DLL seems to have SystemParametersInfoW, but it doesn't
+ seem to be worth the hassle to support that on Windows 9X for the
+ benefit of this minor feature. Let them use on Windows 9X only
+ image file names that can be encoded by the system codepage. */
+ if (w32_unicode_filenames && system_parameters_info_w_fn)
+ {
+ wchar_t fname_w[MAX_PATH];
+
+ if (filename_to_utf16 (fname, fname_w) != 0)
+ err = ERROR_FILE_NOT_FOUND;
+ else
+ result = SystemParametersInfoW (SPI_SETDESKWALLPAPER, 0, fname_w,
+ SPIF_SENDCHANGE);
+ }
+ else
+ {
+ char fname_a[MAX_PATH];
+
+ if (filename_to_ansi (fname, fname_a) != 0)
+ err = ERROR_FILE_NOT_FOUND;
+ else
+ result = SystemParametersInfoA (SPI_SETDESKWALLPAPER, 0, fname_a,
+ SPIF_SENDCHANGE);
+ }
+ if (!result)
+ {
+ if (err == ERROR_FILE_NOT_FOUND)
+ error ("Wallpaper file %s does not exist or cannot be accessed", fname);
+ else
+ {
+ err = GetLastError ();
+ if (err)
+ error ("Could not set desktop wallpaper: %s", w32_strerror (err));
+ else
+ error ("Could not set desktop wallpaper (wrong image type?)");
+ }
+ }
+
+ return Qnil;
+}
+#endif
+
/***********************************************************************
Initialization
***********************************************************************/
@@ -10929,6 +10985,7 @@ keys when IME input is received. */);
defsubr (&Sx_file_dialog);
#ifdef WINDOWSNT
defsubr (&Ssystem_move_file_to_trash);
+ defsubr (&Sw32_set_wallpaper);
#endif
}
@@ -11182,6 +11239,10 @@ globals_of_w32fns (void)
get_proc_addr (user32_lib, "EnumDisplayMonitors");
get_title_bar_info_fn = (GetTitleBarInfo_Proc)
get_proc_addr (user32_lib, "GetTitleBarInfo");
+#ifndef CYGWIN
+ system_parameters_info_w_fn = (SystemParametersInfoW_Proc)
+ get_proc_addr (user32_lib, "SystemParametersInfoW");
+#endif
{
HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
diff --git a/src/w32image.c b/src/w32image.c
index da748b8dab..af10d2bd26 100644
--- a/src/w32image.c
+++ b/src/w32image.c
@@ -256,7 +256,7 @@ w32_can_use_native_image_api (Lisp_Object type)
|| EQ (type, Qbmp)
|| EQ (type, Qnative_image)))
{
- /* GDI+ can also display BMP, Exif, ICON, WMF, and EMF images.
+ /* GDI+ can also display Exif, ICON, WMF, and EMF images.
But we don't yet support these in image.c. */
return false;
}
diff --git a/src/w32notify.c b/src/w32notify.c
index 72e634f77c..6b5fce9f92 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -367,6 +367,12 @@ add_watch (const char *parent_dir, const char *file, BOOL
subdirs, DWORD flags)
if (!file)
return NULL;
+ /* Do not follow symlinks, so that the caller could watch symlink
+ files. */
+ DWORD crflags = FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OVERLAPPED;
+ if (symlinks_supported (parent_dir))
+ crflags |= FILE_FLAG_OPEN_REPARSE_POINT;
+
if (w32_unicode_filenames)
{
wchar_t dir_w[MAX_PATH], file_w[MAX_PATH];
@@ -383,8 +389,7 @@ add_watch (const char *parent_dir, const char *file, BOOL
subdirs, DWORD flags)
processes from deleting files inside
parent_dir. */
FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE,
- NULL, OPEN_EXISTING,
- FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OVERLAPPED,
+ NULL, OPEN_EXISTING, crflags,
NULL);
}
else
@@ -400,8 +405,7 @@ add_watch (const char *parent_dir, const char *file, BOOL
subdirs, DWORD flags)
hdir = CreateFileA (dir_a,
FILE_LIST_DIRECTORY,
FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE,
- NULL, OPEN_EXISTING,
- FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OVERLAPPED,
+ NULL, OPEN_EXISTING, crflags,
NULL);
}
if (hdir == INVALID_HANDLE_VALUE)
diff --git a/src/w32term.c b/src/w32term.c
index d0577efccc..dff21489e5 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1490,6 +1490,8 @@ w32_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
? CHAR_TABLE_REF (Vglyphless_char_display,
glyph->u.glyphless.ch)
: XCHAR_TABLE (Vglyphless_char_display)->extras[0]);
+ if (CONSP (acronym))
+ acronym = XCAR (acronym);
if (STRINGP (acronym))
str = SSDATA (acronym);
}
diff --git a/src/widget.c b/src/widget.c
index b125b4caee..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,12 +298,7 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
base_height = (wmshell->core.height - ew->core.height
+ (rounded_height - (char_height * ch)));
- /* This is kind of sleazy, but I can't see how else to tell it to
- make it mark the WM_SIZE_HINTS size as user specified.
- */
-/* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
-
- XtVaSetValues (wmshell,
+ XtVaSetValues ((Widget) wmshell,
XtNbaseWidth, (XtArgVal) base_width,
XtNbaseHeight, (XtArgVal) base_height,
XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
@@ -305,12 +306,21 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
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
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 960f814e16..3a4d9206ff 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -49,7 +49,6 @@ typedef struct {
Boolean visual_bell; /* flash instead of beep */
int bell_volume; /* how loud is beep */
-
/* private state */
} EmacsFramePart;
diff --git a/src/window.c b/src/window.c
index 2bce4c9723..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. */
@@ -8213,6 +8301,8 @@ init_window_once (void)
minibuf_selected_window = Qnil;
staticpro (&minibuf_selected_window);
+ old_selected_window = Qnil;
+ staticpro (&old_selected_window);
pdumper_do_now_and_after_late_load (init_window_once_for_pdumper);
}
@@ -8363,7 +8453,8 @@ on their symbols to be controlled by this variable. */);
Vscroll_preserve_screen_position = Qnil;
DEFVAR_LISP ("window-point-insertion-type", Vwindow_point_insertion_type,
- doc: /* Type of marker to use for `window-point'. */);
+ doc: /* Insertion type of marker to use for `window-point'.
+See `marker-insertion-type' for the meaning of the possible values. */);
Vwindow_point_insertion_type = Qnil;
DEFSYM (Qwindow_point_insertion_type, "window-point-insertion-type");
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 7ca726b2cd..3b330f315b 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,
@@ -1960,15 +1958,18 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int
*x, int *y,
int top_x_before_string = it3.current_x;
/* Finally, advance the iterator until we hit the
first display element whose character position is
- CHARPOS, or until the first newline from the
- display string, which signals the end of the
- display line. */
+ at or beyond CHARPOS, or until the first newline
+ from the display string, which signals the end of
+ the display line. */
while (get_next_display_element (&it3))
{
if (!EQ (it3.object, string))
top_x_before_string = it3.current_x;
PRODUCE_GLYPHS (&it3);
- if (IT_CHARPOS (it3) == charpos
+ if ((it3.bidi_it.scan_dir == 1
+ && IT_CHARPOS (it3) >= charpos)
+ || (it3.bidi_it.scan_dir == -1
+ && IT_CHARPOS (it3) <= charpos)
|| ITERATOR_AT_END_OF_LINE_P (&it3))
break;
it3_moved = true;
@@ -4165,39 +4166,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. */
@@ -5835,7 +5803,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
@@ -6309,7 +6277,10 @@ handle_composition_prop (struct it *it)
pos_byte = IT_STRING_BYTEPOS (*it);
string = it->string;
s = SDATA (string) + pos_byte;
- it->c = STRING_CHAR (s);
+ if (STRING_MULTIBYTE (string))
+ it->c = STRING_CHAR (s);
+ else
+ it->c = *s;
}
else
{
@@ -6566,6 +6537,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)
@@ -6597,27 +6570,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
@@ -6628,56 +6598,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
@@ -7040,7 +6969,14 @@ pop_it (struct it *it)
|| (STRINGP (it->object)
&& IT_STRING_CHARPOS (*it) == it->bidi_it.charpos
&& IT_STRING_BYTEPOS (*it) == it->bidi_it.bytepos)
- || (CONSP (it->object) && it->method == GET_FROM_STRETCH));
+ || (CONSP (it->object) && it->method == GET_FROM_STRETCH)
+ /* We could be in the middle of handling a list or a
+ vector of several 'display' properties, in which
+ case we should only verify the above conditions when
+ we pop the iterator stack the last time, because
+ higher stack levels cannot "iterate out of the
+ display property". */
+ || it->sp > 0);
}
/* If we move the iterator over text covered by a display property
to a new buffer position, any info about previously seen overlays
@@ -7075,11 +7011,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. */
@@ -7087,14 +7023,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;
+ ptrdiff_t ostart = node->begin;
+ ptrdiff_t oend = node->end;
/* Skip overlays that don't overlap the range. */
if (!((startpos < oend && ostart < endpos)
@@ -7106,49 +7036,17 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t
endpos, struct window *w)
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;
-
- /* 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;
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
str = Foverlay_get (overlay, Qafter_string);
if (STRINGP (str) && SCHARS (str)
&& memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
}
/* Check for 'display' properties whose values include strings. */
@@ -7391,7 +7289,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);
@@ -7842,15 +7740,14 @@ lookup_glyphless_char_display (int c, struct it *it)
&& CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1)
{
if (c >= 0)
- {
- glyphless_method = CHAR_TABLE_REF (Vglyphless_char_display, c);
- if (CONSP (glyphless_method))
- glyphless_method = FRAME_WINDOW_P (it->f)
- ? XCAR (glyphless_method)
- : XCDR (glyphless_method);
- }
+ glyphless_method = CHAR_TABLE_REF (Vglyphless_char_display, c);
else
glyphless_method = XCHAR_TABLE (Vglyphless_char_display)->extras[0];
+
+ if (CONSP (glyphless_method))
+ glyphless_method = FRAME_WINDOW_P (it->f)
+ ? XCAR (glyphless_method)
+ : XCDR (glyphless_method);
}
retry:
@@ -10627,7 +10524,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;
@@ -10711,11 +10607,6 @@ move_it_vertically_backward (struct it *it, int dy)
while (nlines-- && IT_CHARPOS (*it) > pos_limit)
back_to_previous_visible_line_start (it);
- /* Move one line more back, for the (rare) situation where we have
- bidi-reordered continued lines, and we start from the top-most
- screen line, which is the last in logical order. */
- if (it->bidi_p && dy == 0)
- back_to_previous_visible_line_start (it);
/* Reseat the iterator here. When moving backward, we don't want
reseat to skip forward over invisible text, set up the iterator
to deliver from overlay strings at the new position etc. So,
@@ -10957,7 +10848,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
{
struct it it2;
void *it2data = NULL;
- ptrdiff_t start_charpos, i;
+ ptrdiff_t start_charpos, orig_charpos, i;
int nchars_per_row
= (it->last_visible_x - it->first_visible_x) / FRAME_COLUMN_WIDTH
(it->f);
bool hit_pos_limit = false;
@@ -10967,7 +10858,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
position. This may actually move vertically backwards,
in case of overlays, so adjust dvpos accordingly. */
dvpos += it->vpos;
- start_charpos = IT_CHARPOS (*it);
+ orig_charpos = IT_CHARPOS (*it);
move_it_vertically_backward (it, 0);
dvpos -= it->vpos;
@@ -11020,8 +10911,9 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
RESTORE_IT (&it2, &it2, it2data);
SAVE_IT (it2, *it, it2data);
move_it_to (it, -1, -1, -1, it->vpos + delta, MOVE_TO_VPOS);
- /* Move back again if we got too far ahead. */
- if (it->vpos - it2.vpos > delta)
+ /* Move back again if we got too far ahead,
+ or didn't move at all. */
+ if (it->vpos - it2.vpos > delta || IT_CHARPOS (*it) == orig_charpos)
RESTORE_IT (it, &it2, it2data);
else
bidi_unshelve_cache (it2data, true);
@@ -13326,7 +13218,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);
}
@@ -13429,6 +13324,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)
@@ -13473,15 +13369,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;
@@ -13494,8 +13394,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
@@ -18944,7 +18845,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;
@@ -19041,7 +18942,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. */
@@ -19123,12 +19029,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,
@@ -19160,16 +19077,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)
{
@@ -20192,7 +20101,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);
@@ -24615,13 +24537,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. */
@@ -31809,9 +31724,9 @@ gui_produce_glyphs (struct it *it)
/* When no suitable font is found, display this character by
the method specified in the first extra slot of
Vglyphless_char_display. */
- Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
+ Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
- eassert (it->what == IT_GLYPHLESS);
+ eassert (it->what == IT_GLYPHLESS);
produce_glyphless_glyph (it, true,
STRINGP (acronym) ? acronym : Qnil);
goto done;
@@ -34926,7 +34841,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
@@ -35253,7 +35168,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);
}
@@ -35281,7 +35196,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. */
@@ -37145,14 +37060,20 @@ Each element, if non-nil, should be one of the
following:
`empty-box': display as an empty box
`thin-space': display as 1-pixel width space
`zero-width': don't display
+Any other value is interpreted as `empty-box'.
An element may also be a cons cell (GRAPHICAL . TEXT), which specifies the
display method for graphical terminals and text terminals respectively.
GRAPHICAL and TEXT should each have one of the values listed above.
-The char-table has one extra slot to control the display of a character for
-which no font is found. This slot only takes effect on graphical terminals.
-Its value should be an ASCII acronym string, `hex-code', `empty-box', or
-`thin-space'. The default is `empty-box'.
+The char-table has one extra slot to control the display of characters
+for which no font is found on graphical terminals, and characters that
+cannot be displayed by text-mode terminals. Its value should be an
+ASCII acronym string, `hex-code', `empty-box', or `thin-space'. It
+could also be a cons cell of any two of these, to specify separate
+values for graphical and text terminals. The default is `empty-box'.
+
+With the obvious exception of `zero-width', all the other representations
+are displayed using the face `glyphless-char'.
If a character has a non-nil entry in an active display table, the
display table takes effect; in this case, Emacs does not consult
diff --git a/src/xfaces.c b/src/xfaces.c
index bbc1d352c6..ed76db9adb 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3052,6 +3052,15 @@ The value is TO. */)
}
+#define HANDLE_INVALID_NIL_VALUE(A,F) \
+ if (NILP (value)) \
+ { \
+ add_to_log ("Warning: setting attribute `%s' of face `%s': nil " \
+ "value is invalid, use `unspecified' instead.", A, F); \
+ /* Compatibility with 20.x. */ \
+ value = Qunspecified; \
+ }
+
DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
Sinternal_set_lisp_face_attribute, 3, 4, 0,
doc: /* Set attribute ATTR of FACE to VALUE.
@@ -3390,9 +3399,7 @@ FRAME 0 means change the face on all frames, and change
the default
}
else if (EQ (attr, QCforeground))
{
- /* Compatibility with 20.x. */
- if (NILP (value))
- value = Qunspecified;
+ HANDLE_INVALID_NIL_VALUE (QCforeground, face);
if (!UNSPECIFIEDP (value)
&& !IGNORE_DEFFACE_P (value)
&& !RESET_P (value))
@@ -3409,9 +3416,7 @@ FRAME 0 means change the face on all frames, and change
the default
}
else if (EQ (attr, QCdistant_foreground))
{
- /* Compatibility with 20.x. */
- if (NILP (value))
- value = Qunspecified;
+ HANDLE_INVALID_NIL_VALUE (QCdistant_foreground, face);
if (!UNSPECIFIEDP (value)
&& !IGNORE_DEFFACE_P (value)
&& !RESET_P (value))
@@ -3428,9 +3433,7 @@ FRAME 0 means change the face on all frames, and change
the default
}
else if (EQ (attr, QCbackground))
{
- /* Compatibility with 20.x. */
- if (NILP (value))
- value = Qunspecified;
+ HANDLE_INVALID_NIL_VALUE (QCbackground, face);
if (!UNSPECIFIEDP (value)
&& !IGNORE_DEFFACE_P (value)
&& !RESET_P (value))
@@ -6012,8 +6015,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
#ifdef HAVE_WINDOW_SYSTEM
struct face *default_face;
struct frame *f;
- Lisp_Object stipple, underline, overline, strike_through, box, temp_spec;
- Lisp_Object temp_extra, antialias;
+ Lisp_Object stipple, underline, overline, strike_through, box;
eassert (FRAME_WINDOW_P (cache->f));
@@ -6055,28 +6057,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
emacs_abort ();
}
if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
- {
- /* We want attrs to allow overriding most elements in the
- spec (IOW, to start out as an empty font spec), but
- preserve the antialiasing attribute. (bug#17973,
- bug#37473). */
- temp_spec = Ffont_spec (0, NULL);
- temp_extra = AREF (attrs[LFACE_FONT_INDEX],
- FONT_EXTRA_INDEX);
- /* If `:antialias' wasn't specified, keep it unspecified
- instead of changing it to nil. */
-
- if (CONSP (temp_extra))
- antialias = Fassq (QCantialias, temp_extra);
- else
- antialias = Qnil;
-
- if (FONTP (attrs[LFACE_FONT_INDEX]) && !NILP (antialias))
- Ffont_put (temp_spec, QCantialias, Fcdr (antialias));
-
- attrs[LFACE_FONT_INDEX]
- = font_load_for_lface (f, attrs, temp_spec);
- }
+ attrs[LFACE_FONT_INDEX]
+ = font_load_for_lface (f, attrs, attrs[LFACE_FONT_INDEX]);
if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
{
face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]);
@@ -6558,8 +6540,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;
}
@@ -6612,7 +6593,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);
@@ -6625,8 +6605,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;
}
@@ -6635,7 +6614,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);
@@ -6643,11 +6621,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 0b1f707e9f..3ff7a8c286 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -2423,14 +2423,33 @@ x_set_use_frame_synchronization (struct frame *f,
Lisp_Object arg,
{
#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
struct x_display_info *dpyinfo;
+ unsigned long bypass_compositor;
dpyinfo = FRAME_DISPLAY_INFO (f);
if (!NILP (arg) && FRAME_X_EXTENDED_COUNTER (f))
- FRAME_X_OUTPUT (f)->use_vsync_p
- = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn);
+ {
+ FRAME_X_OUTPUT (f)->use_vsync_p
+ = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn);
+
+ /* At the same time, write the bypass compositor property to the
+ outer window. 2 means to never bypass the compositor, as we
+ need its cooperation for frame synchronization. */
+ bypass_compositor = 2;
+ XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_net_wm_bypass_compositor,
+ XA_CARDINAL, 32, PropModeReplace,
+ (unsigned char *) &bypass_compositor, 1);
+ }
else
- FRAME_X_OUTPUT (f)->use_vsync_p = false;
+ {
+ FRAME_X_OUTPUT (f)->use_vsync_p = false;
+
+ /* Remove the compositor bypass property from the outer
+ window. */
+ XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_net_wm_bypass_compositor);
+ }
store_frame_param (f, Quse_frame_synchronization,
FRAME_X_OUTPUT (f)->use_vsync_p ? Qt : Qnil);
@@ -3335,22 +3354,30 @@ struct x_xim_text_conversion_data
{
struct coding_system *coding;
char *source;
+ struct x_display_info *dpyinfo;
};
static Lisp_Object
-x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs,
- Lisp_Object *args)
+x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, Lisp_Object *args)
{
struct x_xim_text_conversion_data *data;
ptrdiff_t nbytes;
+ Lisp_Object coding_system;
data = xmint_pointer (args[0]);
+
+ if (SYMBOLP (Vx_input_coding_system))
+ coding_system = Vx_input_coding_system;
+ else if (!NILP (data->dpyinfo->xim_coding))
+ coding_system = data->dpyinfo->xim_coding;
+ else
+ coding_system = Vlocale_coding_system;
+
nbytes = strlen (data->source);
data->coding->destination = NULL;
- setup_coding_system (Vlocale_coding_system,
- data->coding);
+ setup_coding_system (coding_system, data->coding);
data->coding->mode |= (CODING_MODE_LAST_BLOCK
| CODING_MODE_SAFE_ENCODING);
data->coding->source = (const unsigned char *) data->source;
@@ -3363,8 +3390,7 @@ x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs,
}
static Lisp_Object
-x_xim_text_to_utf8_unix_2 (Lisp_Object val,
- ptrdiff_t nargs,
+x_xim_text_to_utf8_unix_2 (Lisp_Object val, ptrdiff_t nargs,
Lisp_Object *args)
{
struct x_xim_text_conversion_data *data;
@@ -3381,7 +3407,8 @@ x_xim_text_to_utf8_unix_2 (Lisp_Object val,
/* The string returned is not null-terminated. */
static char *
-x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length)
+x_xim_text_to_utf8_unix (struct x_display_info *dpyinfo,
+ XIMText *text, ptrdiff_t *length)
{
unsigned char *wchar_buf;
ptrdiff_t wchar_actual_length, i;
@@ -3405,6 +3432,7 @@ x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length)
data.coding = &coding;
data.source = text->string.multi_byte;
+ data.dpyinfo = dpyinfo;
was_waiting_for_input_p = waiting_for_input;
/* Otherwise Fsignal will crash. */
@@ -3422,18 +3450,21 @@ static void
xic_preedit_draw_callback (XIC xic, XPointer client_data,
XIMPreeditDrawCallbackStruct *call_data)
{
- struct frame *f = x_xic_to_frame (xic);
+ struct frame *f;
struct x_output *output;
- ptrdiff_t text_length = 0;
+ ptrdiff_t text_length;
ptrdiff_t charpos;
ptrdiff_t original_size;
char *text;
char *chg_start, *chg_end;
struct input_event ie;
+
+ f = x_xic_to_frame (xic);
EVENT_INIT (ie);
if (f)
{
+ text_length = 0;
output = FRAME_X_OUTPUT (f);
if (!output->preedit_active)
@@ -3441,7 +3472,8 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data,
if (call_data->text)
{
- text = x_xim_text_to_utf8_unix (call_data->text, &text_length);
+ text = x_xim_text_to_utf8_unix (FRAME_DISPLAY_INFO (f),
+ call_data->text, &text_length);
if (!text)
/* Decoding the IM text failed. */
@@ -3955,10 +3987,6 @@ x_window (struct frame *f, long window_prompting)
XtManageChild (pane_widget);
XtRealizeWidget (shell_widget);
- if (FRAME_X_EMBEDDED_P (f))
- XReparentWindow (FRAME_X_DISPLAY (f), XtWindow (shell_widget),
- f->output_data.x->parent_desc, 0, 0);
-
FRAME_X_WINDOW (f) = XtWindow (frame_widget);
initial_set_up_x_back_buffer (f);
validate_x_resource_name ();
@@ -4132,7 +4160,7 @@ x_window (struct frame *f)
block_input ();
FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
- f->output_data.x->parent_desc,
+ FRAME_DISPLAY_INFO (f)->root_window,
f->left_pos,
f->top_pos,
FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
@@ -4151,11 +4179,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 */
@@ -4958,6 +4990,12 @@ This function is an internal primitive--use `make-frame'
instead. */)
x_window (f);
#endif
+#ifndef USE_GTK
+ if (FRAME_X_EMBEDDED_P (f)
+ && !x_embed_frame (dpyinfo, f))
+ error ("The frame could not be embedded; does the embedder exist?");
+#endif
+
x_icon (f, parms);
x_make_gc (f);
@@ -5519,15 +5557,15 @@ On MS Windows, this returns nothing useful. */)
switch (DoesBackingStore (dpyinfo->screen))
{
case Always:
- result = intern ("always");
+ result = Qalways;
break;
case WhenMapped:
- result = intern ("when-mapped");
+ result = Qwhen_mapped;
break;
case NotUseful:
- result = intern ("not-useful");
+ result = Qnot_useful;
break;
default:
@@ -5556,22 +5594,22 @@ If omitted or nil, that stands for the selected frame's
display.
switch (dpyinfo->visual_info.class)
{
case StaticGray:
- result = intern ("static-gray");
+ result = Qstatic_gray;
break;
case GrayScale:
- result = intern ("gray-scale");
+ result = Qgray_scale;
break;
case StaticColor:
- result = intern ("static-color");
+ result = Qstatic_color;
break;
case PseudoColor:
- result = intern ("pseudo-color");
+ result = Qpseudo_color;
break;
case TrueColor:
- result = intern ("true-color");
+ result = Qtrue_color;
break;
case DirectColor:
- result = intern ("direct-color");
+ result = Qdirect_color;
break;
default:
error ("Display has an unknown visual class");
@@ -6223,8 +6261,8 @@ In addition to the standard attribute keys listed in
the attributes:
source -- String describing the source from which multi-monitor
- information is obtained, one of \"Gdk\", \"XRandr\",
- \"Xinerama\", or \"fallback\"
+ information is obtained, one of \"Gdk\", \"XRandR 1.5\",
+ \"XRandr\", \"Xinerama\", or \"fallback\"
Internal use only, use `display-monitor-attributes-list' instead. */)
(Lisp_Object terminal)
@@ -7229,8 +7267,6 @@ x_display_info_for_name (Lisp_Object name)
if (dpyinfo == 0)
error ("Cannot connect to X server %s", SDATA (name));
- XSETFASTINT (Vwindow_system_version, 11);
-
return dpyinfo;
}
@@ -7274,7 +7310,6 @@ An insecure way to solve the problem may be to use
`xhost'.\n",
error ("Cannot connect to X server %s", SDATA (display));
}
- XSETFASTINT (Vwindow_system_version, 11);
return Qnil;
}
@@ -7693,17 +7728,40 @@ DEFUN ("x-window-property", Fx_window_property,
Sx_window_property,
doc: /* Value is the value of window property PROP on FRAME.
If FRAME is nil or omitted, use the selected frame.
-On X Windows, the following optional arguments are also accepted:
-If TYPE is nil or omitted, get the property as a string.
- Otherwise TYPE is the name of the atom that denotes the expected type.
+On X Windows, the following optional arguments are also accepted: If
+TYPE is nil or omitted, get the property as a string. Otherwise TYPE
+is the name of the atom that denotes the expected type.
+
+If TYPE is the string "AnyPropertyType", decode and return the data
+regardless of what the type really is.
+
+The format of the data returned is the same as a selection conversion
+to the given type. For example, if `x-get-selection-internal' returns
+an integer when the selection data is a given type,
+`x-window-property' will do the same for that type.
+
If WINDOW-ID is non-nil, get the property of that window instead of
- FRAME's X window; the number 0 denotes the root window. This argument
- is separate from FRAME because window IDs are not unique across X
- displays or screens on the same display, so FRAME provides context
- for the window ID.
+FRAME's X window; the number 0 denotes the root window. This argument
+is separate from FRAME because window IDs are not unique across X
+displays, so FRAME provides context for the window ID.
+
If DELETE-P is non-nil, delete the property after retrieving it.
If VECTOR-RET-P is non-nil, return a vector of values instead of a string.
+X allows an arbitrary number of properties to be set on any window.
+However, properties are most often set by the window manager or other
+programs on the root window or FRAME's X window in order to
+communicate information to Emacs and other programs. Most of these
+properties are specified as part of the Extended Window Manager Hints
+and the Inter-Client Communication Conventions Manual, which are
+located here:
+
+ https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html
+
+and
+
+ https://x.org/releases/X11R7.6/doc/xorg-docs/specs/ICCCM/icccm.html
+
Return value is nil if FRAME doesn't have a property with name PROP or
if PROP has no value of TYPE (always a string in the MS Windows case). */)
(Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
@@ -7855,7 +7913,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.
@@ -7871,16 +7929,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;
@@ -7898,6 +7961,8 @@ no such window. */)
dest_y = XFIXNUM (source_y);
}
+ source_frame = NULL;
+
if (!NILP (source_window))
CONS_TO_INTEGER (source_window, Window, src);
else
@@ -7906,6 +7971,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;
@@ -8291,9 +8367,9 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
Lisp_Object parms)
disptype = Qmono;
else if (FRAME_X_VISUAL_INFO (f)->class == GrayScale
|| FRAME_X_VISUAL_INFO (f)->class == StaticGray)
- disptype = intern ("grayscale");
+ disptype = Qgrayscale;
else
- disptype = intern ("color");
+ disptype = Qcolor;
if (NILP (Fframe_parameter (frame, Qdisplay_type)))
{
@@ -8385,7 +8461,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. */
@@ -8635,9 +8721,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;
@@ -8888,41 +8971,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);
@@ -8955,8 +9003,8 @@ Text larger than the specified size is clipped. */)
start_timer:
/* Let the tip disappear after timeout seconds. */
- tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
- intern ("x-hide-tip"));
+ tip_timer = call3 (Qrun_at_time, timeout, Qnil,
+ Qx_hide_tip);
return unbind_to (count, Qnil);
}
@@ -9394,13 +9442,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;
@@ -9416,50 +9472,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
@@ -10054,6 +10099,23 @@ eliminated in future versions of Emacs. */);
/* Tell Emacs about this window system. */
Fprovide (Qx, Qnil);
+ /* Used by Fx_show_tip. */
+ DEFSYM (Qrun_at_time, "run-at-time");
+ DEFSYM (Qx_hide_tip, "x-hide-tip");
+
+ /* Used by display class and backing store reporting functions. */
+ DEFSYM (Qalways, "always");
+ DEFSYM (Qwhen_mapped, "when-mapped");
+ DEFSYM (Qnot_useful, "not-useful");
+ DEFSYM (Qstatic_gray, "static-gray");
+ DEFSYM (Qgray_scale, "gray-scale");
+ DEFSYM (Qstatic_color, "static-color");
+ DEFSYM (Qpseudo_color, "pseudo-color");
+ DEFSYM (Qtrue_color, "true-color");
+ DEFSYM (Qdirect_color, "direct-color");
+ DEFSYM (Qgrayscale, "grayscale");
+ DEFSYM (Qcolor, "color");
+
#ifdef HAVE_XINPUT2
DEFSYM (Qxinput2, "xinput2");
diff --git a/src/xfont.c b/src/xfont.c
index 74237e8aa8..951446b44d 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -253,9 +253,9 @@ xfont_supported_scripts (Display *display, char *fontname,
Lisp_Object props,
/* Two special cases to avoid opening rather big fonts. */
if (EQ (AREF (props, 2), Qja))
- return list2 (intern ("kana"), intern ("han"));
+ return list2 (Qkana, Qhan);
if (EQ (AREF (props, 2), Qko))
- return list1 (intern ("hangul"));
+ return list1 (Qhangul);
scripts = Fgethash (props, xfont_scripts_cache, Qt);
if (EQ (scripts, Qt))
{
@@ -1130,19 +1130,19 @@ static void syms_of_xfont_for_pdumper (void);
struct font_driver const xfont_driver =
{
- .type = LISPSYM_INITIALLY (Qx),
- .get_cache = xfont_get_cache,
- .list = xfont_list,
- .match = xfont_match,
- .list_family = xfont_list_family,
- .open_font = xfont_open,
- .close_font = xfont_close,
- .prepare_face = xfont_prepare_face,
- .has_char = xfont_has_char,
- .encode_char = xfont_encode_char,
- .text_extents = xfont_text_extents,
- .draw = xfont_draw,
- .check = xfont_check,
+ .type = LISPSYM_INITIALLY (Qx),
+ .get_cache = xfont_get_cache,
+ .list = xfont_list,
+ .match = xfont_match,
+ .list_family = xfont_list_family,
+ .open_font = xfont_open,
+ .close_font = xfont_close,
+ .prepare_face = xfont_prepare_face,
+ .has_char = xfont_has_char,
+ .encode_char = xfont_encode_char,
+ .text_extents = xfont_text_extents,
+ .draw = xfont_draw,
+ .check = xfont_check,
};
void
@@ -1153,6 +1153,10 @@ syms_of_xfont (void)
staticpro (&xfont_scratch_props);
xfont_scratch_props = make_nil_vector (8);
pdumper_do_now_and_after_load (syms_of_xfont_for_pdumper);
+
+ DEFSYM (Qkana, "kana");
+ DEFSYM (Qhan, "han");
+ DEFSYM (Qhangul, "hangul");
}
static void
diff --git a/src/xmenu.c b/src/xmenu.c
index 5b8a8f77a2..756842c2fe 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -242,55 +242,65 @@ x_menu_translate_generic_event (XEvent *event)
{
eassert (!event->xcookie.data);
- if (XGetEventData (dpyinfo->display, &event->xcookie))
+ switch (event->xcookie.evtype)
{
- switch (event->xcookie.evtype)
- {
- case XI_ButtonPress:
- case XI_ButtonRelease:
- xev = (XIDeviceEvent *) event->xcookie.data;
- copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress
- ? ButtonPress : ButtonRelease);
- copy.xbutton.serial = xev->serial;
- copy.xbutton.send_event = xev->send_event;
- copy.xbutton.display = dpyinfo->display;
- copy.xbutton.window = xev->event;
- copy.xbutton.root = xev->root;
- copy.xbutton.subwindow = xev->child;
- copy.xbutton.time = xev->time;
- copy.xbutton.x = lrint (xev->event_x);
- copy.xbutton.y = lrint (xev->event_y);
- copy.xbutton.x_root = lrint (xev->root_x);
- copy.xbutton.y_root = lrint (xev->root_y);
- copy.xbutton.state = xi_convert_event_state (xev);
- copy.xbutton.button = xev->detail;
- copy.xbutton.same_screen = True;
-
- device = xi_device_from_id (dpyinfo, xev->deviceid);
-
- /* I don't know the repercussions of changing
- device->grab on XI_ButtonPress events, so be safe and
- only do what is necessary to prevent the grab from
- being left invalid as XMenuActivate swallows
- events. */
- if (device && xev->evtype == XI_ButtonRelease)
- device->grab &= ~(1 << xev->detail);
-
- XPutBackEvent (dpyinfo->display, ©);
-
- break;
- }
+ case XI_ButtonPress:
+ case XI_ButtonRelease:
+
+ if (!XGetEventData (dpyinfo->display, &event->xcookie))
+ break;
+
+ xev = (XIDeviceEvent *) event->xcookie.data;
+ copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress
+ ? ButtonPress : ButtonRelease);
+ copy.xbutton.serial = xev->serial;
+ copy.xbutton.send_event = xev->send_event;
+ copy.xbutton.display = dpyinfo->display;
+ copy.xbutton.window = xev->event;
+ copy.xbutton.root = xev->root;
+ copy.xbutton.subwindow = xev->child;
+ copy.xbutton.time = xev->time;
+ copy.xbutton.x = lrint (xev->event_x);
+ copy.xbutton.y = lrint (xev->event_y);
+ copy.xbutton.x_root = lrint (xev->root_x);
+ copy.xbutton.y_root = lrint (xev->root_y);
+ copy.xbutton.state = xi_convert_event_state (xev);
+ copy.xbutton.button = xev->detail;
+ copy.xbutton.same_screen = True;
+
+ device = xi_device_from_id (dpyinfo, xev->deviceid);
+
+ /* I don't know the repercussions of changing
+ device->grab on XI_ButtonPress events, so be safe and
+ only do what is necessary to prevent the grab from
+ being left invalid as XMenuActivate swallows
+ events. */
+ if (device && xev->evtype == XI_ButtonRelease)
+ device->grab &= ~(1 << xev->detail);
+
+ XPutBackEvent (dpyinfo->display, ©);
XFreeEventData (dpyinfo->display, &event->xcookie);
+
+ break;
+
+ case XI_HierarchyChanged:
+ case XI_DeviceChanged:
+ /* These events must always be handled. */
+ x_dispatch_event (event, dpyinfo->display);
+ break;
}
}
}
#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 */
@@ -1514,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
@@ -1736,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;
@@ -1768,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;
@@ -2552,6 +2540,8 @@ pop_down_menu (void *arg)
}
#endif
+ /* Decrement the popup_activated_flag. */
+ popup_activated_flag = 0;
#endif /* HAVE_X_WINDOWS */
unblock_input ();
@@ -2562,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;
@@ -2613,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;
@@ -2775,18 +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,
@@ -2812,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/xrdb.c b/src/xrdb.c
index faeea04a53..01c9ff5558 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -511,107 +511,3 @@ x_get_string_resource (void *v_rdb, const char *name,
const char *class)
return NULL;
}
-
-/* Stand-alone test facilities. */
-
-#ifdef TESTRM
-
-typedef char **List;
-#define arg_listify(len, list) (list)
-#define car(list) (*(list))
-#define cdr(list) (list + 1)
-#define NIL(list) (! *(list))
-#define free_arglist(list)
-
-static List
-member (char *elt, List list)
-{
- List p;
-
- for (p = list; ! NIL (p); p = cdr (p))
- if (! strcmp (elt, car (p)))
- return p;
-
- return p;
-}
-
-static void
-fatal (char *msg, char *prog)
-{
- fprintf (stderr, msg, prog);
- exit (1);
-}
-
-int
-main (int argc, char **argv)
-{
- Display *display;
- char *displayname, *resource_string, *class, *name;
- XrmDatabase xdb;
- List arg_list, lp;
-
- arg_list = arg_listify (argc, argv);
-
- lp = member ("-d", arg_list);
- if (!NIL (lp))
- displayname = car (cdr (lp));
- else
- displayname = "localhost:0.0";
-
- lp = member ("-xrm", arg_list);
- resource_string = NIL (lp) ? 0 : car (cdr (lp));
-
- lp = member ("-c", arg_list);
- if (! NIL (lp))
- class = car (cdr (lp));
- else
- class = "Emacs";
-
- lp = member ("-n", arg_list);
- if (! NIL (lp))
- name = car (cdr (lp));
- else
- name = "emacs";
-
- free_arglist (arg_list);
-
- if (!(display = XOpenDisplay (displayname)))
- fatal ("Can't open display '%s'\n", XDisplayName (displayname));
-
- xdb = x_load_resources (display, resource_string, name, class);
-
- /* In a real program, you'd want to also do this: */
- display->db = xdb;
-
- while (true)
- {
- char query_name[90];
- char query_class[90];
-
- printf ("Name: ");
- gets (query_name);
-
- if (strlen (query_name))
- {
- char *value;
-
- printf ("Class: ");
- gets (query_class);
-
- value = x_get_string_resource (&xdb, query_name, query_class);
-
- if (value != NULL)
- printf ("\t%s(%s): %s\n\n", query_name, query_class, value);
- else
- printf ("\tNo Value.\n\n");
- }
- else
- break;
- }
- printf ("\tExit.\n\n");
-
- XCloseDisplay (display);
-
- return 0;
-}
-#endif /* TESTRM */
diff --git a/src/xselect.c b/src/xselect.c
index bab0400540..db5c7853e7 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1567,7 +1567,8 @@ receive_incremental_selection (struct x_display_info
*dpyinfo,
unsigned char **data_ret,
ptrdiff_t *size_bytes_ret,
Atom *type_ret, int *format_ret,
- unsigned long *size_ret)
+ unsigned long *size_ret,
+ ptrdiff_t *real_bytes_ret)
{
ptrdiff_t offset = 0;
struct prop_location *wait_object;
@@ -1622,7 +1623,8 @@ receive_incremental_selection (struct x_display_info
*dpyinfo,
if (tmp_size_bytes == 0) /* we're done */
{
- TRACE0 ("Done reading incrementally");
+ TRACE1 ("Done reading incrementally; total bytes: %"pD"d",
+ *size_bytes_ret);
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, STANDARD_EVENT_SET);
@@ -1652,6 +1654,19 @@ receive_incremental_selection (struct x_display_info
*dpyinfo,
memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
offset += tmp_size_bytes;
+ /* *size_bytes_ret is not really the size of the data inside the
+ buffer; it is the size of the buffer allocated by xpalloc.
+
+ This matters when the cardinal specified in the INCR property
+ (a _lower bound_ on the size of the selection data) is
+ smaller than the actual selection contents, which can happen
+ when programs are streaming selection data from a file
+ descriptor. In that case, we used to return junk if xpalloc
+ decided to grow the buffer by more than the provided
+ increment; to avoid that, store the actual size of the
+ selection data in *real_bytes_ret. */
+ *real_bytes_ret += tmp_size_bytes;
+
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
xfree (tmp_data);
@@ -1674,10 +1689,14 @@ x_get_window_property_as_lisp_data (struct
x_display_info *dpyinfo,
int actual_format;
unsigned long actual_size;
unsigned char *data = 0;
- ptrdiff_t bytes = 0;
+ ptrdiff_t bytes = 0, array_bytes;
Lisp_Object val;
Display *display = dpyinfo->display;
+ /* array_bytes is only used as an argument to xpalloc. The actual
+ size of the data inside the buffer is inside bytes. */
+ array_bytes = 0;
+
TRACE0 ("Reading selection data");
x_get_window_property (display, window, property, &data, &bytes,
@@ -1718,10 +1737,15 @@ x_get_window_property_as_lisp_data (struct
x_display_info *dpyinfo,
calls xmalloc itself. */
xfree (data);
unblock_input ();
+
+ /* Clear bytes again. Previously, receive_incremental_selection
+ would set this to min_size_bytes, but that is now done to
+ array_bytes instead. */
+ bytes = 0;
receive_incremental_selection (dpyinfo, window, property, target_type,
- min_size_bytes, &data, &bytes,
+ min_size_bytes, &data, &array_bytes,
&actual_type, &actual_format,
- &actual_size);
+ &actual_size, &bytes);
}
if (!for_multiple)
@@ -1993,7 +2017,17 @@ lisp_data_to_selection_data (struct x_display_info
*dpyinfo,
ptrdiff_t i;
ptrdiff_t size = ASIZE (obj);
- if (SYMBOLP (AREF (obj, 0)))
+ if (!size)
+ {
+ /* This vector is empty and of unknown type. Assume that it
+ is a vector of integers. */
+
+ cs->data = NULL;
+ cs->format = 32;
+ cs->size = 0;
+ type = QINTEGER;
+ }
+ else if (SYMBOLP (AREF (obj, 0)))
/* This vector is an ATOM set */
{
void *data;
@@ -2342,12 +2376,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;
@@ -2358,10 +2399,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);
}
@@ -2734,7 +2787,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;
@@ -2769,11 +2821,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 9c60ff825a..15e7ff5499 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -54,12 +54,14 @@ 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 */
+#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;
@@ -804,16 +806,30 @@ 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 ();
+ 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
@@ -912,8 +928,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 +944,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
@@ -1225,7 +1244,8 @@ xsettings_get_font_options (void)
DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font,
Sfont_get_system_normal_font,
0, 0, 0,
- doc: /* Get the system default application font. */)
+ doc: /* Get the system default application font.
+The font is returned as either a font-spec or font name. */)
(void)
{
return current_font ? build_string (current_font) : Qnil;
@@ -1233,7 +1253,8 @@ DEFUN ("font-get-system-normal-font",
Ffont_get_system_normal_font,
DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font,
0, 0, 0,
- doc: /* Get the system default fixed width font. */)
+ doc: /* Get the system default fixed width font.
+The font is returned as either a font-spec or font name. */)
(void)
{
return current_mono_font ? build_string (current_mono_font) : Qnil;
@@ -1282,6 +1303,10 @@ syms_of_xsettings (void)
DEFSYM (Qmonospace_font_name, "monospace-font-name");
DEFSYM (Qfont_name, "font-name");
DEFSYM (Qfont_render, "font-render");
+ DEFSYM (Qdynamic_setting, "dynamic-setting");
+ DEFSYM (Qfont_render_setting, "font-render-setting");
+ DEFSYM (Qsystem_font_setting, "system-font-setting");
+
defsubr (&Sfont_get_system_font);
defsubr (&Sfont_get_system_normal_font);
@@ -1297,9 +1322,9 @@ If this variable is nil, Emacs ignores system font
changes. */);
Vxft_settings = empty_unibyte_string;
#if defined USE_CAIRO || defined HAVE_XFT
- Fprovide (intern_c_string ("font-render-setting"), Qnil);
+ Fprovide (Qfont_render_setting, Qnil);
#if defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
- Fprovide (intern_c_string ("system-font-setting"), Qnil);
+ Fprovide (Qsystem_font_setting, Qnil);
#endif
#endif
@@ -1307,5 +1332,5 @@ If this variable is nil, Emacs ignores system font
changes. */);
DEFSYM (Qtool_bar_style, "tool-bar-style");
defsubr (&Stool_bar_get_system_style);
- Fprovide (intern_c_string ("dynamic-setting"), Qnil);
+ Fprovide (Qdynamic_setting, Qnil);
}
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 7015a8eb63..7a17e6dbd8 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -511,7 +511,7 @@ Do not call this function yourself. */)
this at the wrong time. */
if (doing_interact && ! kill_emacs)
{
- bool cancel_shutdown = ! NILP (call0 (intern ("emacs-session-save")));
+ bool cancel_shutdown = ! NILP (call0 (Qemacs_session_save));
SmcInteractDone (smc_conn, cancel_shutdown);
SmcSaveYourselfDone (smc_conn, True);
@@ -542,6 +542,8 @@ Do not call this function yourself. */)
void
syms_of_xsmfns (void)
{
+ DEFSYM (Qemacs_session_save, "emacs-session-save");
+
DEFVAR_LISP ("x-session-id", Vx_session_id,
doc: /* The session id Emacs got from the session manager for this session.
Changing the value does not change the session id used by Emacs.
diff --git a/src/xterm.c b/src/xterm.c
index 3dfa908f1e..7dd969b821 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -952,7 +952,7 @@ static const struct x_atom_ref x_atom_refs[] =
ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE)
ATOM_REFS_INIT ("INCR", Xatom_INCR)
ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP)
- ATOM_REFS_INIT ("EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP)
+ ATOM_REFS_INIT ("_EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP)
ATOM_REFS_INIT ("TARGETS", Xatom_TARGETS)
ATOM_REFS_INIT ("NULL", Xatom_NULL)
ATOM_REFS_INIT ("ATOM", Xatom_ATOM)
@@ -970,8 +970,8 @@ static const struct x_atom_ref x_atom_refs[] =
/* Ghostscript support. */
ATOM_REFS_INIT ("DONE", Xatom_DONE)
ATOM_REFS_INIT ("PAGE", Xatom_PAGE)
- ATOM_REFS_INIT ("SCROLLBAR", Xatom_Scrollbar)
- ATOM_REFS_INIT ("HORIZONTAL_SCROLLBAR", Xatom_Horizontal_Scrollbar)
+ ATOM_REFS_INIT ("_EMACS_SCROLLBAR", Xatom_Scrollbar)
+ ATOM_REFS_INIT ("_EMACS_HORIZONTAL_SCROLLBAR", Xatom_Horizontal_Scrollbar)
ATOM_REFS_INIT ("_XEMBED", Xatom_XEMBED)
/* EWMH */
ATOM_REFS_INIT ("_NET_WM_STATE", Xatom_net_wm_state)
@@ -998,6 +998,7 @@ static const struct x_atom_ref x_atom_refs[] =
ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request)
ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER",
Xatom_net_wm_sync_request_counter)
ATOM_REFS_INIT ("_NET_WM_SYNC_FENCES", Xatom_net_wm_sync_fences)
+ ATOM_REFS_INIT ("_NET_WM_BYPASS_COMPOSITOR",
Xatom_net_wm_bypass_compositor)
ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn)
ATOM_REFS_INIT ("_NET_WM_FRAME_TIMINGS", Xatom_net_wm_frame_timings)
ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time)
@@ -1423,9 +1424,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'. */
@@ -1437,9 +1435,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;
@@ -1450,18 +1445,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. */
@@ -1970,6 +1971,10 @@ xm_get_drag_window_1 (struct x_display_info *dpyinfo)
&& tmp_data)
{
drag_window = *(Window *) tmp_data;
+
+ /* This has the side effect of selecting for
+ StructureNotifyMask, meaning that we will get notifications
+ once it is deleted. */
rc = x_special_window_exists_p (dpyinfo, drag_window);
if (!rc)
@@ -3977,12 +3982,10 @@ x_dnd_do_unsupported_drop (struct x_display_info
*dpyinfo,
x_ignore_errors_for_next_request (dpyinfo);
XSendEvent (dpyinfo->display, child,
True, ButtonPressMask, &event);
- x_stop_ignoring_errors (dpyinfo);
event.xbutton.type = ButtonRelease;
event.xbutton.time = before + 2;
- x_ignore_errors_for_next_request (dpyinfo);
XSendEvent (dpyinfo->display, child,
True, ButtonReleaseMask, &event);
x_stop_ignoring_errors (dpyinfo);
@@ -4456,7 +4459,8 @@ x_dnd_get_window_proto (struct x_display_info *dpyinfo,
Window wdesc)
}
static void
-x_dnd_send_enter (struct frame *f, Window target, int supported)
+x_dnd_send_enter (struct frame *f, Window target, Window toplevel,
+ int supported)
{
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
int i;
@@ -4465,7 +4469,7 @@ x_dnd_send_enter (struct frame *f, Window target, int
supported)
msg.xclient.type = ClientMessage;
msg.xclient.message_type = dpyinfo->Xatom_XdndEnter;
msg.xclient.format = 32;
- msg.xclient.window = target;
+ msg.xclient.window = toplevel;
msg.xclient.data.l[0] = FRAME_X_WINDOW (f);
msg.xclient.data.l[1] = (((unsigned int) min (X_DND_SUPPORTED_VERSION,
supported) << 24)
@@ -4493,10 +4497,10 @@ x_dnd_send_enter (struct frame *f, Window target, int
supported)
}
static void
-x_dnd_send_position (struct frame *f, Window target, int supported,
- unsigned short root_x, unsigned short root_y,
- Time timestamp, Atom action, int button,
- unsigned state)
+x_dnd_send_position (struct frame *f, Window target, Window toplevel,
+ int supported, unsigned short root_x,
+ unsigned short root_y, Time timestamp, Atom action,
+ int button, unsigned state)
{
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
XEvent msg;
@@ -4504,7 +4508,7 @@ x_dnd_send_position (struct frame *f, Window target, int
supported,
msg.xclient.type = ClientMessage;
msg.xclient.message_type = dpyinfo->Xatom_XdndPosition;
msg.xclient.format = 32;
- msg.xclient.window = target;
+ msg.xclient.window = toplevel;
msg.xclient.data.l[0] = FRAME_X_WINDOW (f);
msg.xclient.data.l[1] = 0;
@@ -4568,7 +4572,7 @@ x_dnd_send_position (struct frame *f, Window target, int
supported,
}
static void
-x_dnd_send_leave (struct frame *f, Window target)
+x_dnd_send_leave (struct frame *f, Window target, Window toplevel)
{
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
XEvent msg;
@@ -4576,7 +4580,7 @@ x_dnd_send_leave (struct frame *f, Window target)
msg.xclient.type = ClientMessage;
msg.xclient.message_type = dpyinfo->Xatom_XdndLeave;
msg.xclient.format = 32;
- msg.xclient.window = target;
+ msg.xclient.window = toplevel;
msg.xclient.data.l[0] = FRAME_X_WINDOW (f);
msg.xclient.data.l[1] = 0;
msg.xclient.data.l[2] = 0;
@@ -4592,15 +4596,15 @@ x_dnd_send_leave (struct frame *f, Window target)
}
static bool
-x_dnd_send_drop (struct frame *f, Window target, Time timestamp,
- int supported)
+x_dnd_send_drop (struct frame *f, Window target, Window toplevel,
+ Time timestamp, int supported)
{
struct x_display_info *dpyinfo;
XEvent msg;
if (x_dnd_action == None)
{
- x_dnd_send_leave (f, target);
+ x_dnd_send_leave (f, target, toplevel);
return false;
}
@@ -4609,7 +4613,7 @@ x_dnd_send_drop (struct frame *f, Window target, Time
timestamp,
msg.xclient.type = ClientMessage;
msg.xclient.message_type = dpyinfo->Xatom_XdndDrop;
msg.xclient.format = 32;
- msg.xclient.window = target;
+ msg.xclient.window = toplevel;
msg.xclient.data.l[0] = FRAME_X_WINDOW (f);
msg.xclient.data.l[1] = 0;
msg.xclient.data.l[2] = 0;
@@ -4626,10 +4630,10 @@ x_dnd_send_drop (struct frame *f, Window target, Time
timestamp,
}
static bool
-x_dnd_do_drop (Window target, int supported)
+x_dnd_do_drop (Window target, Window toplevel, int supported)
{
if (x_dnd_waiting_for_status_window != target)
- return x_dnd_send_drop (x_dnd_frame, target,
+ return x_dnd_send_drop (x_dnd_frame, target, toplevel,
x_dnd_selection_timestamp, supported);
x_dnd_need_send_drop = true;
@@ -4734,7 +4738,8 @@ x_dnd_cancel_dnd_early (void)
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
x_dnd_send_leave (x_dnd_frame,
- x_dnd_last_seen_window);
+ x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
&& x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
@@ -4792,7 +4797,8 @@ x_dnd_cleanup_drag_and_drop (void *frame)
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
x_dnd_send_leave (x_dnd_frame,
- x_dnd_last_seen_window);
+ x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
&& x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
@@ -4846,16 +4852,13 @@ x_dnd_note_self_position (struct x_display_info
*dpyinfo, Window target,
{
struct frame *f;
int dest_x, dest_y;
- Window child_return;
f = x_top_window_to_frame (dpyinfo, target);
- if (f && XTranslateCoordinates (dpyinfo->display,
- dpyinfo->root_window,
- FRAME_X_WINDOW (f),
- root_x, root_y, &dest_x,
- &dest_y, &child_return))
+ if (f)
{
+ x_translate_coordinates (f, root_x, root_y, &dest_x, &dest_y);
+
x_dnd_movement_frame = f;
x_dnd_movement_x = dest_x;
x_dnd_movement_y = dest_y;
@@ -4871,19 +4874,16 @@ x_dnd_note_self_wheel (struct x_display_info *dpyinfo,
Window target,
{
struct frame *f;
int dest_x, dest_y;
- Window child_return;
if (button < 4 || button > 7)
return;
f = x_top_window_to_frame (dpyinfo, target);
- if (f && XTranslateCoordinates (dpyinfo->display,
- dpyinfo->root_window,
- FRAME_X_WINDOW (f),
- root_x, root_y, &dest_x,
- &dest_y, &child_return))
+ if (f)
{
+ x_translate_coordinates (f, root_x, root_y, &dest_x, &dest_y);
+
x_dnd_wheel_frame = f;
x_dnd_wheel_x = dest_x;
x_dnd_wheel_y = dest_y;
@@ -4906,7 +4906,6 @@ x_dnd_note_self_drop (struct x_display_info *dpyinfo,
Window target,
char **atom_names;
char *name;
int win_x, win_y, i;
- Window dummy;
if (!x_dnd_allow_current_frame
&& (FRAME_OUTER_WINDOW (x_dnd_frame)
@@ -4921,10 +4920,7 @@ x_dnd_note_self_drop (struct x_display_info *dpyinfo,
Window target,
if (NILP (Vx_dnd_native_test_function))
return;
- if (!XTranslateCoordinates (dpyinfo->display, dpyinfo->root_window,
- FRAME_X_WINDOW (f), root_x, root_y,
- &win_x, &win_y, &dummy))
- return;
+ x_translate_coordinates (f, root_x, root_y, &win_x, &win_y);
/* Emacs can't respond to DND events inside the nested event loop,
so when dragging items to itself, call the test function
@@ -5142,24 +5138,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);
@@ -5177,7 +5169,6 @@ x_update_opaque_region (struct frame *f, XEvent
*configure)
}
}
#endif
- unblock_input ();
}
@@ -5378,7 +5369,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
valuator->emacs_value = DBL_MIN;
valuator->increment = info->increment;
valuator->number = info->number;
- valuator->pending_enter_reset = false;
break;
}
@@ -5424,7 +5414,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
{
xi_device->valuators[c].invalid_p = false;
xi_device->valuators[c].current_value = tem->current_value;
- xi_device->valuators[c].pending_enter_reset = true;
}
}
}
@@ -5618,8 +5607,8 @@ 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_scroll_valuator_t *valuator;
@@ -5633,11 +5622,6 @@ xi_reset_scroll_valuators_for_device_id (struct
x_display_info *dpyinfo, int id,
for (int 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;
}
@@ -6125,7 +6109,7 @@ x_cr_export_frames (Lisp_Object frames,
cairo_surface_type_t surface_type)
unbind_to (count, Qnil);
- return CALLN (Fapply, intern ("concat"), Fnreverse (acc));
+ return CALLN (Fapply, Qconcat, Fnreverse (acc));
}
#endif /* USE_CAIRO */
@@ -6629,22 +6613,21 @@ x_set_frame_alpha (struct frame *f)
Do this unconditionally as this function is called on reparent when
alpha has not changed on the frame. */
+ x_ignore_errors_for_next_request (dpyinfo);
+
if (!FRAME_PARENT_FRAME (f))
{
parent = x_find_topmost_parent (f);
if (parent != None)
{
- x_ignore_errors_for_next_request (dpyinfo);
XChangeProperty (dpy, parent,
dpyinfo->Xatom_net_wm_window_opacity,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opac, 1);
- x_stop_ignoring_errors (dpyinfo);
}
}
- x_ignore_errors_for_next_request (dpyinfo);
XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opac, 1);
@@ -6714,9 +6697,9 @@ x_if_event (Display *dpy, XEvent *event_return,
server timestamp TIMESTAMP. Return 0 if the necessary information
is not available. */
-static uint64_t
+static uint_fast64_t
x_sync_get_monotonic_time (struct x_display_info *dpyinfo,
- uint64_t timestamp)
+ uint_fast64_t timestamp)
{
if (dpyinfo->server_time_monotonic_p)
return timestamp;
@@ -6725,19 +6708,29 @@ x_sync_get_monotonic_time (struct x_display_info
*dpyinfo,
if (!dpyinfo->server_time_offset)
return 0;
- return timestamp - dpyinfo->server_time_offset;
+ uint_fast64_t t;
+ return (INT_SUBTRACT_WRAPV (timestamp, dpyinfo->server_time_offset, &t)
+ ? 0 : t);
}
+# ifndef CLOCK_MONOTONIC
+# define CLOCK_MONOTONIC CLOCK_REALTIME
+# endif
+
/* Return the current monotonic time in the same format as a
- high-resolution server timestamp. */
+ high-resolution server timestamp, or 0 if not available. */
-static uint64_t
+static uint_fast64_t
x_sync_current_monotonic_time (void)
{
struct timespec time;
-
- clock_gettime (CLOCK_MONOTONIC, &time);
- return time.tv_sec * 1000000 + time.tv_nsec / 1000;
+ uint_fast64_t t;
+ return (((clock_gettime (CLOCK_MONOTONIC, &time) != 0
+ && (CLOCK_MONOTONIC == CLOCK_REALTIME
+ || clock_gettime (CLOCK_REALTIME, &time) != 0))
+ || INT_MULTIPLY_WRAPV (time.tv_sec, 1000000, &t)
+ || INT_ADD_WRAPV (t, time.tv_nsec / 1000, &t))
+ ? 0 : t);
}
/* Decode a _NET_WM_FRAME_DRAWN message and calculate the time it took
@@ -6747,7 +6740,7 @@ static void
x_sync_note_frame_times (struct x_display_info *dpyinfo,
struct frame *f, XEvent *event)
{
- uint64_t low, high, time;
+ uint_fast64_t low, high, time;
struct x_output *output;
low = event->xclient.data.l[2];
@@ -6756,12 +6749,16 @@ x_sync_note_frame_times (struct x_display_info *dpyinfo,
time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32));
- if (time)
- output->last_frame_time = time - output->temp_frame_time;
+ if (!time || !output->temp_frame_time
+ || INT_SUBTRACT_WRAPV (time, output->temp_frame_time,
+ &output->last_frame_time))
+ output->last_frame_time = 0;
#ifdef FRAME_DEBUG
- fprintf (stderr, "Drawing the last frame took: %lu ms (%lu)\n",
- output->last_frame_time / 1000, time);
+ uint_fast64_t last_frame_ms = output->last_frame_time / 1000;
+ fprintf (stderr,
+ "Drawing the last frame took: %"PRIuFAST64" ms (%"PRIuFAST64")\n",
+ last_frame_ms, time);
#endif
}
@@ -6891,7 +6888,7 @@ x_sync_update_begin (struct frame *f)
static void
x_sync_trigger_fence (struct frame *f, XSyncValue value)
{
- uint64_t n, low, high, idx;
+ uint_fast64_t n, low, high, idx;
/* Sync fences aren't supported by the X server. */
if (FRAME_DISPLAY_INFO (f)->xsync_major < 3
@@ -7039,6 +7036,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) */
@@ -7134,8 +7138,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
@@ -7164,8 +7166,6 @@ show_back_buffer (struct frame *f)
}
FRAME_X_NEED_BUFFER_FLIP (f) = false;
-
- unblock_input ();
}
#endif
@@ -7189,6 +7189,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 ();
@@ -7239,6 +7243,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
@@ -7273,8 +7280,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
@@ -7303,8 +7314,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;
@@ -7325,8 +7334,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 ();
}
}
@@ -7374,7 +7381,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;
@@ -7392,7 +7398,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
@@ -7591,18 +7596,36 @@ 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;
+ uint_fast64_t monotonic_ms;
+ int_fast64_t diff_ms;
+#endif
#ifndef USE_GTK
struct frame *focus_frame;
Time old_time;
-#if defined HAVE_XSYNC && defined HAVE_CLOCK_GETTIME
- uint64_t monotonic_time;
-#endif
focus_frame = dpyinfo->x_focus_frame;
old_time = dpyinfo->last_user_time;
@@ -7621,25 +7644,53 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
/* See if the current CLOCK_MONOTONIC time is reasonably close
to the X server time. */
monotonic_time = x_sync_current_monotonic_time ();
+ monotonic_ms = monotonic_time / 1000;
- if (time * 1000 > monotonic_time - 500 * 1000
- && time * 1000 < monotonic_time + 500 * 1000)
- dpyinfo->server_time_monotonic_p = true;
- else
+ dpyinfo->server_time_monotonic_p
+ = (monotonic_time != 0
+ && !INT_SUBTRACT_WRAPV (time, monotonic_ms, &diff_ms)
+ && -500 < diff_ms && diff_ms < 500);
+
+ if (!dpyinfo->server_time_monotonic_p)
{
/* Compute an offset that can be subtracted from the server
time to estimate the monotonic time on the X server. */
- dpyinfo->server_time_monotonic_p = false;
- dpyinfo->server_time_offset
- = ((int64_t) time * 1000) - monotonic_time;
+ if (!monotonic_time
+ || INT_MULTIPLY_WRAPV (time, 1000, &dpyinfo->server_time_offset)
+ || INT_SUBTRACT_WRAPV (dpyinfo->server_time_offset,
+ monotonic_time,
+ &dpyinfo->server_time_offset))
+ dpyinfo->server_time_offset = 0;
+
+ /* If the server time is reasonably close to the monotonic
+ time after the latter is truncated to CARD32, simply make
+ the offset that between the server time in ms and the
+ actual time in ms. */
+
+ monotonic_ms = monotonic_ms & 0xffffffff;
+ if (!INT_SUBTRACT_WRAPV (time, monotonic_ms, &diff_ms)
+ && -500 < diff_ms && diff_ms < 500)
+ {
+ /* The server timestamp overflowed. Make the time
+ offset exactly how much it overflowed by. */
+
+ if (INT_SUBTRACT_WRAPV (monotonic_time / 1000, monotonic_ms,
+ &dpyinfo->server_time_offset)
+ || INT_MULTIPLY_WRAPV (dpyinfo->server_time_offset,
+ 1000, &dpyinfo->server_time_offset)
+ || INT_SUBTRACT_WRAPV (0, dpyinfo->server_time_offset,
+ &dpyinfo->server_time_offset))
+ dpyinfo->server_time_offset = 0;
+ }
}
}
#endif
#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;
@@ -7676,16 +7727,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);
@@ -7727,12 +7800,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);
@@ -7743,13 +7820,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);
}
@@ -8298,6 +8376,8 @@ x_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
? CHAR_TABLE_REF (Vglyphless_char_display,
glyph->u.glyphless.ch)
: XCHAR_TABLE (Vglyphless_char_display)->extras[0]);
+ if (CONSP (acronym))
+ acronym = XCAR (acronym);
if (STRINGP (acronym))
str = SSDATA (acronym);
}
@@ -9554,31 +9634,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
@@ -9588,6 +9686,7 @@ x_composite_image (struct glyph_string *s, Pixmap dest,
srcX, srcY,
width, height, dstX, dstY);
}
+
#endif /* !USE_CAIRO */
@@ -9666,6 +9765,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);
}
@@ -9679,7 +9781,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
@@ -9845,8 +9952,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
@@ -10727,6 +10837,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 ();
}
@@ -10740,6 +10851,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
@@ -10778,7 +10899,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
@@ -11894,7 +12015,8 @@ x_dnd_process_quit (struct frame *f, Time timestamp)
{
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
- x_dnd_send_leave (f, x_dnd_last_seen_window);
+ x_dnd_send_leave (f, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
&& x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
@@ -12621,9 +12743,11 @@ xi_handle_focus_change (struct x_display_info *dpyinfo)
else
dpyinfo->client_pointer_device = device->device_id;
}
-
- if (device->focus_implicit_frame
- && device->focus_implicit_time > time)
+ /* Even if the implicit focus was set after the explicit focus
+ on this specific device, the explicit focus is what really
+ matters. So use it instead. */
+ else if (device->focus_implicit_frame
+ && device->focus_implicit_time > time)
{
new = device->focus_implicit_frame;
time = device->focus_implicit_time;
@@ -12714,12 +12838,41 @@ 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
+ that means XI_Leave events will not have their focus field
+ set if the core focus is transferred to another window after
+ an entry event that pretends to (or really does) set the
+ implicit focus. In addition, if the core focus is set, but
+ the extension focus on the client pointer is not, all
+ XI_Enter events will have their focus fields set, despite not
+ actually changing the effective focus window. Combined with
+ almost all window managers not setting the focus on input
+ extension devices, this means that Emacs will continue to
+ think the implicit focus is set on one of its frames if the
+ actual (core) focus is transferred to another window while
+ the pointer remains inside a frame. The only workaround in
+ this case is to clear the implicit focus along with
+ XI_FocusOut events, which is not correct at all, but better
+ than leaving frames in an incorrectly-focused state.
+ (bug#57468) */
+ device->focus_implicit_frame = NULL;
break;
case XI_Enter:
@@ -12809,6 +12962,43 @@ xi_handle_interaction (struct x_display_info *dpyinfo,
xi_handle_focus_change (dpyinfo);
}
+/* Return whether or not XEV actually represents a change in the
+ position of the pointer on DEVICE, with respect to the last event
+ received. This is necessary because the input extension reports
+ motion events in very high resolution, while Emacs is only fast
+ enough to process motion events aligned to the pixel grid. */
+
+static bool
+xi_position_changed (struct xi_device_t *device, XIDeviceEvent *xev)
+{
+ bool changed;
+
+ changed = true;
+
+ if (xev->event != device->last_motion_window)
+ goto out;
+
+ if (lrint (xev->event_x) == device->last_motion_x
+ && lrint (xev->event_y) == device->last_motion_y)
+ {
+ changed = false;
+ goto out;
+ }
+
+ out:
+ device->last_motion_x = lrint (xev->event_x);
+ device->last_motion_y = lrint (xev->event_y);
+ device->last_motion_window = xev->event;
+
+ return changed;
+}
+
+static void
+xi_report_motion_window_clear (struct xi_device_t *device)
+{
+ device->last_motion_window = None;
+}
+
#ifdef HAVE_XINPUT2_1
/* Look up a scroll valuator in DEVICE by NUMBER. */
@@ -12916,14 +13106,6 @@ xi_handle_device_changed (struct x_display_info
*dpyinfo,
{
valuator->invalid_p = false;
valuator->current_value = valuator_info->value;
-
- /* Make sure that this is reset if the pointer moves
- into a window of ours.
-
- 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;
}
break;
@@ -13098,7 +13280,12 @@ x_detect_focus_change (struct x_display_info *dpyinfo,
struct frame *frame,
void
x_mouse_leave (struct x_display_info *dpyinfo)
{
- Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
+#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT
+ struct xi_device_t *device;
+#endif
+ Mouse_HLInfo *hlinfo;
+
+ hlinfo = &dpyinfo->mouse_highlight;
if (hlinfo->mouse_face_mouse_frame)
{
@@ -13106,7 +13293,35 @@ x_mouse_leave (struct x_display_info *dpyinfo)
hlinfo->mouse_face_mouse_frame = NULL;
}
- x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame);
+#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT
+ if (!dpyinfo->supports_xi2)
+ /* The call below is supposed to reset the implicit focus and
+ revert the focus back to the last explicitly focused frame. It
+ doesn't work on input extension builds because focus tracking
+ does not set x_focus_event_frame, and proceeds on a per-device
+ basis. On such builds, clear the implicit focus of the client
+ pointer instead. */
+#endif
+ x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame);
+#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT
+ else
+ {
+ if (dpyinfo->client_pointer_device == -1)
+ /* If there's no client pointer device, then no implicit focus
+ is currently set. */
+ return;
+
+ device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device);
+
+ if (device && device->focus_implicit_frame)
+ {
+ device->focus_implicit_frame = NULL;
+
+ /* The focus might have changed; compute the new focus. */
+ xi_handle_focus_change (dpyinfo);
+ }
+ }
+#endif
}
#endif
@@ -13406,6 +13621,160 @@ get_keysym_name (int keysym)
return value;
}
+/* Given the root and event coordinates of an X event destined for F's
+ edit window, compute the offset between that window and F's root
+ window. This information is then used as an optimization to avoid
+ synchronizing when converting coordinates from some other event to
+ F's edit window. */
+
+static void
+x_compute_root_window_offset (struct frame *f, int root_x, int root_y,
+ int event_x, int event_y)
+{
+ FRAME_X_OUTPUT (f)->window_offset_certain_p = true;
+ FRAME_X_OUTPUT (f)->root_x = root_x - event_x;
+ FRAME_X_OUTPUT (f)->root_y = root_y - event_y;
+}
+
+/* Translate the given coordinates from the root window to the edit
+ window of FRAME, taking into account any cached root window
+ offsets. This allows Emacs to avoid excessive calls to _XReply in
+ many cases while handling events, which would otherwise result in
+ slowdowns over slow network connections. */
+
+void
+x_translate_coordinates (struct frame *f, int root_x, int root_y,
+ int *x_out, int *y_out)
+{
+ 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 = root_x - output->root_x;
+ *y_out = root_y - output->root_y;
+
+ return;
+ }
+
+ /* Otherwise, do the transformation manually. Then, cache the root
+ window position. */
+ if (!XTranslateCoordinates (FRAME_X_DISPLAY (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+ FRAME_X_WINDOW (f), root_x, root_y,
+ x_out, y_out, &dummy))
+ /* Use some dummy values. This is not supposed to be called with
+ coordinates out of the screen. */
+ *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 = root_x - *x_out;
+ output->root_y = root_y - *y_out;
+ }
+}
+
+/* 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. */
+
+void
+x_translate_coordinates_to_root (struct frame *f, int x, int y,
+ int *x_out, int *y_out)
+{
+ 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)
+{
+ x_compute_root_window_offset (f, enter->root_x, enter->root_y,
+ enter->event_x, enter->event_y);
+}
+
+#ifdef HAVE_XINPUT2_4
+
+static void
+xi_compute_root_window_offset_pinch (struct frame *f, XIGesturePinchEvent *pev)
+{
+ /* Truncate coordinates instead of rounding them, because that is
+ how the X server handles window hierarchy. */
+ x_compute_root_window_offset (f, pev->root_x, pev->root_y,
+ pev->event_x, pev->event_y);
+}
+
+#endif
+
+#endif
+
static Bool
x_query_pointer_1 (struct x_display_info *dpyinfo,
int client_pointer_device, Window w,
@@ -13463,6 +13832,8 @@ x_query_pointer_1 (struct x_display_info *dpyinfo,
xi_convert_button_state (&buttons, &state);
*mask_return = state | modifiers.effective;
+ XFree (buttons.mask);
+
*root_x_return = lrint (root_x);
*root_y_return = lrint (root_y);
*win_x_return = lrint (win_x);
@@ -13532,10 +13903,10 @@ x_query_pointer (Display *dpy, Window w, Window
*root_return,
X server, and instead be artificially constructed from input
extension events. In these special events, the only fields that
are initialized are `time', `button', `state', `type', `window' and
- `x' and `y'. This function should not access any other fields in
- EVENT without also initializing the corresponding fields in `bv'
- under the XI_ButtonPress and XI_ButtonRelease labels inside
- `handle_one_xevent'. */
+ `x', `y', `x_root' and `y_root'. This function should not access
+ any other fields in EVENT without also initializing the
+ corresponding fields in `bv' under the XI_ButtonPress and
+ XI_ButtonRelease labels inside `handle_one_xevent'. */
static Lisp_Object
x_construct_mouse_click (struct input_event *result,
@@ -13544,7 +13915,6 @@ x_construct_mouse_click (struct input_event *result,
{
int x = event->x;
int y = event->y;
- Window dummy;
/* Make the event type NO_EVENT; we'll change that when we decide
otherwise. */
@@ -13561,9 +13931,8 @@ x_construct_mouse_click (struct input_event *result,
happen with GTK+ scroll bars, for example), translate the
coordinates so they appear at the correct position. */
if (event->window != FRAME_X_WINDOW (f))
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
- event->window, FRAME_X_WINDOW (f),
- x, y, &x, &y, &dummy);
+ x_translate_coordinates (f, event->x_root, event->y_root,
+ &x, &y);
XSETINT (result->x, x);
XSETINT (result->y, y);
@@ -13918,7 +14287,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)
@@ -14266,17 +14636,23 @@ x_protect_window_for_callback (struct x_display_info
*dpyinfo,
return true;
}
-static void
+static Lisp_Object
x_unprotect_window_for_callback (struct x_display_info *dpyinfo)
{
+ Lisp_Object window;
+
if (!dpyinfo->n_protected_windows)
- emacs_abort ();
+ return Qnil;
+
+ window = dpyinfo->protected_windows[0];
dpyinfo->n_protected_windows--;
if (dpyinfo->n_protected_windows)
memmove (dpyinfo->protected_windows, &dpyinfo->protected_windows[1],
sizeof (Lisp_Object) * dpyinfo->n_protected_windows);
+
+ return window;
}
/* Send a client message with message type Xatom_Scrollbar for a
@@ -14343,30 +14719,34 @@ x_send_scroll_bar_event (Lisp_Object window, enum
scroll_bar_part part,
in *IEVENT. */
static void
-x_scroll_bar_to_input_event (const XEvent *event,
+x_scroll_bar_to_input_event (struct x_display_info *dpyinfo,
+ const XEvent *event,
struct input_event *ievent)
{
- const XClientMessageEvent *ev = &event->xclient;
Lisp_Object window;
- struct window *w;
- /* See the comment in the function above. */
- intptr_t iw0 = ev->data.l[0];
- intptr_t iw1 = ev->data.l[1];
- intptr_t iw = (iw0 << 31 << 1) + (iw1 & 0xffffffffu);
- w = (struct window *) iw;
+ /* Every time a scroll bar ClientMessage event is sent, the window
+ is pushed onto a queue that is traced for garbage collection.
+ Every time we need a window for a read scroll bar event, we
+ simply read from the other side of the queue. */
+ window = x_unprotect_window_for_callback (dpyinfo);
- XSETWINDOW (window, w);
+ if (NILP (window))
+ {
+ /* This means we are getting extra scroll bar events for some
+ reason, and shouldn't be possible in practice. */
+ EVENT_INIT (*ievent);
+ return;
+ }
ievent->kind = SCROLL_BAR_CLICK_EVENT;
ievent->frame_or_window = window;
ievent->arg = Qnil;
- ievent->timestamp
- = x_get_last_toolkit_time (FRAME_DISPLAY_INFO (XFRAME (w->frame)));
+ ievent->timestamp = x_get_last_toolkit_time (dpyinfo);
ievent->code = 0;
- ievent->part = ev->data.l[2];
- ievent->x = make_fixnum (ev->data.l[3]);
- ievent->y = make_fixnum (ev->data.l[4]);
+ ievent->part = event->xclient.data.l[2];
+ ievent->x = make_fixnum (event->xclient.data.l[3]);
+ ievent->y = make_fixnum (event->xclient.data.l[4]);
ievent->modifiers = 0;
}
@@ -14374,30 +14754,34 @@ x_scroll_bar_to_input_event (const XEvent *event,
input event in *IEVENT. */
static void
-x_horizontal_scroll_bar_to_input_event (const XEvent *event,
+x_horizontal_scroll_bar_to_input_event (struct x_display_info *dpyinfo,
+ const XEvent *event,
struct input_event *ievent)
{
- const XClientMessageEvent *ev = &event->xclient;
Lisp_Object window;
- struct window *w;
- /* See the comment in the function above. */
- intptr_t iw0 = ev->data.l[0];
- intptr_t iw1 = ev->data.l[1];
- intptr_t iw = (iw0 << 31 << 1) + (iw1 & 0xffffffffu);
- w = (struct window *) iw;
+ /* Every time a scroll bar ClientMessage event is sent, the window
+ is pushed onto a queue that is traced for garbage collection.
+ Every time we need a window for a read scroll bar event, we
+ simply read from the other side of the queue. */
+ window = x_unprotect_window_for_callback (dpyinfo);
- XSETWINDOW (window, w);
+ if (NILP (window))
+ {
+ /* This means we are getting extra scroll bar events for some
+ reason, and shouldn't be possible in practice. */
+ EVENT_INIT (*ievent);
+ return;
+ }
ievent->kind = HORIZONTAL_SCROLL_BAR_CLICK_EVENT;
ievent->frame_or_window = window;
ievent->arg = Qnil;
- ievent->timestamp
- = x_get_last_toolkit_time (FRAME_DISPLAY_INFO (XFRAME (w->frame)));
+ ievent->timestamp = x_get_last_toolkit_time (dpyinfo);
ievent->code = 0;
- ievent->part = ev->data.l[2];
- ievent->x = make_fixnum (ev->data.l[3]);
- ievent->y = make_fixnum (ev->data.l[4]);
+ ievent->part = event->xclient.data.l[2];
+ ievent->x = make_fixnum (event->xclient.data.l[3]);
+ ievent->y = make_fixnum (event->xclient.data.l[4]);
ievent->modifiers = 0;
}
@@ -14520,7 +14904,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)
{
@@ -16744,18 +17129,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
@@ -17003,7 +17391,8 @@ x_dnd_update_state (struct x_display_info *dpyinfo,
Time timestamp)
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag
@@ -17034,16 +17423,15 @@ x_dnd_update_state (struct x_display_info *dpyinfo,
Time timestamp)
x_dnd_waiting_for_finish = false;
target = None;
}
-
- x_dnd_last_seen_toplevel = toplevel;
- }
+ }
if (target != x_dnd_last_seen_window)
{
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag
@@ -17065,13 +17453,14 @@ x_dnd_update_state (struct x_display_info *dpyinfo,
Time timestamp)
}
x_dnd_action = None;
+ x_dnd_last_seen_toplevel = toplevel;
x_dnd_last_seen_window = target;
x_dnd_last_protocol_version = target_proto;
x_dnd_last_motif_style = motif_style;
x_dnd_last_window_is_frame = was_frame;
if (target != None && x_dnd_last_protocol_version != -1)
- x_dnd_send_enter (x_dnd_frame, target,
+ x_dnd_send_enter (x_dnd_frame, target, x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version);
else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag)
@@ -17092,11 +17481,14 @@ x_dnd_update_state (struct x_display_info *dpyinfo,
Time timestamp)
target, &emsg);
}
}
+ else
+ x_dnd_last_seen_toplevel = toplevel;
if (x_dnd_last_window_is_frame && target != None)
x_dnd_note_self_position (dpyinfo, target, root_x, root_y);
else if (x_dnd_last_protocol_version != -1 && target != None)
x_dnd_send_position (x_dnd_frame, target,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version,
root_x, root_y,
x_dnd_selection_timestamp,
@@ -17140,7 +17532,8 @@ x_dnd_update_state (struct x_display_info *dpyinfo,
Time timestamp)
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
x_dnd_send_leave (x_dnd_frame,
- x_dnd_last_seen_window);
+ x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
&& x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
@@ -17457,6 +17850,109 @@ x_coords_from_dnd_message (struct x_display_info
*dpyinfo,
return false;
}
+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;
+ unsigned char *data;
+ unsigned long *state;
+
+ data = NULL;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
+ if (XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_wm_state, 0, 2, False,
+ AnyPropertyType, &type, &format, &nitems,
+ &bytes_after, &data) != Success)
+ return;
+
+ if (!data || nitems != 2 || format != 32)
+ {
+ if (data)
+ XFree (data);
+
+ return;
+ }
+
+ state = (unsigned long *) data;
+
+ if (state[0] == NormalState && FRAME_ICONIFIED_P (f))
+ {
+ /* The frame has been deiconified. It has not been withdrawn
+ and is now visible. */
+ SET_FRAME_VISIBLE (f, 1);
+ SET_FRAME_ICONIFIED (f, false);
+ f->output_data.x->has_been_visible = true;
+
+ 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
+ the correct flags upon withdrawing the window, so there is no
+ need to do anything here. */
+
+ 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.
@@ -17480,10 +17976,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
int do_help = 0;
#ifdef HAVE_XINPUT2
struct xi_device_t *gen_help_device;
- Time gen_help_time;
+ 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_
@@ -17504,7 +18000,17 @@ 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. */
+
+ if (!input_blocked_p ())
+ emacs_abort ();
*finish = X_EVENT_NORMAL;
@@ -17555,7 +18061,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_dnd_last_protocol_version != -1
&& x_dnd_in_progress
- && target == x_dnd_last_seen_window
+ && target == x_dnd_last_seen_toplevel
/* The XDND documentation is not very clearly worded.
But this should be the correct behavior, since
"kDNDStatusSendHereFlag" in the reference
@@ -17652,7 +18158,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_dnd_waiting_for_finish
= x_dnd_send_drop (x_dnd_finish_frame,
- target, x_dnd_selection_timestamp,
+ target,
+ x_dnd_last_seen_toplevel,
+ x_dnd_selection_timestamp,
x_dnd_send_drop_proto);
}
}
@@ -17778,6 +18286,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;
}
@@ -17972,13 +18485,22 @@ handle_one_xevent (struct x_display_info *dpyinfo,
we construct an input_event. */
if (event->xclient.message_type == dpyinfo->Xatom_Scrollbar)
{
- x_scroll_bar_to_input_event (event, &inev.ie);
+ /* Convert the scroll bar event to an input event using
+ the first window entered into the scroll bar event
+ queue. */
+ x_scroll_bar_to_input_event (dpyinfo, event, &inev.ie);
+
*finish = X_EVENT_GOTO_OUT;
goto done;
}
else if (event->xclient.message_type ==
dpyinfo->Xatom_Horizontal_Scrollbar)
{
- x_horizontal_scroll_bar_to_input_event (event, &inev.ie);
+ /* Convert the horizontal scroll bar event to an input
+ event using the first window entered into the scroll
+ bar event queue. */
+ x_horizontal_scroll_bar_to_input_event (dpyinfo, event,
+ &inev.ie);
+
*finish = X_EVENT_GOTO_OUT;
goto done;
}
@@ -18228,6 +18750,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
+ if (f && event->xproperty.atom == dpyinfo->Xatom_wm_state
+ && !FRAME_X_EMBEDDED_P (f) && !FRAME_PARENT_FRAME (f))
+ /* Handle WM_STATE. We use this to clear the iconified flag
+ on a frame if it is set.
+
+ GTK builds ignore deiconifying frames on FocusIn or Expose
+ by default, and cannot wait for the window manager to
+ remove _NET_WM_STATE_HIDDEN, as it is ambiguous when not
+ set. Handling UnmapNotify also checks for
+ _NET_WM_STATE_HIDDEN, and thus suffers from the same
+ problem. */
+ x_handle_wm_state (f, &inev.ie);
+
if (f && FRAME_X_OUTPUT (f)->alpha_identical_p
&& (event->xproperty.atom
== dpyinfo->Xatom_net_wm_window_opacity))
@@ -18357,6 +18892,24 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = x_top_window_to_frame (dpyinfo, event->xreparent.window);
if (f)
{
+#ifndef USE_GTK
+ if (FRAME_OUTPUT_DATA (f)->parent_desc
+ && FRAME_X_EMBEDDED_P (f))
+ {
+ /* The frame's embedder was destroyed; mark the frame as
+ no longer embedded, and map the frame. An
+ UnmapNotify event must have previously been received
+ during the start of save-set processing. */
+
+ FRAME_X_OUTPUT (f)->explicit_parent = false;
+
+ /* Remove the leftover XEMBED_INFO property. */
+ XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ dpyinfo->Xatom_XEMBED_INFO);
+ x_make_frame_visible (f);
+ }
+#endif
+
/* Maybe we shouldn't set this for child frames ?? */
f->output_data.x->parent_desc = event->xreparent.parent;
@@ -18365,8 +18918,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
@@ -18384,11 +18937,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
Window root;
unsigned int dummy_uint;
- block_input ();
XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
&root, &f->left_pos, &f->top_pos,
&dummy_uint, &dummy_uint, &dummy_uint, &dummy_uint);
- unblock_input ();
}
x_set_frame_alpha (f);
@@ -18396,11 +18947,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)
{
@@ -18409,11 +18961,12 @@ 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))
{
- block_input ();
/* By default, do not set the frame's visibility here, see
https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html.
The default behavior can be overridden by setting
@@ -18432,7 +18985,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
f->output_data.x->has_been_visible = true;
SET_FRAME_GARBAGED (f);
- unblock_input ();
}
else if (FRAME_GARBAGED_P (f))
{
@@ -18729,7 +19281,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;
@@ -18757,9 +19310,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)
@@ -18799,6 +19357,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
`event' itself. */
XKeyEvent xkey = event->xkey;
+ if (event->xkey.window == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset for
+ why this optimization is performed. */
+ x_compute_root_window_offset (f, event->xkey.x_root,
+ event->xkey.y_root,
+ event->xkey.x, event->xkey.y);
+
#ifdef HAVE_XINPUT2
Time pending_keystroke_time;
struct xi_device_t *source;
@@ -18826,7 +19391,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;
@@ -18857,7 +19422,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&xkey, (char *) copy_bufptr,
copy_bufsiz, &keysym,
&status_return);
- coding = Qnil;
+ coding = FRAME_X_XIM_CODING (f);
if (status_return == XBufferOverflow)
{
copy_bufsiz = nbytes + 1;
@@ -18943,7 +19508,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
@@ -19201,16 +19766,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);
-
- 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);
@@ -19220,19 +19785,44 @@ 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))
+ x_compute_root_window_offset (f, event->xcrossing.x_root,
+ event->xcrossing.y_root,
+ event->xcrossing.x,
+ event->xcrossing.y);
+
+ /* The code below relies on the first several fields of
+ XCrossingEvent being laid out the same way as
+ XMotionEvent. */
+
if (f && x_mouse_click_focus_ignore_position)
{
ignore_next_mouse_click_timeout = (event->xmotion.time
@@ -19254,6 +19844,21 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case FocusIn:
+#if defined HAVE_XINPUT2 \
+ && (defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT))
+ /* If a FocusIn event is received (because the window manager
+ sent us one), don't set the core focus if XInput 2 is
+ enabled, since that would mess up the device-specific focus
+ tracking.
+
+ The long looking preprocessor conditional only enables this
+ code on GTK 3 and no toolkit builds, since those are the only
+ builds where focus is tracked specific to each master device.
+ Other builds use core events and the client pointer to handle
+ focus, much like on a build without XInput 2. */
+ if (dpyinfo->supports_xi2)
+ goto OTHER;
+#endif
#ifdef USE_GTK
/* Some WMs (e.g. Mutter in Gnome Shell), don't unmap
minimized/iconified windows; thus, for those WMs we won't get
@@ -19287,11 +19892,38 @@ 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
+ 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)
+ {
+#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)
{
@@ -19304,6 +19936,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. */
@@ -19314,14 +19951,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#else
f = x_top_window_to_frame (dpyinfo, event->xcrossing.window);
#endif
-#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 && !defined USE_MOTIF
- /* The XI2 event mask is set on the frame widget, so this event
- likely originates from the shell widget, which we aren't
- interested in. (But don't ignore this on Motif, since we
- want to clear the mouse face when a popup is active.) */
- if (dpyinfo->supports_xi2)
- f = NULL;
-#endif
+
if (f)
{
/* Now clear dpyinfo->last_mouse_motion_frame, or
@@ -19343,6 +19973,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.
@@ -19357,6 +19988,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| EQ (track_mouse, Qdropping))
&& gui_mouse_grabbed (dpyinfo)))
do_help = -1;
+
+ if (event->xcrossing.window == FRAME_X_WINDOW (f))
+ x_compute_root_window_offset (f, event->xcrossing.x_root,
+ event->xcrossing.y_root,
+ event->xcrossing.x,
+ event->xcrossing.y);
+
}
#ifdef USE_GTK
/* See comment in EnterNotify above */
@@ -19367,6 +20005,21 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case FocusOut:
+#if defined HAVE_XINPUT2 \
+ && (defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT))
+ /* If a FocusIn event is received (because the window manager
+ sent us one), don't set the core focus if XInput 2 is
+ enabled, since that would mess up the device-specific focus
+ tracking.
+
+ The long looking preprocessor conditional only enables this
+ code on GTK 3 and no toolkit builds, since those are the only
+ builds where focus is tracked specific to each master device.
+ Other builds use core events and the client pointer to handle
+ focus, much like on a build without XInput 2. */
+ if (dpyinfo->supports_xi2)
+ goto OTHER;
+#endif
x_detect_focus_change (dpyinfo, any, event, &inev.ie);
goto OTHER;
@@ -19378,13 +20031,21 @@ 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);
}
f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window);
+ if (f && event->xmotion.window == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset for
+ why this optimization is performed. */
+ x_compute_root_window_offset (f, event->xmotion.x_root,
+ event->xmotion.y_root,
+ event->xmotion.x,
+ event->xmotion.y);
+
if (x_dnd_in_progress
/* Handle these events normally if the recursion
level is higher than when the drag-and-drop
@@ -19459,7 +20120,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW
(x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag
@@ -19490,8 +20152,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_dnd_waiting_for_finish = false;
target = None;
}
-
- x_dnd_last_seen_toplevel = toplevel;
}
if (target != x_dnd_last_seen_window)
@@ -19499,7 +20159,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW
(x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)
&& x_dnd_disable_motif_drag
@@ -19542,6 +20203,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
x_dnd_action = None;
+ x_dnd_last_seen_toplevel = toplevel;
x_dnd_last_seen_window = target;
x_dnd_last_protocol_version = target_proto;
x_dnd_last_motif_style = motif_style;
@@ -19549,6 +20211,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (target != None && x_dnd_last_protocol_version != -1)
x_dnd_send_enter (x_dnd_frame, target,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version);
else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag)
@@ -19569,6 +20232,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
target, &emsg);
}
}
+ else
+ x_dnd_last_seen_toplevel = toplevel;
if (x_dnd_last_window_is_frame && target != None)
x_dnd_note_self_position (dpyinfo, target,
@@ -19576,6 +20241,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
event->xbutton.y_root);
else if (x_dnd_last_protocol_version != -1 && target != None)
x_dnd_send_position (x_dnd_frame, target,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version,
event->xmotion.x_root,
event->xmotion.y_root,
@@ -19617,7 +20283,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);
@@ -19644,10 +20312,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xmotion.window != FRAME_X_WINDOW (f))
{
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
- xmotion.window, FRAME_X_WINDOW (f),
- xmotion.x, xmotion.y, &xmotion.x,
- &xmotion.y, &xmotion.subwindow);
+ x_translate_coordinates (f, xmotion.x_root, xmotion.y_root,
+ &xmotion.x, &xmotion.y);
xmotion.window = FRAME_X_WINDOW (f);
}
@@ -19698,6 +20364,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;
}
@@ -19870,17 +20539,21 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window);
+
+ /* This means we can no longer be certain of the root window
+ coordinates of any's edit window. */
+ if (any)
+ FRAME_X_OUTPUT (any)->window_offset_certain_p = false;
+
/* Unfortunately, we need to call x_drop_xrender_surfaces for
_all_ ConfigureNotify events, otherwise we miss some and
flicker. Don't try to optimize these calls by looking only
for size changes: that's not sufficient. We miss some
surface invalidations and flicker. */
- block_input ();
#ifdef HAVE_XDBE
if (f && FRAME_X_DOUBLE_BUFFERED_P (f))
x_drop_xrender_surfaces (f);
#endif
- unblock_input ();
#if defined USE_CAIRO && !defined USE_GTK
if (f)
x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width,
@@ -19910,10 +20583,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f->new_width, f->new_height);
#ifdef HAVE_XDBE
- block_input ();
if (FRAME_X_DOUBLE_BUFFERED_P (f))
x_drop_xrender_surfaces (f);
- unblock_input ();
#endif
xg_frame_resized (f, configureEvent.xconfigure.width,
configureEvent.xconfigure.height);
@@ -19992,7 +20663,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);
@@ -20003,11 +20674,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
Window root;
unsigned int dummy_uint;
- block_input ();
XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
&root, &f->left_pos, &f->top_pos,
&dummy_uint, &dummy_uint, &dummy_uint,
&dummy_uint);
- unblock_input ();
}
if (!FRAME_TOOLTIP_P (f)
@@ -20030,6 +20699,28 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif
+#ifdef HAVE_XINPUT2
+ if (f && dpyinfo->supports_xi2)
+ {
+ Mouse_HLInfo *hlinfo;
+
+ /* The input extension doesn't report motion events when
+ the part of the window below the pointer changes. To
+ avoid outdated information from keeping
+ i.e. mouse-highlight at the wrong position after the
+ frame is moved or resized, reset the mouse highlight
+ and last_mouse_motion_frame. */
+
+ if (dpyinfo->last_mouse_motion_frame == f)
+ dpyinfo->last_mouse_motion_frame = NULL;
+
+ hlinfo = MOUSE_HL_INFO (f);
+
+ if (hlinfo->mouse_face_mouse_frame == f)
+ reset_mouse_highlight (hlinfo);
+ }
+#endif
+
}
if (x_dnd_in_progress
@@ -20042,10 +20733,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)
{
@@ -20083,10 +20776,18 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window);
+ if (f && event->xbutton.window == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ x_compute_root_window_offset (f, event->xbutton.x_root,
+ event->xbutton.y_root,
+ event->xbutton.x,
+ event->xbutton.y);
+
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;
@@ -20115,6 +20816,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
else if (x_dnd_last_protocol_version != -1)
x_dnd_send_position (x_dnd_frame,
x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version,
event->xbutton.x_root,
event->xbutton.y_root,
@@ -20160,13 +20862,14 @@ 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_window;
+ x_dnd_pending_finish_target = x_dnd_last_seen_toplevel;
x_dnd_waiting_for_finish_proto =
x_dnd_last_protocol_version;
x_dnd_waiting_for_finish
= x_dnd_do_drop (x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version);
x_dnd_finish_display = dpyinfo->display;
}
@@ -20254,6 +20957,15 @@ handle_one_xevent (struct x_display_info *dpyinfo,
dpyinfo->last_mouse_glyph_frame = NULL;
f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window);
+
+ if (f && event->xbutton.window == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ x_compute_root_window_offset (f, event->xbutton.x_root,
+ event->xbutton.y_root,
+ event->xbutton.x,
+ event->xbutton.y);
+
if (f && event->xbutton.type == ButtonPress
&& !popup_activated ()
&& !x_window_to_scroll_bar (event->xbutton.display,
@@ -20268,12 +20980,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf)))
{
- block_input ();
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
RevertToParent, event->xbutton.time);
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
- unblock_input ();
}
}
@@ -20325,9 +21035,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)
@@ -20345,9 +21058,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 */
@@ -20504,6 +21220,15 @@ handle_one_xevent (struct x_display_info *dpyinfo,
== dpyinfo->net_supported_window)
dpyinfo->net_supported_window = None;
+ if (event->xdestroywindow.window
+ == dpyinfo->motif_drag_window)
+ /* We get DestroyNotify events for the drag window because
+ x_special_window_exists_p selects for structure
+ notification. The drag window is not supposed to go away
+ but not all clients obey that requirement when setting the
+ drag window property. */
+ dpyinfo->motif_drag_window = None;
+
xft_settings_event (dpyinfo, event);
break;
@@ -20519,11 +21244,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
bool must_free_data = false;
XIEvent *xi_event = (XIEvent *) event->xcookie.data;
+
/* Sometimes the event is already claimed by GTK, which
will free its data in due course. */
- if (!xi_event && XGetEventData (dpyinfo->display, &event->xcookie))
+ if (!xi_event)
{
- must_free_data = true;
+ if (XGetEventData (dpyinfo->display, &event->xcookie))
+ must_free_data = true;
+
xi_event = (XIEvent *) event->xcookie.data;
}
@@ -20531,7 +21259,25 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!xi_event)
{
- eassert (!must_free_data);
+ /* It may turn out that the event data has already been
+ implicitly freed for various reasons up to and
+ including XMenuActivate pushing some other event onto
+ the foreign-event queue, or x_menu_wait_for_events
+ calling XNextEvent through a timer that tries to wait
+ for input.
+
+ In that case, XGetEventData will return True, but
+ cookie->data will be NULL. Since handling such input
+ events is not really important, we can afford to
+ discard them.
+
+ The way Xlib is currently implemented makes calling
+ XFreeEventData unnecessary in this case, but call it
+ anyway, since not doing so may lead to a memory leak in
+ the future. */
+
+ if (must_free_data)
+ XFreeEventData (dpyinfo->display, &event->xcookie);
goto OTHER;
}
@@ -20604,7 +21350,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;
@@ -20639,16 +21385,28 @@ handle_one_xevent (struct x_display_info *dpyinfo,
any = x_any_window_to_frame (dpyinfo, enter->event);
#ifdef HAVE_XINPUT2_1
- xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid,
- true);
+ /* 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 (enter->mode != XINotifyUngrab
+ && enter->mode != XINotifyGrab
+ && enter->mode != XINotifyPassiveGrab
+ && enter->mode != XINotifyPassiveUngrab)
+ 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);
@@ -20660,6 +21418,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = any;
+ if (f && enter->event == FRAME_X_WINDOW (f))
+ xi_compute_root_window_offset_enter (f, enter);
+
if (f && x_mouse_click_focus_ignore_position)
{
ignore_next_mouse_click_timeout = (enter->time
@@ -20683,7 +21444,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case XI_Leave:
{
- XILeaveEvent *leave = (XILeaveEvent *) xi_event;
+ XILeaveEvent *leave;
+ struct xi_device_t *device;
+
+ leave = (XILeaveEvent *) xi_event;
#ifdef USE_GTK
struct xi_device_t *source;
XMotionEvent ev;
@@ -20700,6 +21464,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifdef USE_GTK
source = xi_device_from_id (dpyinfo, leave->sourceid);
#endif
+ device = xi_device_from_id (dpyinfo, leave->deviceid);
+
+ if (device)
+ xi_report_motion_window_clear (device);
/* This allows us to catch LeaveNotify events generated by
popup menu grabs. FIXME: this is right when there is a
@@ -20743,24 +21511,43 @@ 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)
+ if (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
+ && 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)
{
@@ -20787,9 +21574,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
just looks up a top window on Xt builds. */
#ifdef HAVE_XINPUT2_1
- if (leave->detail != XINotifyInferior && f)
+ if (f && 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
if (!f)
@@ -20817,6 +21607,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.
@@ -20832,6 +21623,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| EQ (track_mouse, Qdropping))
&& gui_mouse_grabbed (dpyinfo)))
do_help = -1;
+
+ if (f && leave->event == FRAME_X_WINDOW (f))
+ xi_compute_root_window_offset_enter (f, leave);
}
#ifdef USE_GTK
/* See comment in EnterNotify above */
@@ -20875,8 +21669,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto XI_OTHER;
#endif
- Window dummy;
-
#ifdef HAVE_XINPUT2_1
#ifdef HAVE_XWIDGETS
struct xwidget_view *xv = xwidget_view_from_window (xev->event);
@@ -20954,11 +21746,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
real_y = lrint (xev->event_y + bar->top);
}
else
- XTranslateCoordinates (dpyinfo->display,
- xev->event,
FRAME_X_WINDOW (f),
- lrint (xev->event_x),
- lrint (xev->event_y),
- &real_x, &real_y,
&dummy);
+ x_translate_coordinates (f,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
+ &real_x, &real_y);
}
else
{
@@ -21026,7 +21817,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,
@@ -21046,7 +21837,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
@@ -21119,6 +21910,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
#endif /* HAVE_XINPUT2_1 */
+ if (!xi_position_changed (device, xev))
+ goto XI_OTHER;
+
ev.x = lrint (xev->event_x);
ev.y = lrint (xev->event_y);
ev.window = xev->event;
@@ -21157,6 +21951,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = mouse_or_wdesc_frame (dpyinfo, xev->event);
+ if (f && xev->event == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ xi_compute_root_window_offset (f, xev);
+
if (x_dnd_in_progress
/* Handle these events normally if the recursion
level is higher than when the drag-and-drop
@@ -21191,26 +21990,26 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Also remember the mouse glyph and set
mouse_moved. */
if (f != dpyinfo->last_mouse_glyph_frame
- || xev->event_x < r->x
- || xev->event_x >= r->x + r->width
- || xev->event_y < r->y
- || xev->event_y >= r->y + r->height)
+ || lrint (xev->event_x) < r->x
+ || lrint (xev->event_x) >= r->x + r->width
+ || lrint (xev->event_y) < r->y
+ || lrint (xev->event_y) >= r->y + r->height)
{
f->mouse_moved = true;
f->last_mouse_device = (source ? source->name
: Qnil);
dpyinfo->last_mouse_scroll_bar = NULL;
- remember_mouse_glyph (f, xev->event_x,
- xev->event_y, r);
+ remember_mouse_glyph (f, lrint (xev->event_x),
+ lrint (xev->event_y), r);
dpyinfo->last_mouse_glyph_frame = f;
}
}
if (xev->root == dpyinfo->root_window)
target = x_dnd_get_target_window (dpyinfo,
- xev->root_x,
- xev->root_y,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
&target_proto,
&motif_style,
&toplevel,
@@ -21233,7 +22032,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW
(x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame,
x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame,
x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag
@@ -21264,8 +22064,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_dnd_waiting_for_finish = false;
target = None;
}
-
- x_dnd_last_seen_toplevel = toplevel;
}
if (target != x_dnd_last_seen_window)
@@ -21273,7 +22071,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1
&& x_dnd_last_seen_window != FRAME_OUTER_WINDOW
(x_dnd_frame))
- x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window);
+ x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag
@@ -21318,6 +22117,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
x_dnd_action = None;
+ x_dnd_last_seen_toplevel = toplevel;
x_dnd_last_seen_window = target;
x_dnd_last_protocol_version = target_proto;
x_dnd_last_motif_style = motif_style;
@@ -21325,6 +22125,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (target != None && x_dnd_last_protocol_version != -1)
x_dnd_send_enter (x_dnd_frame, target,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version);
else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC
(x_dnd_last_motif_style)
&& !x_dnd_disable_motif_drag)
@@ -21345,17 +22146,22 @@ handle_one_xevent (struct x_display_info *dpyinfo,
target, &emsg);
}
}
+ else
+ x_dnd_last_seen_toplevel = toplevel;
if (x_dnd_last_window_is_frame && target != None)
x_dnd_note_self_position (dpyinfo, target,
- xev->root_x, xev->root_y);
+ lrint (xev->root_x),
+ lrint (xev->root_y));
else if (x_dnd_last_protocol_version != -1 && target != None)
{
dnd_state = xi_convert_event_state (xev);
x_dnd_send_position (x_dnd_frame, target,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version,
- xev->root_x, xev->root_y,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
x_dnd_selection_timestamp,
x_dnd_wanted_action, 0,
dnd_state);
@@ -21398,9 +22204,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
if (xev->event != FRAME_X_WINDOW (f))
{
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
- xev->event, FRAME_X_WINDOW (f),
- ev.x, ev.y, &ev.x, &ev.y, &dummy);
+ x_translate_coordinates (f, lrint (xev->root_x),
+ lrint (xev->root_y),
+ &ev.x, &ev.y);
ev.window = FRAME_X_WINDOW (f);
}
@@ -21477,6 +22283,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
do_help = 1;
}
+
+ if (f)
+ x_flush_dirty_back_buffer_on (f);
goto XI_OTHER;
}
@@ -21506,6 +22315,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = mouse_or_wdesc_frame (dpyinfo, xev->event);
device = xi_device_from_id (dpyinfo, xev->deviceid);
+ if (f && xev->event == FRAME_X_WINDOW (f))
+ /* See the comment above
+ x_compute_root_window_offset for why this
+ optimization is performed. */
+ xi_compute_root_window_offset (f, xev);
+
/* Don't track grab status for emulated pointer
events, because they are ignored by the regular
mouse click processing code. */
@@ -21516,7 +22331,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;
@@ -21559,19 +22374,22 @@ 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,
- xev->root_x, xev->root_y,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
xev->detail, dnd_state,
xev->time);
}
else
x_dnd_send_position (x_dnd_frame,
x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version,
- xev->root_x, xev->root_y,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
xev->time, x_dnd_wanted_action,
xev->detail, dnd_state);
@@ -21614,16 +22432,18 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
x_dnd_waiting_for_finish = false;
x_dnd_note_self_drop (dpyinfo,
x_dnd_last_seen_window,
- xev->root_x, xev->root_y,
xev->time);
+ lrint (xev->root_x),
+ lrint (xev->root_y),
xev->time);
}
else if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
{
- x_dnd_pending_finish_target =
x_dnd_last_seen_window;
+ x_dnd_pending_finish_target =
x_dnd_last_seen_toplevel;
x_dnd_waiting_for_finish_proto =
x_dnd_last_protocol_version;
x_dnd_waiting_for_finish
= x_dnd_do_drop (x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel,
x_dnd_last_protocol_version);
x_dnd_finish_display = dpyinfo->display;
}
@@ -21689,12 +22509,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_dnd_send_unsupported_drop (dpyinfo,
(x_dnd_last_seen_toplevel != None
?
x_dnd_last_seen_toplevel
:
x_dnd_last_seen_window),
- xev->root_x,
xev->root_y, xev->time);
+ lrint
(xev->root_x),
+ lrint
(xev->root_y), xev->time);
}
else if (x_dnd_last_seen_toplevel != None)
x_dnd_send_unsupported_drop (dpyinfo,
x_dnd_last_seen_toplevel,
- xev->root_x,
xev->root_y,
+ lrint (xev->root_x),
+ lrint (xev->root_y),
xev->time);
x_dnd_last_protocol_version = -1;
@@ -21788,7 +22610,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);
@@ -21830,6 +22652,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
bv.type = xev->evtype == XI_ButtonPress ? ButtonPress :
ButtonRelease;
bv.x = lrint (xev->event_x);
bv.y = lrint (xev->event_y);
+ bv.x_root = lrint (xev->root_x);
+ bv.y_root = lrint (xev->root_y);
bv.window = xev->event;
bv.state = xi_convert_event_state (xev);
bv.time = xev->time;
@@ -21838,6 +22662,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = mouse_or_wdesc_frame (dpyinfo, xev->event);
+ if (f && xev->event == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ xi_compute_root_window_offset (f, xev);
+
if (f && xev->evtype == XI_ButtonPress
&& !popup_activated ()
&& !x_window_to_scroll_bar (dpyinfo->display, xev->event, 2)
@@ -21851,7 +22680,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f,
hf)))
{
- block_input ();
#if defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT)
if (device)
{
@@ -21874,7 +22702,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW
(f));
- unblock_input ();
}
}
@@ -21891,9 +22718,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifdef USE_GTK
if (!f)
{
- int real_x = lrint (xev->event_x);
- int real_y = lrint (xev->event_y);
- Window child;
+ int real_x = lrint (xev->root_x);
+ int real_y = lrint (xev->root_y);
f = x_any_window_to_frame (dpyinfo, xev->event);
@@ -21902,9 +22728,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->evtype == XI_ButtonRelease)
{
if (FRAME_X_WINDOW (f) != xev->event)
- XTranslateCoordinates (dpyinfo->display, xev->event,
- FRAME_X_WINDOW (f), real_x,
- real_y, &real_x, &real_y,
&child);
+ x_translate_coordinates (f, real_x, real_y,
+ &real_x, &real_y);
if (xev->detail <= 5)
inev.ie.kind = WHEEL_EVENT;
@@ -21980,9 +22805,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)
@@ -22007,10 +22835,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 */
@@ -22164,11 +22995,16 @@ 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);
+ if (f && xev->event == FRAME_X_WINDOW (f))
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ xi_compute_root_window_offset (f, xev);
+
/* GTK handles TAB events in an undesirable manner, so
keyboard events are always dropped. But as a side
effect, the user time will no longer be set by GDK,
@@ -22302,8 +23138,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)
@@ -22327,7 +23168,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&xkey, (char *) copy_bufptr,
copy_bufsiz, &keysym,
&status_return);
- coding = Qnil;
+ coding = FRAME_X_XIM_CODING (f);
if (status_return == XBufferOverflow)
{
@@ -22682,7 +23523,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;
@@ -22693,24 +23534,36 @@ handle_one_xevent (struct x_display_info *dpyinfo,
any_changed = true;
}
- x_catch_errors (dpyinfo->display);
- info = XIQueryDevice (dpyinfo->display,
hev->info[i].deviceid,
- &ndevices);
- x_uncatch_errors ();
+ /* Under unknown circumstances, multiple
+ XIDeviceEnabled events are sent at once,
+ causing the device to be duplicated. Check
+ that the device doesn't exist before adding
+ it. */
- if (info && info->enabled)
+ if (!xi_device_from_id (dpyinfo,
+ hev->info[i].deviceid))
{
- dpyinfo->devices
- = xrealloc (dpyinfo->devices, (sizeof
*dpyinfo->devices
- *
++dpyinfo->num_devices));
- 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);
- }
+ x_catch_errors (dpyinfo->display);
+ info = XIQueryDevice (dpyinfo->display,
+ hev->info[i].deviceid,
+ &ndevices);
+ x_uncatch_errors ();
- if (info)
- XIFreeDeviceInfo (info);
+ if (info && info->enabled)
+ {
+ dpyinfo->devices
+ = xrealloc (dpyinfo->devices,
+ (sizeof *dpyinfo->devices
+ * ++dpyinfo->num_devices));
+ 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);
+ }
+
+ if (info)
+ XIFreeDeviceInfo (info);
+ }
}
else if (hev->info[i].flags & XIDeviceDisabled)
disabled[n_disabled++] = hev->info[i].deviceid;
@@ -22786,7 +23639,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;
@@ -22796,6 +23649,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = x_window_to_frame (dpyinfo, xev->event);
+ if (f)
+ /* See the comment above x_compute_root_window_offset
+ for why this optimization is performed. */
+ xi_compute_root_window_offset (f, xev);
+
#ifdef HAVE_GTK3
menu_bar_p = (f && FRAME_X_OUTPUT (f)->menubar_widget
&& xg_event_is_for_menubar (f, event));
@@ -22879,7 +23737,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;
@@ -22926,7 +23784,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;
@@ -22967,7 +23825,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;
@@ -22984,11 +23842,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
any = x_window_to_frame (dpyinfo, pev->event);
+
if (any)
{
+ if (pev->event == FRAME_X_WINDOW (any))
+ 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);
@@ -23066,12 +23929,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;
}
}
@@ -23085,8 +23948,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);
}
@@ -23376,10 +24238,20 @@ 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
- block_input ();
if (*finish != X_EVENT_DROP)
{
/* Ignore some obviously bogus ConfigureNotify events that
@@ -23396,7 +24268,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
}
}
- unblock_input ();
#endif /* USE_X_TOOLKIT */
#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2
if (*finish != X_EVENT_DROP && copy)
@@ -23418,12 +24289,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
count++;
}
-#ifdef USE_TOOLKIT_SCROLL_BARS
- if (event->xany.type == ClientMessage
- && inev.ie.kind == SCROLL_BAR_CLICK_EVENT)
- x_unprotect_window_for_callback (dpyinfo);
-#endif
-
if (do_help
&& !(hold_quit && hold_quit->kind != NO_EVENT))
{
@@ -23454,19 +24319,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;
}
@@ -23489,7 +24345,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;
}
@@ -24563,7 +25424,8 @@ x_connection_closed (Display *dpy, const char
*error_message, bool ioerror)
if (x_dnd_last_seen_window != None
&& x_dnd_last_protocol_version != -1)
x_dnd_send_leave (x_dnd_frame,
- x_dnd_last_seen_window);
+ x_dnd_last_seen_window,
+ x_dnd_last_seen_toplevel);
else if (x_dnd_last_seen_window != None
&& !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
&& x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
@@ -24936,6 +25798,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. */
@@ -24956,6 +25859,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);
}
}
@@ -24965,6 +25871,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.
@@ -24973,9 +25881,10 @@ xim_destroy_callback (XIM xim, XPointer client_data,
XPointer call_data)
static void
xim_open_dpy (struct x_display_info *dpyinfo, char *resource_name)
{
+#ifdef HAVE_XIM
XIM xim;
+ const char *locale;
-#ifdef HAVE_XIM
if (use_xim)
{
if (dpyinfo->xim)
@@ -24998,6 +25907,14 @@ xim_open_dpy (struct x_display_info *dpyinfo, char
*resource_name)
destroy.client_data = (XPointer)dpyinfo;
XSetIMValues (xim, XNDestroyCallback, &destroy, NULL);
#endif
+
+ locale = XLocaleOfIM (xim);
+
+ /* Now try to determine the coding system that should be
+ used. locale is in Host Portable Character Encoding, and
+ as such can be passed to build_string as is. */
+ dpyinfo->xim_coding = safe_call1 (Vx_input_coding_function,
+ build_string (locale));
}
}
@@ -26317,6 +27234,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
@@ -26324,11 +27299,11 @@ x_ewmh_activate_frame (struct frame *f)
{
XEvent msg;
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
- if (FRAME_VISIBLE_P (f)
- && x_wm_supports (f, dpyinfo->Xatom_net_active_window))
+ if (FRAME_VISIBLE_P (f))
{
/* See the documentation at
https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html
@@ -26345,6 +27320,43 @@ 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_ignore_errors_for_next_request (dpyinfo);
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ RevertToParent, time);
+ XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
+ x_stop_ignoring_errors (dpyinfo);
+
+ return;
+ }
+ }
+
XSendEvent (dpyinfo->display, dpyinfo->root_window,
False, (SubstructureRedirectMask
| SubstructureNotifyMask), &msg);
@@ -26378,6 +27390,7 @@ static void
x_focus_frame (struct frame *f, bool noactivate)
{
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -26388,14 +27401,46 @@ x_focus_frame (struct frame *f, bool noactivate)
xembed_request_focus (f);
else
{
+ if (!noactivate
+ && x_wm_supports (f, dpyinfo->Xatom_net_active_window))
+ {
+ /* When window manager activation is possible, use it
+ instead. The window manager is expected to perform any
+ necessary actions such as raising the frame, moving it to
+ the current workspace, and mapping it, etc, before moving
+ input focus to the frame. */
+ x_ewmh_activate_frame (f);
+ 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);
+ 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);
+
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ RevertToParent, time);
+ }
+ else
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ /* But when no window manager is in use, we
+ don't care. */
+ RevertToParent, CurrentTime);
x_stop_ignoring_errors (dpyinfo);
-
- if (!noactivate)
- x_ewmh_activate_frame (f);
}
}
@@ -27027,6 +28072,13 @@ x_free_frame_resources (struct frame *f)
#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK && defined
HAVE_CLOCK_GETTIME
x_sync_free_fences (f);
#endif
+
+#ifdef USE_TOOLKIT_SCROLL_BARS
+ /* Since the frame was destroyed, we can no longer guarantee
+ that scroll bar events will be received. Clear
+ protected_windows. */
+ dpyinfo->n_protected_windows = 0;
+#endif
}
#ifdef HAVE_GTK3
@@ -27052,6 +28104,16 @@ x_free_frame_resources (struct frame *f)
if (f == hlinfo->mouse_face_mouse_frame)
reset_mouse_highlight (hlinfo);
+#ifdef HAVE_XINPUT2
+ /* Consider a frame being unfocused with no following FocusIn event
+ while an older focus from another seat exists. The client
+ pointer should then revert to the other seat, so handle potential
+ focus changes. */
+
+ if (dpyinfo->supports_xi2)
+ xi_handle_focus_change (dpyinfo);
+#endif
+
unblock_input ();
}
@@ -27278,6 +28340,31 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom
atom,
return value;
}
+#ifndef USE_GTK
+
+/* Set up XEmbed for F, and change its save set to handle the parent
+ being destroyed. */
+
+bool
+x_embed_frame (struct x_display_info *dpyinfo, struct frame *f)
+{
+ bool rc;
+
+ x_catch_errors (dpyinfo->display);
+ /* Catch errors; the target window might no longer exist. */
+ XReparentWindow (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ FRAME_OUTPUT_DATA (f)->parent_desc, 0, 0);
+ rc = x_had_errors_p (dpyinfo->display);
+ x_uncatch_errors_after_check ();
+
+ if (rc)
+ return false;
+
+ return true;
+}
+
+#endif
+
/* Setting window manager hints. */
@@ -27296,6 +28383,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)
@@ -27310,8 +28400,11 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
eassert (XtIsWMShell (f->output_data.x->widget));
shell = (WMShellWidget) f->output_data.x->widget;
- shell->wm.size_hints.flags &= ~(PPosition | USPosition);
- shell->wm.size_hints.flags |= flags & (PPosition | USPosition);
+ if (flags)
+ {
+ shell->wm.size_hints.flags &= ~(PPosition | USPosition);
+ shell->wm.size_hints.flags |= flags & (PPosition | USPosition);
+ }
if (user_position)
{
@@ -27319,10 +28412,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);
@@ -27333,6 +28430,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;
@@ -27350,15 +28448,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;
@@ -27743,7 +28849,7 @@ xi_select_hierarchy_events (struct x_display_info
*dpyinfo)
extension.
Value is 0 if GTK was not built with the input extension, or if it
- was explictly disabled, 1 if GTK enabled the input extension and
+ was explicitly disabled, 1 if GTK enabled the input extension and
the version was successfully determined, and 2 if that information
could not be determined. */
@@ -27773,9 +28879,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)
@@ -27793,6 +28900,22 @@ 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;
+
+ USE_SAFE_ALLOCA;
+
+ /* Avoid warnings when SAFE_ALLOCA is not actually used. */
+ ((void) SAFE_ALLOCA (0));
block_input ();
@@ -27802,9 +28925,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
@@ -27931,13 +29058,24 @@ 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 ();
+
+ SAFE_FREE ();
return 0;
}
#ifdef USE_XCB
xcb_conn = XGetXCBConnection (dpy);
- if (xcb_conn == 0)
+ if (!xcb_conn)
{
#ifdef USE_GTK
xg_display_close (dpy);
@@ -27950,6 +29088,8 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif /* ! USE_GTK */
unblock_input ();
+
+ SAFE_FREE ();
return 0;
}
#endif
@@ -28457,10 +29597,13 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
(RRScreenChangeNotifyMask
| RRCrtcChangeNotifyMask
| RROutputChangeNotifyMask
- /* Emacs doesn't actually need this, but GTK
- selects for it when the display is
+#ifdef USE_GTK
+ /* Emacs doesn't actually need this, but
+ GTK selects for it when the display is
initialized. */
- | RROutputPropertyNotifyMask));
+ | RROutputPropertyNotifyMask
+#endif
+ ));
dpyinfo->last_monitor_attributes_list
= Fx_display_monitor_attributes_list (term);
@@ -28499,8 +29642,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,
@@ -28510,9 +29652,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)
@@ -28563,7 +29706,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 };
@@ -28612,7 +29754,11 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif
#ifdef HAVE_X_I18N
- xim_initialize (dpyinfo, resource_name);
+ /* Avoid initializing input methods if the X library does not
+ support Emacs's locale. When the current locale is not
+ supported, decoding input method strings becomes undefined. */
+ if (XSupportsLocale ())
+ xim_initialize (dpyinfo, resource_name);
#endif
xsettings_initialize (dpyinfo);
@@ -28727,8 +29873,100 @@ 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 ();
+ SAFE_FREE ();
return dpyinfo;
}
@@ -28864,6 +30102,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
@@ -29035,11 +30277,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
@@ -29049,9 +30286,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;
@@ -29064,6 +30298,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. */
@@ -29246,7 +30492,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;
@@ -29272,7 +30518,7 @@ mark_xterm (void)
}
#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
for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
{
#ifdef HAVE_XINPUT2
@@ -29285,6 +30531,9 @@ mark_xterm (void)
#endif
#if defined HAVE_XRANDR || defined USE_GTK
mark_object (dpyinfo->last_monitor_attributes_list);
+#endif
+#if defined HAVE_X_I18N
+ mark_object (dpyinfo->xim_coding);
#endif
}
#endif
@@ -29467,8 +30716,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),
@@ -29495,6 +30750,9 @@ syms_of_xterm (void)
x_dnd_unsupported_drop_data = Qnil;
staticpro (&x_dnd_unsupported_drop_data);
+ /* Used by x_cr_export_frames. */
+ DEFSYM (Qconcat, "concat");
+
DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms");
DEFSYM (Qlatin_1, "latin-1");
DEFSYM (Qnow, "now");
@@ -29585,6 +30843,9 @@ 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");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* Which keys Emacs uses for the ctrl modifier.
@@ -29811,4 +31072,57 @@ on the same display.
In addition, when this variable is a list, only preserve the
selections whose names are contained within. */);
Vx_auto_preserve_selections = list2 (QCLIPBOARD, QPRIMARY);
+
+ DEFVAR_LISP ("x-input-coding-system", Vx_input_coding_system,
+ doc: /* Coding system used for input from X input methods.
+If a symbol and non-nil, this is the coding system that will be used
+to decode input from X input methods. It does not affect input from
+GTK native input methods enabled through `x-gtk-use-native-input'. */);
+ Vx_input_coding_system = Qnil;
+
+ DEFVAR_LISP ("x-input-coding-function", Vx_input_coding_function,
+ doc: /* Function used to determine the coding system used by input methods.
+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;
}
diff --git a/src/xterm.h b/src/xterm.h
index 8500ec2771..1124dcceb4 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
@@ -286,11 +299,16 @@ struct xi_device_t
/* The frame that is currently this device's implicit keyboard
focus, or NULL. */
struct frame *focus_implicit_frame;
+
+ /* The window on which the last motion event happened. */
+ Window last_motion_window;
+
+ /* The rounded integer coordinates of the last motion event. */
+ int last_motion_x, last_motion_y;
};
#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
{
@@ -302,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. */
@@ -574,6 +608,9 @@ struct x_display_info
XIMStyles *xim_styles;
struct xim_inst_t *xim_callback_data;
XIMStyle preferred_xim_style;
+
+ /* The named coding system to use for this input method. */
+ Lisp_Object xim_coding;
#endif
/* A cache mapping color names to RGB values. */
@@ -650,7 +687,8 @@ struct x_display_info
Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter,
Xatom_net_wm_sync_fences, Xatom_net_wm_frame_drawn,
Xatom_net_wm_frame_timings,
Xatom_net_wm_user_time, Xatom_net_wm_user_time_window,
- Xatom_net_client_list_stacking, Xatom_net_wm_pid;
+ Xatom_net_client_list_stacking, Xatom_net_wm_pid,
+ Xatom_net_wm_bypass_compositor;
/* XSettings atoms and windows. */
Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr;
@@ -768,6 +806,7 @@ struct x_display_info
bool xfixes_supported_p;
int xfixes_major;
int xfixes_minor;
+ int xfixes_event_base;
#endif
#ifdef HAVE_XSYNC
@@ -818,18 +857,30 @@ 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;
-#if defined HAVE_XSYNC && !defined USE_GTK
+#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
/* Whether or not the server time is probably the same as
"clock_gettime (CLOCK_MONOTONIC, ...)". */
bool server_time_monotonic_p;
/* The time difference between the X server clock and the monotonic
- clock. */
- int64_t server_time_offset;
+ clock, or 0 if unknown (if the difference is legitimately 0,
+ server_time_monotonic_p will be true). */
+ int_fast64_t server_time_offset;
#endif
};
@@ -905,11 +956,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;
@@ -1080,6 +1126,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;
@@ -1125,10 +1183,10 @@ struct x_output
bool_bf use_vsync_p : 1;
/* The time (in microseconds) it took to draw the last frame. */
- uint64_t last_frame_time;
+ uint_fast64_t last_frame_time;
/* A temporary time used to calculate that value. */
- uint64_t temp_frame_time;
+ uint_fast64_t temp_frame_time;
#ifdef HAVE_XSYNCTRIGGERFENCE
/* An array of two sync fences that are triggered in order after a
@@ -1188,6 +1246,15 @@ struct x_output
XIEventMask *xi_masks;
int num_xi_masks;
#endif
+
+ /* Whether or not we are certain we know the offset from the root
+ window to this frame. */
+ bool window_offset_certain_p;
+
+ /* The offset of the edit window from the root window. This is
+ strictly an optimization to avoid extraneous synchronizing in
+ some cases. */
+ int root_x, root_y;
};
enum
@@ -1202,7 +1269,6 @@ enum
FOCUS_EXPLICIT = 2
};
-
/* Return the X output data for frame F. */
#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#define FRAME_OUTPUT_DATA(f) FRAME_X_OUTPUT (f)
@@ -1229,6 +1295,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. */
@@ -1332,6 +1402,12 @@ extern void x_mark_frame_dirty (struct frame *f);
#define FRAME_X_XIM_STYLES(f) (FRAME_DISPLAY_INFO (f)->xim_styles)
#define FRAME_XIC_STYLE(f) ((f)->output_data.x->xic_style)
#define FRAME_XIC_FONTSET(f) ((f)->output_data.x->xic_xfs)
+#define FRAME_X_XIM_CODING(f) \
+ (SYMBOLP (Vx_input_coding_system) \
+ ? Vx_input_coding_system \
+ : (!NILP (FRAME_DISPLAY_INFO (f)->xim_coding) \
+ ? FRAME_DISPLAY_INFO(f)->xim_coding \
+ : Vlocale_coding_system))
/* X-specific scroll bar stuff. */
@@ -1581,6 +1657,7 @@ extern void x_wm_set_size_hint (struct frame *, long,
bool);
&& defined HAVE_CLOCK_GETTIME
extern void x_sync_init_fences (struct frame *);
#endif
+extern bool x_embed_frame (struct x_display_info *, struct frame *);
extern void x_delete_terminal (struct terminal *);
extern Cursor x_create_font_cursor (struct x_display_info *, int);
@@ -1619,6 +1696,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);
@@ -1627,6 +1708,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 *);
@@ -1820,7 +1907,7 @@ extern void mark_xterm (void);
/* Is the frame embedded into another application? */
-#define FRAME_X_EMBEDDED_P(f) (FRAME_X_OUTPUT(f)->explicit_parent != 0)
+#define FRAME_X_EMBEDDED_P(f) (FRAME_X_OUTPUT (f)->explicit_parent != 0)
#define STORE_NATIVE_RECT(nr,rx,ry,rwidth,rheight) \
((nr).x = (rx), \
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
index 1b04e8e9de..f672f33491 100644
--- a/test/lisp/ansi-color-tests.el
+++ b/test/lisp/ansi-color-tests.el
@@ -135,7 +135,7 @@ strings with `eq', this function compares them with
`equal'."
(with-temp-buffer
(should (equal-including-properties
filtered-str
- (mapconcat ansi-filt strs ""))))
+ (mapconcat ansi-filt strs))))
;; Tests for `ansi-color-filter-region'
(with-temp-buffer
@@ -156,7 +156,7 @@ strings with `eq', this function compares them with
`equal'."
(with-temp-buffer
(should (ansi-color-tests-equal-props
propertized-str
- (mapconcat ansi-app strs ""))))
+ (mapconcat ansi-app strs))))
;; Tests for `ansi-color-apply-on-region'
(with-temp-buffer
diff --git a/test/lisp/ansi-osc-tests.el b/test/lisp/ansi-osc-tests.el
new file mode 100644
index 0000000000..b3d66fb036
--- /dev/null
+++ b/test/lisp/ansi-osc-tests.el
@@ -0,0 +1,57 @@
+;;; osc-tests.el --- Tests for osc.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Matthias Meulien <orontee@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ansi-osc)
+(require 'ert)
+
+(defvar ansi-osc-tests--strings
+ `(
+ ("Hello World" "Hello World")
+
+ ;; window title
+ ("Buffer \e]2;A window title\e\\content" "Buffer content")
+
+ ;; window title
+ ("Unfinished \e]2;window title" "Unfinished \e]2;window title")
+
+ ;; current directory
+ ("\e]7;file://127.0.0.1/tmp\e\\user@host$ " "user@host$ ")
+
+ ;; hyperlink
+ ("\e]8;;http://example.com\e\\This is a link\e]8;;\e\\" "This is a link")
+ ))
+;; Don't output those strings to stdout since they may have
+;; side-effects on the environment
+
+(ert-deftest ansi-osc-tests-apply-region-no-handlers ()
+ (let ((ansi-osc-handlers nil))
+ (pcase-dolist (`(,input ,text) ansi-osc-tests--strings)
+ (with-temp-buffer
+ (insert input)
+ (ansi-osc-apply-on-region (point-min) (point-max))
+ (should (equal (buffer-string) text))))))
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/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/char-fold-tests.el b/test/lisp/char-fold-tests.el
index 749ec0a8d3..e7f5ff6fd2 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -26,7 +26,7 @@
(defun char-fold--random-word (n)
(mapconcat (lambda (_) (string (+ 9 (random 117))))
- (make-list n nil) ""))
+ (make-list n nil)))
(defun char-fold--ascii-upcase (string)
"Like `upcase' but acts on ASCII characters only."
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 9cf0151905..09becc7fe7 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -456,8 +456,8 @@
(dolist (file '(a b c d))
(make-empty-file (expand-file-name (symbol-name file) testdir)))
(should (= 6 (length (directory-files testdir))))
- (should (equal "abcd" (mapconcat 'identity (directory-files
- testdir nil nod) "")))
+ (should (equal "abcd" (mapconcat #'identity (directory-files
+ testdir nil nod))))
(should (= 2 (length (directory-files testdir nil "[bc]"))))
(should (= 3 (length (directory-files testdir nil nod nil 3))))
(dolist (file '(5 4 3 2 1))
diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el
index 88f6e69457..bdadc0f280 100644
--- a/test/lisp/dnd-tests.el
+++ b/test/lisp/dnd-tests.el
@@ -52,13 +52,13 @@
;; Verify that the action is valid and pretend the drag succeeded
;; (by returning the action).
(cl-ecase action
- ('XdndActionCopy action)
- ('XdndActionMove action)
- ('XdndActionLink action)
+ (XdndActionCopy action)
+ (XdndActionMove action)
+ (XdndActionLink action)
;; These two are not technically valid, but x-begin-drag accepts
;; them anyway.
- ('XdndActionPrivate action)
- ('XdndActionAsk 'XdndActionPrivate))))
+ (XdndActionPrivate action)
+ (XdndActionAsk 'XdndActionPrivate))))
;; This doesn't work during tests.
(defalias 'gui-set-selection
@@ -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/electric-tests.el b/test/lisp/electric-tests.el
index 5d7e905cfa..d34737e609 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -901,7 +901,7 @@ baz\"\""
(should (equal (buffer-string) "int main () {\n \n}"))))
(ert-deftest electric-layout-control-reindentation ()
- "Same as `emacs-lisp-int-main-kernel-style', but checking
+ "Same as `electric-layout-int-main-kernel-style', but checking
Bug#35254."
(ert-with-test-buffer ()
(plainer-c-mode)
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/bytecomp-resources/warn-variable-set-nonvariable.el
b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el
deleted file mode 100644
index 0c76c4d388..0000000000
--- a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el
+++ /dev/null
@@ -1,3 +0,0 @@
-;;; -*- lexical-binding: t -*-
-(defun foo ()
- (set '(a) nil))
diff --git
a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el
b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el
new file mode 100644
index 0000000000..e83f516e58
--- /dev/null
+++
b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+(defun foo-bar ()
+ "This should not warn:
+(fn COMMAND &rest ARGS &key (MARGIN (rx bol (+ \" \"))) (ARGUMENT (rx \"-\" (+
(any \"-\" alnum)) (32 \"=\"))) (METAVAR (rx (32 \" \") (or (+ (any alnum
\"_-\")) (seq \"[\" (+? nonl) \"]\") (seq \"<\" (+? nonl) \">\") (seq \"{\" (+?
nonl) \"}\")))) (SEPARATOR (rx \", \" symbol-start)) (DESCRIPTION (rx (* nonl)
(* \"\\=\\n\" (>= 9 \" \") (* nonl)))) NARROW-START NARROW-END)")
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index a246c25e24..e7c308213e 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -59,6 +59,8 @@ inner loops respectively."
(setq i (1- i)))
res))
+(defvar bytecomp-tests--xx nil)
+
(defconst bytecomp-tests--test-cases
'(
;; some functional tests
@@ -692,6 +694,16 @@ inner loops respectively."
(f (lambda ()
(let ((y x)) (list y 3 y)))))
(funcall f))
+
+ ;; Test rewriting of `set' to `setq' (only done on dynamic variables).
+ (let ((xx 1)) (set 'xx 2) xx)
+ (let ((bytecomp-tests--xx 1))
+ (set 'bytecomp-tests--xx 2)
+ bytecomp-tests--xx)
+ (let ((aaa 1)) (set (make-local-variable 'aaa) 2) aaa)
+ (let ((bytecomp-tests--xx 1))
+ (set (make-local-variable 'bytecomp-tests--xx) 2)
+ bytecomp-tests--xx)
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -912,7 +924,7 @@ byte-compiled. Run with dynamic binding."
"next-line.*interactive use only.*forward-line")
(bytecomp--define-warning-file-test "warn-lambda-malformed-interactive-spec.el"
- "malformed interactive spec")
+ "malformed .interactive. specification")
(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
"foo-obsolete. is an obsolete function (as of 99.99)")
@@ -953,9 +965,6 @@ byte-compiled. Run with dynamic binding."
(bytecomp--define-warning-file-test "warn-variable-set-constant.el"
"attempt to set constant")
-(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el"
- "variable reference to nonvariable")
-
(bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el"
"attempt to set non-variable")
@@ -1006,6 +1015,10 @@ byte-compiled. Run with dynamic binding."
"warn-wide-docstring-ignore-fill-column.el"
"defvar .foo-bar. docstring wider than .* characters" 'reverse)
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-function-signature.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore-override.el"
"defvar .foo-bar. docstring wider than .* characters" 'reverse)
diff --git a/test/lisp/emacs-lisp/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 9904c6a969..e666fe0a4c 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -347,5 +347,22 @@
(list x (funcall g closed-x) (funcall h closed-x))))))))
)
+(ert-deftest cconv-tests-interactive-closure-bug51695 ()
+ (let ((f (let ((d 51695))
+ (lambda (data)
+ (interactive (progn (setq d (1+ d)) (list d)))
+ (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 801885c0d4..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))
@@ -77,7 +97,7 @@
(fn3 (lambda (x _y _z) (string-to-char (format "%S" x)))))
(should (equal lst (cl-map 'list fn1 lst)))
(should (equal (vconcat lst2) (cl-map 'vector fn2 lst lst2)))
- (should (equal (mapconcat (lambda (x) (format "%S" x)) lst "")
+ (should (equal (mapconcat (lambda (x) (format "%S" x)) lst)
(cl-map 'string fn3 lst lst2 lst3)))))
(ert-deftest cl-extra-test-maplist ()
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 19ede627a1..f742637ee3 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -25,6 +25,8 @@
(require 'cl-macs)
(require 'edebug)
(require 'ert)
+(require 'ert-x)
+(require 'pcase)
;;;; cl-loop tests -- many adapted from Steele's CLtL2
@@ -539,7 +541,27 @@ collection clause."
((p (gv-synthetic-place cl (lambda (v) `(setcar l
,v)))))
(cl-incf p)))
l)
- '(1))))
+ '(1)))
+ ;; Make sure `gv-synthetic-place' isn't macro-expanded before
+ ;; `cl-letf' gets to see its `gv-expander'.
+ (should (equal
+ (condition-case err
+ (let ((x 1))
+ (list x
+ (cl-letf (((gv-synthetic-place (+ 1 2)
+ (lambda (v) `(setq x
,v)))
+ 7))
+ x)
+ x))
+ (error err))
+ '(1 7 3)))
+ (should (equal
+ (let ((x (list 42)))
+ (cl-symbol-macrolet ((m (car x)))
+ (list m
+ (cl-letf ((m 5)) m)
+ m)))
+ '(42 5 42))))
(ert-deftest cl-macs-loop-conditional-step-clauses ()
"These tests failed under the initial fixes in #bug#29799."
@@ -727,4 +749,58 @@ collection clause."
;; Just make sure the forms can be instrumented.
(eval-buffer))))
+(ert-deftest cl-case-error ()
+ "Test that `cl-case' and `cl-ecase' signal an error if a t or
+`otherwise' key is misplaced."
+ (let ((text-quoting-style 'grave))
+ (dolist (form '((cl-case val (t 1) (123 2))
+ (cl-ecase val (t 1) (123 2))
+ (cl-ecase val (123 2) (t 1))))
+ (ert-info ((prin1-to-string form) :prefix "Form: ")
+ (let ((error (should-error (macroexpand form))))
+ (should (equal (cdr error)
+ '("Misplaced t or `otherwise' clause"))))))))
+
+(ert-deftest cl-case-warning ()
+ "Test that `cl-case' and `cl-ecase' warn about suspicious
+constructs."
+ (let ((text-quoting-style 'grave))
+ (pcase-dolist (`(,case . ,message)
+ `((nil . "Case nil will never match")
+ ('nil . ,(concat "Case 'nil will match `quote'. "
+ "If that's intended, write "
+ "(nil quote) instead. "
+ "Otherwise, don't quote `nil'."))
+ ('t . ,(concat "Case 't will match `quote'. "
+ "If that's intended, write "
+ "(t quote) instead. "
+ "Otherwise, don't quote `t'."))
+ ('foo . ,(concat "Case 'foo will match `quote'. "
+ "If that's intended, write "
+ "(foo quote) instead. "
+ "Otherwise, don't quote `foo'."))
+ (#'foo . ,(concat "Case #'foo will match "
+ "`function'. If that's "
+ "intended, write (foo function) "
+ "instead. Otherwise, don't "
+ "quote `foo'."))))
+ (dolist (macro '(cl-case cl-ecase))
+ (let ((form `(,macro val (,case 1))))
+ (ert-info ((prin1-to-string form) :prefix "Form: ")
+ (ert-with-message-capture messages
+ (macroexpand form)
+ (should (equal messages
+ (concat "Warning:
" message "\n"))))))))))
+
+(ert-deftest cl-case-no-warning ()
+ "Test that `cl-case' and `cl-ecase' don't warn in some valid cases.
+See Bug#57915."
+ (dolist (case '(quote (quote) function (function)))
+ (dolist (macro '(cl-case cl-ecase))
+ (let ((form `(,macro val (,case 1))))
+ (ert-info ((prin1-to-string form) :prefix "Form: ")
+ (ert-with-message-capture messages
+ (macroexpand form)
+ (should (string-empty-p messages))))))))
+
;;; 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/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index 008e1e467b..dea6e9ed61 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -428,7 +428,8 @@ test and possibly others should be updated."
(verify-keybinding "-" 'negative-argument)
(verify-keybinding "=" 'edebug-temp-display-freq-count)
(should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame))
- (should (eq (lookup-key backtrace-mode-map "s") 'backtrace-goto-source))))
+ (should (eq (lookup-key edebug-backtrace-mode-map "s")
+ 'backtrace-goto-source))))
(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function ()
"Edebug stops at the beginning of an instrumented function."
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index 3869804110..63e7cd7608 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -82,6 +82,21 @@
(should-not (buffer-live-p buffer-1))
(should (buffer-live-p buffer-2))))))
+(ert-deftest ert-test-with-test-buffer-selected/selected ()
+ (ert-with-test-buffer-selected ()
+ (should (eq (window-buffer) (current-buffer)))))
+
+(ert-deftest ert-test-with-test-buffer-selected/modification-hooks ()
+ (ert-with-test-buffer-selected ()
+ (should (null inhibit-modification-hooks))))
+
+(ert-deftest ert-test-with-test-buffer-selected/return-value ()
+ (should (equal (ert-with-test-buffer-selected () "foo") "foo")))
+
+(ert-deftest ert-test-with-test-buffer-selected/buffer-name ()
+ (should (equal (ert-with-test-buffer (:name "foo") (buffer-name))
+ (ert-with-test-buffer-selected (:name "foo")
+ (buffer-name)))))
(ert-deftest ert-filter-string ()
(should (equal (ert-filter-string "foo bar baz" "quux")
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/key.pub
b/test/lisp/emacs-lisp/package-resources/key.pub
index 99965723ba..241051067f 100644
--- a/test/lisp/emacs-lisp/package-resources/key.pub
+++ b/test/lisp/emacs-lisp/package-resources/key.pub
@@ -1,17 +1,14 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
+Comment: Alice's OpenPGP certificate
-mQGiBGFQyDcRBACmAI6cfY3fM02vb9JtC1BS19boKXbBsDoVrD9qRf8tDFROOpO3
-ZMlbuz+O9Vnljo6Y4WZGnyeWWAMqCditMOfr1cLbux77wSrmAVgZ9exwtGzkmUhM
-xcptzKuyod8NuhghXbJgVbfJZ6HlBkk4kiWv98iJQwUBZJfjBUfIv+acjwCg4M2i
-Ifu2A3UYl9VqF7qfcDOZudEEAI7V35yfsBDnr9ndKqdGYNw0alX9BEG3KwnAe0fF
-O1jDVW12Y/bwnyyrRTrz6o1G8dj7M4XVZQb5PpT9mpNzOSZ6yxqhg+foeJwn2JkD
-vyP+kMYU7SZ/tWuMOCdzN95Ki1rf+ti7pLnSMqKx+t3vOWwQbtnsbI6RCLLwETPA
-esghA/0X3Dw7cdiE5Xq4TRaPSGViCWP4ekL2KYKqmKv6M/4f2pgFNJY7C+2SIiiP
-T62zFlIjs5tF2Df34/M5mh4Vx6E8341r55+XO++kfFWJ5QjLiydRAY6ochG9IFgB
-xyBCkCNpiby9PpKyPodedBScdMxIAe4eJR7rG/j9gFC1MypBurQnSm9obm55IFJv
-Y2tldHMgPGpvaG5ueS5yb2NrZXRzQGdmeS5vcmc+iHgEExECADgWIQRIVz1DPzm4
-REDIXNtltQG5ACv6lwUCYVDINwIbAwULCQgHAgYVCgkICwIEFgIDAQIeAQIXgAAK
-CRBltQG5ACv6l4iZAKCqldroRYH7vUzVV0Uv1NcDVcpLngCgmEoLVxGLKSwDEXNq
-qjRDzDRpReg=
-=/l51
+mDMEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
+b7O1u120JkFsaWNlIExvdmVsYWNlIDxhbGljZUBvcGVucGdwLmV4YW1wbGU+iJAE
+ExYIADgCGwMFCwkIBwIGFQoJCAsCBBYCAwECHgECF4AWIQTrhbtfozp14V6UTmPy
+MVUMT0fjjgUCXaWfOgAKCRDyMVUMT0fjjukrAPoDnHBSogOmsHOsd9qGsiZpgRnO
+dypvbm+QtXZqth9rvwD9HcDC0tC+PHAsO7OTh1S1TC9RiJsvawAfCPaQZoed8gK4
+OARcRwTpEgorBgEEAZdVAQUBAQdAQv8GIa2rSTzgqbXCpDDYMiKRVitCsy203x3s
+E9+eviIDAQgHiHgEGBYIACAWIQTrhbtfozp14V6UTmPyMVUMT0fjjgUCXEcE6QIb
+DAAKCRDyMVUMT0fjjlnQAQDFHUs6TIcxrNTtEZFjUFm1M0PJ1Dng/cDW4xN80fsn
+0QEA22Kr7VkCjeAEC08VSTeV+QFsmz55/lntWkwYWhmvOgE=
+=iIGO
-----END PGP PUBLIC KEY BLOCK-----
diff --git a/test/lisp/emacs-lisp/package-resources/key.sec
b/test/lisp/emacs-lisp/package-resources/key.sec
index 5bbac1226a..af11bec899 100644
--- a/test/lisp/emacs-lisp/package-resources/key.sec
+++ b/test/lisp/emacs-lisp/package-resources/key.sec
@@ -1,17 +1,16 @@
-----BEGIN PGP PRIVATE KEY BLOCK-----
+Comment: Alice's OpenPGP Transferable Secret Key
-lQG7BGFQyDcRBACmAI6cfY3fM02vb9JtC1BS19boKXbBsDoVrD9qRf8tDFROOpO3
-ZMlbuz+O9Vnljo6Y4WZGnyeWWAMqCditMOfr1cLbux77wSrmAVgZ9exwtGzkmUhM
-xcptzKuyod8NuhghXbJgVbfJZ6HlBkk4kiWv98iJQwUBZJfjBUfIv+acjwCg4M2i
-Ifu2A3UYl9VqF7qfcDOZudEEAI7V35yfsBDnr9ndKqdGYNw0alX9BEG3KwnAe0fF
-O1jDVW12Y/bwnyyrRTrz6o1G8dj7M4XVZQb5PpT9mpNzOSZ6yxqhg+foeJwn2JkD
-vyP+kMYU7SZ/tWuMOCdzN95Ki1rf+ti7pLnSMqKx+t3vOWwQbtnsbI6RCLLwETPA
-esghA/0X3Dw7cdiE5Xq4TRaPSGViCWP4ekL2KYKqmKv6M/4f2pgFNJY7C+2SIiiP
-T62zFlIjs5tF2Df34/M5mh4Vx6E8341r55+XO++kfFWJ5QjLiydRAY6ochG9IFgB
-xyBCkCNpiby9PpKyPodedBScdMxIAe4eJR7rG/j9gFC1MypBugAAn0mvGeJi+oSo
-5jXAeXBhRiTyI5WPCuK0J0pvaG5ueSBSb2NrZXRzIDxqb2hubnkucm9ja2V0c0Bn
-Znkub3JnPoh4BBMRAgA4FiEESFc9Qz85uERAyFzbZbUBuQAr+pcFAmFQyDcCGwMF
-CwkIBwIGFQoJCAsCBBYCAwECHgECF4AACgkQZbUBuQAr+peImQCgqpXa6EWB+71M
-1VdFL9TXA1XKS54AoJhKC1cRiyksAxFzaqo0Q8w0aUXo
-=cyQm
+lFgEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
+b7O1u10AAP9XBeW6lzGOLx7zHH9AsUDUTb2pggYGMzd0P3ulJ2AfvQ4RtCZBbGlj
+ZSBMb3ZlbGFjZSA8YWxpY2VAb3BlbnBncC5leGFtcGxlPoiQBBMWCAA4AhsDBQsJ
+CAcCBhUKCQgLAgQWAgMBAh4BAheAFiEE64W7X6M6deFelE5j8jFVDE9H444FAl2l
+nzoACgkQ8jFVDE9H447pKwD6A5xwUqIDprBzrHfahrImaYEZzncqb25vkLV2arYf
+a78A/R3AwtLQvjxwLDuzk4dUtUwvUYibL2sAHwj2kGaHnfICnF0EXEcE6RIKKwYB
+BAGXVQEFAQEHQEL/BiGtq0k84Km1wqQw2DIikVYrQrMttN8d7BPfnr4iAwEIBwAA
+/3/xFPG6U17rhTuq+07gmEvaFYKfxRB6sgAYiW6TMTpQEK6IeAQYFggAIBYhBOuF
+u1+jOnXhXpROY/IxVQxPR+OOBQJcRwTpAhsMAAoJEPIxVQxPR+OOWdABAMUdSzpM
+hzGs1O0RkWNQWbUzQ8nUOeD9wNbjE3zR+yfRAQDbYqvtWQKN4AQLTxVJN5X5AWyb
+Pnn+We1aTBhaGa86AQ==
+=n8OM
-----END PGP PRIVATE KEY BLOCK-----
diff --git a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig
b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig
index b40620a0e8..db3eef9d6f 100644
Binary files
a/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig and
b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig differ
diff --git
a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig
b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig
index 1109241160..f6ff8e7af6 100644
Binary files
a/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig and
b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.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 c3e82fd173..30e74156c0 100755
--- a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
+++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
@@ -25,8 +25,9 @@ TRUSTDB="./trust.db"
GPG="gpg --no-default-keyring --trustdb-name $TRUSTDB --keyring $KEYRING --yes"
rm $KEYRING
-$GPG --full-generate-key
-$GPG --export --armor > "../key.pub"
-$GPG --export-secret-keys -armor > "../key.sec"
+#$GPG --full-generate-key
+#$GPG --export --armor > "../key.pub"
+#$GPG --export-secret-keys -armor > "../key.sec"
+$GPG --import ../key.sec
$GPG --detach-sign --sign "./archive-contents"
$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-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/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 1a27467d29..e22f86f044 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -137,6 +137,14 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '())
(should (equal (seq-remove #'test-sequences-evenp seq) '()))))
+(ert-deftest test-seq-remove-at-position ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (should (same-contents-p (seq-remove-at-position seq 2) '(1 2 4)))
+ (should (same-contents-p (seq-remove-at-position seq 0) '(2 3 4)))
+ (should (same-contents-p (seq-remove-at-position seq 3) '(1 2 3)))
+ (should (eq (type-of (seq-remove-at-position seq 2))
+ (type-of seq)))))
+
(ert-deftest test-seq-count ()
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-count #'test-sequences-evenp seq) 3))
@@ -482,6 +490,13 @@ Evaluate BODY for each created sequence.
(should (= (seq-position seq 'a #'eq) 0))
(should (null (seq-position seq (make-symbol "a") #'eq)))))
+(ert-deftest test-seq-positions ()
+ (with-test-sequences (seq '(1 2 3 1 4))
+ (should (equal '(0 3) (seq-positions seq 1)))
+ (should (seq-empty-p (seq-positions seq 9))))
+ (with-test-sequences (seq '(11 5 7 12 9 15))
+ (should (equal '(0 3 5) (seq-positions seq 10 #'>=)))))
+
(ert-deftest test-seq-sort-by ()
(let ((seq ["x" "xx" "xxx"]))
(should (equal (seq-sort-by #'seq-length #'> seq)
@@ -577,5 +592,11 @@ Evaluate BODY for each created sequence.
(should (= (length list) 10000))
(should (= (length (seq-uniq (append list list))) 10000))))
+(ert-deftest test-seq-keep ()
+ (should (equal (seq-keep #'cl-digit-char-p '(?6 ?a ?7))
+ '(6 7)))
+ (should (equal (seq-keep #'cl-digit-char-p [?6 ?a ?7])
+ '(6 7))))
+
(provide 'seq-tests)
;;; seq-tests.el ends here
diff --git a/test/lisp/epg-resources/pubkey.asc
b/test/lisp/epg-resources/pubkey.asc
index c0bf28f620..241051067f 100644
--- a/test/lisp/epg-resources/pubkey.asc
+++ b/test/lisp/epg-resources/pubkey.asc
@@ -1,20 +1,14 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
-Version: GnuPG v1
+Comment: Alice's OpenPGP certificate
-mI0EVRDxCAEEALcScrRmxq5N+Hh+NxPg75RJJdtEi824pwtqMlT/3wG1esmP5gNu
-ZIPVaTTSGNZkEzeYdhaLXBUe5qD+RQIQVh+MLt9nisF9nD35imyOrhHwAHnglOPx
-GdylH8nQ/tIO5p/lfUlw+iCBlPH7eZHqFJhwP0hJML4PKE8ArWG6RtsxABEBAAG0
-J0pvZSBUZXN0ZXIgKHRlc3Qga2V5KSA8am9lQGV4YW1wbGUuY29tPoi4BBMBAgAi
-BQJVEPEIAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRAoscCWMvu4GGYO
-A/0Zzoc2z/dvAtFVLh4ovKqP2qliQt2qschJHVP30hJnKT7dmJfJl7kz9mXmMfSt
-Ym0luYmeSzdeWORM9SygLRYXuDfN6G4ZPJTlsRhgnARhNzNhSx+YlcFh48Z+a5zR
-goBMn7DgYVqfU4UteZOSXMlnuA2Z5ao1qgGhVqESSJgU5riNBFUQ8QgBBADacLkK
-D0U11nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFt
-LO8owCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQ
-q/M2oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABiJ8EGAECAAkFAlUQ8QgC
-GwwACgkQKLHAljL7uBj44AQAkMJRm7VJUryrDKFtfIfytQx/vmyU/cZcVV6IpKqP
-KhztgR+QD9czlHvQhz+y3hqtLRShu2Eyf75dNexcUvKs/lS4LIDXg5V7pWSRk9eQ
-G403muqR/NGu6+QmUx09rJl72trdaGxNkyHA7Zy7ZDGkcMvQsd3qoSNGsPR5TKes
-w7Q=
-=NMxb
+mDMEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
+b7O1u120JkFsaWNlIExvdmVsYWNlIDxhbGljZUBvcGVucGdwLmV4YW1wbGU+iJAE
+ExYIADgCGwMFCwkIBwIGFQoJCAsCBBYCAwECHgECF4AWIQTrhbtfozp14V6UTmPy
+MVUMT0fjjgUCXaWfOgAKCRDyMVUMT0fjjukrAPoDnHBSogOmsHOsd9qGsiZpgRnO
+dypvbm+QtXZqth9rvwD9HcDC0tC+PHAsO7OTh1S1TC9RiJsvawAfCPaQZoed8gK4
+OARcRwTpEgorBgEEAZdVAQUBAQdAQv8GIa2rSTzgqbXCpDDYMiKRVitCsy203x3s
+E9+eviIDAQgHiHgEGBYIACAWIQTrhbtfozp14V6UTmPyMVUMT0fjjgUCXEcE6QIb
+DAAKCRDyMVUMT0fjjlnQAQDFHUs6TIcxrNTtEZFjUFm1M0PJ1Dng/cDW4xN80fsn
+0QEA22Kr7VkCjeAEC08VSTeV+QFsmz55/lntWkwYWhmvOgE=
+=iIGO
-----END PGP PUBLIC KEY BLOCK-----
diff --git a/test/lisp/epg-resources/seckey.asc
b/test/lisp/epg-resources/seckey.asc
index 4ac7ba4a50..af11bec899 100644
--- a/test/lisp/epg-resources/seckey.asc
+++ b/test/lisp/epg-resources/seckey.asc
@@ -1,33 +1,16 @@
-----BEGIN PGP PRIVATE KEY BLOCK-----
-Version: GnuPG v1
+Comment: Alice's OpenPGP Transferable Secret Key
-lQHYBFUQ8QgBBAC3EnK0ZsauTfh4fjcT4O+USSXbRIvNuKcLajJU/98BtXrJj+YD
-bmSD1Wk00hjWZBM3mHYWi1wVHuag/kUCEFYfjC7fZ4rBfZw9+Ypsjq4R8AB54JTj
-8RncpR/J0P7SDuaf5X1JcPoggZTx+3mR6hSYcD9ISTC+DyhPAK1hukbbMQARAQAB
-AAP9Hs9agZTobA5QOksXjt9kwqJ63gePtbwVVNz3AoobaGi39PMkRUCPZwaEEbEo
-H/CwsUMV4J5sjVtpef/A8mN4csai7NYp82mbo+dPim4p+SUtBg4Ms8ujGVcQeRQd
-1CXtIkixDu6fw4wDtNw03ZyNJOhBOXVTgAyOTSlIz3D+6n8CAMeCqEFBHQIVoQpf
-Bza4YvFtJRdfGMTix3u7Cb6y9CHGBok7uUgQAeWnzQvMGTCHc3e8iHGAYBQ88GPF
-v1TpiusCAOroRe69Aiid5JMVTjWoJ0SHKd47nIj0gQFiDfa5de0BNq9gYj7JLg+R
-EjsJbJN39z+Z9HWjIOCUOIXDvucmM1MB/iNxW1Z8mEMflEYK5rop+PDxwqUbr8uZ
-kzogw98ZdmuEuN0bheGWUiJI+0Pd8jb40zlR1KgOEMx1mZchToAJdtybMLQnSm9l
-IFRlc3RlciAodGVzdCBrZXkpIDxqb2VAZXhhbXBsZS5jb20+iLgEEwECACIFAlUQ
-8QgCGwMGCwkIBwMCBhUIAgkKCwQWAgMBAh4BAheAAAoJECixwJYy+7gYZg4D/RnO
-hzbP928C0VUuHii8qo/aqWJC3aqxyEkdU/fSEmcpPt2Yl8mXuTP2ZeYx9K1ibSW5
-iZ5LN15Y5Ez1LKAtFhe4N83obhk8lOWxGGCcBGE3M2FLH5iVwWHjxn5rnNGCgEyf
-sOBhWp9ThS15k5JcyWe4DZnlqjWqAaFWoRJImBTmnQHYBFUQ8QgBBADacLkKD0U1
-1nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFtLO8o
-wCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQq/M2
-oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABAAP7B8uNtb/DLvGoRfL+mA0Q
-REhgOJ1WpRcU6rvKYNPh8xTkKMvM+EK0nVU/znBedEpXjb0pY1WRT0uvXs2pzY2V
-YeaugyKIkdUpPWnyWoEQwI8hFvHOWmU2rNHyXLW0MY7bxcGgqv2XbkL4m7/D6VQS
-SR8hQ2CxBbW+9ov6aBMwv/UCAOW89+5xxuzkv48AVraWlMnaU0ggVOf6ht0Qa40+
-+uw2yziNlD403gAAAycoICiB/oqwslx61B2xOHn0laCKrgsCAPNpIsHRlAwWbAsq
-uCtfIQxg+C3mPXkqsNTMjeK5NjLNytrmO49NXco36zVEG6q7qz5Zj9d9IPYoGOSa
-I+dQZ6sB/RKF5aonR5/e7IHJgc8BG7I0yiya4llE0AB9ghnRI/3uHwnCBnmo/32a
-n4+rQkx6vm+rg3JA/09Gi7W4R9SwV+ane4ifBBgBAgAJBQJVEPEIAhsMAAoJECix
-wJYy+7gY+OAEAJDCUZu1SVK8qwyhbXyH8rUMf75slP3GXFVeiKSqjyoc7YEfkA/X
-M5R70Ic/st4arS0UobthMn++XTXsXFLyrP5UuCyA14OVe6VkkZPXkBuNN5rqkfzR
-ruvkJlMdPayZe9ra3WhsTZMhwO2cu2QxpHDL0LHd6qEjRrD0eUynrMO0
-=iCIm
+lFgEXEcE6RYJKwYBBAHaRw8BAQdArjWwk3FAqyiFbFBKT4TzXcVBqPTB3gmzlC/U
+b7O1u10AAP9XBeW6lzGOLx7zHH9AsUDUTb2pggYGMzd0P3ulJ2AfvQ4RtCZBbGlj
+ZSBMb3ZlbGFjZSA8YWxpY2VAb3BlbnBncC5leGFtcGxlPoiQBBMWCAA4AhsDBQsJ
+CAcCBhUKCQgLAgQWAgMBAh4BAheAFiEE64W7X6M6deFelE5j8jFVDE9H444FAl2l
+nzoACgkQ8jFVDE9H447pKwD6A5xwUqIDprBzrHfahrImaYEZzncqb25vkLV2arYf
+a78A/R3AwtLQvjxwLDuzk4dUtUwvUYibL2sAHwj2kGaHnfICnF0EXEcE6RIKKwYB
+BAGXVQEFAQEHQEL/BiGtq0k84Km1wqQw2DIikVYrQrMttN8d7BPfnr4iAwEIBwAA
+/3/xFPG6U17rhTuq+07gmEvaFYKfxRB6sgAYiW6TMTpQEK6IeAQYFggAIBYhBOuF
+u1+jOnXhXpROY/IxVQxPR+OOBQJcRwTpAhsMAAoJEPIxVQxPR+OOWdABAMUdSzpM
+hzGs1O0RkWNQWbUzQ8nUOeD9wNbjE3zR+yfRAQDbYqvtWQKN4AQLTxVJN5X5AWyb
+Pnn+We1aTBhaGa86AQ==
+=n8OM
-----END PGP PRIVATE KEY BLOCK-----
diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el
index 65aaafd9f1..dca6f33764 100644
--- a/test/lisp/epg-tests.el
+++ b/test/lisp/epg-tests.el
@@ -101,16 +101,15 @@
(ert-deftest epg-decrypt-1 ()
:expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme
(with-epg-tests (:require-passphrase t)
- (with-temp-file (expand-file-name "gpg.conf" epg-tests-home-directory)
- (insert "ignore-mdc-error"))
(should (equal "test"
(epg-decrypt-string epg-tests-context "\
-----BEGIN PGP MESSAGE-----
-Version: GnuPG v2
-jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
-=U8z7
------END PGP MESSAGE-----")))))
+jA0ECQMCdW8+qtS9Tin/0jUBO1/9Oz69BWPmtFKEeBM62WpFP4o1+bNzdxogdyeg
++WTt292OD0yV85m5UqvLgp4ttVUmAw==
+=K5Eh
+-----END PGP MESSAGE-----
+")))))
(ert-deftest epg-roundtrip-1 ()
:expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme
@@ -123,7 +122,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
(with-epg-tests (:require-passphrase t
:require-public-key t
:require-secret-key t)
- (let* ((recipients (epg-list-keys epg-tests-context "joe@example.com"))
+ (let* ((recipients (epg-list-keys epg-tests-context
"alice@openpgp.example"))
(cipher (epg-encrypt-string epg-tests-context "public key"
recipients nil t)))
(should (equal "public key"
@@ -135,7 +134,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
:require-secret-key t)
(let (signature verify-result)
(setf (epg-context-signers epg-tests-context)
- (epg-list-keys epg-tests-context "joe@example.com"))
+ (epg-list-keys epg-tests-context "alice@openpgp.example"))
(setq signature (epg-sign-string epg-tests-context "signed" t))
(epg-verify-string epg-tests-context signature "signed")
(setq verify-result (epg-context-result-for context 'verify))
@@ -148,7 +147,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
:require-secret-key t)
(let (signature verify-result)
(setf (epg-context-signers epg-tests-context)
- (epg-list-keys epg-tests-context "joe@example.com"))
+ (epg-list-keys epg-tests-context "alice@openpgp.example"))
(setq signature (epg-sign-string epg-tests-context "clearsigned" 'clear))
;; Clearsign signature always ends with a new line.
(should (equal "clearsigned\n"
@@ -163,7 +162,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
:require-secret-key t)
(let (signature verify-result)
(setf (epg-context-signers epg-tests-context)
- (epg-list-keys epg-tests-context "joe@example.com"))
+ (epg-list-keys epg-tests-context "alice@openpgp.example"))
(setq signature (epg-sign-string epg-tests-context "normal signed"))
(should (equal "normal signed"
(epg-verify-string epg-tests-context signature)))
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
new file mode 100644
index 0000000000..cd7598703b
--- /dev/null
+++ b/test/lisp/erc/erc-match-tests.el
@@ -0,0 +1,193 @@
+;;; erc-match-tests.el --- Tests for erc-match. -*- 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-x)
+(require 'erc-match)
+
+
+(ert-deftest erc-add-entry-to-list ()
+ (let ((erc-pals '("z"))
+ (erc-match-quote-when-adding 'ask))
+
+ (ert-info ("Default (ask)")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\."))))
+
+ (ert-info ("Skipped")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '(("x")) nil)
+ (should (equal (pop erc-pals) "x")))))
+
+ (ert-info ("Verbatim")
+ (setq erc-match-quote-when-adding nil)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) ".")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) "\\.")))))
+
+ (ert-info ("Quoted")
+ (setq erc-match-quote-when-adding t)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) ".")))))
+
+ (should (equal erc-pals '("z")))))
+
+(ert-deftest erc-pals ()
+ (with-temp-buffer
+ (setq erc-server-process (start-process "true" (current-buffer) "true")
+ erc-server-users (make-hash-table :test #'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
+ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
+
+ (let ((erc-match-quote-when-adding t)
+ erc-pals calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-pal'")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-pal))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-pals '("foo\\[m]"))))
+
+ (ert-info ("`erc-match-pal-p'")
+ (should (erc-match-pal-p "FOO[m]!~u@example.net" nil)))
+
+ (ert-info ("`erc-delete-pal'")
+ (push "foo\\[m]" rvs)
+ (ert-simulate-command '(erc-delete-pal))
+ (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
+ (should-not erc-pals))
+
+ (ert-info ("`erc-add-pal' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-pal (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-pals '("foo[m]"))))))))
+
+(ert-deftest erc-fools ()
+ (with-temp-buffer
+ (setq erc-server-process (start-process "true" (current-buffer) "true")
+ erc-server-users (make-hash-table :test #'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
+ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
+
+ (let ((erc-match-quote-when-adding t)
+ erc-fools calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-fool'")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-fool))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-fools '("foo\\[m]"))))
+
+ (ert-info ("`erc-match-fool-p'")
+ (should (erc-match-fool-p "FOO[m]!~u@example.net" ""))
+ (should (erc-match-fool-p "tester!~u@example.net" "FOO[m]: die")))
+
+ (ert-info ("`erc-delete-fool'")
+ (push "foo\\[m]" rvs)
+ (ert-simulate-command '(erc-delete-fool))
+ (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
+ (should-not erc-fools))
+
+ (ert-info ("`erc-add-fool' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-fool (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-fools '("foo[m]"))))))))
+
+(ert-deftest erc-keywords ()
+ (let ((erc-match-quote-when-adding t)
+ erc-keywords calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-keyword'")
+ (push "[cit. needed]" rvs)
+ (ert-simulate-command '(erc-add-keyword))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-keywords '("\\[cit\\. needed]"))))
+
+ (ert-info ("`erc-match-keyword-p'")
+ (should (erc-match-keyword-p nil "is pretty [cit. needed]")))
+
+ (ert-info ("`erc-delete-keyword'")
+ (push "\\[cit\\. needed]" rvs)
+ (ert-simulate-command '(erc-delete-keyword))
+ (should (equal (cadr (pop calls)) '(("\\[cit\\. needed]"))))
+ (should-not erc-keywords))
+
+ (ert-info ("`erc-add-keyword' verbatim")
+ (push "[...]" rvs)
+ (ert-simulate-command '(erc-add-keyword (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-keywords '("[...]")))))))
+
+(ert-deftest erc-dangerous-hosts ()
+ (let ((erc-match-quote-when-adding t)
+ erc-dangerous-hosts calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-dangerous-host'")
+ (push "example.net" rvs)
+ (ert-simulate-command '(erc-add-dangerous-host))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-dangerous-hosts '("example\\.net"))))
+
+ (ert-info ("`erc-match-dangerous-host-p'")
+ (should (erc-match-dangerous-host-p "FOO[m]!~u@example.net" nil)))
+
+ (ert-info ("`erc-delete-dangerous-host'")
+ (push "example\\.net" rvs)
+ (ert-simulate-command '(erc-delete-dangerous-host))
+ (should (equal (cadr (pop calls)) '(("example\\.net"))))
+ (should-not erc-dangerous-hosts))
+
+ (ert-info ("`erc-add-dangerous-host' verbatim")
+ (push "example.net" rvs)
+ (ert-simulate-command '(erc-add-dangerous-host (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-dangerous-hosts '("example.net")))))))
+
+;;; erc-match-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 30d692058d..49298dc594 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -99,10 +99,11 @@
(funcall test)
+ ;; A manual /JOIN command tells ERC we're done auto-reconnecting
(with-current-buffer "FooNet" (erc-cmd-JOIN "#spam"))
- (erc-d-t-wait-for 5 "Channel #spam shown when autojoined"
- (eq (window-buffer) (get-buffer "#spam")))
+ (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'"
+ (not (eq (window-buffer) (get-buffer "#spam"))))
(ert-info ("Wait for auto reconnect")
(with-current-buffer erc-server-buffer
@@ -114,43 +115,43 @@
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(funcall expect 10 "her elves come here anon")))))
-(ert-deftest erc-scenarios-base-reconnect-options--default ()
+(ert-deftest erc-scenarios-base-reconnect-options--buffer ()
:tags '(:expensive-test)
- (should (eq erc-join-buffer 'buffer))
+ (should (eq erc-join-buffer 'bury))
(should-not erc-reconnect-display)
;; FooNet (the server buffer) is not switched to because it's
;; already current (but not shown) when `erc-open' is called. See
;; related conditional guard towards the end of that function.
- (erc-scenarios-common--base-reconnect-options
- (lambda ()
- (pop-to-buffer-same-window "*Messages*")
+ (let ((erc-reconnect-display 'buffer))
+ (erc-scenarios-common--base-reconnect-options
+ (lambda ()
+ (pop-to-buffer-same-window "*Messages*")
- (erc-d-t-ensure-for 1 "Server buffer not shown"
- (not (eq (window-buffer) (get-buffer "FooNet"))))
+ (erc-d-t-ensure-for 1 "Server buffer not shown"
+ (not (eq (window-buffer) (get-buffer "FooNet"))))
- (erc-d-t-wait-for 5 "Channel #chan shown when autojoined"
- (eq (window-buffer) (get-buffer "#chan"))))))
+ (erc-d-t-wait-for 5 "Channel #chan shown when autojoined"
+ (eq (window-buffer) (get-buffer "#chan")))))))
-(ert-deftest erc-scenarios-base-reconnect-options--bury ()
+(ert-deftest erc-scenarios-base-reconnect-options--default ()
:tags '(:expensive-test)
- (should (eq erc-join-buffer 'buffer))
+ (should (eq erc-join-buffer 'bury))
(should-not erc-reconnect-display)
- (let ((erc-reconnect-display 'bury))
- (erc-scenarios-common--base-reconnect-options
+ (erc-scenarios-common--base-reconnect-options
- (lambda ()
- (pop-to-buffer-same-window "*Messages*")
+ (lambda ()
+ (pop-to-buffer-same-window "*Messages*")
- (erc-d-t-ensure-for 1 "Server buffer not shown"
- (not (eq (window-buffer) (get-buffer "FooNet"))))
+ (erc-d-t-ensure-for 1 "Server buffer not shown"
+ (not (eq (window-buffer) (get-buffer "FooNet"))))
- (erc-d-t-ensure-for 3 "Channel #chan not shown"
- (not (eq (window-buffer) (get-buffer "#chan"))))
+ (erc-d-t-ensure-for 3 "Channel #chan not shown"
+ (not (eq (window-buffer) (get-buffer "#chan"))))
- (eq (window-buffer) (messages-buffer))))))
+ (eq (window-buffer) (messages-buffer)))))
;; Upon reconnecting, playback for channel and target buffers is
;; routed correctly. Autojoin is irrelevant here, but for the
diff --git a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
index f134f3ffb6..8e7e939d04 100644
--- a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
+++ b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el
@@ -131,43 +131,38 @@ Adapted from scenario clash-of-chans/uniquify described
in Bug#48598:
(get-buffer (format "127.0.0.1:%d/127.0.0.1" port)))
(server-buffer-bar
(get-buffer (format "127.0.0.1:%d/127.0.0.1<2>" port)))
- (chan-buffer-foo (get-buffer "#chan/127.0.0.1"))
- (chan-buffer-bar (get-buffer "#chan/127.0.0.1<2>"))
- (server-process-foo (with-current-buffer server-buffer-foo
- erc-server-process))
- (server-process-bar (with-current-buffer server-buffer-bar
- erc-server-process)))
+ (server-process-foo
+ (buffer-local-value 'erc-server-process server-buffer-foo))
+ (server-process-bar
+ (buffer-local-value 'erc-server-process server-buffer-bar)))
(ert-info ("Unique #chan buffers exist")
- (let ((chan-bufs (erc-scenarios-common-buflist "#chan"))
- (known (list chan-buffer-bar chan-buffer-foo)))
- (should (memq (pop chan-bufs) known))
- (should (memq (pop chan-bufs) known))
- (should-not chan-bufs)))
+ (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1<2>"))
+ (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1")))
(ert-info ("#chan@foonet is exclusive and not contaminated")
- (with-current-buffer chan-buffer-foo
+ (with-current-buffer "#chan/127.0.0.1"
(funcall expect 1 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
(funcall expect 1 "strength to climb")
(should (eq erc-server-process server-process-foo))))
(ert-info ("#chan@barnet is exclusive and not contaminated")
- (with-current-buffer chan-buffer-bar
+ (with-current-buffer "#chan/127.0.0.1<2>"
(funcall expect 1 "<joe>")
(erc-d-t-absent-for 0.1 "<bob>")
(funcall expect 1 "the loudest noise")
(should (eq erc-server-process server-process-bar))))
(ert-info ("Part #chan@foonet")
- (with-current-buffer chan-buffer-foo
+ (with-current-buffer "#chan/127.0.0.1"
(erc-d-t-search-for 1 "shake my sword")
(erc-cmd-PART "#chan")
(funcall expect 3 "You have left channel #chan")
(erc-cmd-JOIN "#chan")))
(ert-info ("Part #chan@barnet")
- (with-current-buffer chan-buffer-bar
+ (with-current-buffer "#chan/127.0.0.1<2>"
(funcall expect 10 "Arm it in rags")
(should (erc-get-channel-user (erc-current-nick)))
(erc-cmd-PART "#chan")
@@ -179,7 +174,7 @@ Adapted from scenario clash-of-chans/uniquify described in
Bug#48598:
(get-buffer "#chan/127.0.0.1<3>"))
(ert-info ("Activity continues in new, <n>-suffixed #chan@foonet buffer")
- (with-current-buffer chan-buffer-foo
+ (with-current-buffer "#chan/127.0.0.1"
(should-not (erc-get-channel-user (erc-current-nick))))
(with-current-buffer "#chan/127.0.0.1<3>"
(should (erc-get-channel-user (erc-current-nick)))
@@ -194,7 +189,7 @@ Adapted from scenario clash-of-chans/uniquify described in
Bug#48598:
(get-buffer "#chan/127.0.0.1<4>"))
(ert-info ("Activity continues in new, <n>-suffixed #chan@barnet buffer")
- (with-current-buffer chan-buffer-bar
+ (with-current-buffer "#chan/127.0.0.1<2>"
(should-not (erc-get-channel-user (erc-current-nick))))
(with-current-buffer "#chan/127.0.0.1<4>"
(funcall expect 2 "You have joined channel #chan")
@@ -221,12 +216,12 @@ Adapted from scenario clash-of-chans/uniquify described
in Bug#48598:
(ert-info ("Buffers are exempt from shortening")
(kill-buffer "#chan/127.0.0.1<4>")
(kill-buffer "#chan/127.0.0.1<3>")
- (kill-buffer chan-buffer-bar)
+ (kill-buffer "#chan/127.0.0.1<2>")
(should-not (get-buffer "#chan"))
- (should chan-buffer-foo))))
+ (should (get-buffer "#chan/127.0.0.1")))))
(ert-deftest erc-scenarios-base-reuse-buffers-channel-buffers--disabled ()
- :tags '(:expensive-test :unstable)
+ :tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-reuse-buffers))
(should erc-reuse-buffers)
(let ((erc-scenarios-common-dialog "base/reuse-buffers/channel")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 55efe2fd2d..b2ed29e80e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -522,7 +522,7 @@
(erc-send-current-line)
(should (ring-p erc-input-ring))
(should (zerop (ring-member erc-input-ring "/one"))) ; equal
- (should (save-excursion (forward-line -1) (goto-char (pos-bol))
+ (should (save-excursion (forward-line -1)
(looking-at-p "[*]+ echo: one")))
(should-not erc-input-ring-index)
(erc-bol)
diff --git a/test/lisp/erc/resources/base/assoc/samenet/chester.eld
b/test/lisp/erc/resources/base/assoc/samenet/chester.eld
index f1aed2836c..0132de677c 100644
--- a/test/lisp/erc/resources/base/assoc/samenet/chester.eld
+++ b/test/lisp/erc/resources/base/assoc/samenet/chester.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK chester"))
((user 1 "USER user 0 * :chester")
(0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester")
diff --git a/test/lisp/erc/resources/base/assoc/samenet/tester.eld
b/test/lisp/erc/resources/base/assoc/samenet/tester.eld
index cd9cacbe5d..995fab00f7 100644
--- a/test/lisp/erc/resources/base/assoc/samenet/tester.eld
+++ b/test/lisp/erc/resources/base/assoc/samenet/tester.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/erc/resources/base/assoc/samenet/tester2.eld
b/test/lisp/erc/resources/base/assoc/samenet/tester2.eld
index 67c3a94a26..33a05fe261 100644
--- a/test/lisp/erc/resources/base/assoc/samenet/tester2.eld
+++ b/test/lisp/erc/resources/base/assoc/samenet/tester2.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/erc/resources/base/netid/samenet/chester.eld
b/test/lisp/erc/resources/base/netid/samenet/chester.eld
index 8c2448733c..7b4bfee9c9 100644
--- a/test/lisp/erc/resources/base/netid/samenet/chester.eld
+++ b/test/lisp/erc/resources/base/netid/samenet/chester.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK chester"))
((user 1 "USER user 0 * :chester")
(0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester")
diff --git a/test/lisp/erc/resources/base/netid/samenet/tester.eld
b/test/lisp/erc/resources/base/netid/samenet/tester.eld
index 76312a7a14..f41b041db4 100644
--- a/test/lisp/erc/resources/base/netid/samenet/tester.eld
+++ b/test/lisp/erc/resources/base/netid/samenet/tester.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/erc/resources/erc-d/erc-d-tests.el
b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index 357bc48b08..a4befd96b5 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -673,7 +673,7 @@ nonzero for this to work."
(cadr (pop errors))))))
(ert-deftest erc-d-run-linger ()
- :tags '(:expensive-test)
+ :tags '(:unstable :expensive-test)
(erc-d-tests-with-server (dumb-s _) linger
(with-current-buffer (erc-d-t-wait-for 6 (get-buffer "#chan"))
(erc-d-t-search-for 2 "hey"))
@@ -683,7 +683,7 @@ nonzero for this to work."
(erc-d-t-search-for 3 "Lingered for 1.00 seconds"))))
(ert-deftest erc-d-run-linger-fail ()
- :tags '(:expensive-test)
+ :tags '(:unstable :expensive-test)
(let ((erc-server-flood-penalty 0.1)
errors)
(erc-d-tests-with-failure-spy
@@ -696,7 +696,7 @@ nonzero for this to work."
(should (string-match-p "Match failed.*hi" (cadr (pop errors))))))
(ert-deftest erc-d-run-linger-direct ()
- :tags '(:expensive-test)
+ :tags '(:unstable :expensive-test)
(let* ((dumb-server (erc-d-run "localhost" t
'linger-multi-a 'linger-multi-b))
(port (process-contact dumb-server :service))
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index 3a582965d6..92d785d7fd 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -74,6 +74,25 @@ e.g. \"{(+ 1 2)} 3\" => 3"
(eshell-command-result-equal "{(+ 1 2)} 3" 3))
+;; Lisp forms
+
+(ert-deftest esh-cmd-test/quoted-lisp-form ()
+ "Test parsing of a quoted Lisp form."
+ (eshell-command-result-equal "echo #'(1 2)" '(1 2)))
+
+(ert-deftest esh-cmd-test/backquoted-lisp-form ()
+ "Test parsing of a backquoted Lisp form."
+ (let ((eshell-test-value 42))
+ (eshell-command-result-equal "echo `(answer ,eshell-test-value)"
+ '(answer 42))))
+
+(ert-deftest esh-cmd-test/backquoted-lisp-form/splice ()
+ "Test parsing of a backquoted Lisp form using splicing."
+ (let ((eshell-test-value '(2 3)))
+ (eshell-command-result-equal "echo `(1 ,@eshell-test-value)"
+ '(1 2 3))))
+
+
;; Logical operators
(ert-deftest esh-cmd-test/and-operator ()
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-io-tests.el b/test/lisp/eshell/esh-io-tests.el
new file mode 100644
index 0000000000..37b234eaf0
--- /dev/null
+++ b/test/lisp/eshell/esh-io-tests.el
@@ -0,0 +1,292 @@
+;;; esh-io-tests.el --- esh-io 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 'ert-x)
+(require 'esh-mode)
+(require 'eshell)
+
+(require 'eshell-tests-helpers
+ (expand-file-name "eshell-tests-helpers"
+ (file-name-directory (or load-file-name
+ default-directory))))
+
+(defvar eshell-test-value nil)
+
+(defun eshell-test-file-string (file)
+ "Return the contents of FILE as a string."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (buffer-string)))
+
+(defun eshell/test-output ()
+ "Write some test output separately to stdout and stderr."
+ (eshell-printn "stdout")
+ (eshell-errorn "stderr"))
+
+;;; Tests:
+
+
+;; Basic redirection
+
+(ert-deftest esh-io-test/redirect-file/overwrite ()
+ "Check that redirecting to a file in overwrite mode works."
+ (ert-with-temp-file temp-file
+ :text "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new > %s" temp-file)))
+ (should (equal (eshell-test-file-string temp-file) "new"))))
+
+(ert-deftest esh-io-test/redirect-file/append ()
+ "Check that redirecting to a file in append mode works."
+ (ert-with-temp-file temp-file
+ :text "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new >> %s" temp-file)))
+ (should (equal (eshell-test-file-string temp-file) "oldnew"))))
+
+(ert-deftest esh-io-test/redirect-file/insert ()
+ "Check that redirecting to a file in insert works."
+ (ert-with-temp-file temp-file
+ :text "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new >>> %s" temp-file)))
+ (should (equal (eshell-test-file-string temp-file) "newold"))))
+
+(ert-deftest esh-io-test/redirect-buffer/overwrite ()
+ "Check that redirecting to a buffer in overwrite mode works."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new > #<%s>" bufname)))
+ (should (equal (buffer-string) "new"))))
+
+(ert-deftest esh-io-test/redirect-buffer/append ()
+ "Check that redirecting to a buffer in append mode works."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new >> #<%s>" bufname)))
+ (should (equal (buffer-string) "oldnew"))))
+
+(ert-deftest esh-io-test/redirect-buffer/insert ()
+ "Check that redirecting to a buffer in insert mode works."
+ (eshell-with-temp-buffer bufname "old"
+ (goto-char (point-min))
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new >>> #<%s>" bufname)))
+ (should (equal (buffer-string) "newold"))))
+
+(ert-deftest esh-io-test/redirect-buffer/escaped ()
+ "Check that redirecting to a buffer with escaped characters works."
+ (with-temp-buffer
+ (rename-buffer "eshell\\temp\\buffer" t)
+ (let ((bufname (buffer-name)))
+ (with-temp-eshell
+ (eshell-insert-command (format "echo hi > #<%s>"
+ (string-replace "\\" "\\\\" bufname))))
+ (should (equal (buffer-string) "hi")))))
+
+(ert-deftest esh-io-test/redirect-symbol/overwrite ()
+ "Check that redirecting to a symbol in overwrite mode works."
+ (let ((eshell-test-value "old"))
+ (with-temp-eshell
+ (eshell-insert-command "echo new > #'eshell-test-value"))
+ (should (equal eshell-test-value "new"))))
+
+(ert-deftest esh-io-test/redirect-symbol/append ()
+ "Check that redirecting to a symbol in append mode works."
+ (let ((eshell-test-value "old"))
+ (with-temp-eshell
+ (eshell-insert-command "echo new >> #'eshell-test-value"))
+ (should (equal eshell-test-value "oldnew"))))
+
+(ert-deftest esh-io-test/redirect-marker ()
+ "Check that redirecting to a marker works."
+ (with-temp-buffer
+ (let ((eshell-test-value (point-marker)))
+ (with-temp-eshell
+ (eshell-insert-command "echo hi > $eshell-test-value"))
+ (should (equal (buffer-string) "hi")))))
+
+(ert-deftest esh-io-test/redirect-multiple ()
+ "Check that redirecting to multiple targets works."
+ (let ((eshell-test-value "old"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "echo new > #<%s> > #'eshell-test-value"
+ bufname)))
+ (should (equal (buffer-string) "new"))
+ (should (equal eshell-test-value "new")))))
+
+(ert-deftest esh-io-test/redirect-multiple/repeat ()
+ "Check that redirecting to multiple targets works when repeating a target."
+ (let ((eshell-test-value "old"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command
+ (format "echo new > #<%s> > #'eshell-test-value > #<%s>"
+ bufname bufname)))
+ (should (equal (buffer-string) "new"))
+ (should (equal eshell-test-value "new")))))
+
+
+;; Redirecting specific handles
+
+(ert-deftest esh-io-test/redirect-stdout ()
+ "Check that redirecting to stdout doesn't redirect stderr."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output > #<%s>" bufname)
+ "stderr\n"))
+ (should (equal (buffer-string) "stdout\n")))
+ ;; Also check explicitly specifying the stdout fd.
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output 1> #<%s>" bufname)
+ "stderr\n"))
+ (should (equal (buffer-string) "stdout\n"))))
+
+(ert-deftest esh-io-test/redirect-stderr/overwrite ()
+ "Check that redirecting to stderr doesn't redirect stdout."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output 2> #<%s>" bufname)
+ "stdout\n"))
+ (should (equal (buffer-string) "stderr\n"))))
+
+(ert-deftest esh-io-test/redirect-stderr/append ()
+ "Check that redirecting to stderr doesn't redirect stdout."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output 2>> #<%s>" bufname)
+ "stdout\n"))
+ (should (equal (buffer-string) "oldstderr\n"))))
+
+(ert-deftest esh-io-test/redirect-stderr/insert ()
+ "Check that redirecting to stderr doesn't redirect stdout."
+ (eshell-with-temp-buffer bufname "old"
+ (goto-char (point-min))
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output 2>>> #<%s>" bufname)
+ "stdout\n"))
+ (should (equal (buffer-string) "stderr\nold"))))
+
+(ert-deftest esh-io-test/redirect-stdout-and-stderr ()
+ "Check that redirecting to both stdout and stderr works."
+ (eshell-with-temp-buffer bufname-1 "old"
+ (eshell-with-temp-buffer bufname-2 "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output > #<%s> 2> #<%s>"
+ bufname-1 bufname-2)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stderr\n")))
+ (should (equal (buffer-string) "stdout\n"))))
+
+(ert-deftest esh-io-test/redirect-all/overwrite ()
+ "Check that redirecting to stdout and stderr via shorthand works."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output &> #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\n")))
+ ;; Also check the alternate (and less-preferred in Bash) `>&' syntax.
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output >& #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\n"))))
+
+(ert-deftest esh-io-test/redirect-all/append ()
+ "Check that redirecting to stdout and stderr via shorthand works."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output &>> #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "oldstdout\nstderr\n")))
+ ;; Also check the alternate (and less-preferred in Bash) `>>&' syntax.
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output >>& #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "oldstdout\nstderr\n"))))
+
+(ert-deftest esh-io-test/redirect-all/insert ()
+ "Check that redirecting to stdout and stderr via shorthand works."
+ (eshell-with-temp-buffer bufname "old"
+ (goto-char (point-min))
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output &>>> #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\nold")))
+ ;; Also check the alternate `>>>&' syntax.
+ (eshell-with-temp-buffer bufname "old"
+ (goto-char (point-min))
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output >>>& #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\nold"))))
+
+(ert-deftest esh-io-test/redirect-copy ()
+ "Check that redirecting stdout and then copying stdout to stderr works.
+This should redirect both stdout and stderr to the same place."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output > #<%s> 2>&1" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\n"))))
+
+(ert-deftest esh-io-test/redirect-copy-first ()
+ "Check that copying stdout to stderr and then redirecting stdout works.
+This should redirect stdout to a buffer, and stderr to where
+stdout originally pointed (the terminal)."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output (format "test-output 2>&1 > #<%s>" bufname)
+ "stderr\n"))
+ (should (equal (buffer-string) "stdout\n"))))
+
+(ert-deftest esh-io-test/redirect-pipe ()
+ "Check that \"redirecting\" to a pipe works."
+ ;; `|' should only redirect stdout.
+ (eshell-command-result-equal "test-output | rev"
+ "stderr\ntuodts\n")
+ ;; `|&' should redirect stdout and stderr.
+ (eshell-command-result-equal "test-output |& rev"
+ "tuodts\nrredts\n"))
+
+
+;; Virtual targets
+
+(ert-deftest esh-io-test/virtual-dev-eshell ()
+ "Check that redirecting to /dev/eshell works."
+ (with-temp-eshell
+ (eshell-match-command-output "echo hi > /dev/eshell" "hi")))
+
+(ert-deftest esh-io-test/virtual-dev-kill ()
+ "Check that redirecting to /dev/kill works."
+ (with-temp-eshell
+ (eshell-insert-command "echo one > /dev/kill")
+ (should (equal (car kill-ring) "one"))
+ (eshell-insert-command "echo two > /dev/kill")
+ (should (equal (car kill-ring) "two"))
+ (eshell-insert-command "echo three >> /dev/kill")
+ (should (equal (car kill-ring) "twothree"))))
+
+;;; esh-io-tests.el ends here
diff --git a/test/lisp/eshell/esh-proc-tests.el
b/test/lisp/eshell/esh-proc-tests.el
index 62e784e8f6..abe363bee0 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -28,15 +28,97 @@
(file-name-directory (or load-file-name
default-directory))))
+(defvar esh-proc-test--output-cmd
+ (concat "sh -c '"
+ "echo stdout; "
+ "echo stderr >&2"
+ "'")
+ "A shell command that prints to both stdout and stderr.")
+
(defvar esh-proc-test--detect-pty-cmd
(concat "sh -c '"
"if [ -t 0 ]; then echo stdin; fi; "
"if [ -t 1 ]; then echo stdout; fi; "
"if [ -t 2 ]; then echo stderr; fi"
- "'"))
+ "'")
+ "A shell command that prints the standard streams connected as TTYs.")
;;; Tests:
+
+;; Output and redirection
+
+(ert-deftest esh-proc-test/output/to-screen ()
+ "Check that outputting stdout and stderr to the screen works."
+ (skip-unless (executable-find "sh"))
+ (with-temp-eshell
+ (eshell-match-command-output esh-proc-test--output-cmd
+ "stdout\nstderr\n")))
+
+(ert-deftest esh-proc-test/output/stdout-to-buffer ()
+ "Check that redirecting only stdout works."
+ (skip-unless (executable-find "sh"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "%s > #<%s>" esh-proc-test--output-cmd bufname)
+ "stderr\n"))
+ (should (equal (buffer-string) "stdout\n"))))
+
+(ert-deftest esh-proc-test/output/stderr-to-buffer ()
+ "Check that redirecting only stderr works."
+ (skip-unless (executable-find "sh"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "%s 2> #<%s>" esh-proc-test--output-cmd bufname)
+ "stdout\n"))
+ (should (equal (buffer-string) "stderr\n"))))
+
+(ert-deftest esh-proc-test/output/stdout-and-stderr-to-buffer ()
+ "Check that redirecting stdout and stderr works."
+ (skip-unless (executable-find "sh"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "%s &> #<%s>" esh-proc-test--output-cmd bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "stdout\nstderr\n"))))
+
+
+;; Exit status
+
+(ert-deftest esh-proc-test/exit-status/success ()
+ "Check that successful execution is properly recorded."
+ (skip-unless (executable-find "sh"))
+ (with-temp-eshell
+ (eshell-insert-command "sh -c 'exit 0'")
+ (eshell-wait-for-subprocess)
+ (should (= eshell-last-command-status 0))
+ (should (eq eshell-last-command-result t))))
+
+(ert-deftest esh-proc-test/exit-status/failure ()
+ "Check that failed execution is properly recorded."
+ (skip-unless (executable-find "sh"))
+ (with-temp-eshell
+ (eshell-insert-command "sh -c 'exit 1'")
+ (eshell-wait-for-subprocess)
+ (should (= eshell-last-command-status 1))
+ (should (eq eshell-last-command-result nil))))
+
+(ert-deftest esh-proc-test/exit-status/with-stderr-pipe ()
+ "Check that failed execution is properly recorded even with a pipe process."
+ (skip-unless (executable-find "sh"))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "sh -c 'exit 1' > #<%s>" bufname))
+ (eshell-wait-for-subprocess)
+ (should (= eshell-last-command-status 1))
+ (should (eq eshell-last-command-result nil)))))
+
+
+;; Pipelines
+
(ert-deftest esh-proc-test/sigpipe-exits-process ()
"Test that a SIGPIPE is properly sent to a process if a pipe closes"
(skip-unless (and (executable-find "sh")
@@ -46,8 +128,10 @@
(eshell-match-command-output
;; The first command is like `yes' but slower. This is to prevent
;; it from taxing Emacs's process filter too much and causing a
- ;; hang.
- (concat "sh -c 'while true; do echo y; sleep 1; done' | "
+ ;; hang. Note that we use "|&" to connect the processes so that
+ ;; Emacs doesn't create an extra pipe process for the first "sh"
+ ;; invocation.
+ (concat "sh -c 'while true; do echo y; sleep 1; done' |& "
"sh -c 'read NAME; echo ${NAME}'")
"y\n")
(eshell-wait-for-subprocess t)
@@ -74,23 +158,54 @@
(ert-deftest esh-proc-test/pipeline-connection-type/middle ()
"Test that all streams are pipes when a command is in the middle of a
pipeline."
- ;; Repeated unreproducible errors.
- :tags '(:unstable)
(skip-unless (and (executable-find "sh")
(executable-find "cat")))
- (eshell-command-result-equal
- (concat "echo | " esh-proc-test--detect-pty-cmd " | cat")
- nil))
+ ;; An `eshell-pipe-broken' signal might occur internally; let Eshell
+ ;; handle it!
+ (let ((debug-on-error nil))
+ (eshell-command-result-equal
+ (concat "echo hi | " esh-proc-test--detect-pty-cmd " | cat")
+ nil)))
(ert-deftest esh-proc-test/pipeline-connection-type/last ()
"Test that only output streams are PTYs when a command ends a pipeline."
- ;; Repeated unreproducible errors.
- :tags '(:unstable)
(skip-unless (executable-find "sh"))
- (eshell-command-result-equal
- (concat "echo | " esh-proc-test--detect-pty-cmd)
- (unless (eq system-type 'windows-nt)
- "stdout\nstderr\n")))
+ ;; An `eshell-pipe-broken' signal might occur internally; let Eshell
+ ;; handle it!
+ (let ((debug-on-error nil))
+ (eshell-command-result-equal
+ (concat "echo hi | " esh-proc-test--detect-pty-cmd)
+ (unless (eq system-type 'windows-nt)
+ "stdout\nstderr\n"))))
+
+
+;; Killing processes
+
+(ert-deftest esh-proc-test/kill-process/foreground-only ()
+ "Test that `eshell-kill-process' only kills foreground processes."
+ (with-temp-eshell
+ (eshell-insert-command "sleep 100 &")
+ (eshell-insert-command "sleep 100")
+ (should (equal (length eshell-process-list) 2))
+ ;; This should kill only the foreground process.
+ (eshell-kill-process)
+ (eshell-wait-for-subprocess)
+ (should (equal (length eshell-process-list) 1))
+ ;; Now kill everything, including the background process.
+ (eshell-process-interact 'kill-process t)
+ (eshell-wait-for-subprocess t)
+ (should (equal (length eshell-process-list) 0))))
+
+(ert-deftest esh-proc-test/kill-process/background-prompt ()
+ "Test that killing a background process doesn't emit a new
+prompt. See bug#54136."
+ (skip-unless (and (executable-find "sh")
+ (executable-find "sleep")))
+ (with-temp-eshell
+ (eshell-insert-command "sh -c 'while true; do sleep 1; done' &")
+ (kill-process (caar eshell-process-list))
+ (eshell-wait-for-subprocess)
+ (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n"))))
(ert-deftest esh-proc-test/kill-pipeline ()
"Test that killing a pipeline of processes only emits a single
@@ -131,14 +246,4 @@ write the exit status to the pipe. See bug#54136."
output-start (eshell-end-of-output))
"")))))
-(ert-deftest esh-proc-test/kill-background-process ()
- "Test that killing a background process doesn't emit a new
-prompt. See bug#54136."
- (skip-unless (and (executable-find "sh")
- (executable-find "sleep")))
- (with-temp-eshell
- (eshell-insert-command "sh -c 'while true; do sleep 1; done' &")
- (kill-process (caar eshell-process-list))
- ;; Give `eshell-sentinel' a chance to run.
- (sit-for 0.1)
- (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n"))))
+;;; esh-proc-tests.el ends here
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index bebc57d359..d9b2585a32 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
@@ -105,9 +107,11 @@
(ert-deftest esh-var-test/interp-var-assoc ()
"Interpolate alist variable with index"
- (let ((eshell-test-value '(("foo" . 1))))
+ (let ((eshell-test-value '(("foo" . 1) (bar . 2))))
(eshell-command-result-equal "echo $eshell-test-value[foo]"
- 1)))
+ 1)
+ (eshell-command-result-equal "echo $eshell-test-value[#'bar]"
+ 2)))
(ert-deftest esh-var-test/interp-var-length-list ()
"Interpolate length of list variable"
@@ -257,9 +261,11 @@ inside double-quotes"
(ert-deftest esh-var-test/quoted-interp-var-assoc ()
"Interpolate alist variable with index inside double-quotes"
- (let ((eshell-test-value '(("foo" . 1))))
+ (let ((eshell-test-value '(("foo" . 1) (bar . 2))))
(eshell-command-result-equal "echo \"$eshell-test-value[foo]\""
- "1")))
+ "1")
+ (eshell-command-result-equal "echo \"$eshell-test-value[#'bar]\""
+ "2")))
(ert-deftest esh-var-test/quoted-interp-var-length-list ()
"Interpolate length of list variable inside double-quotes"
@@ -436,6 +442,150 @@ 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."
+ (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"))
+ (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 ()
@@ -461,6 +611,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
@@ -468,9 +677,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"
@@ -480,9 +688,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.
@@ -493,9 +700,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 8f0f993447..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
@@ -51,6 +63,16 @@ See `eshell-wait-for-subprocess'.")
(let (kill-buffer-query-functions)
(kill-buffer eshell-buffer)))))))
+(defmacro eshell-with-temp-buffer (bufname text &rest body)
+ "Create a temporary buffer containing TEXT and evaluate BODY there.
+BUFNAME will be set to the name of the temporary buffer."
+ (declare (indent 2))
+ `(with-temp-buffer
+ (insert ,text)
+ (rename-buffer "eshell-temp-buffer" t)
+ (let ((,bufname (buffer-name)))
+ ,@body)))
+
(defun eshell-wait-for-subprocess (&optional all)
"Wait until there is no interactive subprocess running in Eshell.
If ALL is non-nil, wait until there are no Eshell subprocesses at
@@ -73,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/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 1845dba280..d5112146c2 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -105,25 +105,6 @@
(format template "format \"%s\" eshell-in-pipeline-p")
"nil")))
-(ert-deftest eshell-test/redirect-buffer ()
- "Check that piping to a buffer works"
- (with-temp-buffer
- (rename-buffer "eshell-temp-buffer" t)
- (let ((bufname (buffer-name)))
- (with-temp-eshell
- (eshell-insert-command (format "echo hi > #<%s>" bufname)))
- (should (equal (buffer-string) "hi")))))
-
-(ert-deftest eshell-test/redirect-buffer-escaped ()
- "Check that piping to a buffer with escaped characters works"
- (with-temp-buffer
- (rename-buffer "eshell\\temp\\buffer" t)
- (let ((bufname (buffer-name)))
- (with-temp-eshell
- (eshell-insert-command (format "echo hi > #<%s>"
- (string-replace "\\" "\\\\" bufname))))
- (should (equal (buffer-string) "hi")))))
-
(ert-deftest eshell-test/escape-nonspecial ()
"Test that \"\\c\" and \"c\" are equivalent when \"c\" is not a
special character."
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 4ed1786a8e..d82e2dae7a 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -137,6 +137,10 @@ Return nil when any other file notification watch is still
active."
(defun file-notify--test-cleanup ()
"Cleanup after a test."
+ ;; (when (getenv "EMACS_EMBA_CI")
+ ;; (dolist (buf (tramp-list-tramp-buffers))
+ ;; (message ";; %s\n%s" buf (tramp-get-buffer-string buf))
+ ;; (kill-buffer buf)))
(file-notify-rm-all-watches)
(ignore-errors
@@ -173,6 +177,7 @@ Return nil when any other file notification watch is still
active."
(setq file-notify-debug nil
password-cache-expiry nil
+ ;; tramp-verbose (if (getenv "EMACS_EMBA_CI") 10 0)
tramp-verbose 0
;; When the remote user id is 0, Tramp refuses unsafe temporary files.
tramp-allow-unsafe-temporary-files
@@ -639,7 +644,9 @@ delivered."
(ert-deftest file-notify-test03-events ()
"Check file creation/change/removal notifications."
- :tags '(:expensive-test)
+ :tags (if (getenv "EMACS_EMBA_CI")
+ '(:expensive-test :unstable)
+ '(:expensive-test))
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
@@ -1382,7 +1389,9 @@ descriptors that were issued when registering the
watches. This
test caters for the situation in bug#22736 where the callback for
the directory received events for the file with the descriptor of
the file watch."
- :tags '(:expensive-test)
+ :tags (if (getenv "EMACS_EMBA_CI")
+ '(:expensive-test :unstable)
+ '(:expensive-test))
(skip-unless (file-notify--test-local-enabled))
;; A directory to be watched.
@@ -1567,6 +1576,136 @@ the file watch."
(file-notify--deftest-remote file-notify-test10-sufficient-resources
"Check `file-notify-test10-sufficient-resources' for remote files.")
+(ert-deftest file-notify-test11-symlinks ()
+ "Check that file notification do not follow symbolic links."
+ :tags '(:expensive-test)
+ (skip-unless (file-notify--test-local-enabled))
+ ;; This test does not work for kqueue (yet).
+ (skip-unless (not (string-equal (file-notify--test-library) "kqueue")))
+
+ (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
+ file-notify--test-tmpfile1 (file-notify--test-make-temp-name))
+
+ ;; Symlink a file.
+ (unwind-protect
+ (progn
+ (write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message)
+ ;; Some systems, like MS Windows w/o sufficient privileges, do
+ ;; not allow creation of symbolic links.
+ (condition-case nil
+ (make-symbolic-link
+ file-notify--test-tmpfile1 file-notify--test-tmpfile)
+ (error (ert-skip "`make-symbolic-link' not supported")))
+ (should
+ (setq file-notify--test-desc
+ (file-notify--test-add-watch
+ file-notify--test-tmpfile
+ '(attribute-change change) #'file-notify--test-event-handler)))
+ (should (file-notify-valid-p file-notify--test-desc))
+
+ ;; Writing to either the symlink or the target should not
+ ;; raise any event.
+ (file-notify--test-with-actions nil
+ (write-region
+ "another text" nil file-notify--test-tmpfile nil 'no-message)
+ (write-region
+ "another text" nil file-notify--test-tmpfile1 nil 'no-message))
+ ;; Sanity check.
+ (file-notify--test-wait-for-events
+ (file-notify--test-timeout)
+ (not (input-pending-p)))
+ (should-not file-notify--test-events)
+
+ ;; Changing timestamp of the target should not raise any
+ ;; event. We don't use `nofollow'.
+ (file-notify--test-with-actions nil
+ (set-file-times file-notify--test-tmpfile1 '(0 0))
+ (set-file-times file-notify--test-tmpfile '(0 0)))
+ ;; Sanity check.
+ (file-notify--test-wait-for-events
+ (file-notify--test-timeout)
+ (not (input-pending-p)))
+ (should-not file-notify--test-events)
+
+ ;; Changing timestamp of the symlink shows the event.
+ (file-notify--test-with-actions
+ (cond
+ ;; w32notify does not distinguish between `changed' and
+ ;; `attribute-changed'.
+ ((string-equal (file-notify--test-library) "w32notify")
+ '(changed))
+ ;; GFam{File,Directory}Monitor, GKqueueFileMonitor and
+ ;; GPollFileMonitor do not report the `attribute-changed'
+ ;; event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor
+ GKqueueFileMonitor GPollFileMonitor))
+ '())
+ (t '(attribute-changed)))
+ (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow))
+
+ ;; Deleting the target should not raise any event.
+ (file-notify--test-with-actions nil
+ (delete-file file-notify--test-tmpfile1)
+ (delete-file file-notify--test-tmpfile))
+ ;; Sanity check.
+ (file-notify--test-wait-for-events
+ (file-notify--test-timeout)
+ (not (input-pending-p)))
+ (should-not file-notify--test-events)
+
+ ;; The environment shall be cleaned up.
+ (file-notify-rm-watch file-notify--test-desc)
+ (file-notify--test-cleanup-p))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup))
+
+ (setq file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
+ file-notify--test-tmpfile (file-notify--test-make-temp-name))
+
+ ;; Symlink a directory.
+ (unwind-protect
+ (let ((tmpfile (expand-file-name "foo" file-notify--test-tmpfile))
+ (tmpfile1 (expand-file-name "foo" file-notify--test-tmpfile1)))
+ (make-directory file-notify--test-tmpfile1)
+ (make-symbolic-link file-notify--test-tmpfile1
file-notify--test-tmpfile)
+ (write-region "any text" nil tmpfile1 nil 'no-message)
+ (should
+ (setq file-notify--test-desc
+ (file-notify--test-add-watch
+ file-notify--test-tmpfile
+ '(attribute-change change) #'file-notify--test-event-handler)))
+ (should (file-notify-valid-p file-notify--test-desc))
+
+ ;; None of the actions on a file in the symlinked directory
+ ;; will be reported.
+ (file-notify--test-with-actions nil
+ (write-region "another text" nil tmpfile nil 'no-message)
+ (write-region "another text" nil tmpfile1 nil 'no-message)
+ (set-file-times tmpfile '(0 0))
+ (set-file-times tmpfile '(0 0) 'nofollow)
+ (set-file-times tmpfile1 '(0 0))
+ (set-file-times tmpfile1 '(0 0) 'nofollow)
+ (delete-file tmpfile)
+ (delete-file tmpfile1))
+ ;; Sanity check.
+ (file-notify--test-wait-for-events
+ (file-notify--test-timeout)
+ (not (input-pending-p)))
+ (should-not file-notify--test-events)
+
+ ;; The environment shall be cleaned up.
+ (delete-directory file-notify--test-tmpdir 'recursive)
+ (file-notify-rm-watch file-notify--test-desc)
+ (file-notify--test-cleanup-p))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup)))
+
+(file-notify--deftest-remote file-notify-test11-symlinks
+ "Check `file-notify-test11-symlinks' for remote files.")
+
(defun file-notify-test-all (&optional interactive)
"Run all tests for \\[file-notify]."
(interactive "p")
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 54ada08800..682b5cdb44 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -221,22 +221,41 @@ form.")
("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
("x:/foo/bar/baz/" "z:/qux/foo/"))
- ("//foo/bar/" "$FOO/baz/;/qux/foo/"
- ("/foo/bar//baz/" "/qux/foo/")))
- '(("/foo/bar//baz/:/bar/foo/baz//" nil
- ("/foo/bar//baz/" "/bar/foo/baz//"))
- ("/foo/bar/:/bar/qux/:/qux/foo" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("//foo/bar/:/bar/qux/:/qux/foo/" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo/bar/:/bar/qux/:/qux/foo/" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo//bar/:/bar/qux/:/qux/foo/" nil
- ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo//bar/:/bar/qux/:/qux/foo" nil
- ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
- ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar//baz/"
"/qux/foo/")))))
+ ("///foo/bar/" "$FOO/baz/;/qux/foo/"
+ ("//foo/bar//baz/" "/qux/foo/")))
+ (if (eq system-type 'cygwin)
+ '(("/foo/bar//baz/:/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
+ ("/foo/bar/:/bar/qux/:/qux/foo" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("//foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("//foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar" "$FOO/baz/:/qux/foo/"
+ ("/foo/bar/baz/" "/qux/foo/"))
+ ("///foo/bar/" "$FOO/baz/:/qux/foo/"
+ ("//foo/bar//baz/" "/qux/foo/")))
+ '(("/foo/bar//baz/:/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
+ ("/foo/bar/:/bar/qux/:/qux/foo" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("//foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar" "$FOO/baz/:/qux/foo/"
+ ("/foo/bar/baz/" "/qux/foo/"))
+ ("//foo/bar/" "$FOO/baz/:/qux/foo/"
+ ("/foo/bar//baz/" "/qux/foo/"))))))
(foo-env (getenv "FOO"))
(bar-env (getenv "BAR")))
(unwind-protect
@@ -1504,7 +1523,11 @@ See <https://debbugs.gnu.org/36401>."
(should (equal (parse-colon-path "/foo//bar/baz")
'("/foo//bar/baz/"))))
(should (equal (parse-colon-path (concat "." path-separator "/tmp"))
- '("./" "/tmp/"))))
+ '("./" "/tmp/")))
+ (should (equal (parse-colon-path (concat "/foo" path-separator "///bar"))
+ (if (memq system-type '(windows-nt cygwin ms-dos))
+ '("/foo/" "//bar/")
+ '("/foo/" "/bar/")))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
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/format-spec-tests.el b/test/lisp/format-spec-tests.el
index 4a3cc74c33..bd493ae1d7 100644
--- a/test/lisp/format-spec-tests.el
+++ b/test/lisp/format-spec-tests.el
@@ -148,6 +148,17 @@
(format-spec fmt '((?b . "asd") (?a . "fgh")))
#("fgh%asdasd" 0 3 (a b) 3 4 (c d) 7 10 (e f))))))
+(ert-deftest format-spec/function ()
+ (let* (called
+ (spec `((?a . "foo")
+ (?f . ,(lambda ()
+ (setq called t)
+ "bar")))))
+ (should (equal (format-spec "%a" spec) "foo"))
+ (should-not called)
+ (should (equal (format-spec "%f" spec) "bar"))
+ (should called)))
+
(ert-deftest format-spec-unknown ()
(should-error (format-spec "foo %b %z zot" '((?b . "bar"))))
(should-error (format-spec "foo %b %%%z zot" '((?b . "bar"))))
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0062E2DBC6D6848AE88BCE181CC1938F2FAC816C.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0062E2DBC6D6848AE88BCE181CC1938F2FAC816C.key
new file mode 100644
index 0000000000..6f1e145295
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0062E2DBC6D6848AE88BCE181CC1938F2FAC816C.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40C5151DC16303D3BD25F10C092E411CC3D65F7DF30DD8DDBDB17771EED64F8874#)
+ (d #7AA2EEE8EC08C2B41C4AAD9484D2ED8F6C630392892322827901B37EE3973E68#)
+ ))
+Created: 20121130T230715
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
deleted file mode 100644
index 58fd0b5edb..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/052E3324B4811A197A1DE922671AA6ABE475025E.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/052E3324B4811A197A1DE922671AA6ABE475025E.key
new file mode 100644
index 0000000000..cdc19ed266
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/052E3324B4811A197A1DE922671AA6ABE475025E.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #40AB5C863639D2154343F2196F43F95CCFAE91203324A0C63019EDA7942EA23E1F#)
+ (d #692D35D0062BE19EA22D92D7B58F8FAC5E1ACCBA78FE6260ADDDF987D2923A86#)
+ ))
+Created: 20150822T122925
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/066DBED74BA05B5AA1E2A6E4634EF6F62C0D7A5F.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/066DBED74BA05B5AA1E2A6E4634EF6F62C0D7A5F.key
new file mode 100644
index 0000000000..5a64f9f23e
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/066DBED74BA05B5AA1E2A6E4634EF6F62C0D7A5F.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #402C67E839BFBF7BE2095CA2E9502482C8E8314936689E922B9EF870F0F3F4944F#)
+ (d #225DF7626A9308083437959FFDF825AE05919CB92670D1E22B2C6A2FB0EAE7A4#)
+ ))
+Created: 20101231T230030
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0B0D8E451BFADF816524AF5E185EBF3DED48CA00.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0B0D8E451BFADF816524AF5E185EBF3DED48CA00.key
new file mode 100644
index 0000000000..995b93a4fc
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/0B0D8E451BFADF816524AF5E185EBF3DED48CA00.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #40127BA3ECD3C22145A892CC9A8EF12BBF91537B2180F54CBD22CB2696B7A7C4EA#)
+ (d #8CF76D6F3FD2893E87B08AC9A9E56419DB7D10BEC5F8AC4600516DC370E97DAB#)
+ ))
+Created: 20111231T230004
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
deleted file mode 100644
index 62f4ab25a6..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1967CB6C7B1C00996FCFF5930C3467D3D4FB702C.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1967CB6C7B1C00996FCFF5930C3467D3D4FB702C.key
new file mode 100644
index 0000000000..42773a1d96
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1967CB6C7B1C00996FCFF5930C3467D3D4FB702C.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #40D900D660C533BB480921CC5455679E9AD53C8BA2240A8946CC07759CAC14ADD5#)
+ (d #B568C991BB392303AF680093C87DF54B07288EA6D1642567D574A0FFA235B15B#)
+ ))
+Created: 20121231T230003
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
deleted file mode 100644
index 2a8ce135fb..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
deleted file mode 100644
index 9f8de71c5e..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
deleted file mode 100644
index 6e4a4e548f..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/2C9A99AF2FB073D3328B0F995BD6DE74616A6CC2.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/2C9A99AF2FB073D3328B0F995BD6DE74616A6CC2.key
new file mode 100644
index 0000000000..c4941533f4
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/2C9A99AF2FB073D3328B0F995BD6DE74616A6CC2.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #4043E90064F42A73C20C5D3984A355F5DA2CAD5218E512B9A4038E0ACDBA237818#)
+ (d #02A2BE84BCCF0EB82D81BF991013AC77D0F8325D8FB3B98511799844DC106618#)
+ ))
+Created: 20111230T230147
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/3250B5BE67E704F82BC9AAE00EC8A0CAC8C2A94F.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/3250B5BE67E704F82BC9AAE00EC8A0CAC8C2A94F.key
new file mode 100644
index 0000000000..6fbc08d06d
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/3250B5BE67E704F82BC9AAE00EC8A0CAC8C2A94F.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40C5CE487C55EC9735F736D24AA11A66E05F9BBCE52EBAE5671B858585BF36E12D#)
+ (d #7DE9D5E8209B9F7E28A0C39F53FDD18125DDDEAB6D7FBD8A8D8DB2AEDE990330#)
+ ))
+Created: 20150822T113710
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
deleted file mode 100644
index cff58edaa8..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
deleted file mode 100644
index 14af8662f7..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
deleted file mode 100644
index 207a7237d3..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5294CDB62DB28FBB486DE077DAF248FB32BE286A.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5294CDB62DB28FBB486DE077DAF248FB32BE286A.key
new file mode 100644
index 0000000000..76418968b7
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5294CDB62DB28FBB486DE077DAF248FB32BE286A.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #400F656F4251142032FB4C989B33F2ED84E7673BF6D2DDA34EB936839977BC1DBE#)
+ (d #12F8EC3BD83533A35D9ABE9A9100E9A41C68E4BF9247552409259F365C913D03#)
+ ))
+Created: 20150822T113710
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
deleted file mode 100644
index 85ca78da04..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5B2B6633E89C0BD58A0FA2C785A31EAA96278695.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5B2B6633E89C0BD58A0FA2C785A31EAA96278695.key
new file mode 100644
index 0000000000..89c2fb779d
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5B2B6633E89C0BD58A0FA2C785A31EAA96278695.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #403C440DA39CEB741E321784F06DB254552919F71B20EF9ED031F0FA02D6D5F661#)
+ (d #4163D84B6D1B3241A23A03B1BACA8697766C8AA1A964676E7B15C84DFF9215B0#)
+ ))
+Created: 20141121T150116
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/61F5836DA69D9F63059D2665451F18E4346DF43A.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/61F5836DA69D9F63059D2665451F18E4346DF43A.key
new file mode 100644
index 0000000000..955ae5a046
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/61F5836DA69D9F63059D2665451F18E4346DF43A.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #4006D1FF44AAE3A141CFC2018E7DDF1F97311B4939768E0F0BC7EE19150DB11D05#)
+ (d #2E1202F780E0C11F3F99176CBF786538D98465B1EC432E4D70CDFEA307012667#)
+ ))
+Created: 20141118T190135
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
deleted file mode 100644
index 79f3cd2b84..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/64CA92780975EEB798D2083FF25AFD43A4033DB7.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/64CA92780975EEB798D2083FF25AFD43A4033DB7.key
new file mode 100644
index 0000000000..e5e07e6548
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/64CA92780975EEB798D2083FF25AFD43A4033DB7.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #4089CBD8F3505333F4366B6CEC9C77984501D01A656E3835FE5E48AC68C485448D#)
+ (d #892D99E44F5DF2DE2E78ED7B92D321422876125ED53159C80EDE105058EBA119#)
+ ))
+Created: 20111230T230130
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
deleted file mode 100644
index 2b464f0ccb..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
deleted file mode 100644
index 28a07668b2..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7A788436224049A2FE1E446E16B70DB012C830BB.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7A788436224049A2FE1E446E16B70DB012C830BB.key
new file mode 100644
index 0000000000..4df0858b89
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7A788436224049A2FE1E446E16B70DB012C830BB.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #409BA575D98C4F4F414AFF624CE0E63882099BDEA95261963C9A0C1185D2D5261C#)
+ (d #62A2816B08C1489F5978E36725E3A1D844EA5CD0DD95FBD64208ABBD809DDE50#)
+ ))
+Created: 20141118T185800
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
deleted file mode 100644
index 137659693b..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
deleted file mode 100644
index c99824ccd4..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/8865328E25351B0D7697D4156A13497174F999D5.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/8865328E25351B0D7697D4156A13497174F999D5.key
new file mode 100644
index 0000000000..d1faca4208
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/8865328E25351B0D7697D4156A13497174F999D5.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40BBF4FB0A5BD7D8C29C1FC6DF99A14930805025C9B8161535913F7B9486049C69#)
+ (d #6AB812F3623F8D8F7E20DC5072D765655EFD719DDC36A0CE38336C26D7466D40#)
+ ))
+Created: 20121130T230051
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/9504643B1FB8AAC7529134D1565DF8B4ECA01E35.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/9504643B1FB8AAC7529134D1565DF8B4ECA01E35.key
new file mode 100644
index 0000000000..711b4994cf
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/9504643B1FB8AAC7529134D1565DF8B4ECA01E35.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40E940D65F4BEC8205787968C2BD5B8BBAA8CF49A7ED1A2F0216E1CD595E363243#)
+ (d #5E90072772C99862227F8A8335C71DA603A3CE8E8C84F82626DD72CE6AF91950#)
+ ))
+Created: 20101231T230030
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
deleted file mode 100644
index ca12840895..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A6BC0634D18962998AB53A0134DD2AD0DC4E0782.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A6BC0634D18962998AB53A0134DD2AD0DC4E0782.key
new file mode 100644
index 0000000000..4d8a2da326
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A6BC0634D18962998AB53A0134DD2AD0DC4E0782.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #401619EB6E565EA32E569C4AB914A9631288FD0E01802835AD00362FDACC90A171#)
+ (d #71C77142D31B30081D28CD6EF9897B8808527FF1E511DF6EEF6ED23FF49C64B8#)
+ ))
+Created: 20120101T230044
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
deleted file mode 100644
index 06adc06c42..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/BCFF2771AD5F49BEC185CDED47EC47D15550CB93.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/BCFF2771AD5F49BEC185CDED47EC47D15550CB93.key
new file mode 100644
index 0000000000..52e1aaa9ba
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/BCFF2771AD5F49BEC185CDED47EC47D15550CB93.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #404CD8B5371C0868C770EC91255E5703812174BED5AD019C58C0BAE9DA0383EB67#)
+ (d #6C05D0EFE8281C1D22A7E652DCCF33FF24C4DB7291D1B772FAE469D95BC4D81E#)
+ ))
+Created: 20150822T111645
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
deleted file mode 100644
index cf9a60d233..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C36C6A8B40A2179CFE83CB0C2827358AB171CDFD.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C36C6A8B40A2179CFE83CB0C2827358AB171CDFD.key
new file mode 100644
index 0000000000..2c491e5361
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C36C6A8B40A2179CFE83CB0C2827358AB171CDFD.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #404B32D4946068A43D436843191272244F5FD661A624E2F3BAAA5B48158C14C12A#)
+ (d #6FD7F940800F8749B7709638BC020B8BA6CD7072967D9E456A39C4FCF2C09798#)
+ ))
+Created: 20111230T230130
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
deleted file mode 100644
index 0ed35172fe..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
deleted file mode 100644
index 9061f67512..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
deleted file mode 100644
index 89f6013100..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CF723A68027A82B538F04BF4A2A1323D1B3E095C.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CF723A68027A82B538F04BF4A2A1323D1B3E095C.key
new file mode 100644
index 0000000000..5e431d38a8
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CF723A68027A82B538F04BF4A2A1323D1B3E095C.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40D5985FA4E3038AD26D8685213A0ADDBB87A065B228D7D2853572FE9716ABD813#)
+ (d #42441AEA366A281B481E1993A0FECA94B487AE2C13734704797131C8F3CACB68#)
+ ))
+Created: 20150822T111645
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/D6A2C195DEBA3506F0ECFBE3DDD7C57F6913DC7C.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/D6A2C195DEBA3506F0ECFBE3DDD7C57F6913DC7C.key
new file mode 100644
index 0000000000..8ed162c023
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/D6A2C195DEBA3506F0ECFBE3DDD7C57F6913DC7C.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #40B1F1895AB187AC68A375C6604BB75F1B995BD9C36F14BAC8115F7A4E7E26F6EB#)
+ (d #7DDE136B2995E97E279A7CF8D193468742D56451D70C8EA8DEAE69BDEBFECBA2#)
+ ))
+Created: 20141118T185800
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/DB8C922A471E08FAF083EC2465AFB4063904C282.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/DB8C922A471E08FAF083EC2465AFB4063904C282.key
new file mode 100644
index 0000000000..969c2ec690
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/DB8C922A471E08FAF083EC2465AFB4063904C282.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40ACCC6083DE0BE9E0CD37E47B305B0AD7611AA100BD7D0BBDA489489BB0A96B10#)
+ (d #4A015D5FF823AD615F618117FD465FD515D8A6F6D1788546E46E5E2F68CA8578#)
+ ))
+Created: 20111231T230214
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E0C3163E69C57319C6038F9EBE14F5D55DE553F7.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E0C3163E69C57319C6038F9EBE14F5D55DE553F7.key
new file mode 100644
index 0000000000..1e4cef029f
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E0C3163E69C57319C6038F9EBE14F5D55DE553F7.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Curve25519)(flags djb-tweak)(q
+ #40E67DD44B95A0B37286E0B7812C6AE59FD37B487323496D2FD02ADF184722EF3A#)
+ (d #55AA402F49A1896142FC1E3311C5FC734820301ADE06D1F339C8DDF0351FAC20#)
+ ))
+Created: 20141118T190135
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
deleted file mode 100644
index 41dac37574..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/ECB164A45A1D5C5078508A9869DF6DB84DEA543B.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/ECB164A45A1D5C5078508A9869DF6DB84DEA543B.key
new file mode 100644
index 0000000000..6447ec553a
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/ECB164A45A1D5C5078508A9869DF6DB84DEA543B.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #40964BF2C5B3BE05C4F82CCC49BA0A40B090AB03C9A4076B096115D1C61A47C470#)
+ (d #1ECC4B3E224D9A07FDA2B3B041729949B02F86F8284688D6E640D64B138FECE0#)
+ ))
+Created: 20141121T150116
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
deleted file mode 100644
index 5df7b4a595..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
deleted file mode 100644
index 03daf80975..0000000000
Binary files
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
and /dev/null differ
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4E86D61A71E9CE6B0DBC65C5121846E542913B9.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4E86D61A71E9CE6B0DBC65C5121846E542913B9.key
new file mode 100644
index 0000000000..a95f02bd3a
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4E86D61A71E9CE6B0DBC65C5121846E542913B9.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #4017C963514FEF755C31DA3805DA2C4855F3E335048E3BD91038FA79B743FC1993#)
+ (d #5CDC629D6C26FD0E943792EFF739A5E633DCF506E3C587F58806D59ED346F631#)
+ ))
+Created: 20111231T230214
diff --git
a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/FE38C61A8DB32297C7C3C18E7A837D7B70263BC7.key
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/FE38C61A8DB32297C7C3C18E7A837D7B70263BC7.key
new file mode 100644
index 0000000000..ad4078fefd
--- /dev/null
+++
b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/FE38C61A8DB32297C7C3C18E7A837D7B70263BC7.key
@@ -0,0 +1,5 @@
+Key: (private-key (ecc (curve Ed25519)(flags eddsa)(q
+ #400D3537C332AF3DA91B8A186A8294CB663D8FABCBE26CD57255AEB3EFA4F4A49A#)
+ (d #978A174337FDA5815C221F379BDF657B90E779C9C5E085DE8160BABA695749C5#)
+ ))
+Created: 20111231T230149
diff --git a/test/lisp/gnus/mml-sec-resources/pubring.gpg
b/test/lisp/gnus/mml-sec-resources/pubring.gpg
index 6bd169963d..579ca74999 100644
Binary files a/test/lisp/gnus/mml-sec-resources/pubring.gpg and
b/test/lisp/gnus/mml-sec-resources/pubring.gpg differ
diff --git a/test/lisp/gnus/mml-sec-resources/secring.gpg
b/test/lisp/gnus/mml-sec-resources/secring.gpg
index b323c072c0..005f9485ae 100644
Binary files a/test/lisp/gnus/mml-sec-resources/secring.gpg and
b/test/lisp/gnus/mml-sec-resources/secring.gpg differ
diff --git a/test/lisp/gnus/mml-sec-resources/trustdb.gpg
b/test/lisp/gnus/mml-sec-resources/trustdb.gpg
index 09ebd8db11..132c0bb71c 100644
Binary files a/test/lisp/gnus/mml-sec-resources/trustdb.gpg and
b/test/lisp/gnus/mml-sec-resources/trustdb.gpg differ
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index f308a61764..e4e607b70e 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -199,7 +199,7 @@ In both cases, the first key is customized for signing and
encryption."
(let* ((mml-secure-key-preferences
'((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
(pcontext (epg-make-context 'OpenPGP))
- (pkey (epg-list-keys pcontext "C3999CF1268DBEA2"))
+ (pkey (epg-list-keys pcontext "2FAF8726121EB3C6"))
(scontext (epg-make-context 'CMS))
(skey (epg-list-keys scontext "0x479DC6E2")))
(mml-secure-cust-record-keys pcontext 'encrypt "sub@example.org" pkey)
@@ -259,17 +259,17 @@ In both cases, the first key is customized for signing
and encryption."
(should-not (mml-secure-check-sub-key context (car keys5) 'sign))
;; The next key has multiple subkeys.
- ;; 42466F0F is valid sign subkey, 501FFD98 is expired
- (should (mml-secure-check-sub-key context (car keys6) 'sign "42466F0F"))
+ ;; 167C1C27A9D25305 is valid sign subkey, 2DD796DBDAC43424 is expired
+ (should (mml-secure-check-sub-key context (car keys6) 'sign
"167C1C27A9D25305"))
(should-not
- (mml-secure-check-sub-key context (car keys6) 'sign "501FFD98"))
- ;; DC7F66E7 is encrypt subkey
+ (mml-secure-check-sub-key context (car keys6) 'sign "2DD796DBDAC43424"))
+ ;; 8D850AA2B34936F9 is encrypt subkey
(should
- (mml-secure-check-sub-key context (car keys6) 'encrypt "DC7F66E7"))
+ (mml-secure-check-sub-key context (car keys6) 'encrypt
"8D850AA2B34936F9"))
(should-not
- (mml-secure-check-sub-key context (car keys6) 'sign "DC7F66E7"))
+ (mml-secure-check-sub-key context (car keys6) 'sign "8D850AA2B34936F9"))
(should-not
- (mml-secure-check-sub-key context (car keys6) 'encrypt "42466F0F"))
+ (mml-secure-check-sub-key context (car keys6) 'encrypt
"167C1C27A9D25305"))
;; The final key is just a public key.
(should (mml-secure-check-sub-key context (car keys7) 'encrypt))
@@ -305,9 +305,9 @@ In both cases, the first key is customized for signing and
encryption."
;; Expired key should not be usable.
;; Will fail for Ma Gnus v0.14 and earlier.
- ;; sign@example.org has the expired subkey 0x501FFD98.
+ ;; sign@example.org has the expired subkey 0x2DD796DBDAC43424.
(should-not
- (mml-secure-find-usable-keys context "0x501FFD98" 'sign))
+ (mml-secure-find-usable-keys context "0x2DD796DBDAC43424" 'sign))
(should
(mml-secure-find-usable-keys context "no-exp@example.org" 'encrypt))
@@ -355,16 +355,16 @@ In both cases, the first key is customized for signing
and encryption."
;; Search works with key IDs, with and without prefix "0x".
(should
(= 1 (length (mml-secure-find-usable-keys
- context "A142FD84" 'encrypt))))
+ context "CA9EA5175C9043FB" 'encrypt))))
(should
(= 1 (length (mml-secure-find-usable-keys
- context "0xA142FD84" 'encrypt))))
+ context "0xCA9EA5175C9043FB" 'encrypt))))
(should
(= 0 (length (mml-secure-find-usable-keys
- context "A142FD84" 'sign))))
+ context "CA9EA5175C9043FB" 'sign))))
(should
(= 0 (length (mml-secure-find-usable-keys
- context "0xA142FD84" 'sign))))
+ context "0xCA9EA5175C9043FB" 'sign))))
))))
(ert-deftest mml-secure-select-preferred-keys-1 ()
@@ -373,7 +373,7 @@ In both cases, the first key is customized for signing and
encryption."
(mml-secure-test-fixture
(lambda ()
(let ((context (epg-make-context 'OpenPGP)))
- (should (equal "832F3CC6518D37BC658261B802372A42CA6D40FB"
+ (should (equal "0281C7D97E90771C0D9A61BFA049C1E9179C086B"
(mml-secure-fingerprint
(car (mml-secure-select-preferred-keys
context '("no-exp@example.org") 'encrypt)))))))))
@@ -413,18 +413,18 @@ In both cases, the first key is customized for signing
and encryption."
(let ((context (epg-make-context 'OpenPGP))
(mml-secure-key-preferences
'((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
- ;; sub@example.org has two keys (268DBEA2, AE31D471).
+ ;; sub@example.org has two keys (2FAF8726121EB3C6, 8E7FEE76BB1FB195).
;; Normal preference works.
(mml-secure-cust-record-keys
- context 'encrypt "sub@example.org" (epg-list-keys context "268DBEA2"))
+ context 'encrypt "sub@example.org" (epg-list-keys context
"2FAF8726121EB3C6"))
(should (mml-secure-select-preferred-keys
context '("sub@example.org") 'encrypt))
(mml-secure-cust-remove-keys context 'encrypt "sub@example.org")
- ;; Fake preference for expired (unrelated) key CE15FAE7,
+ ;; Fake preference for expired (unrelated) key 22F24E21C5010683,
;; results in error (and automatic removal of outdated preference).
(mml-secure-cust-record-keys
- context 'encrypt "sub@example.org" (epg-list-keys context "CE15FAE7"))
+ context 'encrypt "sub@example.org" (epg-list-keys context
"22F24E21C5010683"))
(should-error (mml-secure-select-preferred-keys
context '("sub@example.org") 'encrypt))
(should-not
@@ -438,8 +438,8 @@ In both cases, the first key is customized for signing and
encryption."
(lambda ()
(let ((pcontext (epg-make-context 'OpenPGP))
(scontext (epg-make-context 'CMS))
- (pkeys '("1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"
- "14632ECAB9E227369C8DD97BF7E79AB7AE31D471"))
+ (pkeys '("4D661F67B8BC4F7F1C53C2232FAF8726121EB3C6"
+ "EB67A6310389C9AE8A5695908E7FEE76BB1FB195"))
(skeys '("0x5F88E9FC" "0x479DC6E2"))
(mml-secure-key-preferences
'((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
@@ -456,17 +456,17 @@ In both cases, the first key is customized for signing
and encryption."
pcontext 'sign "sub@example.org")))
(should (= 2 (length p-e-fprs)))
(should (= 2 (length p-s-fprs)))
- (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-e-fprs))
- (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-e-fprs))
- (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-s-fprs))
- (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-s-fprs)))
+ (should (member "4D661F67B8BC4F7F1C53C2232FAF8726121EB3C6" p-e-fprs))
+ (should (member "EB67A6310389C9AE8A5695908E7FEE76BB1FB195" p-e-fprs))
+ (should (member "4D661F67B8BC4F7F1C53C2232FAF8726121EB3C6" p-s-fprs))
+ (should (member "EB67A6310389C9AE8A5695908E7FEE76BB1FB195" p-s-fprs)))
;; Duplicate record does not change anything.
(mml-secure-cust-record-keys
pcontext 'encrypt "sub@example.org"
- (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+ (epg-list-keys pcontext "4D661F67B8BC4F7F1C53C2232FAF8726121EB3C6"))
(mml-secure-cust-record-keys
pcontext 'sign "sub@example.org"
- (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+ (epg-list-keys pcontext "4D661F67B8BC4F7F1C53C2232FAF8726121EB3C6"))
(let ((p-e-fprs (mml-secure-cust-fpr-lookup
pcontext 'encrypt "sub@example.org"))
(p-s-fprs (mml-secure-cust-fpr-lookup
@@ -524,10 +524,10 @@ Pass optional INTERACTIVE to
mml-secure-test-mail-fixture."
(concat "Good signature from "
(if (eq protocol 'CMS)
"0E58229B80EE33959FF718FEEF25402B479DC6E2"
- "02372A42CA6D40FB"))
+ "A049C1E9179C086B"))
gnus-info)))
(dolist (fpr signer-fprs nil)
- ;; OpenPGP: "Good signature from 02372A42CA6D40FB No Expiry
<no-exp@example.org> (trust undefined) created ..."
+ ;; OpenPGP: "Good signature from A049C1E9179C086B No Expiry
<no-exp@example.org> (trust undefined) created ..."
;; S/MIME: "Good signature from
D06AA118653CC38E9D0CAF56ED7A2135E1582177 /CN=No Expiry (trust full) ..."
(should (string-match-p
(concat "Good signature from "
@@ -586,7 +586,7 @@ In this test, the single matching key is chosen
automatically."
;; no-exp@example.org with single encryption key
(mml-secure-test-en-decrypt
method "no-exp@example.org" "sub@example.org" nil t
- (list (cons "02372A42CA6D40FB" "ED7A2135E1582177")))))
+ (list (cons "A049C1E9179C086B" "ED7A2135E1582177")))))
(ert-deftest mml-secure-en-decrypt-2 ()
"Encrypt message; then decrypt and test for expected result.
@@ -600,7 +600,7 @@ In this test, the encryption key needs to fixed among
multiple ones."
(dolist (method (enc-standards) nil)
(mml-secure-test-en-decrypt
method "sub@example.org" "no-exp@example.org" nil t
- (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")))))))
+ (list (cons "2FAF8726121EB3C6" "EF25402B479DC6E2")))))))
(ert-deftest mml-secure-en-decrypt-3 ()
"Encrypt message; then decrypt and test for expected result.
@@ -619,8 +619,8 @@ In this test, encrypt-to-self variables are set to t."
(dolist (method (enc-standards) nil)
(mml-secure-test-en-decrypt
method "sub@example.org" "no-exp@example.org" nil t
- (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
- (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))))))
+ (list (cons "2FAF8726121EB3C6" "EF25402B479DC6E2")
+ (cons "A049C1E9179C086B" "ED7A2135E1582177"))))))))
(ert-deftest mml-secure-en-decrypt-4 ()
"Encrypt message; then decrypt and test for expected result.
@@ -628,14 +628,14 @@ In this test, encrypt-to-self variables are set to lists."
(skip-unless (test-conf))
;; Send from sub@example.org, which has two keys; encrypt to both.
(let ((mml-secure-openpgp-encrypt-to-self
- '("C3999CF1268DBEA2" "F7E79AB7AE31D471"))
+ '("2FAF8726121EB3C6" "8E7FEE76BB1FB195"))
(mml-secure-smime-encrypt-to-self
'("EF25402B479DC6E2" "4035D59B5F88E9FC")))
(dolist (method (enc-standards) nil)
(mml-secure-test-en-decrypt
method "no-exp@example.org" "sub@example.org" nil t
- (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
- (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC"))))))
+ (list (cons "2FAF8726121EB3C6" "EF25402B479DC6E2")
+ (cons "8E7FEE76BB1FB195" "4035D59B5F88E9FC"))))))
(ert-deftest mml-secure-en-decrypt-sign-1-1-single ()
"Sign and encrypt message; then decrypt and test for expected result.
@@ -672,7 +672,7 @@ In this test, just multiple encryption and signing keys may
be available."
(mml-secure-smime-sign-with-sender t))
;; Now use both keys to sign. The customized one via sign-with-sender,
;; the other one via the following setting.
- (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471"))
+ (let ((mml-secure-openpgp-signers '("8E7FEE76BB1FB195"))
(mml-secure-smime-signers '("0x5F88E9FC")))
(dolist (method (enc-sign-standards) nil)
(mml-secure-test-en-decrypt
@@ -690,7 +690,7 @@ In this test, just multiple encryption and signing keys may
be available."
(let ((mml-secure-openpgp-sign-with-sender nil)
(mml-secure-smime-sign-with-sender nil)
(mml-secure-openpgp-signers
- '("F7E79AB7AE31D471" "C3999CF1268DBEA2"))
+ '("8E7FEE76BB1FB195" "2FAF8726121EB3C6"))
(mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2")))
(dolist (method (enc-sign-standards) nil)
(mml-secure-test-en-decrypt
@@ -709,7 +709,7 @@ In this test, lists of encryption and signing keys are
customized."
(scontext (epg-make-context 'CMS))
(mml-secure-openpgp-sign-with-sender t)
(mml-secure-smime-sign-with-sender t))
- (dolist (key '("F7E79AB7AE31D471" "C3999CF1268DBEA2") nil)
+ (dolist (key '("8E7FEE76BB1FB195" "2FAF8726121EB3C6") nil)
(mml-secure-cust-record-keys
pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key))
(mml-secure-cust-record-keys
@@ -745,8 +745,8 @@ Use sign-with-sender and encrypt-to-self."
(dolist (method (enc-sign-standards) nil)
(mml-secure-test-en-decrypt
method "sub@example.org" "no-exp@example.org" 1 t
- (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
- (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))
+ (list (cons "2FAF8726121EB3C6" "EF25402B479DC6E2")
+ (cons "A049C1E9179C086B" "ED7A2135E1582177"))))
))))
(ert-deftest mml-secure-sign-verify-1 ()
@@ -765,7 +765,7 @@ Use sign-with-sender and encrypt-to-self."
;; From sub@example.org, sign with two keys;
;; sign-with-sender and one from signers-variable:
- (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB"))
+ (let ((mml-secure-openpgp-signers '("A049C1E9179C086B"))
(mml-secure-smime-signers
'("D06AA118653CC38E9D0CAF56ED7A2135E1582177")))
(mml-secure-test-en-decrypt
@@ -781,7 +781,7 @@ With Ma Gnus v0.14 and earlier a signature would be created
with a wrong key."
(lambda ()
(let ((with-smime nil)
(mml-secure-openpgp-sign-with-sender nil)
- (mml-secure-openpgp-signers '("501FFD98")))
+ (mml-secure-openpgp-signers '("2DD796DBDAC43424")))
(dolist (method (sign-standards) nil)
(mml-secure-test-en-decrypt
method "no-exp@example.org" "sign@example.org" 1 nil)
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 833c32ffb2..0fcaacb644 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -181,8 +181,12 @@ M-g M-c switch-to-completions
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
(with-substitute-command-keys-test
+ ;; Global binding should be found even if specifying a specific map
(test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
- (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
+ (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")
+ ;; Specific map overrides advertised-binding
+ (test "\\<undo-repeat-map>\\[undo]" "u")
+ (test "\\[undo]" "C-x u")))
(defvar-keymap help-tests-remap-map
:full t
@@ -200,25 +204,45 @@ M-g M-c switch-to-completions
"\nUses keymap [`'‘]foobar-map['’], which is not currently
defined.\n")))
(ert-deftest help-tests-substitute-command-keys/quotes ()
- (with-substitute-command-keys-test
+ (with-substitute-command-keys-test
+ (let ((text-quoting-style 'curve))
+ (test "quotes ‘like this’" "quotes ‘like this’")
+ (test "`x'" "‘x’")
+ (test "`" "‘")
+ (test "'" "’")
+ (test "\\`" "\\‘"))
+ (let ((text-quoting-style 'straight))
+ (test "quotes `like this'" "quotes 'like this'")
+ (test "`x'" "'x'")
+ (test "`" "'")
+ (test "'" "'")
+ (test "\\`" "\\'"))
+ (let ((text-quoting-style 'grave))
+ (test "quotes `like this'" "quotes `like this'")
+ (test "`x'" "`x'")
+ (test "`" "`")
+ (test "'" "'")
+ (test "\\`" "\\`"))))
+
+(ert-deftest help-tests-substitute-quotes ()
(let ((text-quoting-style 'curve))
- (test "quotes ‘like this’" "quotes ‘like this’")
- (test "`x'" "‘x’")
- (test "`" "‘")
- (test "'" "’")
- (test "\\`" "\\‘"))
+ (should (string= (substitute-quotes "quotes ‘like this’") "quotes ‘like
this’"))
+ (should (string= (substitute-quotes "`x'") "‘x’"))
+ (should (string= (substitute-quotes "`") "‘"))
+ (should (string= (substitute-quotes "'") "’"))
+ (should (string= (substitute-quotes "\\`") "\\‘")))
(let ((text-quoting-style 'straight))
- (test "quotes `like this'" "quotes 'like this'")
- (test "`x'" "'x'")
- (test "`" "'")
- (test "'" "'")
- (test "\\`" "\\'"))
+ (should (string= (substitute-quotes "quotes `like this'") "quotes 'like
this'"))
+ (should (string= (substitute-quotes "`x'") "'x'"))
+ (should (string= (substitute-quotes "`") "'"))
+ (should (string= (substitute-quotes "'") "'"))
+ (should (string= (substitute-quotes "\\`") "\\'")))
(let ((text-quoting-style 'grave))
- (test "quotes `like this'" "quotes `like this'")
- (test "`x'" "`x'")
- (test "`" "`")
- (test "'" "'")
- (test "\\`" "\\`"))))
+ (should (string= (substitute-quotes "quotes `like this'") "quotes `like
this'"))
+ (should (string= (substitute-quotes "`x'") "`x'"))
+ (should (string= (substitute-quotes "`") "`"))
+ (should (string= (substitute-quotes "'") "'"))
+ (should (string= (substitute-quotes "\\`") "\\`"))))
(ert-deftest help-tests-substitute-command-keys/literals ()
(with-substitute-command-keys-test
diff --git a/test/lisp/image-dired-tests.el
b/test/lisp/image/image-dired-tests.el
similarity index 100%
rename from test/lisp/image-dired-tests.el
rename to test/lisp/image/image-dired-tests.el
diff --git a/test/lisp/image/image-dired-util-tests.el
b/test/lisp/image/image-dired-util-tests.el
new file mode 100644
index 0000000000..63d42f56de
--- /dev/null
+++ b/test/lisp/image/image-dired-util-tests.el
@@ -0,0 +1,71 @@
+;;; image-dired-util-tests.el --- Tests for image-dired.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 'ert)
+(require 'ert-x)
+(require 'image-dired)
+(require 'image-dired-util)
+(require 'xdg)
+
+(ert-deftest image-dired-thumb-name/standard ()
+ (let ((image-dired-thumbnail-storage 'standard))
+ (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg")))
+ (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg")))
+ (should (equal
+ (file-name-directory (image-dired-thumb-name "foo.jpg"))
+ (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg"))))
+ (should (string-search (xdg-cache-home)
+ (image-dired-thumb-name "foo.jpg")))
+ (should (string-match (rx (in "0-9a-f") ".png")
+ (image-dired-thumb-name "foo.jpg")))))
+
+(ert-deftest image-dired-thumb-name/image-dired ()
+ ;; Avoid trying to create `image-dired-dir'.
+ (ert-with-temp-directory dir
+ (let ((image-dired-dir dir)
+ (image-dired-thumbnail-storage 'image-dired))
+ (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg")))
+ (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg")))
+ (should (equal
+ (file-name-directory (image-dired-thumb-name "foo.jpg"))
+ (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg"))))
+ (should (equal (file-name-nondirectory
+ ;; The checksum is based on the file name.
+ (image-dired-thumb-name "/some/path/foo.jpg"))
+ "dc4e6f7068157023e7f2e8362d15bdd2e3ca89e4.jpg"))
+ (should (equal (file-name-extension
+ (image-dired-thumb-name "foo.gif"))
+ "jpg")))))
+
+(ert-deftest image-dired-thumb-name/per-directory ()
+ (let ((image-dired-thumbnail-storage 'per-directory))
+ (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg")))
+ (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg")))
+ (should (equal
+ (file-name-nondirectory (image-dired-thumb-name "foo.jpg"))
+ (file-name-nondirectory (image-dired-thumb-name "/tmp/foo.jpg"))))
+ (should (equal (file-name-split (image-dired-thumb-name "/tmp/foo.jpg"))
+ '("" "tmp" ".image-dired" "foo.jpg.thumb.jpg")))
+ (should (equal (file-name-nondirectory
+ (image-dired-thumb-name "foo.jpg"))
+ "foo.jpg.thumb.jpg"))))
+
+;;; image-dired-util-tests.el ends here
diff --git a/test/lisp/image/wallpaper-tests.el
b/test/lisp/image/wallpaper-tests.el
new file mode 100644
index 0000000000..a5d3343bd4
--- /dev/null
+++ b/test/lisp/image/wallpaper-tests.el
@@ -0,0 +1,184 @@
+;;; wallpaper-tests.el --- tests for wallpaper.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 'ert)
+(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)))))
+
+(ert-deftest wallpaper--find-command-args/return-list ()
+ (should (or (not (wallpaper--find-command-args))
+ (listp (wallpaper--find-command-args)))))
+
+(ert-deftest wallpaper--image-file-regexp/return-string ()
+ (should (stringp (wallpaper--image-file-regexp))))
+
+(ert-deftest wallpaper--get-default-file/empty-gives-nil ()
+ (with-temp-buffer
+ (should-not (wallpaper--get-default-file))))
+
+(ert-deftest wallpaper--get-default-file/visiting-file ()
+ (ert-with-temp-file _
+ :buffer buf
+ :suffix (format ".%s" (car image-file-name-extensions))
+ (with-current-buffer buf
+ (should (wallpaper--get-default-file)))))
+
+(ert-deftest wallpaper--get-default-file/file-at-point ()
+ ;; ffap needs the file to exist
+ (ert-with-temp-file fil
+ :buffer buf
+ :suffix (format ".%s" (car image-file-name-extensions))
+ (with-current-buffer buf
+ (insert fil)
+ (should (stringp (wallpaper--get-default-file))))))
+
+(ert-deftest wallpaper--format-arg/filename ()
+ (should (file-name-absolute-p (wallpaper--format-arg "%f" "foo.jpg"))))
+
+(ert-deftest wallpaper--format-arg/filename-hex ()
+ (should (equal (wallpaper--format-arg "%F" "foo bar åäö.jpg")
+ "foo%20bar%20%C3%A5%C3%A4%C3%B6.jpg")))
+
+(ert-deftest wallpaper--format-arg/width ()
+ (skip-unless noninteractive)
+ (should (equal (wallpaper--format-arg "%w" "foo.jpg")
+ (number-to-string wallpaper-default-width))))
+
+(ert-deftest wallpaper--format-arg/height ()
+ (skip-unless noninteractive)
+ (should (equal (wallpaper--format-arg "%h" "foo.jpg")
+ (number-to-string wallpaper-default-height))))
+
+(ert-deftest wallpaper--format-arg/screen ()
+ (skip-unless noninteractive)
+ (should (equal (wallpaper--format-arg "%S" "foo.jpg") "0")))
+
+(ert-deftest wallpaper--format-arg/monitor ()
+ (skip-unless noninteractive)
+ (should (equal (wallpaper--format-arg "%M" "foo.jpg") "0")))
+
+(ert-deftest wallpaper--format-arg/workspace ()
+ (skip-unless noninteractive)
+ (should (equal (wallpaper--format-arg "%W" "foo.jpg") "0")))
+
+;;; wallpaper-tests.el ends here
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/international/ucs-normalize-tests.el
b/test/lisp/international/ucs-normalize-tests.el
index 774a3ea7ec..9e359d5022 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -207,8 +207,17 @@ must be true for all conformant implementations:
16326 16327 16328 16329 16330 16331 16332 16333
16334 16335 16336 16337 16338 16339 16340 16341
16342 16343 16344 16345 16346 16347 16348 16349
- 16350 16351 16488 16489 16490 16491 16492 16493
- 16494 16495 16496 16497))
+ 16350 16351 16352 16353 16354 16355 16356 16357
+ 16358 16359 16360 16361 16362 16363 16364 16365
+ 16366 16367 16368 16369 16370 16371 16372 16373
+ 16374 16375 16376 16377 16378 16379 16380 16381
+ 16382 16383 16384 16385 16386 16387 16388 16389
+ 16390 16391 16392 16393 16394 16395 16396 16397
+ 16398 16399 16400 16401 16402 16403 16404 16405
+ 16406 16407 16408 16409 16410 16411 16412 16413
+ 16550 16551 16552 16553 16554 16555 16556 16557
+ 16488 16489 16490 16491 16492 16493 16494 16495
+ 16496 16497 16558 16559))
;; Keep a record of failures, for consulting afterwards (the ert
;; backtrace only shows a truncated version of these lists).
@@ -293,17 +302,19 @@ must be true for all conformant implementations:
17692 17693 17694 17707 17708 17713 17714 17715
17716 17727 17728 17733 17734 17739 17740 17745
17746 17749 17750 17753 17754 17759 17760 17767
- 17768 17807 17808 17809 17810 17811 17812 17813
- 17814 17816 17843 17844 17845 17846 17851 17852
- 17861 17875 17876 17879 17880 17899 17900 17911
- 17912 17913 17914 17915 17916 17917 17918 17919
- 17920 17921 17922 17927 17928 17929 17930 17931
- 17932 17933 17935 17937 17938 17939 17940 17941
- 17943 17945 17947 17949 17951 17952 17953 17955
- 17957 17959 17961 17962 17967 17968 17987 17988
- 17993 17994 18003 18004 18005 18006 18007 18008
- 18009 18010 18011 18012 18017 18018 18019 18020
- 18021 18022 18023 18024 18041 18042 18053 18054
+ 17768 17789 17790 17801 17802 17807 17808 17809
+ 17810 17811 17812 17813 17814 17815 17816 17821
+ 17822 17829 17830 17843 17844 17845 17846 17851
+ 17852 17861 17875 17876 17879 17880 17899 17900
+ 17097 17907 17908 17911 17912 17913 17914 17915
+ 17916 17917 17918 17919 17920 17921 17922 17927
+ 17928 17929 17930 17931 17932 17933 17935 17937
+ 17938 17939 17940 17941 17943 17945 17947 17949
+ 17951 17952 17953 17955 17957 17959 17961 17962
+ 17967 17968 17987 17988 17993 17994 18003 18004
+ 18005 18006 18007 18008 18009 18010 18011 18012
+ 18017 18018 18019 18020 18021 18022 18023 18024
+ 18041 18042 18049 18050 18053 18054 18055 18056
18069 18070 18079 18080 18163 18164 18165 18166
18171 18172 18175 18176 18211 18212 18219 18220
18221 18222 18223 18224 18225 18226 18301 18302
@@ -316,27 +327,37 @@ must be true for all conformant implementations:
18521 18523 18524 18525 18527 18528 18531 18537
18538 18539 18541 18543 18545 18547 18549 18550
18551 18553 18554 18555 18557 18558 18559 18560
- 18561 18563 18564 18565 18566 18567 18569 18571
- 18573 18575 18577 18579 18581 18583 18585 18587
- 18589 18591 18593 18595 18596 18597 18599 18601
- 18602 18603 18605 18606 18607 18609 18611 18612
- 18613 18615 18617 18618 18619 18621 18623 18624
- 18625 18627 18629 18631 18633 18635 18636 18637
- 18639 18641 18643 18645 18647 18649 18651 18653
- 18655 18657 18659 18661 18663 18665 18667 18668
- 18669 18670 18671 18674 18676 18686 18688 18690
- 18692 18694 18695 18696 18697 18698 18699 18700
- 18701 18702 18703 18704 18705 18706 18707 18708
- 18709 18710 18721 18722 18723 18724 18739 18741
- 18743 18745 18747 18749 18751 18753 18755 18757
- 18759 18761 18763 18765 18767 18769 18771 18773
- 18775 18777 18779 18781 18783 18785 18787 18789
- 18791 18793 18795 18797 18799 18801 18803 18805
- 18807 18809 18811 18813 18815 18817 18819 18821
- 18823 18825 18827 18829 18831 18833 18835 18837
- 18839 18840 18841 18842 18843 18844 18845 18846
- 18847 18848 18849 18850 18851 18852 18853 18855
- 18857 18859 18861 18863 18865 18866))
+ 18561 18562 18563 18564 18565 18566 18567 18569
+ 18571 18573 18575 18577 18579 18581 18583 18585
+ 18587 18589 18591 18593 18595 18596 18597 18599
+ 18601 18602 18603 18605 18606 18607 18609 18611
+ 18612 18613 18615 18617 18618 18619 18621 18622
+ 18623 18624 18625 18626 18627 18628 18629 18631
+ 18632 18633 18634 18635 18636 18637 18639 18641
+ 18643 18645 18647 18649 18651 18653 18655 18657
+ 18659 18661 18663 18664 18665 18667 18668 18669
+ 18670 18671 18673 18674 18675 18676 18677 18679
+ 18680 18681 18683 18685 18686 18687 18688 18689
+ 18690 18691 18692 18693 18694 18695 18696 18697
+ 18698 18699 18700 18701 18702 18703 18704 18705
+ 18706 18707 18708 18709 18710 18711 18712 18713
+ 18714 18715 18717 18719 18721 18722 18723 18724
+ 18725 18727 18729 18731 18733 18735 18737 18739
+ 18740 18741 18742 18743 18745 18747 18749 18751
+ 18753 18755 18757 18759 18761 18763 18765 18767
+ 18769 18771 18773 18775 18777 18779 18781 18783
+ 18785 18787 18789 18791 18793 18795 18797 18799
+ 18801 18803 18805 18807 18809 18811 18813 18815
+ 18817 18819 18821 18823 18825 18827 18829 18831
+ 18833 18835 18837 18839 18840 18841 18842 18843
+ 18844 18845 18846 18847 18848 18849 18850 18851
+ 18852 18853 18855 18857 18859 18861 18863 18865
+ 18866 18867 18869 18871 18873 18875 18877 18879
+ 18881 18883 18885 18887 18888 18889 18891 18893
+ 18895 18897 18899 18901 18903 18905 18907 18909
+ 18911 18913 18914 18915 18916 18917 18918 18919
+ 18920 18921 18923 18925 18927 18929 18931 18933
+ 18935 18937 18939 18941 18943 18945 18947 18948))
(ert-deftest ucs-normalize-part2 ()
:tags '(:expensive-test)
diff --git a/test/lisp/md4-tests.el b/test/lisp/md4-tests.el
index fb7df652bc..d1f227cb90 100644
--- a/test/lisp/md4-tests.el
+++ b/test/lisp/md4-tests.el
@@ -29,7 +29,7 @@
(defun md4-tests-digest->hex (str)
"Print digest STR in hexadecimal."
- (mapconcat (lambda (x) (format "%02x" x)) str ""))
+ (mapconcat (lambda (x) (format "%02x" x)) str))
(ert-deftest md4-test-rfc1320 ()
"Verify the test suite results in RFC 1320.
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
new file mode 100644
index 0000000000..915006a97c
--- /dev/null
+++ b/test/lisp/net/eudc-tests.el
@@ -0,0 +1,155 @@
+;;; 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-tests.el ends here
diff --git a/test/lisp/net/hmac-md5-tests.el b/test/lisp/net/hmac-md5-tests.el
index ce08dd89d1..09bbb8015e 100644
--- a/test/lisp/net/hmac-md5-tests.el
+++ b/test/lisp/net/hmac-md5-tests.el
@@ -48,7 +48,7 @@
(should (equal (encode-hex-string
(hmac-md5 (decode-hex-string
(mapconcat (lambda (c) (concat (list c) "d"))
- (make-string 50 ?c) ""))
+ (make-string 50 ?c)))
(decode-hex-string
"0102030405060708090a0b0c0d0e0f10111213141516171819")))
"697eaf0aca3a3aea3a75164746ffaa79"))
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index 188706fc86..9e60a243b3 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -133,4 +133,409 @@
(mailcap-view-file (ert-resource-file "test.test")))
(should mailcap--test-result))))
+
+
+(ert-deftest mailcap-add-mailcap-entry-new-major ()
+ "Add a major entry not yet in ‘mailcap-mime-data’."
+ (let ((mailcap-mime-data))
+
+ ;; Add a new major entry to a empty ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major1" "minor1"
+ (list (cons 'viewer "viewer1"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major1"
+ ("minor1" . ((viewer . "viewer1")))))))
+
+ ;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major2" "minor2"
+ (list (cons 'viewer "viewer2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major2"
+ ("minor2" . ((viewer . "viewer2"))))
+ ("major1"
+ ("minor1" . ((viewer . "viewer1"))))))))
+
+ ;; Same spiel but with extra entries in INFO.
+ (let ((mailcap-mime-data))
+ ;; Add a new major entry to an empty ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major1" "minor1"
+ (list (cons 'viewer "viewer1")
+ (cons 'print "print1"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major1"
+ ("minor1" . ((viewer . "viewer1")
+ (print . "print1")))))))
+
+ ;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major2" "minor2"
+ (list (cons 'viewer "viewer2")
+ (cons 'print "print2")
+ (cons 'compose "compose2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major2"
+ ("minor2" . ((viewer . "viewer2")
+ (print . "print2")
+ (compose . "compose2"))))
+ ("major1"
+ ("minor1" . ((viewer . "viewer1")
+ (print . "print1")))))))))
+
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-empty-major ()
+ "Add a minor entry to a an empty major entry."
+ (let ((mailcap-mime-data (list (list "major"))))
+ (mailcap-add-mailcap-entry "major" "minor1"
+ (list (cons 'viewer "viewer1")
+ (cons 'print "print1"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor1" . ((viewer . "viewer1")
+ (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-non-empty-major ()
+ "Add a minor to a major entry containing already minor entries."
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor1"
+ (cons 'viewer "viewer1")
+ (cons 'test "test1")
+ (cons 'print "print1"))))))
+
+ (mailcap-add-mailcap-entry "major" "minor2"
+ (list (cons 'viewer "viewer2")
+ (cons 'test "test2")
+ (cons 'print "print2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor2" . ((viewer . "viewer2")
+ (test . "test2")
+ (print . "print2")))
+ ("minor1" . ((viewer . "viewer1")
+ (test . "test1")
+ (print . "print1")))))))
+
+ (mailcap-add-mailcap-entry "major" "minor3"
+ (list (cons 'viewer "viewer3")
+ (cons 'test "test3")
+ (cons 'compose "compose3"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor3" . ((viewer . "viewer3")
+ (test . "test3")
+ (compose . "compose3")))
+ ("minor2" . ((viewer . "viewer2")
+ (test . "test2")
+ (print . "print2")))
+ ("minor1" . ((viewer . "viewer1")
+ (test . "test1")
+ (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-various-major-positions ()
+ "Add a new minor entry to major entries at various positions
+in ‘mailcap-mime-data’."
+ (let ((mailcap-mime-data
+ (list
+ (list "major1"
+ (list "minor1.1"
+ (cons 'viewer "viewer1.1")
+ (cons 'print "print1.1")))
+ (list "major2"
+ (list "minor2.1"
+ (cons 'viewer "viewer2.1")
+ (cons 'print "print2.1")
+ (cons 'compose "compose2.1")))
+ (list "major3"
+ (list "minor3.1"
+ (cons 'viewer "viewer3.1")
+ (cons 'compose "compose3.1")))
+ (list "major4"
+ (list "minor4.1"
+ (cons 'viewer "viewer4.1")
+ (cons 'edit "edit4.1"))))))
+
+ ;; Add a minor entry to a major mode at the front of
+ ;; ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major1" "minor1.2"
+ (list (cons 'viewer "viewer1.2")
+ (cons 'test "test1.2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major1"
+ ("minor1.2" . ((viewer . "viewer1.2")
+ (test . "test1.2")))
+ ("minor1.1" . ((viewer . "viewer1.1")
+ (print . "print1.1"))))
+ ("major2"
+ ("minor2.1" . ((viewer . "viewer2.1")
+ (print . "print2.1")
+ (compose . "compose2.1"))))
+ ("major3"
+ ("minor3.1" . ((viewer . "viewer3.1")
+ (compose . "compose3.1"))))
+ ("major4"
+ ("minor4.1" . ((viewer . "viewer4.1")
+ (edit . "edit4.1")))))))
+
+ ;; Add a minor entry to a major mode in the middle of
+ ;; ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major3" "minor3.2"
+ (list (cons 'viewer "viewer3.2")
+ (cons 'test "test3.2")
+ (cons 'compose "compose3.2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major1"
+ ("minor1.2" . ((viewer . "viewer1.2")
+ (test . "test1.2")))
+ ("minor1.1" . ((viewer . "viewer1.1")
+ (print . "print1.1"))))
+ ("major2"
+ ("minor2.1" . ((viewer . "viewer2.1")
+ (print . "print2.1")
+ (compose . "compose2.1"))))
+ ("major3"
+ ("minor3.2" . ((viewer . "viewer3.2")
+ (test . "test3.2")
+ (compose . "compose3.2")))
+ ("minor3.1" . ((viewer . "viewer3.1")
+ (compose . "compose3.1"))))
+ ("major4"
+ ("minor4.1" . ((viewer . "viewer4.1")
+ (edit . "edit4.1")))))))
+
+ ;; Add a minor entry to a major mode at the end of
+ ;; ‘mailcap-mime-data’.
+ (mailcap-add-mailcap-entry "major4" "minor4.2"
+ (list (cons 'viewer "viewer4.2")
+ (cons 'test "test4.2")
+ (cons 'print "print4.2")
+ (cons 'compose "compose4.2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major1"
+ ("minor1.2" . ((viewer . "viewer1.2")
+ (test . "test1.2")))
+ ("minor1.1" . ((viewer . "viewer1.1")
+ (print . "print1.1"))))
+ ("major2"
+ ("minor2.1" . ((viewer . "viewer2.1")
+ (print . "print2.1")
+ (compose . "compose2.1"))))
+ ("major3"
+ ("minor3.2" . ((viewer . "viewer3.2")
+ (test . "test3.2")
+ (compose . "compose3.2")))
+ ("minor3.1" . ((viewer . "viewer3.1")
+ (compose . "compose3.1"))))
+ ("major4"
+ ("minor4.2" . ((viewer . "viewer4.2")
+ (test . "test4.2")
+ (print . "print4.2")
+ (compose . "compose4.2")))
+ ("minor4.1" . ((viewer . "viewer4.1")
+ (edit . "edit4.1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-with-test-differing-viewer ()
+ "Add a new entry for an already existing major/minor entry."
+
+ ;; The new and the existing entry have each a test info field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer1")
+ (cons 'test "test1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer2")
+ (cons 'test "test2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer2")
+ (test . "test2")))
+ ("minor" . ((viewer . "viewer1")
+ (test . "test1")
+ (print . "print1"))))))))
+
+ ;; Only the new entry has a test info field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer2")
+ (cons 'test "test2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer2")
+ (test . "test2")))
+ ("minor" . ((viewer . "viewer1")
+ (print . "print1"))))))))
+
+ ;; Only the existing entry has a test info field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer1")
+ (cons 'test "test1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer2")))
+ ("minor" . ((viewer . "viewer1")
+ (test . "test1")
+ (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-with-test-same-viewer ()
+ "Add a new entry for an already existing major/minor entry."
+ ;; Both the new and the existing entry have each a test info field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer")
+ (cons 'test "test1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer")
+ (cons 'test "test2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer")
+ (test . "test2")))
+ ("minor" . ((viewer . "viewer")
+ (test . "test1")
+ (print . "print1"))))))))
+
+ ;; Only the new entry has a test field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer")
+ (cons 'test "test2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer")
+ (test . "test2")))
+ ("minor" . ((viewer . "viewer")
+ (print . "print1"))))))))
+
+ ;; Only the existing entry has a test info field.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer")
+ (cons 'test "test1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer")))
+ ("minor" . ((viewer . "viewer")
+ (test . "test1")
+ (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-without-test-differing-viewer
()
+ "Add a new entry for an already existing major/minor entry."
+ ;; Both entries do not have test fields.
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer1")
+ (cons 'print "print1"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer2")
+ (cons 'compose "print2"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer2")
+ (compose . "print2")))
+ ("minor" . ((viewer . "viewer1")
+ (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-simple-merge ()
+ "Merge entries without tests (no extra info fields in the existing entry)."
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer"))
+ 'mailcap-mime-data)
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer"))))))))
+
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer")
+ (cons 'print "print"))
+ 'mailcap-mime-data)
+
+ (should (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer")
+ (print . "print")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-erroneous-merge ()
+ "Merge entries without tests (extra info fields in existing entry).
+
+In its current implementation ‘mailcap-add-mailcap-entry’ loses
+extra fields of an entry already existing in ‘mailcap-mime-data’.
+This test does not actually verify a correct result; it merely
+checks whether ‘mailcap-add-mailcap-entry’ behavior is still the
+incorrect one. As such, it can be satisfied by any other result
+than the expected and known wrong one, and its success does not
+help to verify the correct addition and merging of an entry."
+ :expected-result :failed
+
+ (let ((mailcap-mime-data
+ (list
+ (list "major"
+ (list "minor"
+ (cons 'viewer "viewer")
+ (cons 'print "print"))))))
+ (mailcap-add-mailcap-entry "major" "minor"
+ (list (cons 'viewer "viewer")
+ (cons 'edit "edit"))
+ 'mailcap-mime-data)
+ ;; Has the print field been lost?
+ (should-not (equal mailcap-mime-data
+ '(("major"
+ ("minor" . ((viewer . "viewer")
+ (edit . "edit")))))))))
+
+
;;; mailcap-tests.el ends here
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-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index f51037aabb..f8a0aa03e3 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -40,7 +40,8 @@
"Format for `ert-resource-directory'.")
(defvar ert-resource-directory-trim-left-regexp ""
"Regexp for `string-trim' (left) used by `ert-resource-directory'.")
- (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
+ (defvar ert-resource-directory-trim-right-regexp
+ (rx (? "-test" (? "s")) ".el")
"Regexp for `string-trim' (right) used by `ert-resource-directory'.")
(defmacro ert-resource-directory ()
@@ -615,13 +616,15 @@ This checks also `file-name-as-directory',
`file-name-directory',
(insert-directory tramp-archive-test-archive nil)
(goto-char (point-min))
(should
- (looking-at-p (regexp-quote tramp-archive-test-archive))))
+ (looking-at-p
+ (tramp-compat-rx (literal tramp-archive-test-archive)))))
(with-temp-buffer
(insert-directory tramp-archive-test-archive "-al")
(goto-char (point-min))
(should
(looking-at-p
- (format "^.+ %s$" (regexp-quote tramp-archive-test-archive)))))
+ (tramp-compat-rx
+ bol (+ nonl) blank (literal tramp-archive-test-archive) eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tramp-archive-test-archive)
@@ -629,15 +632,17 @@ This checks also `file-name-as-directory',
`file-name-directory',
(goto-char (point-min))
(should
(looking-at-p
- (concat
- ;; There might be a summary line.
- "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?"
- ;; We don't know in which order the files appear.
- (format
- "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
- (regexp-opt (directory-files tramp-archive-test-archive))
- (length (directory-files tramp-archive-test-archive)))))))
-
+ (rx-to-string
+ `(:
+ ;; There might be a summary line.
+ (? "total" (+ nonl) (+ digit) (? blank)
+ (? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
+ ;; We don't know in which order the files appear.
+ (= ,(length (directory-files tramp-archive-test-archive))
+ (+ nonl) blank
+ (regexp
+ ,(regexp-opt (directory-files tramp-archive-test-archive)))
+ (? " ->" (+ nonl)) "\n"))))))
;; Check error case.
(with-temp-buffer
(should-error
@@ -727,7 +732,7 @@ This tests also `access-file', `file-readable-p' and
`file-regular-p'."
(setq attr (directory-files-and-attributes tmp-name 'full))
(dolist (elt attr)
(should (equal (file-attributes (car elt)) (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name nil "\\`b"))
+ (setq attr (directory-files-and-attributes tmp-name nil (rx bos "b")))
(should (equal (mapcar #'car attr) '("bar"))))
;; Cleanup.
@@ -914,11 +919,15 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive
"foo")))
(should
(string-match
- (format
- "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s"
- (tramp-archive-file-name-p default-directory)
- (or (tramp-archive-file-name-p default-directory)
- (and enabled (tramp-archive-file-name-p file))))
+ (tramp-compat-rx
+ "tramp-archive loaded: "
+ (literal (symbol-name
+ (tramp-archive-file-name-p default-directory)))
+ (+ ascii)
+ "tramp-archive loaded: "
+ (literal (symbol-name
+ (or (tramp-archive-file-name-p default-directory)
+ (and enabled (tramp-archive-file-name-p file))))))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s --eval %s"
@@ -955,9 +964,10 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(dolist (tae '(t nil))
(should
(string-match
- (format
- "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded:
nil[[:ascii:]]+tramp-archive loaded: %s"
- tae)
+ (tramp-compat-rx
+ "tramp-archive loaded: nil" (+ ascii)
+ "tramp-archive loaded: nil" (+ ascii)
+ "tramp-archive loaded: " (literal (symbol-name tae)))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -1005,7 +1015,8 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(apply
'append
(mapcar
- (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort))
+ (lambda (x)
+ (directory-files (concat dir x) 'full (rx "uu" eos) 'sort))
'("~/src/libarchive-3.2.2/libarchive/test"
"~/src/libarchive-3.2.2/cpio/test"
"~/src/libarchive-3.2.2/tar/test"))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 4dcf671f51..2db4449438 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -91,7 +91,8 @@
"Format for `ert-resource-directory'.")
(defvar ert-resource-directory-trim-left-regexp ""
"Regexp for `string-trim' (left) used by `ert-resource-directory'.")
- (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
+ (defvar ert-resource-directory-trim-right-regexp
+ (rx (? "-test" (? "s")) ".el")
"Regexp for `string-trim' (right) used by `ert-resource-directory'.")
(defmacro ert-resource-directory ()
@@ -204,7 +205,7 @@ being the result.")
;; Remove old test files.
(dolist (dir `(,temporary-file-directory
,ert-remote-temporary-file-directory))
- (dolist (file (directory-files dir 'full "\\`\\(\\.#\\)?tramp-test"))
+ (dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
(ignore-errors
(if (file-directory-p file)
(delete-directory file 'recursive)
@@ -387,15 +388,17 @@ Also see `ignore'."
;; `tramp-ignored-file-name-regexp' suppresses Tramp.
(let ((tramp-ignored-file-name-regexp "^/method:user@host:"))
(should-not (tramp-tramp-file-p "/method:user@host:")))
- ;; Methods shall be at least two characters on MS Windows,
- ;; except the default method.
+ ;; Methods shall be at least two characters, except the
+ ;; default method.
(let ((system-type 'windows-nt))
(should-not (tramp-tramp-file-p "/c:/path/to/file"))
(should-not (tramp-tramp-file-p "/c::/path/to/file"))
- (should (tramp-tramp-file-p "/-::/path/to/file")))
+ (should (tramp-tramp-file-p "/-::/path/to/file"))
+ (should (tramp-tramp-file-p "/mm::/path/to/file")))
(let ((system-type 'gnu/linux))
+ (should-not (tramp-tramp-file-p "/m::/path/to/file"))
(should (tramp-tramp-file-p "/-:h:/path/to/file"))
- (should (tramp-tramp-file-p "/m::/path/to/file"))))
+ (should (tramp-tramp-file-p "/mm::/path/to/file"))))
;; Exit.
(tramp-change-syntax syntax))))
@@ -1064,8 +1067,7 @@ Also see `ignore'."
(file-remote-p "/user@email@host:")
(format "/%s@%s:" "user@email" "host")))
(should (string-equal
- (file-remote-p
- "/user@email@host:" 'method) "default-method"))
+ (file-remote-p "/user@email@host:" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/user@email@host:" 'user) "user@email"))
(should (string-equal
@@ -1474,11 +1476,10 @@ Also see `ignore'."
(file-remote-p "/[method/user@email@host]")
(format "/[%s/%s@%s]" "method" "user@email" "host")))
(should (string-equal
- (file-remote-p
- "/[method/user@email@host]" 'method) "method"))
+ (file-remote-p "/[method/user@email@host]" 'method)
"method"))
(should (string-equal
- (file-remote-p
- "/[method/user@email@host]" 'user) "user@email"))
+ (file-remote-p "/[method/user@email@host]" 'user)
+ "user@email"))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'host) "host"))
(should (string-equal
@@ -1505,11 +1506,10 @@ Also see `ignore'."
(file-remote-p "/[/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
- (file-remote-p
- "/[/user@host#1234]" 'method) "default-method"))
+ (file-remote-p "/[/user@host#1234]" 'method)
+ "default-method"))
(should (string-equal
- (file-remote-p
- "/[/user@host#1234]" 'user) "user"))
+ (file-remote-p "/[/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
(should (string-equal
@@ -1535,11 +1535,10 @@ Also see `ignore'."
(file-remote-p "/[-/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
- (file-remote-p
- "/[-/user@host#1234]" 'method) "default-method"))
+ (file-remote-p "/[-/user@host#1234]" 'method)
+ "default-method"))
(should (string-equal
- (file-remote-p
- "/[-/user@host#1234]" 'user) "user"))
+ (file-remote-p "/[-/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
(should (string-equal
@@ -1569,8 +1568,7 @@ Also see `ignore'."
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'user) "user"))
(should (string-equal
- (file-remote-p
- "/[method/user@host#1234]" 'host) "host#1234"))
+ (file-remote-p "/[method/user@host#1234]" 'host)
"host#1234"))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'localname) ""))
(should (string-equal
@@ -1595,8 +1593,7 @@ Also see `ignore'."
(file-remote-p "/[/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
- (file-remote-p
- "/[/user@1.2.3.4]" 'method) "default-method"))
+ (file-remote-p "/[/user@1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
(should (string-equal
@@ -1624,8 +1621,7 @@ Also see `ignore'."
(file-remote-p "/[-/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
- (file-remote-p
- "/[-/user@1.2.3.4]" 'method) "default-method"))
+ (file-remote-p "/[-/user@1.2.3.4]" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
(should (string-equal
@@ -2299,9 +2295,9 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Check `directory-abbrev-alist' abbreviation.
(let ((directory-abbrev-alist
- `((,(concat "\\`" (regexp-quote home-dir) "/foo")
+ `((,(tramp-compat-rx bos (literal home-dir) "/foo")
. ,(concat home-dir "/f"))
- (,(concat "\\`" (regexp-quote remote-host) "/nowhere")
+ (,(tramp-compat-rx bos (literal remote-host) "/nowhere")
. ,(concat remote-host "/nw")))))
(should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
(concat remote-host-nohop "~/f/bar")))
@@ -2514,8 +2510,9 @@ This checks also `file-name-as-directory',
`file-name-directory',
(string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
- (format "^Wrote %s\n\\'" (regexp-quote tmp-name))
- "^\\'")
+ (tramp-compat-rx
+ bol "Wrote " (literal tmp-name) "\n" eos)
+ (rx bos))
tramp--test-messages))))))
;; We do not test lockname here. See
@@ -3215,38 +3212,42 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(with-temp-buffer
(insert-directory tmp-name1 nil)
(goto-char (point-min))
- (should (looking-at-p (regexp-quote tmp-name1))))
+ (should (looking-at-p (tramp-compat-rx (literal tmp-name1)))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) nil)
(goto-char (point-min))
(should
(looking-at-p
- (regexp-quote (file-name-as-directory tmp-name1)))))
+ (tramp-compat-rx (literal (file-name-as-directory
tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
- (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
+ (looking-at-p
+ (tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) "-al")
(goto-char (point-min))
(should
- (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
- (let ((directory-files (directory-files tmp-name1)))
- (with-temp-buffer
- (insert-directory
- (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
- (goto-char (point-min))
- (should
- (looking-at-p
- (concat
+ (looking-at-p
+ (tramp-compat-rx
+ bol (+ nonl) blank (literal tmp-name1) "/" eol))))
+ (with-temp-buffer
+ (insert-directory
+ (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
+ (goto-char (point-min))
+ (should
+ (looking-at-p
+ (rx-to-string
+ `(:
;; There might be a summary line.
- "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?"
+ (? "total" (+ nonl) (+ digit) (? blank)
+ (? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order ".", ".." and "foo" appear.
- (format
- "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
- (regexp-opt directory-files)
- (length directory-files)))))))
+ (= ,(length (directory-files tmp-name1))
+ (+ nonl) blank
+ (regexp ,(regexp-opt (directory-files tmp-name1)))
+ (? " ->" (+ nonl)) "\n"))))))
;; Check error cases.
(when (and (tramp--test-supports-set-file-modes-p)
@@ -3274,7 +3275,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test17-dired-with-wildcards ()
"Check `dired' with wildcards."
;; `separate' syntax and IPv6 host name syntax do not work.
- (skip-unless (not (string-match-p "\\["
ert-remote-temporary-file-directory)))
+ (skip-unless
+ (not (string-match-p (rx "[") ert-remote-temporary-file-directory)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -3313,15 +3315,17 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name1 ert-remote-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name2 ert-remote-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name2 ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for expanded directory and file names.
@@ -3333,16 +3337,18 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name3 ert-remote-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name4
- ert-remote-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name4
+ ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for special characters.
@@ -3361,16 +3367,18 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name3 ert-remote-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name4
- ert-remote-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name4
+ ert-remote-temporary-file-directory))))))
(kill-buffer buffer))
;; Cleanup.
@@ -3420,7 +3428,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(string-equal
(dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name2)))
- (should-not (re-search-forward "dired" nil t))
+ (should-not (search-forward "dired" nil t))
;; The copied file has been inserted the line before.
(forward-line -1)
(should
@@ -3593,12 +3601,19 @@ This tests also `access-file', `file-readable-p',
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
- (let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (cons '(nil "perl" nil)
- tramp-connection-properties)))
- (funcall (ert-test-body ert-test)))))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (cons '(nil "perl" nil)
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
(defmacro tramp--test-deftest-with-perl (test)
"Define ert `TEST-with-perl'."
@@ -3612,15 +3627,24 @@ This tests also `access-file', `file-readable-p',
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
- (let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (append
- '((nil "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (nil "readlink" nil))
- tramp-connection-properties)))
- (funcall (ert-test-body ert-test)))))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil)
+ ;; See `tramp-sh-handle-get-remote-*'.
+ (nil "id" nil))
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
(defmacro tramp--test-deftest-with-ls (test)
"Define ert `TEST-with-ls'."
@@ -3633,16 +3657,23 @@ This tests also `access-file', `file-readable-p',
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- (let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (append
- '((nil "perl" nil)
- (nil "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (nil "readlink" nil))
- tramp-connection-properties)))
- (funcall (ert-test-body ert-test)))))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "perl" nil)
+ (nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil))
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
(tramp--test-deftest-with-stat tramp-test18-file-attributes)
@@ -3754,14 +3785,15 @@ They might differ only in time attributes or directory
size."
(tramp--test-file-attributes-equal-p
(file-attributes (car elt)) (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name2 nil "\\`b"))
+ (setq attr (directory-files-and-attributes
+ tmp-name2 nil (rx bos "b")))
(should (equal (mapcar #'car attr) '("bar" "boz")))
;; Check the COUNT arg. It exists since Emacs 28.
(when (tramp--test-emacs28-p)
(with-no-warnings
(setq attr (directory-files-and-attributes
- tmp-name2 nil "\\`b" nil nil 1))
+ tmp-name2 nil (rx bos "b") nil nil 1))
(should (equal (mapcar #'car attr) '("bar"))))))
;; Cleanup.
@@ -3867,8 +3899,8 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
`(condition-case err
(progn ,@body)
(file-error
- (unless (string-match-p "^error with add-name-to-file"
- (error-message-string err))
+ (unless (string-prefix-p "error with add-name-to-file"
+ (error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
@@ -4598,7 +4630,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(defun tramp--test-shell-file-name ()
"Return default remote shell."
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+ (if (file-exists-p
+ (concat
+ (file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh"))
+ "/system/bin/sh" "/bin/sh"))
(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
@@ -4638,7 +4673,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(let ((process-file-return-signal-string t))
(should
(string-match-p
- "Interrupt\\|Signal 2"
+ (rx (| "Interrupt" "Signal 2"))
(process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
@@ -4718,7 +4753,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(insert-file-contents tmp-name)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name))))
@@ -4868,8 +4904,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; On macOS, there is always newline conversion.
;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page.
- "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
- "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
+ (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
+ (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
(buffer-string))))
;; Cleanup.
@@ -5066,7 +5102,9 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; On some MS Windows systems, it returns "unknown signal".
- (should (string-match-p "unknown signal\\|killed" (buffer-string))))
+ (should
+ (string-match-p
+ (rx (| "unknown signal" "killed")) (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -5099,7 +5137,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(delete-process proc)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -5126,7 +5165,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(insert-file-contents tmp-name)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -5177,8 +5217,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; On macOS, there is always newline conversion.
;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page.
- "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
- "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
+ (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
+ (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
(buffer-string))))
;; Cleanup.
@@ -5657,7 +5697,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is set.
(should
(string-match-p
- (regexp-quote envvar)
+ (tramp-compat-rx (literal envvar))
(funcall this-shell-command-to-string "set"))))
(unless (tramp-direct-async-process-p)
@@ -5684,7 +5724,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is unset.
(should-not
(string-match-p
- (regexp-quote envvar)
+ (tramp-compat-rx (literal envvar))
;; We must remove PS1, the output is truncated otherwise.
;; We must suppress "_=VAR...".
(funcall
@@ -5836,7 +5876,7 @@ INPUT, if non-nil, is a string sent to the process."
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
- (should (string-match-p "^foo$" (buffer-string)))))
+ (should (string-match-p (rx bol "foo" eol) (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -6354,7 +6394,7 @@ INPUT, if non-nil, is a string sent to the process."
;; When `lock-file-name-transforms' is set, another lock
;; file is used.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (let ((lock-file-name-transforms `((".*" ,tmp-name2))))
+ (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2))))
(should
(string-equal
(with-no-warnings (make-lock-file-name tmp-name1))
@@ -6480,10 +6520,12 @@ INPUT, if non-nil, is a string sent to the process."
(insert "bar")
(when create-lockfiles
(should (string-match-p
- (format
- "^%s changed on disk; really edit the
buffer\\?"
- (if (tramp--test-crypt-p)
- ".+" (file-name-nondirectory tmp-name)))
+ (rx-to-string
+ `(: bol
+ ,(if (tramp--test-crypt-p)
+ '(+ nonl)
+ (file-name-nondirectory tmp-name))
+ " changed on disk; really edit the
buffer?"))
captured-messages))
(should (file-locked-p tmp-name)))))
@@ -6574,7 +6616,7 @@ This is used in tests which we don't want to tag
:body nil :tags '(:tramp-asynchronous-processes))))
;; tramp-adb.el cannot apply multi-byte commands.
(not (and (tramp--test-adb-p)
- (string-match-p "[[:multibyte:]]" default-directory)))))
+ (string-match-p (tramp-compat-rx multibyte) default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is encrypted."
@@ -6599,8 +6641,8 @@ completely."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (string-match-p
- "ftp$" (file-remote-p ert-remote-temporary-file-directory 'method)))
+ (string-suffix-p
+ "ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-fuse-p ()
"Check, whether an FUSE file system isused."
@@ -6623,7 +6665,7 @@ If optional METHOD is given, it is checked first."
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
(file-truename ert-remote-temporary-file-directory)
- (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX")))
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec (rx bol "HP-UX"))))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
@@ -6631,8 +6673,9 @@ ksh93 makes some strange conversions of non-latin
characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
(file-truename ert-remote-temporary-file-directory)
- (string-match-p
- "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
+ (string-suffix-p
+ "ksh"
+ (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-macos-p ()
"Check, whether the remote host runs macOS."
@@ -6680,7 +6723,7 @@ Additionally, ls does not support \"--dired\"."
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
(string-match-p
- "^\\(afp\\|davs?\\|smb\\)$"
+ (rx bol (| "afp" (: "dav" (? "s")) "smb") eol)
(file-remote-p ert-remote-temporary-file-directory 'method))))
(defun tramp--test-sshfs-p ()
@@ -6732,7 +6775,7 @@ This requires restrictions of file name syntax."
;; Not all tramp-gvfs.el methods support changing the file mode.
(and
(tramp--test-gvfs-p)
- (string-match-p
+ (string-suffix-p
"ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))))
(defun tramp--test-check-files (&rest files)
@@ -6881,14 +6924,14 @@ This requires restrictions of file name syntax."
(should
(string-equal
(caar (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))
+ file1 nil (tramp-compat-rx (literal elt1))))
elt1))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(cadr (car (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))))
+ file1 nil (tramp-compat-rx (literal
elt1))))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3))))
@@ -6943,10 +6986,9 @@ This requires restrictions of file name syntax."
(goto-char (point-min))
(should
(re-search-forward
- (format
- "^%s=%s$"
- (regexp-quote envvar)
- (regexp-quote (getenv envvar))))))))))
+ (tramp-compat-rx
+ bol (literal envvar)
+ "=" (literal (getenv envvar)) eol))))))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
@@ -7078,7 +7120,7 @@ This requires restrictions of file name syntax."
;; ?\n and ?/ shouldn't be part of any file name. ?\t,
;; ?. and ?? do not work for "smb" method. " " does not
;; work at begin or end of the string for MS Windows.
- (replace-regexp-in-string "[ \t\n/.?]" "" x)))
+ (replace-regexp-in-string (rx (any " \t\n/.?")) "" x)))
language-info-alist)))))))
(tramp--test-deftest-with-stat tramp-test42-utf8)
@@ -7461,7 +7503,7 @@ process sentinels. They shall not disturb each other."
ert-remote-temporary-file-directory)))
(should
(string-match-p
- "Tramp loaded: t[\n\r]+"
+ (rx "Tramp loaded: t" (+ (any "\n\r")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -7488,9 +7530,10 @@ process sentinels. They shall not disturb each other."
(dolist (tm '(t nil))
(should
(string-match-p
- (format
- "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded:
%s[\n\r]+"
- tm)
+ (tramp-compat-rx
+ "Tramp loaded: nil" (+ (any "\n\r"))
+ "Tramp loaded: nil" (+ (any "\n\r"))
+ "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -7535,9 +7578,9 @@ process sentinels. They shall not disturb each other."
(tramp-cleanup-all-connections))"))
(should
(string-match-p
- (format
- "Loading %s"
- (regexp-quote
+ (tramp-compat-rx
+ "Loading "
+ (literal
(expand-file-name
"tramp-cmds" (file-name-directory (locate-library "tramp")))))
(shell-command-to-string
@@ -7580,11 +7623,13 @@ Since it unloads Tramp, it shall be the last test to
run."
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x))))
(macrop x))
- (string-match-p "^tramp" (symbol-name x))
+ (string-prefix-p "tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
- (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
- (not (string-match-p "unload-hook$" (symbol-name x)))
+ (not (string-match-p
+ (rx bol "tramp" (? "-archive") (** 1 2 "-") "test")
+ (symbol-name x)))
+ (not (string-suffix-p "unload-hook" (symbol-name x)))
(not (get x 'tramp-autoload))
(ert-fail (format "`%s' still bound" x)))))
@@ -7594,7 +7639,7 @@ Since it unloads Tramp, it shall be the last test to run."
(mapatoms
(lambda (x)
(and (functionp x) (null (autoloadp (symbol-function x)))
- (string-match-p "tramp-file-name" (symbol-name x))
+ (string-prefix-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
@@ -7602,8 +7647,9 @@ Since it unloads Tramp, it shall be the last test to run."
(mapatoms
(lambda (x)
(and (boundp x)
- (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
- (not (string-match-p "unload-hook$" (symbol-name x)))
+ (string-match-p
+ (rx "-" (| "hook" "function") (? "s") eol) (symbol-name x))
+ (not (string-suffix-p "unload-hook" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))
@@ -7614,7 +7660,7 @@ Since it unloads Tramp, it shall be the last test to run."
(and (functionp x)
(advice-mapc
(lambda (fun _symbol)
- (and (string-match-p "^tramp" (symbol-name fun))
+ (and (string-prefix-p "tramp" (symbol-name fun))
(ert-fail
(format "Function `%s' still contains Tramp advice" x))))
x))))
@@ -7631,7 +7677,7 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
(interactive "p")
(funcall
(if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
- "^tramp"))
+ (rx bol "tramp")))
;; TODO:
@@ -7640,6 +7686,7 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * file-in-directory-p
;; * file-name-case-insensitive-p
;; * tramp-get-remote-gid
+;; * tramp-get-remote-groups
;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid
diff --git a/test/lisp/thumbs-tests.el b/test/lisp/obsolete/thumbs-tests.el
similarity index 100%
rename from test/lisp/thumbs-tests.el
rename to test/lisp/obsolete/thumbs-tests.el
diff --git a/test/lisp/pcomplete-tests.el b/test/lisp/pcomplete-tests.el
new file mode 100644
index 0000000000..00a82502f3
--- /dev/null
+++ b/test/lisp/pcomplete-tests.el
@@ -0,0 +1,100 @@
+;;; pcomplete-tests.el --- Tests for pcomplete.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 'pcomplete)
+
+(ert-deftest pcomplete-test-parse-gpg-help ()
+ (cl-letf ((pcomplete-from-help (make-hash-table :test #'equal))
+ ((symbol-function 'call-process)
+ (lambda (&rest _) (insert "\
+gpg (GnuPG) 2.3.7
+
+Commands:
+
+ -s, --sign make a signature
+ --clear-sign make a clear text signature
+ -b, --detach-sign make a detached signature
+ --tofu-policy VALUE set the TOFU policy for a key
+
+Options to specify keys:
+ -r, --recipient USER-ID encrypt for USER-ID
+ -u, --local-user USER-ID use USER-ID to sign or decrypt
+
+(See the man page for a complete listing of all commands and options)
+
+Examples:
+
+ -se -r Bob [file] sign and encrypt for user Bob
+ --clear-sign [file] make a clear text signature
+"))))
+ (should
+ (equal-including-properties
+ (pcomplete-from-help "gpg --help" :narrow-end "^ -se")
+ '(#("-s" 0 1 (pcomplete-help "make a signature"))
+ #("--sign" 0 1 (pcomplete-help "make a signature"))
+ #("--clear-sign" 0 1 (pcomplete-help "make a clear text signature"))
+ #("-b" 0 1 (pcomplete-help "make a detached signature"))
+ #("--detach-sign" 0 1 (pcomplete-help "make a detached signature"))
+ #("--tofu-policy" 0 1
+ (pcomplete-help "set the TOFU policy for a key" pcomplete-annotation
" VALUE"))
+ #("-r" 0 1 (pcomplete-help "encrypt for USER-ID"))
+ #("--recipient" 0 1
+ (pcomplete-help "encrypt for USER-ID" pcomplete-annotation "
USER-ID"))
+ #("-u" 0 1
+ (pcomplete-help "use USER-ID to sign or decrypt"))
+ #("--local-user" 0 1
+ (pcomplete-help "use USER-ID to sign or decrypt"
pcomplete-annotation " USER-ID")))))))
+
+(ert-deftest pcomplete-test-parse-git-help ()
+ (cl-letf ((pcomplete-from-help (make-hash-table :test #'equal))
+ ((symbol-function 'call-process)
+ (lambda (&rest _) (insert "\
+usage: git [-v | --version] [-h | --help] [-C <path>] [-c <name>=<value>]
+ [--exec-path[=<path>]] [--html-path] [--man-path] [--info-path]
+ [-p | --paginate | -P | --no-pager] [--no-replace-objects] [--bare]
+ [--git-dir=<path>] [--work-tree=<path>] [--namespace=<name>]
+ [--super-prefix=<path>] [--config-env=<name>=<envvar>]
+ <command> [<args>]
+"))))
+ (should
+ (equal-including-properties
+ (pcomplete-from-help "git help"
+ :margin "\\(\\[\\)-"
+ :separator " | "
+ :description "\\`")
+ '("-v" "--version" "-h" "--help"
+ #("-C" 0 1 (pcomplete-annotation " <path>"))
+ #("-c" 0 1 (pcomplete-annotation " <name>"))
+ #("--exec-path" 0 1 (pcomplete-annotation "[=<path>]"))
+ "--html-path" "--man-path" "--info-path"
+ "-p" "--paginate" "-P" "--no-pager"
+ "--no-replace-objects" "--bare"
+ #("--git-dir=" 0 1 (pcomplete-annotation "<path>"))
+ #("--work-tree=" 0 1 (pcomplete-annotation "<path>"))
+ #("--namespace=" 0 1 (pcomplete-annotation "<name>"))
+ #("--super-prefix=" 0 1 (pcomplete-annotation "<path>"))
+ #("--config-env=" 0 1 (pcomplete-annotation "<name>")))))))
+
+(provide 'pcomplete-tests)
+;;; pcomplete-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl
new file mode 100644
index 0000000000..566b7e7550
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl
@@ -0,0 +1,8 @@
+{
+ my @zzzz=(\%seen_couchrequsts, \%seen_people );
+ my @zzzz=\(%seen_couchrequsts, %seen_people );
+ my @zzzz=(\%seen_couchrequsts, \%seen_people );
+}
+
+print "\"Watch out\"";
+$ref = \"howdy";
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
new file mode 100644
index 0000000000..6b874ffaa1
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
@@ -0,0 +1,26 @@
+Code:
+ (lambda ()
+ (cperl-mode)
+ (indent-region (point-min) (point-max)))
+
+Name: cperl-indent1
+
+=-=
+{
+ print "",
+ "",
+ foo::bar(),
+ "";
+}
+=-=-=
+
+Name: cperl-indents1
+
+=-=
+{
+ print "",
+ "",
+ foobar(),
+ "";
+}
+=-=-=
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/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 7eb2d9be75..1bb206e704 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -723,6 +723,18 @@ created by CPerl mode, so skip it for Perl mode."
;;; Tests for issues reported in the Bug Tracker
+(ert-deftest cperl-test-bug-997 ()
+ "Test that we distinguish a regexp match when there's nothing before it."
+ (let ((code "# some comment\n\n/fontify me/;\n"))
+ (with-temp-buffer
+ (funcall cperl-test-mode)
+ (insert code)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (search-forward "/f")
+ (should (equal (get-text-property (point) 'face)
+ 'font-lock-string-face)))))
+
(defun cperl-test--run-bug-10483 ()
"Runs a short program, intended to be under timer scrutiny.
This function is intended to be used by an Emacs subprocess in
@@ -776,6 +788,36 @@ under timeout control."
(should (string-match
"poop ('foo', \n 'bar')" (buffer-string))))))
+(ert-deftest cperl-test-bug-11996 ()
+ "Verify that we give the right syntax property to a backslash operator."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-11996.pl"))
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (re-search-forward "\\(\\\\(\\)")
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (should (equal (syntax-after (point)) (string-to-syntax ".")))
+ ;; `forward-sexp' shouldn't complain.
+ (forward-sexp)
+ (should (char-equal (char-after) ?\;)))
+ (re-search-forward "\\(\\\\\"\\)")
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (should (equal (syntax-after (point)) (string-to-syntax "\\")))
+ (should (equal (get-text-property (point) 'face)
'font-lock-string-face)))
+ (re-search-forward "\\(\\\\\"\\)")
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (should (equal (syntax-after (point)) (string-to-syntax "\\"))))
+ (re-search-forward "\\(\\\\\"\\)")
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (should (equal (syntax-after (point)) (string-to-syntax ".")))
+ (should (equal (get-text-property (1+ (point)) 'face)
+ 'font-lock-string-face)))))
+
(ert-deftest cperl-test-bug-14343 ()
"Verify that inserting text into a HERE-doc string with Elisp
does not break fontification."
@@ -1103,4 +1145,7 @@ as a regex."
(funcall cperl-test-mode)
(should-not (nth 3 (syntax-ppss 3)))))
+(ert-deftest test-indentation ()
+ (ert-test-erts-file (ert-resource-file "cperl-indents.erts")))
+
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index 8074d8d706..e73be0db50 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -183,6 +183,16 @@
(call-interactively #'eval-last-sexp)
(should (equal (current-message) "66 (#o102, #x42, ?B)"))))))
+;;; eval-defun
+
+(ert-deftest eval-defun-prints-edebug-when-instrumented ()
+ (skip-unless (not noninteractive))
+ (with-temp-buffer
+ (let ((current-prefix-arg '(4)))
+ (erase-buffer) (insert "(defun foo ())") (message nil)
+ (call-interactively #'eval-defun)
+ (should (equal (current-message) "Edebug: foo")))))
+
;;; eldoc
(defun elisp-mode-tests--face-propertized-string (string)
diff --git a/test/lisp/progmodes/hideshow-tests.el
b/test/lisp/progmodes/hideshow-tests.el
new file mode 100644
index 0000000000..22d73fb3c4
--- /dev/null
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -0,0 +1,374 @@
+;;; hideshow-tests.el --- Test suite for hideshow.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 'hideshow)
+
+;; Dependencies for testing:
+(require 'cc-mode)
+
+
+(defmacro hideshow-tests-with-temp-buffer (mode contents &rest body)
+ "Create a `hs-minor-mode' enabled MODE temp buffer with CONTENTS.
+BODY is code to be executed within the temp buffer. Point is
+always located at the beginning of buffer."
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (,mode)
+ (hs-minor-mode 1)
+ (insert ,contents)
+ (goto-char (point-min))
+ ,@body))
+
+(defmacro hideshow-tests-with-temp-buffer-selected (mode contents &rest body)
+ "Create and switch to a `hs-minor-mode' enabled MODE temp buffer with
CONTENTS.
+BODY is code to be executed within the temp buffer. Point is
+always located at the beginning of buffer."
+ (declare (indent 1) (debug t))
+ `(ert-with-test-buffer-selected ()
+ (,mode)
+ (hs-minor-mode 1)
+ (insert ,contents)
+ (goto-char (point-min))
+ ,@body))
+
+(defun hideshow-tests-look-at (string &optional num restore-point)
+ "Move point at beginning of STRING in the current buffer.
+Optional argument NUM defaults to 1 and is an integer indicating
+how many occurrences must be found, when positive the search is
+done forwards, otherwise backwards. When RESTORE-POINT is
+non-nil the point is not moved but the position found is still
+returned. When searching forward and point is already looking at
+STRING, it is skipped so the next STRING occurrence is selected."
+ (let* ((num (or num 1))
+ (starting-point (point))
+ (string (regexp-quote string))
+ (search-fn (if (> num 0) #'re-search-forward #'re-search-backward))
+ (deinc-fn (if (> num 0) #'1- #'1+))
+ (found-point))
+ (prog2
+ (catch 'exit
+ (while (not (= num 0))
+ (when (and (> num 0)
+ (looking-at string))
+ ;; Moving forward and already looking at STRING, skip it.
+ (forward-char (length (match-string-no-properties 0))))
+ (and (not (funcall search-fn string nil t))
+ (throw 'exit t))
+ (when (> num 0)
+ ;; `re-search-forward' leaves point at the end of the
+ ;; occurrence, move back so point is at the beginning
+ ;; instead.
+ (forward-char (- (length (match-string-no-properties 0)))))
+ (setq
+ num (funcall deinc-fn num)
+ found-point (point))))
+ found-point
+ (and restore-point (goto-char starting-point)))))
+
+(defun hideshow-tests-visible-string (&optional min max)
+ "Return the buffer string excluding invisible overlays.
+Argument MIN and MAX delimit the region to be returned and
+default to `point-min' and `point-max' respectively."
+ (let* ((min (or min (point-min)))
+ (max (or max (point-max)))
+ (buffer-contents (buffer-substring-no-properties min max))
+ (overlays
+ (sort (overlays-in min max)
+ (lambda (a b)
+ (let ((overlay-end-a (overlay-end a))
+ (overlay-end-b (overlay-end b)))
+ (> overlay-end-a overlay-end-b))))))
+ (with-temp-buffer
+ (insert buffer-contents)
+ (dolist (overlay overlays)
+ (if (overlay-get overlay 'invisible)
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay))))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+(defun hideshow-tests-make-event-at (string)
+ "Make dummy mouse event at beginning of STRING."
+ (save-excursion
+ (let ((pos (hideshow-tests-look-at string)))
+ (vector
+ `(S-mouse-2
+ (,(get-buffer-window) ,pos (1 . 1) 0 nil ,pos (1 . 1)
+ nil (1 . 1) (1 . 1)))))))
+
+(ert-deftest hideshow-already-hidden-p-1 ()
+ (let ((contents "
+int
+main()
+{
+ printf(\"Hello\\n\");
+}
+"))
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ contents
+ (hideshow-tests-look-at "printf")
+ (should (not (hs-already-hidden-p)))
+ (hs-hide-block)
+ (goto-char (point-min))
+ (hideshow-tests-look-at "{")
+ (should (hs-already-hidden-p))
+ (forward-line -1)
+ (should (not (hs-already-hidden-p)))
+ (hideshow-tests-look-at "}")
+ (should (hs-already-hidden-p))
+ (forward-line)
+ (should (not (hs-already-hidden-p))))))
+
+(ert-deftest hideshow-hide-block-1 ()
+ "Should hide current block."
+ (let ((contents "
+int
+main()
+{
+ printf(\"Hello\\n\");
+}
+"))
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ contents
+ (hideshow-tests-look-at "printf")
+ (hs-hide-block)
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+int
+main()
+{}
+"))
+ (hs-show-block)
+ (should (string= (hideshow-tests-visible-string) contents)))))
+
+(ert-deftest hideshow-hide-all-1 ()
+ "Should hide all blocks and comments."
+ (let ((contents "
+/*
+ Comments
+*/
+
+int
+main()
+{
+ sub();
+}
+
+void
+sub()
+{
+ printf(\"Hello\\n\");
+}
+"))
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ contents
+ (hs-hide-all)
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+/*
+
+int
+main()
+{}
+
+void
+sub()
+{}
+"))
+ (hs-show-all)
+ (should (string= (hideshow-tests-visible-string) contents)))))
+
+(ert-deftest hideshow-hide-all-2 ()
+ "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil."
+ (let ((contents "
+/*
+ Comments
+*/
+
+int
+main()
+{
+ sub();
+}
+
+void
+sub()
+{
+ printf(\"Hello\\n\");
+}
+"))
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ contents
+ (let ((hs-hide-comments-when-hiding-all nil))
+ (hs-hide-all))
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+/*
+ Comments
+*/
+
+int
+main()
+{}
+
+void
+sub()
+{}
+"))
+ (hs-show-all)
+ (should (string= (hideshow-tests-visible-string) contents)))))
+
+(ert-deftest hideshow-hide-level-1 ()
+ "Should hide 1st level blocks."
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ "
+/*
+ Comments
+*/
+
+int
+main(int argc, char **argv)
+{
+ if (argc > 1) {
+ printf(\"Hello\\n\");
+ }
+}
+"
+ (hs-hide-level 1)
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+/*
+ Comments
+*/
+
+int
+main(int argc, char **argv)
+{}
+"))))
+
+(ert-deftest hideshow-hide-level-2 ()
+ "Should hide 2nd level blocks."
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ "
+/*
+ Comments
+*/
+
+int
+main(int argc, char **argv)
+{
+ if (argc > 1) {
+ printf(\"Hello\\n\");
+ }
+}
+"
+ (hs-hide-level 2)
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+/*
+ Comments
+*/
+
+int
+main(int argc, char **argv)
+{
+ if (argc > 1) {}
+}
+"))))
+
+(ert-deftest hideshow-toggle-hiding-1 ()
+ "Should toggle hiding/showing of a block."
+ (let ((contents "
+int
+main()
+{
+ printf(\"Hello\\n\");
+}
+"))
+ (hideshow-tests-with-temp-buffer
+ c-mode
+ contents
+ (hideshow-tests-look-at "printf")
+ (hs-toggle-hiding)
+ (should (string=
+ (hideshow-tests-visible-string)
+ "
+int
+main()
+{}
+"))
+ (hs-toggle-hiding)
+ (should (string= (hideshow-tests-visible-string) contents)))))
+
+(ert-deftest hideshow-mouse-toggle-hiding-1 ()
+ "Should toggle hiding/showing of a block by mouse events."
+ (let ((contents "
+int
+main()
+{
+ printf(\"Hello\\n\");
+}
+")
+ (hidden "
+int
+main()
+{}
+")
+ (call-at (lambda (str)
+ (let* ((events (hideshow-tests-make-event-at str))
+ (last-nonmenu-event (aref events 0)))
+ (call-interactively #'hs-toggle-hiding nil events)))))
+ (hideshow-tests-with-temp-buffer-selected
+ c-mode
+ contents
+ ;; Should not hide the block when clicked outside of the block.
+ (funcall call-at "int")
+ (should (string= (hideshow-tests-visible-string) contents))
+ ;; Should hide the block when clicked inside of the block.
+ (goto-char (point-min))
+ (funcall call-at "printf")
+ (should (string= (hideshow-tests-visible-string) hidden))
+ ;; Should not show the block when clicked outside of the block.
+ (goto-char (point-min))
+ (funcall call-at "int")
+ (should (string= (hideshow-tests-visible-string) hidden))
+ ;; Should show the block when clicked inside of the block.
+ (goto-char (point-min))
+ (funcall call-at "}")
+ (should (string= (hideshow-tests-visible-string) contents)))))
+
+(provide 'hideshow-tests)
+
+;;; hideshow-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 12ac871fdf..8330525394 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
@@ -574,10 +602,14 @@ u\"\\n\""
(195 . font-lock-string-face)
(196 . font-lock-constant-face)
(215 . font-lock-string-face) (218)
- (221 . font-lock-string-face) (274)
- (277 . font-lock-string-face) (330)
- (333 . font-lock-string-face) (386)
- (389 . font-lock-string-face) (442)
+ (221 . font-lock-string-face) (254)
+ (271 . font-lock-string-face) (274)
+ (277 . font-lock-string-face) (310)
+ (327 . font-lock-string-face) (330)
+ (333 . font-lock-string-face) (366)
+ (383 . font-lock-string-face) (386)
+ (389 . font-lock-string-face) (422)
+ (439 . font-lock-string-face) (442)
(444 . font-lock-string-face) (497)
(499 . font-lock-string-face) (552)
(555 . font-lock-string-face) (608)
@@ -2338,6 +2370,21 @@ class C:
(beginning-of-line)
(point))))))
+(ert-deftest python-nav-beginning-of-defun-6 ()
+ (python-tests-with-temp-buffer
+ "
+class C:
+ def foo(self):
+ pass
+"
+ (python-tests-look-at "self")
+ (should (= (save-excursion
+ (python-nav-beginning-of-defun)
+ (point))
+ (save-excursion
+ (beginning-of-line)
+ (point))))))
+
(ert-deftest python-nav-end-of-defun-1 ()
(python-tests-with-temp-buffer
"
@@ -2468,6 +2515,26 @@ def \\
(save-excursion
(point-max))))))
+(ert-deftest python-end-of-defun-1 ()
+ (python-tests-with-temp-buffer
+ "
+class C:
+ def a(self
+ ):
+ pass
+
+ def b(self):
+ pass
+"
+ (should (= (save-excursion
+ (python-tests-look-at "def a")
+ (end-of-defun)
+ (point))
+ (save-excursion
+ (python-tests-look-at "def b")
+ (forward-line -1)
+ (point))))))
+
(ert-deftest python-nav-backward-defun-1 ()
(python-tests-with-temp-buffer
"
@@ -4326,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))))))
@@ -4334,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
@@ -4343,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
@@ -4406,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
@@ -5730,6 +6002,52 @@ def \\
(should (not (python-info-looking-at-beginning-of-defun)))
(should (not (python-info-looking-at-beginning-of-defun nil t)))))
+(ert-deftest python-info-looking-at-beginning-of-defun-3 ()
+ (python-tests-with-temp-buffer
+ "
+def foo(arg=\"default\"): # Comment
+ pass
+"
+ (python-tests-look-at "arg")
+ (should (python-info-looking-at-beginning-of-defun))
+ (python-tests-look-at "default")
+ (should (python-info-looking-at-beginning-of-defun))
+ (python-tests-look-at "Comment")
+ (should (python-info-looking-at-beginning-of-defun))))
+
+(ert-deftest python-info-looking-at-beginning-of-block-1 ()
+ (python-tests-with-temp-buffer
+ "
+def f():
+ if True:
+ pass
+ l = [x * 2
+ for x in range(5)
+ if x < 3]
+# if False:
+\"\"\"
+if 0:
+\"\"\"
+"
+ (python-tests-look-at "def f():")
+ (should (python-info-looking-at-beginning-of-block))
+ (forward-char)
+ (should (not (python-info-looking-at-beginning-of-block)))
+ (python-tests-look-at "if True:")
+ (should (python-info-looking-at-beginning-of-block))
+ (forward-char)
+ (should (not (python-info-looking-at-beginning-of-block)))
+ (beginning-of-line)
+ (should (python-info-looking-at-beginning-of-block))
+ (python-tests-look-at "for x")
+ (should (not (python-info-looking-at-beginning-of-block)))
+ (python-tests-look-at "if x < 3")
+ (should (not (python-info-looking-at-beginning-of-block)))
+ (python-tests-look-at "if False:")
+ (should (not (python-info-looking-at-beginning-of-block)))
+ (python-tests-look-at "if 0:")
+ (should (not (python-info-looking-at-beginning-of-block)))))
+
(ert-deftest python-info-current-line-comment-p-1 ()
(python-tests-with-temp-buffer
"
@@ -6183,8 +6501,11 @@ class SomeClass:
class SomeClass:
def __init__(self, arg, kwarg=1):
+
def filter(self, nums):
- def __str__(self):"))))
+
+ def __str__(self):
+"))))
(or enabled (hs-minor-mode -1)))))
(ert-deftest python-hideshow-hide-levels-2 ()
@@ -6230,6 +6551,165 @@ class SomeClass:
"))))
(or enabled (hs-minor-mode -1)))))
+(ert-deftest python-hideshow-hide-levels-3 ()
+ "Should hide all blocks."
+ (python-tests-with-temp-buffer
+ "
+def f():
+ if 0:
+ l = [i for i in range(5)
+ if i < 3]
+ abc = o.match(1, 2, 3)
+
+def g():
+ pass
+"
+ (hs-minor-mode 1)
+ (hs-hide-level 1)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+def f():
+
+def g():
+"))))
+
+(ert-deftest python-hideshow-hide-levels-4 ()
+ "Should hide 2nd level block."
+ (python-tests-with-temp-buffer
+ "
+def f():
+ if 0:
+ l = [i for i in range(5)
+ if i < 3]
+ abc = o.match(1, 2, 3)
+
+def g():
+ pass
+"
+ (hs-minor-mode 1)
+ (hs-hide-level 2)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+def f():
+ if 0:
+
+def g():
+ pass
+"))))
+
+(ert-deftest python-hideshow-hide-all-1 ()
+ "Should hide all blocks."
+ (python-tests-with-temp-buffer
+ "if 0:
+
+ aaa
+ l = [i for i in range(5)
+ if i < 3]
+ ccc
+ abc = o.match(1, 2, 3)
+ ddd
+
+def f():
+ pass
+"
+ (hs-minor-mode 1)
+ (hs-hide-all)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "if 0:
+
+def f():
+"))))
+
+(ert-deftest python-hideshow-hide-all-2 ()
+ "Should hide comments."
+ (python-tests-with-temp-buffer
+ "
+# Multi line
+# comment
+
+\"\"\"
+# Multi line
+# string
+\"\"\"
+"
+ (hs-minor-mode 1)
+ (hs-hide-all)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+# Multi line
+
+\"\"\"
+# Multi line
+# string
+\"\"\"
+"))))
+
+(ert-deftest python-hideshow-hide-all-3 ()
+ "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil."
+ (python-tests-with-temp-buffer
+ "
+# Multi line
+# comment
+
+\"\"\"
+# Multi line
+# string
+\"\"\"
+"
+ (hs-minor-mode 1)
+ (let ((hs-hide-comments-when-hiding-all nil))
+ (hs-hide-all))
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+# Multi line
+# comment
+
+\"\"\"
+# Multi line
+# string
+\"\"\"
+"))))
+
+(ert-deftest python-hideshow-hide-block-1 ()
+ "Should hide current block."
+ (python-tests-with-temp-buffer
+ "
+if 0:
+
+ aaa
+ l = [i for i in range(5)
+ if i < 3]
+ ccc
+ abc = o.match(1, 2, 3)
+ ddd
+
+def f():
+ pass
+"
+ (hs-minor-mode 1)
+ (python-tests-look-at "ddd")
+ (forward-line)
+ (hs-hide-block)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+if 0:
+
+def f():
+ pass
+"))))
+
(ert-deftest python-tests--python-nav-end-of-statement--infloop ()
"Checks that `python-nav-end-of-statement' doesn't infloop in a
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/so-long-tests/so-long-tests-helpers.el
b/test/lisp/so-long-tests/so-long-tests-helpers.el
index 852e7811cc..79df532f89 100644
--- a/test/lisp/so-long-tests/so-long-tests-helpers.el
+++ b/test/lisp/so-long-tests/so-long-tests-helpers.el
@@ -41,14 +41,14 @@
(should (eq so-long--active t))
;; pcase fails here in Emacs 24.
(cl-case action
- ('so-long-mode
+ (so-long-mode
(should (eq major-mode 'so-long-mode))
(so-long-tests-assert-overrides)
(so-long-tests-assert-preserved))
- ('so-long-minor-mode
+ (so-long-minor-mode
(should (eq so-long-minor-mode t))
(so-long-tests-assert-overrides))
- ('longlines-mode
+ (longlines-mode
(should (eq longlines-mode t))))))
(defun so-long-tests-assert-reverted (action)
@@ -61,14 +61,14 @@
(should (eq so-long--active nil))
;; pcase fails here in Emacs 24.
(cl-case action
- ('so-long-mode
+ (so-long-mode
(should-not (eq major-mode 'so-long-mode))
(so-long-tests-assert-overrides-reverted)
(so-long-tests-assert-preserved))
- ('so-long-minor-mode
+ (so-long-minor-mode
(should-not (eq so-long-minor-mode t))
(so-long-tests-assert-overrides-reverted))
- ('longlines-mode
+ (longlines-mode
(should-not (eq longlines-mode t))))))
(defun so-long-tests-assert-and-revert (action)
diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el
index 7f49cc38d1..d8d42452ec 100644
--- a/test/lisp/sort-tests.el
+++ b/test/lisp/sort-tests.el
@@ -28,7 +28,7 @@
(mapconcat (lambda (_) (string (let ((c (random 52)))
(+ (if (> c 25) 71 65)
c))))
- (make-list n nil) ""))
+ (make-list n nil)))
(defun sort-tests--insert-words-sort-and-compare (words separator function
reverse less-predicate)
(with-temp-buffer
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 3d03057f56..cc9610cd39 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -635,7 +635,7 @@ cf. Bug#25477."
(let ((default "foo") res)
(cl-letf (((symbol-function 'read-string)
(lambda (_prompt &optional _init _hist def _inher-input) def)))
- (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default
"")))
+ (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default)))
(should (string= default res)))))
(ert-deftest subr-tests--gensym ()
@@ -968,7 +968,21 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(insert "Foo bar zot foobar")
(should (= (replace-string-in-region "Foo" "new" (point-min))
1))
- (should (equal (buffer-string) "new bar zot foobar"))))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar baz")
+ (should (= (replace-string-in-region "ba" "quux corge grault" (point-min))
+ 2))
+ (should (equal (buffer-string)
+ "foo quux corge graultr quux corge graultz")))
+
+ (with-temp-buffer
+ (insert "foo bar bar")
+ (should (= (replace-string-in-region " bar" "" (point-min) 8)
+ 1))
+ (should (equal (buffer-string)
+ "foo bar"))))
(ert-deftest test-replace-regexp-in-region ()
(with-temp-buffer
@@ -991,7 +1005,21 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(insert "Foo bar zot foobar")
(should (= (replace-regexp-in-region "Fo+" "new" (point-min))
1))
- (should (equal (buffer-string) "new bar zot foobar"))))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar baz")
+ (should (= (replace-regexp-in-region "ba." "quux corge grault" (point-min))
+ 2))
+ (should (equal (buffer-string)
+ "foo quux corge grault quux corge grault")))
+
+ (with-temp-buffer
+ (insert "foo bar bar")
+ (should (= (replace-regexp-in-region " bar" "" (point-min) 8)
+ 1))
+ (should (equal (buffer-string)
+ "foo bar"))))
(ert-deftest test-with-existing-directory ()
(let ((dir (make-temp-name "/tmp/not-exist-")))
@@ -1111,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'."
@@ -1130,5 +1161,13 @@ final or penultimate step during initialization."))
(should (equal (butlast l n)
(subr-tests--butlast-ref l n))))))
+(ert-deftest test-list-of-strings-p ()
+ (should-not (list-of-strings-p 1))
+ (should (list-of-strings-p nil))
+ (should (list-of-strings-p '("a" "b")))
+ (should-not (list-of-strings-p ["a" "b"]))
+ (should-not (list-of-strings-p '("a" nil "b")))
+ (should-not (list-of-strings-p '("a" "b" . "c"))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/tabify-tests.el b/test/lisp/tabify-tests.el
index eaa3527df0..1c8940c30f 100644
--- a/test/lisp/tabify-tests.el
+++ b/test/lisp/tabify-tests.el
@@ -27,9 +27,9 @@
(defun tabify-tests--test-changes (fun changes width)
(with-temp-buffer
(let ((tab-width width))
- (insert (mapconcat #'car changes ""))
+ (insert (mapconcat #'car changes))
(funcall fun (point-min) (point-max))
- (should (equal (buffer-string) (mapconcat #'cadr changes ""))))))
+ (should (equal (buffer-string) (mapconcat #'cadr changes))))))
(ert-deftest tabify-tests-untabify ()
(let ((changes '(("***\n" "***\n")
diff --git a/test/lisp/textmodes/reftex-tests.el
b/test/lisp/textmodes/reftex-tests.el
index 97ff390817..67e0100475 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -334,6 +334,179 @@ And this should be % \\cite{ignored}.
#'string<)))
(kill-buffer (file-name-nondirectory tex-file)))))
+(ert-deftest reftex-renumber-simple-labels ()
+ "Test `reftex-renumber-simple-labels'.
+The function must recognize labels defined with macros like
+\\label and the ones as key=value option in optional or mandatory
+argument of other macros or environments."
+ (ert-with-temp-directory temp-dir
+ (let ((tex-file (expand-file-name "renumber.tex" temp-dir)))
+ (with-temp-buffer
+ (insert "\
+\\documentclass{article}
+\\usepackage{tcolorbox}
+\\tcbuselibrary{theorems}
+\\usepackage{fancyvrb}
+\\usepackage{listings}
+
+\\begin{document}
+
+This is with tcolorbox package:
+\\begin{problem}[%
+ colback = white ,
+ colframe = red!50!black ,
+ fonttitle = \\bfseries ,
+ description delimiters = {\\flqq}{\\frqq} ,
+ label = {problem:2}]{Prove RH2}{}
+ Problem
+\\end{problem}
+
+This is with vanilla \\LaTeX:
+\\begin{equation}
+ \\label{eq:2}
+ 2
+\\end{equation}
+By \\eqref{eq:2} and \\ref{problem:2}
+
+This is with tcolorbox package:
+\\begin{problem}[%
+ colback=white,
+ colframe=red!50!black,
+ fonttitle=\\bfseries,
+ theorem label supplement={hypertarget={XYZ-##1}},
+ theorem full label supplement={code={\\marginnote{##1}}},
+ label={problem:1}]{Prove RH1}{}
+ Problem
+\\end{problem}
+
+This is with vanilla \\LaTeX:
+\\begin{equation}
+ \\label{eq:1}
+ 1
+\\end{equation}
+
+\\Cref{problem:1} and \\pageref{eq:1}.
+
+\\begin{problem}[label={problem:6}]{Some Problem}{}
+ Problem
+\\end{problem}
+
+\\Ref{problem:6}.
+
+This is with fancyvrb package:
+\\begin{Verbatim}[reflabel={lst:6}]
+Some Verb Content
+\\end{Verbatim}
+
+\\pageref{lst:6}
+
+This is with listings package:
+\\begin{lstlisting}[language=elisp,caption=Some Caption,label={lst:3}]
+(car (cons 1 '(2)))
+\\end{lstlisting}
+
+\\ref{lst:3}
+
+\\end{document}")
+ (write-region (point-min) (point-max) tex-file))
+ ;; The label prefix must be known to RefTeX:
+ (add-to-list 'reftex-label-alist
+ '("problem" ?p "problem:" "~\\ref{%s}"
+ nil nil nil)
+ t)
+ (add-to-list 'reftex-label-alist
+ '("Verbatim" ?l "lst:" "~\\ref{%s}"
+ nil nil nil)
+ t)
+ ;; The environments must be known to RefTeX otherwise the labels
+ ;; aren't parsed correctly:
+ (add-to-list 'reftex-label-regexps
+ (concat "\\\\begin{\\(?:problem\\|Verbatim\\)}"
+ "\\[[^][]*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
+ "}[^][]*\\)*"
+ "\\<\\(?:ref\\)?label[[:space:]]*=[[:space:]]*"
+ "{?\\(?1:[^] ,}\r\n\t%]+\\)"
+ "[^]]*\\]")
+ t)
+ ;; Always run this after changing `reftex-label-regexps':
+ (reftex-compile-variables)
+ (find-file tex-file)
+ ;; Silence the user query:
+ (cl-letf (((symbol-function 'yes-or-no-p) #'always))
+ (reftex-renumber-simple-labels))
+ (should (string= (buffer-string)
+ "\
+\\documentclass{article}
+\\usepackage{tcolorbox}
+\\tcbuselibrary{theorems}
+\\usepackage{fancyvrb}
+\\usepackage{listings}
+
+\\begin{document}
+
+This is with tcolorbox package:
+\\begin{problem}[%
+ colback = white ,
+ colframe = red!50!black ,
+ fonttitle = \\bfseries ,
+ description delimiters = {\\flqq}{\\frqq} ,
+ label = {problem:1}]{Prove RH2}{}
+ Problem
+\\end{problem}
+
+This is with vanilla \\LaTeX:
+\\begin{equation}
+ \\label{eq:1}
+ 2
+\\end{equation}
+By \\eqref{eq:1} and \\ref{problem:1}
+
+This is with tcolorbox package:
+\\begin{problem}[%
+ colback=white,
+ colframe=red!50!black,
+ fonttitle=\\bfseries,
+ theorem label supplement={hypertarget={XYZ-##1}},
+ theorem full label supplement={code={\\marginnote{##1}}},
+ label={problem:2}]{Prove RH1}{}
+ Problem
+\\end{problem}
+
+This is with vanilla \\LaTeX:
+\\begin{equation}
+ \\label{eq:2}
+ 1
+\\end{equation}
+
+\\Cref{problem:2} and \\pageref{eq:2}.
+
+\\begin{problem}[label={problem:3}]{Some Problem}{}
+ Problem
+\\end{problem}
+
+\\Ref{problem:3}.
+
+This is with fancyvrb package:
+\\begin{Verbatim}[reflabel={lst:1}]
+Some Verb Content
+\\end{Verbatim}
+
+\\pageref{lst:1}
+
+This is with listings package:
+\\begin{lstlisting}[language=elisp,caption=Some Caption,label={lst:2}]
+(car (cons 1 '(2)))
+\\end{lstlisting}
+
+\\ref{lst:2}
+
+\\end{document}"))
+ (kill-buffer (file-name-nondirectory tex-file)))))
+
;;; Autoload tests
;; Test to check whether reftex autoloading mechanisms are working
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/whitespace-tests.el b/test/lisp/whitespace-tests.el
index 2a59bfe9d8..fb53543c9e 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -20,8 +20,37 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
+(require 'faceup)
(require 'whitespace)
+(defmacro whitespace-tests--with-test-buffer (style &rest body)
+ "Run BODY in a buffer with `whitespace-mode' style STYLE.
+The buffer is displayed in `selected-window', and
+`noninteractive' is set to nil even in batch mode. If STYLE is
+nil, `whitespace-mode' is left disabled."
+ (declare (debug ((style form) def-body))
+ (indent 1))
+ `(ert-with-test-buffer-selected ()
+ ;; In case global-*-mode is enabled.
+ (whitespace-mode -1)
+ (font-lock-mode -1)
+ (let ((noninteractive nil)
+ (whitespace-style ,style))
+ (font-lock-mode 1)
+ ,(when style
+ '(whitespace-mode 1))
+ ,@body)))
+
+(defun whitespace-tests--faceup (&rest lines)
+ "Convenience wrapper around `faceup-test-font-lock-buffer'.
+Returns non-nil if the concatenated LINES match the current
+buffer's content."
+ (faceup-test-font-lock-buffer nil (apply #'concat lines)))
+(let ((x (get 'faceup-test-font-lock-buffer 'ert-explainer)))
+ (put 'whitespace-tests--faceup 'ert-explainer
+ (lambda (&rest lines) (funcall x nil (apply #'concat lines)))))
+
(defun whitespace-tests--cleanup-string (string)
(with-temp-buffer
(insert string)
@@ -80,6 +109,224 @@
(whitespace-turn-off)
buffer-display-table))))))
+(ert-deftest whitespace-tests--empty-bob ()
+ (whitespace-tests--with-test-buffer '(face empty)
+ (electric-indent-mode -1)
+
+ ;; Insert some empty lines. None of the lines should be
+ ;; highlighted even though point is on the last line because the
+ ;; entire buffer is empty lines.
+ (execute-kbd-macro (kbd "SPC RET C-q TAB RET RET SPC"))
+ (should (equal (buffer-string) " \n\t\n\n "))
+ (should (equal (line-number-at-pos) 4))
+ (should (whitespace-tests--faceup " \n"
+ "\t\n"
+ "\n"
+ " "))
+
+ ;; Adding content on the last line (and keeping point there)
+ ;; should cause the previous lines to be highlighted. Note that
+ ;; the `whitespace-empty' face applies to the newline just before
+ ;; the last line, which has the desired property of extending the
+ ;; highlight the full width of the window.
+ (execute-kbd-macro (kbd "x"))
+ (should (equal (buffer-string) " \n\t\n\n x"))
+ (should (equal (line-number-at-pos) 4))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "\t\n"
+ "\n"
+ "» x"))
+
+ ;; Lines should become un-highlighted as point moves up into the
+ ;; empty lines.
+ (execute-kbd-macro (kbd "<up>"))
+ (should (equal (line-number-at-pos) 3))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "\t\n"
+ "»\n"
+ " x"))
+ (execute-kbd-macro (kbd "<up>"))
+ (should (equal (line-number-at-pos) 2))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "»\t\n"
+ "\n"
+ " x"))
+ (execute-kbd-macro (kbd "<up> C-a"))
+ (should (equal (point) 1))
+ (should (whitespace-tests--faceup " \n"
+ "\t\n"
+ "\n"
+ " x"))
+
+ ;; Line 1 should be un-highlighted when point is in line 1 even if
+ ;; point is not bobp.
+ (execute-kbd-macro (kbd "<right>"))
+ (should (equal (line-number-at-pos) 1))
+ (should (> (point) 1))
+ (should (whitespace-tests--faceup " \n"
+ "\t\n"
+ "\n"
+ " x"))
+
+ ;; Make sure lines become re-highlighted as point moves down.
+ (execute-kbd-macro (kbd "<down>"))
+ (should (equal (line-number-at-pos) 2))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "»\t\n"
+ "\n"
+ " x"))
+ (execute-kbd-macro (kbd "<down>"))
+ (should (equal (line-number-at-pos) 3))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "\t\n"
+ "»\n"
+ " x"))
+ (execute-kbd-macro (kbd "<down>"))
+ (should (equal (line-number-at-pos) 4))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "\t\n"
+ "\n"
+ "» x"))
+
+ ;; Inserting content on line 2 should un-highlight lines 2 and 3.
+ (execute-kbd-macro (kbd "<up> <up> C-e"))
+ (should (equal (line-number-at-pos) 2))
+ (should (equal (- (point) (line-beginning-position)) 1))
+ (execute-kbd-macro (kbd "y <down> <down>"))
+ (should (equal (line-number-at-pos) 4))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "»\ty\n"
+ "\n"
+ " x"))
+
+ ;; Removing the content on line 2 should re-highlight lines 2 and
+ ;; 3.
+ (execute-kbd-macro (kbd "<up> <up> C-e"))
+ (should (equal (line-number-at-pos) 2))
+ (should (equal (- (point) (line-beginning-position)) 2))
+ (execute-kbd-macro (kbd "DEL <down> <down>"))
+ (should (equal (line-number-at-pos) 4))
+ (should (whitespace-tests--faceup "«:whitespace-empty: \n"
+ "\t\n"
+ "\n"
+ "» x"))))
+
+(ert-deftest whitespace-tests--empty-eob ()
+ (whitespace-tests--with-test-buffer '(face empty)
+ (electric-indent-mode -1)
+
+ ;; Insert some empty lines. None of the lines should be
+ ;; highlighted even though point is on line 1 because the entire
+ ;; buffer is empty lines.
+ (execute-kbd-macro (kbd "RET RET C-q TAB RET SPC C-<home>"))
+ (should (equal (buffer-string) "\n\n\t\n "))
+ (should (equal (line-number-at-pos) 1))
+ (should (whitespace-tests--faceup "\n"
+ "\n"
+ "\t\n"
+ " "))
+
+ ;; Adding content on the first line (and keeping point there)
+ ;; should cause the subsequent lines to be highlighted.
+ (execute-kbd-macro (kbd "x"))
+ (should (equal (buffer-string) "x\n\n\t\n "))
+ (should (equal (line-number-at-pos) 1))
+ (should (whitespace-tests--faceup "x\n"
+ "«:whitespace-empty:\n"
+ "\t\n"
+ " »"))
+
+ ;; Lines should become un-highlighted as point moves down into the
+ ;; empty lines.
+ (execute-kbd-macro (kbd "<down>"))
+ (should (equal (line-number-at-pos) 2))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "«:whitespace-empty:\t\n"
+ " »"))
+ (execute-kbd-macro (kbd "<down>"))
+ (should (equal (line-number-at-pos) 3))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "\t\n"
+ "«:whitespace-empty: »"))
+ (execute-kbd-macro (kbd "C-<end>"))
+ (should (equal (line-number-at-pos) 4))
+ (should (eobp))
+ (should (equal (- (point) (line-beginning-position)) 1))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "\t\n"
+ " "))
+
+ ;; The last line should be un-highlighted when point is in that
+ ;; line even if point is not eobp.
+ (execute-kbd-macro (kbd "<left>"))
+ (should (equal (line-number-at-pos) 4))
+ (should (not (eobp)))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "\t\n"
+ " "))
+
+ ;; Make sure lines become re-highlighted as point moves up.
+ (execute-kbd-macro (kbd "<up>"))
+ (should (equal (line-number-at-pos) 3))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "\t\n"
+ "«:whitespace-empty: »"))
+ (execute-kbd-macro (kbd "<up>"))
+ (should (equal (line-number-at-pos) 2))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "«:whitespace-empty:\t\n"
+ " »"))
+ (execute-kbd-macro (kbd "<up>"))
+ (should (equal (line-number-at-pos) 1))
+ (should (whitespace-tests--faceup "x\n"
+ "«:whitespace-empty:\n"
+ "\t\n"
+ " »"))
+
+ ;; Inserting content on line 3 should un-highlight lines 2 and 3.
+ (execute-kbd-macro (kbd "<down> <down> C-a"))
+ (should (equal (line-number-at-pos) 3))
+ (should (equal (- (point) (line-beginning-position)) 0))
+ (execute-kbd-macro (kbd "y <up> <up>"))
+ (should (equal (line-number-at-pos) 1))
+ (should (whitespace-tests--faceup "x\n"
+ "\n"
+ "y\t\n"
+ "«:whitespace-empty: »"))
+
+ ;; Removing the content on line 3 should re-highlight lines 2 and
+ ;; 3.
+ (execute-kbd-macro (kbd "<down> <down> C-a"))
+ (should (equal (line-number-at-pos) 3))
+ (should (equal (- (point) (line-beginning-position)) 0))
+ (execute-kbd-macro (kbd "<deletechar> <up> <up>"))
+ (should (equal (line-number-at-pos) 1))
+ (should (whitespace-tests--faceup "x\n"
+ "«:whitespace-empty:\n"
+ "\t\n"
+ " »"))))
+
+(ert-deftest whitespace-tests--empty-bob-eob-read-only-buffer ()
+ (whitespace-tests--with-test-buffer '()
+ (insert "\nx\n\n")
+ (should (equal (buffer-string) "\nx\n\n"))
+ (setq-local buffer-read-only t)
+ (goto-char 2)
+ (should (equal (line-number-at-pos) 2))
+ (should (equal (- (point) (line-beginning-position)) 0))
+ (let ((whitespace-style '(face empty)))
+ (whitespace-mode 1)
+ (should (whitespace-tests--faceup "«:whitespace-empty:\n"
+ "»x\n"
+ "«:whitespace-empty:\n"
+ "»")))))
+
(provide 'whitespace-tests)
;;; whitespace-tests.el ends here
diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
index e8e103348b..882160743a 100644
--- a/test/lisp/xdg-tests.el
+++ b/test/lisp/xdg-tests.el
@@ -59,6 +59,16 @@
(should (equal (xdg-desktop-strings " ") nil))
(should (equal (xdg-desktop-strings "a; ;") '("a" " "))))
+(ert-deftest xdg-current-desktop ()
+ (let ((env (getenv "XDG_CURRENT_DESKTOP")))
+ (unwind-protect
+ (progn
+ (setenv "XDG_CURRENT_DESKTOP" "KDE")
+ (should (equal (xdg-current-desktop) '("KDE")))
+ (setenv "XDG_CURRENT_DESKTOP" "ubuntu:GNOME")
+ (should (equal (xdg-current-desktop) '("ubuntu" "GNOME"))))
+ (setenv "XDG_CURRENT_DESKTOP" env))))
+
(ert-deftest xdg-mime-associations ()
"Test reading MIME associations from files."
(let* ((apps (ert-resource-file "mimeapps.list"))
diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el
index 9318e8ef59..379ad7bf03 100644
--- a/test/lisp/xt-mouse-tests.el
+++ b/test/lisp/xt-mouse-tests.el
@@ -28,28 +28,34 @@
(defmacro with-xterm-mouse-mode (&rest body)
"Run BODY with `xterm-mouse-mode' temporarily enabled."
(declare (indent 0))
- ;; Make the frame huge so that the test input events below don't hit
- ;; the menu bar.
- `(cl-letf (((frame-width nil) 2000)
- ((frame-height nil) 2000)
- ;; Reset XTerm parameters so that the tests don't get
- ;; confused.
- ((terminal-parameter nil 'xterm-mouse-x) nil)
- ((terminal-parameter nil 'xterm-mouse-y) nil)
- ((terminal-parameter nil 'xterm-mouse-last-down) nil)
- ((terminal-parameter nil 'xterm-mouse-last-click) nil))
- (if xterm-mouse-mode
- (progn ,@body)
- (unwind-protect
- (progn
- ;; `xterm-mouse-mode' doesn't work in the initial
- ;; terminal. Since we can't create a second terminal in
- ;; batch mode, fake it temporarily.
- (cl-letf (((symbol-function 'terminal-name)
- (lambda (&optional _terminal) "fake-terminal")))
- (xterm-mouse-mode))
- ,@body)
- (xterm-mouse-mode 0)))))
+ `(let ((width (frame-width))
+ (height (frame-height)))
+ (unwind-protect
+ (progn
+ ;; Make the frame huge so that the test input events below
+ ;; don't hit the menu bar.
+ (set-frame-width nil (max width 2000))
+ (set-frame-height nil (max height 2000))
+ (cl-letf (;; Reset XTerm parameters so that the tests don't
+ ;; get confused.
+ ((terminal-parameter nil 'xterm-mouse-x) nil)
+ ((terminal-parameter nil 'xterm-mouse-y) nil)
+ ((terminal-parameter nil 'xterm-mouse-last-down) nil)
+ ((terminal-parameter nil 'xterm-mouse-last-click) nil))
+ (if xterm-mouse-mode
+ ,(macroexp-progn body)
+ (unwind-protect
+ (progn
+ ;; `xterm-mouse-mode' doesn't work in the initial
+ ;; terminal. Since we can't create a second
+ ;; terminal in batch mode, fake it temporarily.
+ (cl-letf (((symbol-function 'terminal-name)
+ (lambda (&optional _terminal)
"fake-terminal")))
+ (xterm-mouse-mode))
+ ,@body)
+ (xterm-mouse-mode 0)))))
+ (set-frame-width nil width)
+ (set-frame-height nil height))))
(ert-deftest xt-mouse-tracking-basic ()
(should (equal (xterm-mouse-tracking-enable-sequence)
diff --git a/test/manual/BidiCharacterTest.txt
b/test/manual/BidiCharacterTest.txt
index c30d077861..619d4b4412 100644
--- a/test/manual/BidiCharacterTest.txt
+++ b/test/manual/BidiCharacterTest.txt
@@ -1,14 +1,14 @@
-# BidiCharacterTest-14.0.0.txt
-# Date: 2020-03-30, 23:56:00 GMT [LI]
-# © 2020 Unicode®, Inc.
-# For terms of use, see http://www.unicode.org/terms_of_use.html
+# BidiCharacterTest-15.0.0.txt
+# Date: 2022-05-03, 18:46:00 GMT [LI]
+# © 2022 Unicode®, Inc.
+# For terms of use, see https://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
-# For documentation, see http://www.unicode.org/reports/tr44/
+# For documentation, see https://www.unicode.org/reports/tr44/
#
# This file provides a conformance test for implementations of the
# Unicode Bidirectional Algorithm, specified in UAX #9: Unicode
-# Bidirectional Algorithm, at http://www.unicode.org/reports/tr9/
+# Bidirectional Algorithm, at https://www.unicode.org/reports/tr9/
#
# The test data has been generated with a few constraints. Each test case
# is a single paragraph, so the test data does not contain any characters
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/src/image-tests.el b/test/manual/image-tests.el
similarity index 68%
copy from test/src/image-tests.el
copy to test/manual/image-tests.el
index 36278f4b9f..400657132c 100644
--- a/test/src/image-tests.el
+++ b/test/manual/image-tests.el
@@ -1,8 +1,9 @@
-;;; image-tests.el --- Tests for image.c -*- lexical-binding: t -*-
+;;; image-tests.el --- tests for image.c -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
+;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -21,23 +22,23 @@
;;; Commentary:
-;; Most of these tests will only run in a GUI session, and not with
-;; "make check". Run them manually in an interactive session with
-;; `M-x eval-buffer' followed by `M-x ert'.
+;; These tests will only run in a GUI session. You must run them
+;; manually in an interactive session with, for example, `M-x
+;; eval-buffer' followed by `M-x ert'.
+;;
+;; To run them from the command line instead, try:
+;; ./src/emacs -Q -l test/manual/image-tests.el -eval "(ert t)"
;;; Code:
-(require 'ert)
-
-(defmacro image-skip-unless (format)
- `(skip-unless (and (display-images-p)
- (image-type-available-p ,format))))
-
-;;;; Images
+(defmacro image-skip-unless (format &rest condition)
+ `(skip-unless (and (and (display-images-p)
+ (image-type-available-p ,format))
+ ,@condition)))
(defconst image-tests--images
`((gif . ,(expand-file-name "test/data/image/black.gif"
- source-directory))
+ source-directory))
(jpeg . ,(expand-file-name "test/data/image/black.jpg"
source-directory))
(pbm . ,(find-image '((:file "splash.svg" :type svg))))
@@ -51,6 +52,64 @@
(xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm))))
(xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
+
+;;;; Load image
+
+(defmacro image-tests-make-load-image-test (type)
+ `(ert-deftest ,(intern (format "image-tests-load-image/%s"
+ (eval type t)))
+ ()
+ (image-skip-unless ,type)
+ (let* ((img (cdr (assq ,type image-tests--images)))
+ (file (if (listp img)
+ (plist-get (cdr img) :file)
+ img)))
+ (find-file file))
+ (should (equal major-mode 'image-mode))
+ ;; Cleanup
+ (kill-buffer (current-buffer))))
+
+(image-tests-make-load-image-test 'gif)
+(image-tests-make-load-image-test 'jpeg)
+(image-tests-make-load-image-test 'pbm)
+(image-tests-make-load-image-test 'png)
+(image-tests-make-load-image-test 'svg)
+(image-tests-make-load-image-test 'tiff)
+(image-tests-make-load-image-test 'webp)
+(image-tests-make-load-image-test 'xbm)
+(image-tests-make-load-image-test 'xpm)
+
+(ert-deftest image-tests-load-image/svg-too-big ()
+ (with-temp-buffer
+ (let* ((max-image-size 0)
+ (messages-buffer-name (buffer-name (current-buffer)))
+ (img (cdr (assq 'svg image-tests--images)))
+ (file (if (listp img)
+ (plist-get (cdr img) :file)
+ img)))
+ (save-excursion (find-file file))
+ (should (string-match-p "invalid image size" (buffer-string)))
+ ;; no annoying newlines
+ (should-not (string-match-p "^[ \t\n\r]+$" (buffer-string)))
+ ;; no annoying double error reporting
+ (should-not (string-match-p "error parsing" (buffer-string))))))
+
+(ert-deftest image-tests-load-image/svg-invalid ()
+ (with-temp-buffer
+ (let ((messages-buffer-name (buffer-name (current-buffer))))
+ (with-temp-buffer
+ (pop-to-buffer (current-buffer))
+ (insert (propertize " "
+ 'display '(image :data
+ "invalid foo bar"
+ :type svg)))
+ (redisplay))
+ ;; librsvg error: "... Start tag expected, '<' not found [3 times]"
+ (should (string-match-p "[Ee]rror.+Start tag expected" (buffer-string)))
+ ;; no annoying newlines
+ (should-not (string-match-p "^[ \t\n\r]+$" (buffer-string))))))
+
+
;;;; image-test-size
(declare-function image-size "image.c" (spec &optional pixels frame))
@@ -122,10 +181,7 @@
(skip-unless (display-images-p))
(should-error (image-size 'invalid-spec)))
-(ert-deftest image-tests-image-size/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
- (should-error (image-size 'invalid-spec)))
-
+
;;;; image-mask-p
(declare-function image-mask-p "image.c" (spec &optional frame))
@@ -174,10 +230,7 @@
(skip-unless (display-images-p))
(should-error (image-mask-p 'invalid-spec)))
-(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
- (should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
-
+
;;;; image-metadata
(declare-function image-metadata "image.c" (spec &optional frame))
@@ -186,9 +239,11 @@
;; contain metadata.
(ert-deftest image-tests-image-metadata/gif ()
- (image-skip-unless 'gif)
- (should-not (image-metadata
- (create-image (cdr (assq 'gif image-tests--images))))))
+ (image-skip-unless 'gif
+ (not (bound-and-true-p w32-use-native-image-API)))
+ (should (memq 'delay
+ (image-metadata
+ (create-image (cdr (assq 'gif image-tests--images)))))))
(ert-deftest image-tests-image-metadata/jpeg ()
(image-skip-unless 'jpeg)
@@ -214,8 +269,9 @@
(ert-deftest image-tests-image-metadata/webp ()
(image-skip-unless 'webp)
- (should-not (image-metadata
- (create-image (cdr (assq 'webp image-tests--images))))))
+ (should (memq 'delay
+ (image-metadata
+ (create-image (cdr (assq 'webp image-tests--images)))))))
(ert-deftest image-tests-image-metadata/xbm ()
(image-skip-unless 'xbm)
@@ -229,23 +285,4 @@
(skip-unless (display-images-p))
(should-not (image-metadata 'invalid-spec)))
-(ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
- (should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
-
-;;;; ImageMagick
-
-(ert-deftest image-tests-imagemagick-types ()
- (skip-unless (fboundp 'imagemagick-types))
- (when (fboundp 'imagemagick-types)
- (should (listp (imagemagick-types)))))
-
-;;;; Initialization
-
-(ert-deftest image-tests-init-image-library ()
- (skip-unless (fboundp 'init-image-library))
- (declare-function init-image-library "image.c" (type))
- (should (init-image-library 'pbm)) ; built-in
- (should-not (init-image-library 'invalid-image-type)))
-
-;;; image-tests.el ends here
+;;; image-size-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..beef1dbc09
--- /dev/null
+++ b/test/manual/noverlay/Makefile.in
@@ -0,0 +1,32 @@
+PROGRAM = itree-tests
+LIBS = check
+top_srcdir = @top_srcdir@
+CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(LIBS)) -I $(top_srcdir)/src
+LDFLAGS += $(shell pkg-config --libs $(LIBS)) -lm
+OBJECTS = itree-tests.o
+CC = gcc
+EMACS ?= ../../../src/emacs
+
+.PHONY: all check have-libcheck
+
+all: check
+
+have-libcheck:
+ pkg-config --cflags $(LIBS)
+
+check: have-libcheck $(PROGRAM)
+ ./check-sanitize.sh ./$(PROGRAM)
+
+itree-tests.o: emacs-compat.h itree-tests.c $(top_srcdir)/src/itree.c
$(top_srcdir)/src/itree.h
+
+$(PROGRAM): $(OBJECTS)
+ $(CC) $(CFLAGS) $(LDFLAGS) $(OBJECTS) -o $(PROGRAM)
+
+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..03eedce8a6
--- /dev/null
+++ b/test/manual/noverlay/check-sanitize.sh
@@ -0,0 +1,11 @@
+#!/bin/bash
+
+prog=$1
+shift
+
+[ -z "$prog" ] && {
+ echo "usage:$(basename $0) CHECK_PRGOGRAM";
+ exit 1;
+}
+
+"$prog" "$@" | sed -e 's/^\([^:]\+\):\([0-9]\+\):[PFE]:[^:]*:\([^:]*\):[^:]*:
*\(.*\)/\1:\2:\3:\4/'
diff --git a/test/manual/noverlay/emacs-compat.h
b/test/manual/noverlay/emacs-compat.h
new file mode 100644
index 0000000000..812f8e48a3
--- /dev/null
+++ b/test/manual/noverlay/emacs-compat.h
@@ -0,0 +1,52 @@
+#ifndef TEST_COMPAT_H
+#define TEST_COMPAT_H
+
+#include <stdio.h>
+#include <limits.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 (1);
+}
+
+#ifndef eassert
+#define eassert(cond) \
+ do { \
+ if (! (cond)) { \
+ fprintf (stderr, "\n%s:%d:eassert condition failed: %s\n", \
+ __FILE__, __LINE__ ,#cond); \
+ exit (1); \
+ } \
+ } while (0)
+#endif
+
+#ifndef max
+#define max(x,y) ((x) >= (y) ? (x) : (y))
+#endif
+#ifndef min
+#define min(x,y) ((x) <= (y) ? (x) : (y))
+#endif
+
+#endif
diff --git a/test/manual/noverlay/itree-tests.c
b/test/manual/noverlay/itree-tests.c
new file mode 100644
index 0000000000..a318389213
--- /dev/null
+++ b/test/manual/noverlay/itree-tests.c
@@ -0,0 +1,1381 @@
+#include <config.h>
+#include <check.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include "emacs-compat.h"
+
+#define EMACS_LISP_H /* lisp.h inclusion guard */
+#define ITREE_DEBUG 1
+#define ITREE_TESTING
+#include "itree.c"
+
+/* Basic tests of the interval_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. */
+
+#define N_50 (n[0])
+#define N_30 (n[1])
+#define N_20 (n[2])
+#define N_10 (n[3])
+#define N_15 (n[4])
+#define N_05 (n[5])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node n[6]; \
+ interval_tree_init (&tree); \
+ const int values[] = {50, 30, 20, 10, 15, 5}; \
+ for (int i = 0; i < 6; ++i) \
+ { \
+ n[i].begin = values[i]; \
+ n[i].end = values[i]; \
+ }
+
+START_TEST (test_insert_1)
+{
+ /*
+ * [50]
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (&N_50 == tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_2)
+{
+ /*
+ * [50]
+ * /
+ * (30)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_RED);
+ ck_assert (&N_50 == tree.root);
+ ck_assert (N_30.parent == &N_50);
+ ck_assert (N_50.left == &N_30);
+ ck_assert (N_50.right == &tree.nil);
+ ck_assert (N_30.left == &tree.nil);
+ ck_assert (N_30.right == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_3)
+{
+ /* case 3.a
+ * [30]
+ * / \
+ * (20) (50)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ ck_assert (N_50.color == ITREE_RED);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_30);
+}
+END_TEST
+
+START_TEST (test_insert_4)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * [20] [50]
+ * /
+ * (10)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_30);
+ ck_assert (N_10.parent == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_10.right == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_5)
+{
+ /* 2.a
+ * [30]
+ * / \
+ * [15] [50]
+ * / \
+ * (10) (20)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_RED);
+ ck_assert (N_10.color == ITREE_RED);
+ ck_assert (N_15.color == ITREE_BLACK);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_15);
+ ck_assert (N_10.parent == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_10.right == &tree.nil);
+ ck_assert (N_15.right == &N_20);
+ ck_assert (N_15.left == &N_10);
+ ck_assert (N_15.parent == &N_30);
+
+}
+END_TEST
+
+START_TEST (test_insert_6)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * (15) [50]
+ * / \
+ * [10] [20]
+ * /
+ * (5)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_BLACK);
+ ck_assert (N_15.color == ITREE_RED);
+ ck_assert (N_05.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_15);
+ ck_assert (N_10.parent == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_10.right == &tree.nil);
+ ck_assert (N_15.right == &N_20);
+ ck_assert (N_15.left == &N_10);
+ ck_assert (N_15.parent == &N_30);
+ ck_assert (N_05.parent == &N_10);
+ ck_assert (N_10.left == &N_05);
+ ck_assert (N_05.right == &tree.nil);
+}
+END_TEST
+
+#undef N_50
+#undef N_30
+#undef N_20
+#undef N_10
+#undef N_15
+#undef N_05
+#undef DEF_TEST_SETUP
+
+
+
+/* These are the mirror cases to the above ones. */
+
+#define N_50 (n[0])
+#define N_70 (n[1])
+#define N_80 (n[2])
+#define N_90 (n[3])
+#define N_85 (n[4])
+#define N_95 (n[5])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node n[6]; \
+ interval_tree_init (&tree); \
+ const int values[] = {50, 70, 80, 90, 85, 95}; \
+ for (int i = 0; i < 6; ++i) \
+ { \
+ n[i].begin = values[i]; \
+ n[i].end = values[i]; \
+ }
+
+START_TEST (test_insert_7)
+{
+ /*
+ * [50]
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (&N_50 == tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_8)
+{
+ /*
+ * [50]
+ * \
+ * (70)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_RED);
+ ck_assert (&N_50 == tree.root);
+ ck_assert (N_70.parent == &N_50);
+ ck_assert (N_50.right == &N_70);
+ ck_assert (N_50.left == &tree.nil);
+ ck_assert (N_70.right == &tree.nil);
+ ck_assert (N_70.left == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_9)
+{
+ /* 3.a
+ * [70]
+ * / \
+ * (50) (80)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ ck_assert (N_50.color == ITREE_RED);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_80);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_70);
+}
+END_TEST
+
+START_TEST (test_insert_10)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] [80]
+ * \
+ * (90)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_BLACK);
+ ck_assert (N_90.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_80);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &N_90);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_70);
+ ck_assert (N_90.parent == &N_80);
+ ck_assert (N_80.right == &N_90);
+ ck_assert (N_90.left == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_11)
+{
+ /* 2.b
+ * [70]
+ * / \
+ * [50] [85]
+ * / \
+ * (80) (90)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_RED);
+ ck_assert (N_90.color == ITREE_RED);
+ ck_assert (N_85.color == ITREE_BLACK);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_85);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_85);
+ ck_assert (N_90.parent == &N_85);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_90.left == &tree.nil);
+ ck_assert (N_85.right == &N_90);
+ ck_assert (N_85.left == &N_80);
+ ck_assert (N_85.parent == &N_70);
+
+}
+END_TEST
+
+START_TEST (test_insert_12)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] (85)
+ * / \
+ * [80] [90]
+ * \
+ * (95)
+ */
+
+ DEF_TEST_SETUP ();
+ 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.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_BLACK);
+ ck_assert (N_90.color == ITREE_BLACK);
+ ck_assert (N_85.color == ITREE_RED);
+ ck_assert (N_95.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_85);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_85);
+ ck_assert (N_90.parent == &N_85);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_90.left == &tree.nil);
+ ck_assert (N_85.right == &N_90);
+ ck_assert (N_85.left == &N_80);
+ ck_assert (N_85.parent == &N_70);
+ ck_assert (N_95.parent == &N_90);
+ ck_assert (N_90.right == &N_95);
+ ck_assert (N_95.left == &tree.nil);
+}
+END_TEST
+
+#undef N_50
+#undef N_70
+#undef N_80
+#undef N_90
+#undef N_85
+#undef N_95
+#undef DEF_TEST_SETUP
+
+struct interval_tree*
+test_get_tree4 (struct interval_node **n)
+{
+ static struct interval_tree tree;
+ static struct interval_node nodes[4];
+ memset (&tree, 0, sizeof (struct interval_tree));
+ memset (&nodes, 0, 4 * sizeof (struct interval_node));
+ interval_tree_init (&tree);
+ for (int i = 0; i < 4; ++i)
+ {
+ nodes[i].begin = 10 * (i + 1);
+ nodes[i].end = nodes[i].begin;
+ interval_tree_insert (&tree, &nodes[i]);
+ }
+ *n = nodes;
+ return &tree;
+}
+
+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;
+ }
+}
+
+#define N_10 (nodes[0])
+#define N_20 (nodes[1])
+#define N_30 (nodes[2])
+#define N_40 (nodes[3])
+
+START_TEST (test_insert_13)
+{
+ struct interval_node *nodes = NULL;
+ struct interval_tree *tree = test_get_tree4 (&nodes);
+
+
+ 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_10.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_RED);
+}
+END_TEST
+
+START_TEST (test_insert_14)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[3];
+
+ nodes[0].begin = nodes[1].begin = nodes[2].begin = 10;
+ nodes[0].end = nodes[1].end = nodes[2].end = 10;
+
+ for (int i = 0; i < 3; ++i)
+ interval_tree_insert (&tree, &nodes[i]);
+ for (int i = 0; i < 3; ++i)
+ ck_assert (interval_tree_contains (&tree, &nodes[i]));
+}
+END_TEST
+
+
+
+
+/*
+===================================================================================+
+ * | Remove
+ *
+===================================================================================+
*/
+
+#define A (nodes[0])
+#define B (nodes[1])
+#define C (nodes[2])
+#define D (nodes[3])
+#define E (nodes[4])
+
+/* Creating proper test trees for the formal tests via insertions is
+ way to tedious, so we just fake it and only test the
+ fix-routine. */
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node nodes[5]; \
+ interval_tree_init (&tree); \
+ tree.root = &B; \
+ A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
+ D.parent = &B; E.parent = &D; \
+ A.left = A.right = C.left = C.right = &tree.nil; \
+ E.left = E.right = &tree.nil; \
+ B.left = &A; B.right = &D; D.left = &C; D.right = &E \
+
+/* 1.a -> 2.a
+ * [B]
+ * / \
+ * [A] (D)
+ * / \
+ * [C] [E]
+ */
+
+
+START_TEST (test_remove_1)
+{
+ DEF_TEST_SETUP ();
+ B.color = A.color = C.color = E.color = ITREE_BLACK;
+ D.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (D.right == &E);
+ ck_assert (D.left == &B);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+/* 2.a */
+START_TEST (test_remove_2)
+{
+ DEF_TEST_SETUP ();
+ B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_RED);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &D);
+ ck_assert (C.parent == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &B);
+}
+END_TEST
+
+/* 3.a -> 4.a*/
+START_TEST (test_remove_3)
+{
+ DEF_TEST_SETUP ();
+ D.color = A.color = E.color = ITREE_BLACK;
+ B.color = C.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &tree.nil);
+ ck_assert (&C == tree.root);
+ ck_assert (C.left == &B);
+ ck_assert (C.right == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (D.left == &tree.nil);
+
+}
+END_TEST
+
+/* 4.a */
+START_TEST (test_remove_4)
+{
+ DEF_TEST_SETUP ();
+ B.color = C.color = E.color = ITREE_RED;
+ A.color = D.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+
+#undef A
+#undef B
+#undef C
+#undef D
+#undef E
+#undef DEF_TEST_SETUP
+
+
+
+/* These are the mirrored cases. */
+
+#define A (nodes[0])
+#define B (nodes[1])
+#define C (nodes[2])
+#define D (nodes[3])
+#define E (nodes[4])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node nodes[5]; \
+ interval_tree_init (&tree); \
+ tree.root = &B; \
+ A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
+ D.parent = &B; E.parent = &D; \
+ A.right = A.left = C.right = C.left = &tree.nil; \
+ E.right = E.left = &tree.nil; \
+ 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)
+{
+ DEF_TEST_SETUP ();
+ B.color = A.color = C.color = E.color = ITREE_BLACK;
+ D.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (D.left == &E);
+ ck_assert (D.right == &B);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+/* 2.b */
+START_TEST (test_remove_6)
+{
+ DEF_TEST_SETUP ();
+ B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_RED);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &D);
+ ck_assert (C.parent == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &B);
+}
+END_TEST
+
+/* 3.b -> 4.b*/
+START_TEST (test_remove_7)
+{
+ DEF_TEST_SETUP ();
+ D.color = A.color = E.color = ITREE_BLACK;
+ B.color = C.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &tree.nil);
+ ck_assert (&C == tree.root);
+ ck_assert (C.right == &B);
+ ck_assert (C.left == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (D.right == &tree.nil);
+
+}
+END_TEST
+
+/* 4.b */
+START_TEST (test_remove_8)
+{
+ DEF_TEST_SETUP ();
+ B.color = C.color = E.color = ITREE_RED;
+ A.color = D.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+
+#undef A
+#undef B
+#undef C
+#undef D
+#undef E
+#undef DEF_TEST_SETUP
+
+
+START_TEST (test_remove_9)
+{
+ struct interval_node *nodes = NULL;
+ struct interval_tree *tree = test_get_tree4 (&nodes);
+
+ 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.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_RED);
+
+ interval_tree_remove (tree, &N_10);
+
+ ck_assert (tree->root == &N_30);
+ ck_assert (N_30.parent == &tree->nil);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_30.right == &N_40);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_BLACK);
+}
+END_TEST
+
+#define N 3
+
+START_TEST (test_remove_10)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[N];
+ int index[N];
+
+ srand (42);
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i].begin = (i + 1) * 10;
+ nodes[i].end = nodes[i].begin + 1;
+ index[i] = i;
+ }
+ shuffle (index, N);
+ for (int i = 0; i < N; ++i)
+ interval_tree_insert (&tree, &nodes[index[i]]);
+
+ shuffle (index, N);
+ for (int i = 0; i < N; ++i)
+ {
+ ck_assert (interval_tree_contains (&tree, &nodes[index[i]]));
+ interval_tree_remove (&tree, &nodes[index[i]]);
+ }
+ ck_assert (tree.root == &tree.nil);
+ ck_assert (tree.size == 0);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Generator
+ *
+===================================================================================+
*/
+
+START_TEST (test_generator_1)
+{
+ struct interval_tree tree;
+ struct interval_node node, *n;
+ struct interval_generator *g;
+ interval_tree_init (&tree);
+ node.begin = 10;
+ node.end = 20;
+ interval_tree_insert (&tree, &node);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 30, ITREE_ASCENDING);
+ n = interval_generator_next (g);
+ ck_assert (n == &node);
+ ck_assert (n->begin == 10 && n->end == 20);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ interval_generator_destroy (g);
+
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 30, 50, ITREE_ASCENDING);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ interval_generator_destroy (g);
+}
+END_TEST
+
+void
+test_check_generator (struct interval_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end,
+ int n, ...)
+{
+ va_list ap;
+ struct interval_generator *g = interval_generator_create (tree);
+ interval_generator_reset (g, begin, end, ITREE_ASCENDING);
+
+ va_start (ap, n);
+ for (int i = 0; i < n; ++i)
+ {
+ ptrdiff_t begin = va_arg (ap, ptrdiff_t);
+ struct interval_node *node = interval_generator_next (g);
+ ck_assert (node);
+ ck_assert_int_eq (node->begin, begin);
+ }
+ va_end (ap);
+ ck_assert (! interval_generator_next (g));
+ ck_assert (! interval_generator_next (g));
+ interval_generator_destroy (g);
+}
+
+#define DEF_TEST_SETUP() \
+
+
+START_TEST (test_generator_2)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[3];
+
+ interval_tree_init (&tree);
+
+ for (int i = 0; i < 3; ++i) {
+ nodes[i].begin = 10 * (i + 1);
+ nodes[i].end = 10 * (i + 2);
+ interval_tree_insert (&tree, &nodes[i]);
+ }
+
+ 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
+
+
+struct interval_node*
+test_create_tree (struct interval_tree *tree, int n,
+ bool doshuffle, ...)
+{
+ va_list ap;
+ struct interval_node *nodes = calloc (n, sizeof (struct interval_node));
+ int *index = calloc (n, sizeof (int));
+
+ interval_tree_init (tree);
+ va_start (ap, doshuffle);
+ for (int i = 0; i < n; ++i)
+ {
+ ptrdiff_t begin = va_arg (ap, ptrdiff_t);
+ ptrdiff_t end = va_arg (ap, ptrdiff_t);
+ nodes[i].begin = begin;
+ nodes[i].end = end;
+ index[i] = i;
+ }
+ va_end (ap);
+ srand (42);
+ if (doshuffle)
+ shuffle (index, n);
+ for (int i = 0; i < n; ++i)
+ interval_tree_insert (tree, &nodes[index[i]]);
+ free (index);
+
+ return nodes;
+}
+
+START_TEST (test_generator_3)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes = NULL;
+
+ nodes = test_create_tree (&tree, 3, true,
+ 10, 10,
+ 10, 10,
+ 10, 10);
+ 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);
+ free (nodes);
+}
+END_TEST
+
+#define FOREACH(n, g) \
+ for ((n) = interval_generator_next (g); (n) != NULL; \
+ (n) = interval_generator_next (g))
+
+START_TEST (test_generator_5)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, false,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_PRE_ORDER);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (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;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_6)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, true,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_ASCENDING);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (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;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_7)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, true,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_DESCENDING);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (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;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_8)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes, *n;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 2, false,
+ 20, 30,
+ 40, 50);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 1, 60, ITREE_DESCENDING);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 40);
+ interval_generator_narrow (g, 50, 60);
+ n = interval_generator_next (g);
+ ck_assert (n == NULL);
+ free (nodes);
+}
+END_TEST
+
+
+START_TEST (test_generator_9)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes, *n;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 2, false,
+ 25, 25,
+ 20, 30);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 1, 30, ITREE_DESCENDING);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 25);
+ interval_generator_narrow (g, 25, 35);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 20);
+ free (nodes);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Insert Gap
+ *
+===================================================================================+
*/
+
+static struct interval_tree gap_tree;
+static struct interval_node gap_node;
+
+#define N_BEG (interval_tree_validate (&gap_tree, &gap_node)->begin)
+#define N_END (interval_tree_validate (&gap_tree, &gap_node)->end)
+
+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.begin = begin;
+ gap_node.end = end;
+ gap_node.front_advance = front_advance;
+ gap_node.rear_advance = rear_advance;
+ interval_tree_insert (&gap_tree, &gap_node);
+}
+
+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 (100, 200, false, false);
+ interval_tree_insert_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_insert_2)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 300, 10);
+ 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 (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 0, 15);
+ 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);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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 (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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);
+ interval_tree_insert_gap (&gap_tree, 200, 20);
+ 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 (100, 200, false, false);
+ interval_tree_insert_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_insert_8)
+{
+ test_setup_gap_node (100, 100, true, true);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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 (100, 100, false, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ 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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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);
+ interval_tree_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
+
+
+
+Suite * basic_suite ()
+{
+ Suite *s = suite_create ("basic_suite");
+ TCase *tc = tcase_create ("basic_test");
+
+ 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);
+ 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);
+ tcase_add_test (tc, test_insert_13);
+
+ 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);
+ 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);
+ tcase_add_test (tc, test_remove_9);
+ tcase_add_test (tc, test_remove_10);
+
+ 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);
+
+ 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);
+
+ 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);
+
+ /* tcase_set_timeout (tc, 120); */
+ suite_add_tcase (s, tc);
+ return s;
+}
+
+int
+main (void)
+{
+ int nfailed;
+ Suite *s = basic_suite ();
+ SRunner *sr = srunner_create (s);
+
+ srunner_run_all (sr, CK_NORMAL);
+ 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..e84941c08f
--- /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 expectes 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 3c6a9208ff..e020732524 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -20,8 +20,202 @@
;;; Code:
(require 'ert)
+(require 'seq)
(require 'ert-x)
(require 'cl-lib)
+(require 'let-alist)
+
+(defun overlay-tests-start-recording-modification-hooks (overlay)
+ "Start recording modification hooks on OVERLAY.
+
+Always overwrites the `insert-in-front-hooks',
+`modification-hooks' and `insert-behind-hooks' properties. Any
+recorded history from a previous call is erased.
+
+The history is stored in a property on the overlay itself. Call
+`overlay-tests-get-recorded-modification-hooks' to retrieve the
+recorded calls conveniently."
+ (dolist (hooks-property '(insert-in-front-hooks
+ modification-hooks
+ insert-behind-hooks))
+ (overlay-put
+ 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)
+ (overlay-get overlay
+ 'recorded-modification-hook-calls)))))
+ (overlay-put overlay 'recorded-modification-hook-calls nil)))
+
+(defun overlay-tests-get-recorded-modification-hooks (overlay)
+ "Extract the recorded calls made to modification hooks on OVERLAY.
+
+Must be preceded by a call to
+`overlay-tests-start-recording-modification-hooks' on OVERLAY.
+
+Returns a list. Each element of the list represents a recorded
+call to a particular modification hook.
+
+Each call is itself a sub-list where the first element is a
+symbol matching the modification hook property (one of
+`insert-in-front-hooks', `modification-hooks' or
+`insert-behind-hooks') and the second element is the list of
+arguments passed to the hook. The first hook argument, the
+overlay itself, is omitted to make test result verification
+easier."
+ (reverse (overlay-get overlay
+ 'recorded-modification-hook-calls)))
+
+(ert-deftest overlay-modification-hooks ()
+ "Test the basic functionality of overlay modification hooks.
+
+This exercises hooks registered on the `insert-in-front-hooks',
+`modification-hooks' and `insert-behind-hooks' overlay
+properties."
+ ;; This is a data driven test loop. Each test case is described
+ ;; by an alist. The test loop initializes a new temporary buffer
+ ;; for each case, creates an overlay, registers modification hooks
+ ;; on the overlay, modifies the buffer, and then verifies which
+ ;; modification hooks (if any) were called for the overlay, as
+ ;; well as which arguments were passed to the hooks.
+ ;;
+ ;; The following keys are available in the alist:
+ ;;
+ ;; `buffer-text': the initial buffer text of the temporary buffer.
+ ;; Defaults to "1234".
+ ;;
+ ;; `overlay-beg' and `overlay-end': the begin and end positions of
+ ;; the overlay under test. Defaults to 2 and 4 respectively.
+ ;;
+ ;; `insert-at': move to the given position and insert the string
+ ;; "x" into the test case's buffer.
+ ;;
+ ;; `replace': replace the first occurrence of the given string in
+ ;; the test case's buffer with "x". The test will fail if the
+ ;; string is not found.
+ ;;
+ ;; `expected-calls': a description of the expected buffer
+ ;; modification hooks. See
+ ;; `overlay-tests-get-recorded-modification-hooks' for the format.
+ ;; May be omitted, in which case the test will insist that no
+ ;; modification hooks are called.
+ ;;
+ ;; The test will fail itself in the degenerate case where no
+ ;; buffer modifications are requested.
+ (dolist (test-case
+ '(
+ ;; Remember that the default buffer text is "1234" and
+ ;; the default overlay begins at position 2 and ends at
+ ;; position 4. Most of the test cases below assume
+ ;; this.
+
+ ;; TODO: (info "(elisp) Special Properties") says this
+ ;; about `modification-hooks': "Furthermore, insertion
+ ;; will not modify any existing character, so this hook
+ ;; will only be run when removing some characters,
+ ;; replacing them with others, or changing their
+ ;; text-properties." So, why are modification-hooks
+ ;; being called when inserting at position 3 below?
+ ((insert-at . 1))
+ ((insert-at . 2)
+ (expected-calls . ((insert-in-front-hooks (nil 2 2))
+ (insert-in-front-hooks (t 2 3 0)))))
+ ((insert-at . 3)
+ (expected-calls . ((modification-hooks (nil 3 3))
+ (modification-hooks (t 3 4 0)))))
+ ((insert-at . 4)
+ (expected-calls . ((insert-behind-hooks (nil 4 4))
+ (insert-behind-hooks (t 4 5 0)))))
+ ((insert-at . 5))
+
+ ;; Replacing text never calls `insert-in-front-hooks'
+ ;; or `insert-behind-hooks'. It calls
+ ;; `modification-hooks' if the overlay covers any text
+ ;; that has changed.
+ ((replace . "1"))
+ ((replace . "2")
+ (expected-calls . ((modification-hooks (nil 2 3))
+ (modification-hooks (t 2 3 1)))))
+ ((replace . "3")
+ (expected-calls . ((modification-hooks (nil 3 4))
+ (modification-hooks (t 3 4 1)))))
+ ((replace . "4"))
+ ((replace . "12")
+ (expected-calls . ((modification-hooks (nil 1 3))
+ (modification-hooks (t 1 2 2)))))
+ ((replace . "23")
+ (expected-calls . ((modification-hooks (nil 2 4))
+ (modification-hooks (t 2 3 2)))))
+ ((replace . "34")
+ (expected-calls . ((modification-hooks (nil 3 5))
+ (modification-hooks (t 3 4 2)))))
+ ((replace . "123")
+ (expected-calls . ((modification-hooks (nil 1 4))
+ (modification-hooks (t 1 2 3)))))
+ ((replace . "234")
+ (expected-calls . ((modification-hooks (nil 2 5))
+ (modification-hooks (t 2 3 3)))))
+ ((replace . "1234")
+ (expected-calls . ((modification-hooks (nil 1 5))
+ (modification-hooks (t 1 2 4)))))
+
+ ;; Inserting at the position of a zero-length overlay
+ ;; calls both `insert-in-front-hooks' and
+ ;; `insert-behind-hooks'.
+ ((buffer-text . "") (overlay-beg . 1) (overlay-end . 1)
+ (insert-at . 1)
+ (expected-calls . ((insert-in-front-hooks
+ (nil 1 1))
+ (insert-behind-hooks
+ (nil 1 1))
+ (insert-in-front-hooks
+ (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-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
@@ -666,6 +860,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
@@ -743,6 +964,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 ()
@@ -854,6 +1108,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)
;; +==========================================================================+
@@ -1146,6 +1443,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
@@ -1314,6 +1619,6559 @@ with parameters from the *Messages* buffer
modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+(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 failng 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
+ (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 "................................................................")
+ (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 overlay-autogenerated-test-2 nil
+ (with-temp-buffer
+ (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 "................................................................")
+ (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)
+ (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 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"
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index eb096f2112..652af41729 100644
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -57,7 +57,7 @@
errors)))
(setq expected (cdr expected)))))
(when errors
- (ert-fail (mapconcat (lambda (line) line) (nreverse errors) "")))))
+ (ert-fail (mapconcat #'identity (nreverse errors))))))
(defconst casefiddle-tests--characters
@@ -98,7 +98,7 @@
errors)))
(setq props (cdr props) tabs (cdr tabs) expected (cdr expected)))))
(when errors
- (mapconcat (lambda (line) line) (nreverse errors) "")))))
+ (mapconcat #'identity (nreverse errors))))))
(ert-deftest casefiddle-tests-casing-character ()
@@ -116,7 +116,7 @@
errors)))
(setq funcs (cdr funcs) expected (cdr expected)))))
(when errors
- (mapconcat (lambda (line) line) (nreverse errors) "")))))
+ (mapconcat (lambda (line) line) (nreverse errors))))))
(ert-deftest casefiddle-tests-casing-word ()
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 1b239cec79..734b4a0d22 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -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
@@ -860,21 +860,26 @@ Return a list of results."
(cl-eval-when (compile eval load)
(defconst comp-tests-type-spec-tests
- `(
+ ;; Why we quote everything here, you ask? So that values of
+ ;; `most-positive-fixnum' and `most-negative-fixnum', which can be
+ ;; architecture-dependent, do not end up hardcoded in the
+ ;; resulting byte-compiled file, and thus we could run the same
+ ;; .elc file on several architectures without fear.
+ '(
;; 1
((defun comp-tests-ret-type-spec-f (x)
x)
- t)
+ 't)
;; 2
((defun comp-tests-ret-type-spec-f ()
1)
- (integer 1 1))
+ '(integer 1 1))
;; 3
((defun comp-tests-ret-type-spec-f (x)
(if x 1 3))
- (or (integer 1 1) (integer 3 3)))
+ '(or (integer 1 1) (integer 3 3)))
;; 4
((defun comp-tests-ret-type-spec-f (x)
@@ -883,7 +888,7 @@ Return a list of results."
(setf y 1)
(setf y 2))
y))
- (integer 1 2))
+ '(integer 1 2))
;; 5
((defun comp-tests-ret-type-spec-f (x)
@@ -892,73 +897,73 @@ Return a list of results."
(setf y 1)
(setf y 3))
y))
- (or (integer 1 1) (integer 3 3)))
+ '(or (integer 1 1) (integer 3 3)))
;; 6
((defun comp-tests-ret-type-spec-f (x)
(if x
(list x)
3))
- (or cons (integer 3 3)))
+ '(or cons (integer 3 3)))
;; 7
((defun comp-tests-ret-type-spec-f (x)
(if x
'foo
3))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 8
((defun comp-tests-ret-type-spec-f (x)
(if (eq x 3)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 9
((defun comp-tests-ret-type-spec-f (x)
(if (eq 3 x)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 10
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 3)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 11
((defun comp-tests-ret-type-spec-f (x)
(if (eql 3 x)
x
'foo))
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;; 12
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 3)
'foo
x))
- (not (integer 3 3)))
+ '(not (integer 3 3)))
;; 13
((defun comp-tests-ret-type-spec-f (x y)
(if (= x y)
x
'foo))
- (or (member foo) marker number))
+ '(or (member foo) marker number))
;; 14
((defun comp-tests-ret-type-spec-f (x)
(comp-hint-fixnum x))
- (integer ,most-negative-fixnum ,most-positive-fixnum))
+ `(integer ,most-negative-fixnum ,most-positive-fixnum))
;; 15
((defun comp-tests-ret-type-spec-f (x)
(comp-hint-cons x))
- cons)
+ 'cons)
;; 16
((defun comp-tests-ret-type-spec-f (x)
@@ -966,7 +971,7 @@ Return a list of results."
(when x
(setf y 4))
y))
- (or null (integer 4 4)))
+ '(or null (integer 4 4)))
;; 17
((defun comp-tests-ret-type-spec-f ()
@@ -974,7 +979,7 @@ Return a list of results."
(y 3))
(setf x y)
y))
- (integer 3 3))
+ '(integer 3 3))
;; 18
((defun comp-tests-ret-type-spec-f (x)
@@ -982,120 +987,120 @@ Return a list of results."
(when x
(setf y x))
y))
- t)
+ 't)
;; 19
((defun comp-tests-ret-type-spec-f (x y)
(eq x y))
- boolean)
+ 'boolean)
;; 20
((defun comp-tests-ret-type-spec-f (x)
(when x
'foo))
- (or (member foo) null))
+ '(or (member foo) null))
;; 21
((defun comp-tests-ret-type-spec-f (x)
(unless x
'foo))
- (or (member foo) null))
+ '(or (member foo) null))
;; 22
((defun comp-tests-ret-type-spec-f (x)
(when (> x 3)
x))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 23
((defun comp-tests-ret-type-spec-f (x)
(when (>= x 3)
x))
- (or null float (integer 3 *)))
+ '(or null float (integer 3 *)))
;; 24
((defun comp-tests-ret-type-spec-f (x)
(when (< x 3)
x))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 25
((defun comp-tests-ret-type-spec-f (x)
(when (<= x 3)
x))
- (or null float (integer * 3)))
+ '(or null float (integer * 3)))
;; 26
((defun comp-tests-ret-type-spec-f (x)
(when (> 3 x)
x))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 27
((defun comp-tests-ret-type-spec-f (x)
(when (>= 3 x)
x))
- (or null float (integer * 3)))
+ '(or null float (integer * 3)))
;; 28
((defun comp-tests-ret-type-spec-f (x)
(when (< 3 x)
x))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 29
((defun comp-tests-ret-type-spec-f (x)
(when (<= 3 x)
x))
- (or null float (integer 3 *)))
+ '(or null float (integer 3 *)))
;; 30
((defun comp-tests-ret-type-spec-f (x)
(let ((y 3))
(when (> x y)
x)))
- (or null float (integer 4 *)))
+ '(or null float (integer 4 *)))
;; 31
((defun comp-tests-ret-type-spec-f (x)
(let ((y 3))
(when (> y x)
x)))
- (or null float (integer * 2)))
+ '(or null float (integer * 2)))
;; 32
((defun comp-tests-ret-type-spec-f (x)
(when (and (> x 3)
(< x 10))
x))
- (or null float (integer 4 9)))
+ '(or null float (integer 4 9)))
;; 33
((defun comp-tests-ret-type-spec-f (x)
(when (or (> x 3)
(< x 10))
x))
- (or null float integer))
+ '(or null float integer))
;; 34
((defun comp-tests-ret-type-spec-f (x)
(when (or (< x 3)
(> x 10))
x))
- (or null float (integer * 2) (integer 11 *)))
+ '(or null float (integer * 2) (integer 11 *)))
;; 35 No float range support.
((defun comp-tests-ret-type-spec-f (x)
(when (> x 1.0)
x))
- (or null marker number))
+ '(or null marker number))
;; 36
((defun comp-tests-ret-type-spec-f (x y)
(when (and (> x 3)
(> y 2))
(+ x y)))
- (or null float (integer 7 *)))
+ '(or null float (integer 7 *)))
;; 37
;; SBCL: (OR REAL NULL)
@@ -1103,14 +1108,14 @@ Return a list of results."
(when (and (<= x 3)
(<= y 2))
(+ x y)))
- (or null float (integer * 5)))
+ '(or null float (integer * 5)))
;; 38
((defun comp-tests-ret-type-spec-f (x y)
(when (and (< 1 x 5)
(< 1 y 5))
(+ x y)))
- (or null float (integer 4 8)))
+ '(or null float (integer 4 8)))
;; 39
;; SBCL gives: (OR REAL NULL)
@@ -1118,7 +1123,7 @@ Return a list of results."
(when (and (<= 1 x 10)
(<= 2 y 3))
(+ x y)))
- (or null float (integer 3 13)))
+ '(or null float (integer 3 13)))
;; 40
;; SBCL: (OR REAL NULL)
@@ -1126,42 +1131,42 @@ Return a list of results."
(when (and (<= 1 x 10)
(<= 2 y 3))
(- x y)))
- (or null float (integer -2 8)))
+ '(or null float (integer -2 8)))
;; 41
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 1 x)
(<= 2 y 3))
(- x y)))
- (or null float (integer -2 *)))
+ '(or null float (integer -2 *)))
;; 42
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 1 x 10)
(<= 2 y))
(- x y)))
- (or null float (integer * 8)))
+ '(or null float (integer * 8)))
;; 43
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= x 10)
(<= 2 y))
(- x y)))
- (or null float (integer * 8)))
+ '(or null float (integer * 8)))
;; 44
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= x 10)
(<= y 3))
(- x y)))
- (or null float integer))
+ '(or null float integer))
;; 45
((defun comp-tests-ret-type-spec-f (x y)
(when (and (<= 2 x)
(<= 3 y))
(- x y)))
- (or null float integer))
+ '(or null float integer))
;; 46
;; SBCL: (OR (RATIONAL (6) (30)) (SINGLE-FLOAT 6.0 30.0)
@@ -1174,63 +1179,63 @@ Return a list of results."
(< 1 j 5)
(< 1 k 5))
(+ x y z i j k)))
- (or null float (integer 12 24)))
+ '(or null float (integer 12 24)))
;; 47
((defun comp-tests-ret-type-spec-f (x)
(when (<= 1 x 5)
(1+ x)))
- (or null float (integer 2 6)))
+ '(or null float (integer 2 6)))
;;48
((defun comp-tests-ret-type-spec-f (x)
(when (<= 1 x 5)
(1- x)))
- (or null float (integer 0 4)))
+ '(or null float (integer 0 4)))
;; 49
((defun comp-tests-ret-type-spec-f ()
(error "Foo"))
- nil)
+ 'nil)
;; 50
((defun comp-tests-ret-type-spec-f (x)
(if (stringp x)
x
'bar))
- (or (member bar) string))
+ '(or (member bar) string))
;; 51
((defun comp-tests-ret-type-spec-f (x)
(if (stringp x)
'bar
x))
- (not string))
+ '(not string))
;; 52
((defun comp-tests-ret-type-spec-f (x)
(if (integerp x)
x
'bar))
- (or (member bar) integer))
+ '(or (member bar) integer))
;; 53
((defun comp-tests-ret-type-spec-f (x)
(when (integerp x)
x))
- (or null integer))
+ '(or null integer))
;; 54
((defun comp-tests-ret-type-spec-f (x)
(unless (symbolp x)
x))
- t)
+ 't)
;; 55
((defun comp-tests-ret-type-spec-f (x)
(unless (integerp x)
x))
- (not integer))
+ '(not integer))
;; 56
((defun comp-tests-ret-type-spec-f (x)
@@ -1238,7 +1243,7 @@ Return a list of results."
(1 (message "one"))
(5 (message "five")))
x)
- t
+ 't
;; FIXME improve `comp-cond-cstrs-target-mvar' to cross block
;; boundary if necessary as this should return:
;; (or (integer 1 1) (integer 5 5))
@@ -1250,7 +1255,7 @@ Return a list of results."
(eql x 3))
(error "Not foo or 3"))
x)
- (or (member foo) (integer 3 3)))
+ '(or (member foo) (integer 3 3)))
;;58
((defun comp-tests-ret-type-spec-f (x y)
@@ -1259,7 +1264,7 @@ Return a list of results."
(<= x y))
x
(error "")))
- (integer 0 *))
+ '(integer 0 *))
;; 59
((defun comp-tests-ret-type-spec-f (x y)
@@ -1268,7 +1273,7 @@ Return a list of results."
(<= x y))
x
(error "")))
- (or float (integer 3 10)))
+ '(or float (integer 3 10)))
;; 60
((defun comp-tests-ret-type-spec-f (x y)
@@ -1277,56 +1282,56 @@ Return a list of results."
(>= x y))
x
(error "")))
- (or float (integer 3 10)))
+ '(or float (integer 3 10)))
;; 61
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.0)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 62
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.0)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 63
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1.1)
x
(error "")))
- (member 1.1))
+ '(member 1.1))
;; 64
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 65
((defun comp-tests-ret-type-spec-f (x)
(if (= x 1)
x
(error "")))
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 66
((defun comp-tests-ret-type-spec-f (x)
(if (eql x 0.0)
x
(error "")))
- float)
+ 'float)
;; 67
((defun comp-tests-ret-type-spec-f (x)
(if (equal x '(1 2 3))
x
(error "")))
- cons)
+ 'cons)
;; 68
((defun comp-tests-ret-type-spec-f (x)
@@ -1335,7 +1340,7 @@ Return a list of results."
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 69
((defun comp-tests-ret-type-spec-f (x)
@@ -1344,7 +1349,7 @@ Return a list of results."
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
- (or (member 1.0) (integer 1 1)))
+ '(or (member 1.0) (integer 1 1)))
;; 70
((defun comp-tests-ret-type-spec-f (x y)
@@ -1353,14 +1358,14 @@ Return a list of results."
(= x y))
x
(error "")))
- (or float integer))
+ '(or float integer))
;; 71
((defun comp-tests-ret-type-spec-f (x)
(if (= x 0.0)
x
(error "")))
- (or (member -0.0 0.0) (integer 0 0)))
+ '(or (member -0.0 0.0) (integer 0 0)))
;; 72
((defun comp-tests-ret-type-spec-f (x)
@@ -1369,27 +1374,27 @@ Return a list of results."
(unless (eql x -0.0)
(error ""))
x)
- float)
+ 'float)
;; 73
((defun comp-tests-ret-type-spec-f (x)
(when (eql x 1.0)
(error ""))
x)
- t)
+ 't)
;; 74
((defun comp-tests-ret-type-spec-f (x)
(if (eq x 0)
(error "")
(1+ x)))
- number)))
+ 'number)))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
,(format "Type specifier test number %d." number)
(let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-tests-check-ret-type-spec ',(car x) ',(cadr x))))))
+ (comp-tests-check-ret-type-spec ',(car x) ,(cadr x))))))
(defmacro comp-tests-define-type-spec-tests ()
"Define all type specifier tests."
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 0f84b2fb77..463a894d09 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -200,8 +200,7 @@ this is exactly representable and is greater than
nibbles)
(setf v (nthcdr 4 v)))
(mapconcat (lambda (n) (format "%X" n))
- (nreverse nibbles)
- "")))
+ (nreverse nibbles))))
(defun test-bool-vector-count-consecutive-tc (desc)
"Run a test case for `bool-vector-count-consecutive'.
diff --git a/test/src/emacs-module-resources/mod-test.c
b/test/src/emacs-module-resources/mod-test.c
index 187af821c2..b47a0b7a39 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -24,7 +24,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <errno.h>
#include <limits.h>
-#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
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 1b2ad99360..bb2f04e8ee 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -108,26 +108,6 @@ Bug#24912."
(should-error (eval (cons 'cond clauses) nil))
(should-error (eval (cons 'cond clauses) t))))
-(defun eval-tests--exceed-specbind-limit ()
- (defvar eval-tests--var1)
- (defvar eval-tests--var2)
- ;; Bind two variables, to make extra sure we hit the
- ;; `max-specpdl-size' limit before the `max-lisp-eval-depth' limit.
- (let ((eval-tests--var1 1)
- (eval-tests--var2 2))
- ;; Recurse until we hit the limit.
- (eval-tests--exceed-specbind-limit)))
-
-(ert-deftest eval-exceed-specbind-with-signal-hook ()
- "Test for Bug#30481.
-Check that Emacs doesn't crash when exceeding specbind limit with
-`signal-hook-function' bound. NOTE: Without the fix for
-Bug#30481, this test can appear to pass, but cause a
-crash/abort/malloc assert failure on the next test."
- (let ((max-specpdl-size (/ max-lisp-eval-depth 2))
- (signal-hook-function #'ignore))
- (should-error (eval-tests--exceed-specbind-limit))))
-
(ert-deftest defvar/bug31072 ()
"Check that Bug#31072 is fixed."
(should-error (eval '(defvar 1) t) :type 'wrong-type-argument))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a84cce3ad4..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))
@@ -131,47 +145,56 @@
(should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
(defconst fns-tests--string-lessp-cases
- '((a 97 error)
- (97 "a" error)
- ("abc" "abd" t)
- ("abd" "abc" nil)
- (abc "abd" t)
- ("abd" abc nil)
- (abc abd t)
- (abd abc nil)
- ("" "" nil)
- ("" " " t)
- (" " "" nil)
- ("abc" "abcd" t)
- ("abcd" "abc" nil)
- ("abc" "abc" nil)
- (abc abc nil)
- ("\0" "" nil)
- ("" "\0" t)
- ("~" "\x80" t)
- ("\x80" "\x80" nil)
- ("\xfe" "\xff" t)
- ("Munchen" "München" t)
- ("München" "Munchen" nil)
- ("München" "München" nil)
- ("Ré" "Réunion" t)))
-
+ `(("abc" < "abd")
+ (abc < "abd")
+ (abc < abd)
+ ("" = "")
+ ("" < " ")
+ ("abc" < "abcd")
+ ("abc" = "abc")
+ (abc = abc)
+ ("" < "\0")
+ ("~" < "\x80")
+ ("\x80" = "\x80")
+ ("\xfe" < "\xff")
+ ("Munchen" < "München")
+ ("München" = "München")
+ ("Ré" < "Réunion")
+ ("abc" = ,(string-to-multibyte "abc"))
+ (,(string-to-multibyte "abc") = ,(string-to-multibyte "abc"))
+ ("abc" < ,(string-to-multibyte "abd"))
+ (,(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
+ ;; it equates unibyte 80..FF with multibyte U+0080..00FF, and is also
+ ;; inconsistent with `string=' (see bug#58168).
+ ;;("\x80" < ,(string-to-multibyte "\x80"))
+ ;;("\xff" < ,(string-to-multibyte "\x80"))
+ ;;("ü" < "\xfc")
+ ;;("ü" < ,(string-to-multibyte "\xfc"))
+ )
+ "List of (A REL B) where REL is the relation (`<' or `=') between A and B.")
(ert-deftest fns-tests-string-lessp ()
;; Exercise both `string-lessp' and its alias `string<', both directly
;; and in a function (exercising its bytecode).
- (dolist (lessp (list #'string-lessp #'string<
- (lambda (a b) (string-lessp a b))
- (lambda (a b) (string< a b))))
- (ert-info ((prin1-to-string lessp) :prefix "function: ")
+ (dolist (fun (list #'string-lessp #'string<
+ (lambda (a b) (string-lessp a b))
+ (lambda (a b) (string< a b))))
+ (ert-info ((prin1-to-string fun) :prefix "function: ")
+ (should-error (funcall fun 'a 97))
+ (should-error (funcall fun 97 "a"))
(dolist (case fns-tests--string-lessp-cases)
(ert-info ((prin1-to-string case) :prefix "case: ")
- (pcase case
- (`(,x ,y error)
- (should-error (funcall lessp x y)))
- (`(,x ,y ,expected)
- (should (equal (funcall lessp x y) expected)))))))))
-
+ (pcase-let ((`(,x ,rel ,y) case))
+ (cl-assert (memq rel '(< =)))
+ (should (equal (funcall fun x y) (eq rel '<)))
+ (should (equal (funcall fun y x) nil))))))))
(ert-deftest fns-tests-compare-strings ()
(should-error (compare-strings))
@@ -614,9 +637,9 @@
(should (string= (mapconcat #'identity '("Ä" "ø" "☭" "தமிழ்") "_漢字_")
"Ä_漢字_ø_漢字_☭_漢字_தமிழ்"))
;; vector
- (should (string= (mapconcat #'identity ["a" "b"] "") "ab"))
+ (should (string= (mapconcat #'identity ["a" "b"]) "ab"))
;; bool-vector
- (should (string= (mapconcat #'identity [nil nil] "") ""))
+ (should (string= (mapconcat #'identity [nil nil]) ""))
(should-error (mapconcat #'identity [nil nil t])
:type 'wrong-type-argument))
@@ -834,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))
@@ -888,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
@@ -1327,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))))
@@ -1412,6 +1443,41 @@
(should (equal (take 5 list) '(a b c b c)))
(should (equal (take 10 list) '(a b c b c b c b c b)))
- (should (equal (ntake 10 list) '(a b)))))
+ (should (equal (ntake 10 list) '(a b))))
+
+ ;; Bignum N argument.
+ (let ((list (list 'a 'b 'c)))
+ (should (equal (take (+ most-positive-fixnum 1) list) '(a b c)))
+ (should (equal (take (- most-negative-fixnum 1) list) nil))
+ (should (equal (ntake (+ most-positive-fixnum 1) list) '(a b c)))
+ (should (equal (ntake (- most-negative-fixnum 1) list) nil))
+ (should (equal list '(a b c)))))
+
+(ert-deftest fns--copy-alist ()
+ (dolist (orig '(nil
+ ((a . 1) (b . 2) (a . 3))
+ (a (b . 3) ((c) (d)))))
+ (ert-info ((prin1-to-string orig) :prefix "orig: ")
+ (let ((copy (copy-alist orig)))
+ (should (equal orig copy))
+ (while orig
+ (should-not (eq orig copy))
+ ;; Check that cons pairs are copied but nothing else.
+ (let ((orig-elt (car orig))
+ (copy-elt (car copy)))
+ (if (atom orig-elt)
+ (should (eq orig-elt copy-elt))
+ (should-not (eq orig-elt copy-elt))
+ (should (eq (car orig-elt) (car copy-elt)))
+ (should (eq (cdr orig-elt) (cdr copy-elt)))))
+ (setq orig (cdr orig))
+ (setq copy (cdr copy))))))
+
+ (should-error (copy-alist 'a)
+ :type 'wrong-type-argument)
+ (should-error (copy-alist [(a . 1) (b . 2) (a . 3)])
+ :type 'wrong-type-argument)
+ (should-error (copy-alist "abc")
+ :type 'wrong-type-argument))
;;; fns-tests.el ends here
diff --git a/test/src/image-tests.el b/test/src/image-tests.el
index 36278f4b9f..d1a4dad37b 100644
--- a/test/src/image-tests.el
+++ b/test/src/image-tests.el
@@ -19,25 +19,17 @@
;; 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:
-
-;; Most of these tests will only run in a GUI session, and not with
-;; "make check". Run them manually in an interactive session with
-;; `M-x eval-buffer' followed by `M-x ert'.
-
;;; Code:
(require 'ert)
-(defmacro image-skip-unless (format)
- `(skip-unless (and (display-images-p)
- (image-type-available-p ,format))))
-
-;;;; Images
+(declare-function image-size "image.c" (spec &optional pixels frame))
+(declare-function image-mask-p "image.c" (spec &optional frame))
+(declare-function image-metadata "image.c" (spec &optional frame))
(defconst image-tests--images
`((gif . ,(expand-file-name "test/data/image/black.gif"
- source-directory))
+ source-directory))
(jpeg . ,(expand-file-name "test/data/image/black.jpg"
source-directory))
(pbm . ,(find-image '((:file "splash.svg" :type svg))))
@@ -51,197 +43,23 @@
(xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm))))
(xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
-;;;; image-test-size
-
-(declare-function image-size "image.c" (spec &optional pixels frame))
-
-(ert-deftest image-tests-image-size/gif ()
- (image-skip-unless 'gif)
- (pcase (image-size (create-image (cdr (assq 'gif image-tests--images))))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/jpeg ()
- (image-skip-unless 'jpeg)
- (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--images))))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/pbm ()
- (image-skip-unless 'pbm)
- (pcase (image-size (cdr (assq 'pbm image-tests--images)))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/png ()
- (image-skip-unless 'png)
- (pcase (image-size (cdr (assq 'png image-tests--images)))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/svg ()
- (image-skip-unless 'svg)
- (pcase (image-size (cdr (assq 'svg image-tests--images)))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/tiff ()
- (image-skip-unless 'tiff)
- (pcase (image-size (create-image (cdr (assq 'tiff image-tests--images))))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/webp ()
- (image-skip-unless 'webp)
- (pcase (image-size (create-image (cdr (assq 'webp image-tests--images))))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/xbm ()
- (image-skip-unless 'xbm)
- (pcase (image-size (cdr (assq 'xbm image-tests--images)))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/xpm ()
- (image-skip-unless 'xpm)
- (pcase (image-size (cdr (assq 'xpm image-tests--images)))
- (`(,a . ,b)
- (should (floatp a))
- (should (floatp b)))))
-
-(ert-deftest image-tests-image-size/error-on-invalid-spec ()
- (skip-unless (display-images-p))
- (should-error (image-size 'invalid-spec)))
-
(ert-deftest image-tests-image-size/error-on-nongraphical-display ()
(skip-unless (not (display-images-p)))
(should-error (image-size 'invalid-spec)))
-;;;; image-mask-p
-
-(declare-function image-mask-p "image.c" (spec &optional frame))
-
-(ert-deftest image-tests-image-mask-p/gif ()
- (image-skip-unless 'gif)
- (should-not (image-mask-p (create-image
- (cdr (assq 'gif image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/jpeg ()
- (image-skip-unless 'jpeg)
- (should-not (image-mask-p (create-image
- (cdr (assq 'jpeg image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/pbm ()
- (image-skip-unless 'pbm)
- (should-not (image-mask-p (cdr (assq 'pbm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/png ()
- (image-skip-unless 'png)
- (should-not (image-mask-p (cdr (assq 'png image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/svg ()
- (image-skip-unless 'svg)
- (should-not (image-mask-p (cdr (assq 'svg image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/tiff ()
- (image-skip-unless 'tiff)
- (should-not (image-mask-p (create-image
- (cdr (assq 'tiff image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/webp ()
- (image-skip-unless 'webp)
- (should-not (image-mask-p (create-image
- (cdr (assq 'webp image-tests--images))))))
-
-(ert-deftest image-tests-image-mask-p/xbm ()
- (image-skip-unless 'xbm)
- (should-not (image-mask-p (cdr (assq 'xbm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/xpm ()
- (image-skip-unless 'xpm)
- (should-not (image-mask-p (cdr (assq 'xpm image-tests--images)))))
-
-(ert-deftest image-tests-image-mask-p/error-on-invalid-spec ()
- (skip-unless (display-images-p))
- (should-error (image-mask-p 'invalid-spec)))
-
(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
(skip-unless (not (display-images-p)))
(should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
-;;;; image-metadata
-
-(declare-function image-metadata "image.c" (spec &optional frame))
-
-;; TODO: These tests could be expanded with files that actually
-;; contain metadata.
-
-(ert-deftest image-tests-image-metadata/gif ()
- (image-skip-unless 'gif)
- (should-not (image-metadata
- (create-image (cdr (assq 'gif image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/jpeg ()
- (image-skip-unless 'jpeg)
- (should-not (image-metadata
- (create-image (cdr (assq 'jpeg image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/pbm ()
- (image-skip-unless 'pbm)
- (should-not (image-metadata (cdr (assq 'pbm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/png ()
- (image-skip-unless 'png)
- (should-not (image-metadata (cdr (assq 'png image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/svg ()
- (image-skip-unless 'svg)
- (should-not (image-metadata (cdr (assq 'svg image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/tiff ()
- (image-skip-unless 'tiff)
- (should-not (image-metadata
- (create-image (cdr (assq 'tiff image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/webp ()
- (image-skip-unless 'webp)
- (should-not (image-metadata
- (create-image (cdr (assq 'webp image-tests--images))))))
-
-(ert-deftest image-tests-image-metadata/xbm ()
- (image-skip-unless 'xbm)
- (should-not (image-metadata (cdr (assq 'xbm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/xpm ()
- (image-skip-unless 'xpm)
- (should-not (image-metadata (cdr (assq 'xpm image-tests--images)))))
-
-(ert-deftest image-tests-image-metadata/nil-on-invalid-spec ()
- (skip-unless (display-images-p))
- (should-not (image-metadata 'invalid-spec)))
-
(ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
(skip-unless (not (display-images-p)))
(should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
-;;;; ImageMagick
-
(ert-deftest image-tests-imagemagick-types ()
(skip-unless (fboundp 'imagemagick-types))
(when (fboundp 'imagemagick-types)
(should (listp (imagemagick-types)))))
-;;;; Initialization
-
(ert-deftest image-tests-init-image-library ()
(skip-unless (fboundp 'init-image-library))
(declare-function init-image-library "image.c" (type))
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/print-tests.el b/test/src/print-tests.el
index 5c349342eb..faab196f22 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -190,7 +190,8 @@ otherwise, use a different charset."
"Printing observes `print-continuous-numbering'."
;; cl-print does not support print-continuous-numbering.
:expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
- #'cl-prin1-to-string) :failed :passed)
+ #'cl-prin1-to-string)
+ :failed :passed)
(let* ((x (list 1))
(y "hello")
(g (gensym))
@@ -201,7 +202,8 @@ otherwise, use a different charset."
(print-number-table nil))
(should (string-match
"(#1=(1) #1# #2=\"hello\" #2#)(#3=#:g[[:digit:]]+ #3#)(#1# #2#
#3#)#2#$"
- (mapconcat #'print-tests--prin1-to-string `((,x ,x ,y ,y) (,g
,g) (,x ,y ,g) ,y) ""))))
+ (mapconcat #'print-tests--prin1-to-string
+ `((,x ,x ,y ,y) (,g ,g) (,x ,y ,g) ,y)))))
;; This is the special case for byte-compile-output-docform
;; mentioned in a comment in print_preprocess. When
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 6e1e148332..7d3d9eb72b 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -134,12 +134,12 @@ process to complete."
(should (equal 1 (with-current-buffer stdout-buffer
(point-max))))
(should (equal "hello stdout!\n"
- (mapconcat #'identity (nreverse stdout-output) "")))
+ (mapconcat #'identity (nreverse stdout-output))))
(should stderr-sentinel-called)
(should (equal 1 (with-current-buffer stderr-buffer
(point-max))))
(should (equal "hello stderr!\n"
- (mapconcat #'identity (nreverse stderr-output) ""))))))
+ (mapconcat #'identity (nreverse stderr-output)))))))
(ert-deftest set-process-filter-t ()
"Test setting process filter to t and back." ;; Bug#36591
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