summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2024-04-01 18:50:20 +0800
committerSean Whitton <spwhitton@spwhitton.name>2024-04-01 18:50:20 +0800
commit0fef2018445b257bf26814e6659bc2ff5b270d77 (patch)
tree2310ce1fd8781a6203ec56e2f985f6adfcc2278d
parent3a8546615a38337dc991f6546ade63a372edc2ca (diff)
parent49f76dcc17055e60569b6096e8ea3c9961ebbf63 (diff)
downloademacs-0fef2018445b257bf26814e6659bc2ff5b270d77.tar.gz
Merge branch 'athena/unstable' into athena/bookworm-backports
-rw-r--r--.dir-locals.el22
-rw-r--r--.gitignore3
-rw-r--r--.mailmap9
-rw-r--r--BUGS4
-rw-r--r--CONTRIBUTE48
-rw-r--r--ChangeLog.34
-rw-r--r--ChangeLog.42147
-rw-r--r--GNUmakefile50
-rw-r--r--Makefile.in2
-rw-r--r--admin/CPP-DEFINES15
-rw-r--r--admin/MAINTAINERS7
-rw-r--r--admin/README18
-rw-r--r--admin/authors.el7
-rw-r--r--admin/coccinelle/alloc_cast.cocci6
-rw-r--r--admin/coccinelle/build_string.cocci6
-rw-r--r--admin/coccinelle/nilp.cocci6
-rw-r--r--admin/coccinelle/unibyte_string.cocci6
-rw-r--r--admin/coccinelle/xsave.cocci11
-rw-r--r--admin/codespell/README27
-rw-r--r--admin/codespell/codespell.dictionary17
-rw-r--r--admin/codespell/codespell.exclude1587
-rw-r--r--admin/codespell/codespell.ignore41
-rw-r--r--admin/codespell/codespell.rc4
-rw-r--r--admin/cus-test.el9
-rwxr-xr-xadmin/git-bisect-start8
-rw-r--r--admin/gitmerge.el8
-rwxr-xr-xadmin/merge-gnulib7
-rw-r--r--admin/notes/bugtracker4
-rw-r--r--admin/notes/java2
-rw-r--r--admin/notes/kind-communication21
-rwxr-xr-xadmin/notes/tree-sitter/build-module/batch.sh1
-rwxr-xr-xadmin/notes/tree-sitter/build-module/build.sh2
-rwxr-xr-xadmin/run-codespell68
-rw-r--r--admin/syncdoc-type-hierarchy.el133
-rwxr-xr-xautogen.sh16
-rwxr-xr-xbuild-aux/config.guess15
-rwxr-xr-xbuild-aux/config.sub174
-rwxr-xr-xbuild-aux/install-sh8
-rw-r--r--build-aux/ndk-build-helper-1.mk2
-rw-r--r--build-aux/ndk-build-helper-2.mk2
-rwxr-xr-xbuild-aux/update-copyright159
-rw-r--r--configure.ac33
-rw-r--r--cross/ndk-build/Makefile.in26
-rw-r--r--cross/ndk-build/ndk-build.mk.in2
-rw-r--r--cross/ndk-build/ndk-resolve.mk32
-rw-r--r--cross/verbose.mk.android13
-rw-r--r--debian/changelog6
-rw-r--r--doc/emacs/android.texi335
-rw-r--r--doc/emacs/back.texi2
-rw-r--r--doc/emacs/basic.texi26
-rw-r--r--doc/emacs/buffers.texi69
-rw-r--r--doc/emacs/custom.texi5
-rw-r--r--doc/emacs/display.texi9
-rw-r--r--doc/emacs/files.texi9
-rw-r--r--doc/emacs/fixit.texi28
-rw-r--r--doc/emacs/help.texi27
-rw-r--r--doc/emacs/killing.texi28
-rw-r--r--doc/emacs/maintaining.texi34
-rw-r--r--doc/emacs/mini.texi4
-rw-r--r--doc/emacs/misc.texi9
-rw-r--r--doc/emacs/msdos.texi23
-rw-r--r--doc/emacs/regs.texi5
-rw-r--r--doc/emacs/rmail.texi5
-rw-r--r--doc/emacs/text.texi6
-rw-r--r--doc/emacs/windows.texi2
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi171
-rw-r--r--doc/lispref/Makefile.in11
-rw-r--r--doc/lispref/abbrevs.texi2
-rw-r--r--doc/lispref/buffers.texi19
-rw-r--r--doc/lispref/commands.texi41
-rw-r--r--doc/lispref/compile.texi66
-rw-r--r--doc/lispref/control.texi131
-rw-r--r--doc/lispref/debugging.texi17
-rw-r--r--doc/lispref/display.texi33
-rw-r--r--doc/lispref/elisp.texi3
-rw-r--r--doc/lispref/elisp_type_hierarchy.jpgbin0 -> 288444 bytes
-rw-r--r--doc/lispref/elisp_type_hierarchy.txt33
-rw-r--r--doc/lispref/eval.texi19
-rw-r--r--doc/lispref/frames.texi4
-rw-r--r--doc/lispref/functions.texi32
-rw-r--r--doc/lispref/hash.texi54
-rw-r--r--doc/lispref/help.texi2
-rw-r--r--doc/lispref/internals.texi9
-rw-r--r--doc/lispref/intro.texi6
-rw-r--r--doc/lispref/markers.texi8
-rw-r--r--doc/lispref/minibuf.texi60
-rw-r--r--doc/lispref/modes.texi178
-rw-r--r--doc/lispref/numbers.texi1
-rw-r--r--doc/lispref/objects.texi80
-rw-r--r--doc/lispref/os.texi12
-rw-r--r--doc/lispref/package.texi57
-rw-r--r--doc/lispref/parsing.texi33
-rw-r--r--doc/lispref/sequences.texi195
-rw-r--r--doc/lispref/streams.texi2
-rw-r--r--doc/lispref/strings.texi12
-rw-r--r--doc/lispref/symbols.texi162
-rw-r--r--doc/lispref/variables.texi4
-rw-r--r--doc/lispref/windows.texi109
-rw-r--r--doc/misc/calc.texi16
-rw-r--r--doc/misc/dired-x.texi10
-rw-r--r--doc/misc/efaq.texi10
-rw-r--r--doc/misc/eglot.texi6
-rw-r--r--doc/misc/epa.texi9
-rw-r--r--doc/misc/erc.texi59
-rw-r--r--doc/misc/ert.texi45
-rw-r--r--doc/misc/eshell.texi711
-rw-r--r--doc/misc/eww.texi30
-rw-r--r--doc/misc/gnus.texi16
-rw-r--r--doc/misc/info.texi1
-rw-r--r--doc/misc/modus-themes.org1435
-rw-r--r--doc/misc/ses.texi2
-rw-r--r--doc/misc/texinfo.tex89
-rw-r--r--doc/misc/tramp.texi68
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--doc/misc/transient.texi28
-rw-r--r--doc/misc/vtable.texi13
-rw-r--r--doc/misc/widget.texi222
-rw-r--r--doc/translations/README211
-rw-r--r--doc/translations/fr/misc/ses-fr.texi (renamed from doc/lang/fr/misc/ses-fr.texi)0
-rw-r--r--etc/AUTHORS144
-rw-r--r--etc/DEBUG41
-rw-r--r--etc/EGLOT-NEWS13
-rw-r--r--etc/ERC-NEWS62
-rw-r--r--etc/HISTORY4
-rw-r--r--etc/NEWS597
-rw-r--r--etc/NEWS.255
-rw-r--r--etc/NEWS.271
-rw-r--r--etc/NEWS.2941
-rw-r--r--etc/PROBLEMS183
-rw-r--r--etc/TODO18
-rw-r--r--etc/compilation.txt13
-rw-r--r--etc/emacs_lldb.py1
-rw-r--r--etc/images/README7
-rw-r--r--etc/images/conceal.pbmbin0 -> 41 bytes
-rw-r--r--etc/images/conceal.svg4
-rw-r--r--etc/images/reveal.pbmbin0 -> 41 bytes
-rw-r--r--etc/images/reveal.svg4
-rw-r--r--etc/themes/modus-operandi-deuteranopia-theme.el77
-rw-r--r--etc/themes/modus-operandi-theme.el75
-rw-r--r--etc/themes/modus-operandi-tinted-theme.el84
-rw-r--r--etc/themes/modus-operandi-tritanopia-theme.el77
-rw-r--r--etc/themes/modus-themes.el545
-rw-r--r--etc/themes/modus-vivendi-deuteranopia-theme.el78
-rw-r--r--etc/themes/modus-vivendi-theme.el77
-rw-r--r--etc/themes/modus-vivendi-tinted-theme.el96
-rw-r--r--etc/themes/modus-vivendi-tritanopia-theme.el77
-rw-r--r--etc/tutorials/TUTORIAL.pl14
-rw-r--r--exec/Makefile.in5
-rwxr-xr-xexec/config.guess1774
-rwxr-xr-xexec/config.sub1907
-rw-r--r--exec/configure.ac25
-rw-r--r--exec/exec.c2
-rw-r--r--exec/exec.h5
-rwxr-xr-xexec/install-sh541
-rw-r--r--exec/trace.c278
-rw-r--r--java/AndroidManifest.xml.in137
-rw-r--r--java/INSTALL34
-rw-r--r--java/Makefile.in13
-rwxr-xr-xjava/debug.sh13
-rw-r--r--java/org/gnu/emacs/EmacsActivity.java129
-rw-r--r--java/org/gnu/emacs/EmacsContextMenu.java17
-rw-r--r--java/org/gnu/emacs/EmacsDesktopNotification.java202
-rw-r--r--java/org/gnu/emacs/EmacsNative.java22
-rw-r--r--java/org/gnu/emacs/EmacsOpenActivity.java43
-rw-r--r--java/org/gnu/emacs/EmacsPreferencesActivity.java5
-rw-r--r--java/org/gnu/emacs/EmacsService.java254
-rw-r--r--java/org/gnu/emacs/EmacsView.java33
-rw-r--r--java/org/gnu/emacs/EmacsWindow.java159
-rw-r--r--java/org/gnu/emacs/EmacsWindowAttachmentManager.java9
-rw-r--r--leim/Makefile.in6
-rw-r--r--lib-src/Makefile.in4
-rw-r--r--lib-src/etags.c6
-rw-r--r--lib-src/seccomp-filter.c4
-rw-r--r--lib/acl-internal.h3
-rw-r--r--lib/alloca.in.h4
-rw-r--r--lib/attribute.h2
-rw-r--r--lib/binary-io.h3
-rw-r--r--lib/boot-time-aux.h16
-rw-r--r--lib/boot-time.c9
-rw-r--r--lib/c-ctype.h3
-rw-r--r--lib/c-strcasecmp.c3
-rw-r--r--lib/c-strncasecmp.c3
-rw-r--r--lib/careadlinkat.c4
-rw-r--r--lib/cdefs.h4
-rw-r--r--lib/cloexec.c3
-rw-r--r--lib/close-stream.c3
-rw-r--r--lib/diffseq.h4
-rw-r--r--lib/dirent.in.h6
-rw-r--r--lib/dirfd.c65
-rw-r--r--lib/dup2.c3
-rw-r--r--lib/faccessat.c6
-rw-r--r--lib/fdopendir.c36
-rw-r--r--lib/filemode.h4
-rw-r--r--lib/fpending.c4
-rw-r--r--lib/fpending.h4
-rw-r--r--lib/fsusage.c4
-rw-r--r--lib/getgroups.c3
-rw-r--r--lib/getloadavg.c4
-rw-r--r--lib/getopt-cdefs.in.h6
-rw-r--r--lib/getopt.c33
-rw-r--r--lib/getopt1.c2
-rw-r--r--lib/gettext.h4
-rw-r--r--lib/gettime.c3
-rw-r--r--lib/gettimeofday.c3
-rw-r--r--lib/gnulib.mk.in18
-rw-r--r--lib/group-member.c4
-rw-r--r--lib/intprops-internal.h5
-rw-r--r--lib/limits.in.h2
-rw-r--r--lib/malloc.c3
-rw-r--r--lib/md5-stream.c4
-rw-r--r--lib/md5.c4
-rw-r--r--lib/md5.h26
-rw-r--r--lib/memmem.c4
-rw-r--r--lib/memrchr.c4
-rw-r--r--lib/nanosleep.c3
-rw-r--r--lib/nstrftime.c1501
-rw-r--r--lib/open.c6
-rw-r--r--lib/rawmemchr.c26
-rw-r--r--lib/readutmp.h24
-rw-r--r--lib/regex.c4
-rw-r--r--lib/save-cwd.h4
-rw-r--r--lib/set-permissions.c1
-rw-r--r--lib/sha1.c3
-rw-r--r--lib/sha1.h16
-rw-r--r--lib/sha256.h16
-rw-r--r--lib/sha512.h16
-rw-r--r--lib/sig2str.c3
-rw-r--r--lib/stat-time.h13
-rw-r--r--lib/stddef.in.h28
-rw-r--r--lib/stdint.in.h2
-rw-r--r--lib/stdio.in.h51
-rw-r--r--lib/stdlib.in.h145
-rw-r--r--lib/strftime.c2051
-rw-r--r--lib/strftime.h73
-rw-r--r--lib/string.in.h139
-rw-r--r--lib/strtoimax.c4
-rw-r--r--lib/strtol.c4
-rw-r--r--lib/strtoll.c4
-rw-r--r--lib/sys_stat.in.h30
-rw-r--r--lib/tempname.c4
-rw-r--r--lib/time.in.h20
-rw-r--r--lib/time_r.c8
-rw-r--r--lib/unistd.c2
-rw-r--r--lib/unistd.in.h31
-rw-r--r--lib/unlocked-io.h2
-rw-r--r--lib/utimens.c4
-rw-r--r--lib/verify.h10
-rw-r--r--lib/warn-on-use.h4
-rw-r--r--lib/xalloc-oversized.h14
-rw-r--r--lisp/abbrev.el7
-rw-r--r--lisp/align.el9
-rw-r--r--lisp/allout.el8
-rw-r--r--lisp/ansi-osc.el3
-rw-r--r--lisp/auth-source.el21
-rw-r--r--lisp/bind-key.el44
-rw-r--r--lisp/bookmark.el9
-rw-r--r--lisp/buff-menu.el133
-rw-r--r--lisp/calc/calc-aent.el1
-rw-r--r--lisp/calc/calc-prog.el16
-rw-r--r--lisp/calendar/calendar.el12
-rw-r--r--lisp/calendar/todo-mode.el36
-rw-r--r--lisp/cedet/mode-local.el4
-rw-r--r--lisp/cedet/semantic/lex-spp.el6
-rw-r--r--lisp/cedet/semantic/lex.el4
-rw-r--r--lisp/cedet/semantic/symref/grep.el6
-rw-r--r--lisp/cedet/semantic/tag.el3
-rw-r--r--lisp/char-fold.el2
-rw-r--r--lisp/comint.el4
-rw-r--r--lisp/completion-preview.el42
-rw-r--r--lisp/completion.el8
-rw-r--r--lisp/cus-edit.el100
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/cus-start.el7
-rw-r--r--lisp/descr-text.el52
-rw-r--r--lisp/desktop.el21
-rw-r--r--lisp/dired-aux.el4
-rw-r--r--lisp/dired-x.el26
-rw-r--r--lisp/dired.el34
-rw-r--r--lisp/dnd.el15
-rw-r--r--lisp/dom.el2
-rw-r--r--lisp/edmacro.el22
-rw-r--r--lisp/emacs-lisp/advice.el2
-rw-r--r--lisp/emacs-lisp/bindat.el7
-rw-r--r--lisp/emacs-lisp/byte-opt.el11
-rw-r--r--lisp/emacs-lisp/bytecomp.el713
-rw-r--r--lisp/emacs-lisp/cconv.el12
-rw-r--r--lisp/emacs-lisp/check-declare.el118
-rw-r--r--lisp/emacs-lisp/checkdoc.el7
-rw-r--r--lisp/emacs-lisp/cl-extra.el68
-rw-r--r--lisp/emacs-lisp/cl-generic.el150
-rw-r--r--lisp/emacs-lisp/cl-macs.el64
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el236
-rw-r--r--lisp/emacs-lisp/cl-print.el2
-rw-r--r--lisp/emacs-lisp/comp-common.el7
-rw-r--r--lisp/emacs-lisp/comp-cstr.el104
-rw-r--r--lisp/emacs-lisp/comp-run.el55
-rw-r--r--lisp/emacs-lisp/comp.el1234
-rw-r--r--lisp/emacs-lisp/compat.el92
-rw-r--r--lisp/emacs-lisp/debug-early.el85
-rw-r--r--lisp/emacs-lisp/debug.el25
-rw-r--r--lisp/emacs-lisp/derived.el135
-rw-r--r--lisp/emacs-lisp/disass.el41
-rw-r--r--lisp/emacs-lisp/easy-mmode.el2
-rw-r--r--lisp/emacs-lisp/edebug.el184
-rw-r--r--lisp/emacs-lisp/eieio-core.el98
-rw-r--r--lisp/emacs-lisp/eieio-opt.el2
-rw-r--r--lisp/emacs-lisp/eieio.el16
-rw-r--r--lisp/emacs-lisp/eldoc.el12
-rw-r--r--lisp/emacs-lisp/elint.el1
-rw-r--r--lisp/emacs-lisp/ert-font-lock.el73
-rw-r--r--lisp/emacs-lisp/ert-x.el4
-rw-r--r--lisp/emacs-lisp/ert.el139
-rw-r--r--lisp/emacs-lisp/find-func.el1
-rw-r--r--lisp/emacs-lisp/icons.el14
-rw-r--r--lisp/emacs-lisp/inline.el4
-rw-r--r--lisp/emacs-lisp/lisp-mode.el11
-rw-r--r--lisp/emacs-lisp/loaddefs-gen.el73
-rw-r--r--lisp/emacs-lisp/macroexp.el10
-rw-r--r--lisp/emacs-lisp/map.el28
-rw-r--r--lisp/emacs-lisp/nadvice.el36
-rw-r--r--lisp/emacs-lisp/oclosure.el9
-rw-r--r--lisp/emacs-lisp/package-vc.el19
-rw-r--r--lisp/emacs-lisp/package.el47
-rw-r--r--lisp/emacs-lisp/pcase.el200
-rw-r--r--lisp/emacs-lisp/pp.el111
-rw-r--r--lisp/emacs-lisp/re-builder.el2
-rw-r--r--lisp/emacs-lisp/seq.el7
-rw-r--r--lisp/emacs-lisp/shortdoc.el40
-rw-r--r--lisp/emacs-lisp/shorthands.el34
-rw-r--r--lisp/emacs-lisp/tabulated-list.el68
-rw-r--r--lisp/emacs-lisp/trace.el116
-rw-r--r--lisp/emacs-lisp/vtable.el59
-rw-r--r--lisp/emulation/viper-cmd.el2
-rw-r--r--lisp/emulation/viper-init.el10
-rw-r--r--lisp/emulation/viper.el1
-rw-r--r--lisp/epa-ks.el3
-rw-r--r--lisp/epa.el34
-rw-r--r--lisp/erc/erc-backend.el37
-rw-r--r--lisp/erc/erc-button.el5
-rw-r--r--lisp/erc/erc-common.el95
-rw-r--r--lisp/erc/erc-compat.el48
-rw-r--r--lisp/erc/erc-dcc.el2
-rw-r--r--lisp/erc/erc-desktop-notifications.el24
-rw-r--r--lisp/erc/erc-fill.el64
-rw-r--r--lisp/erc/erc-goodies.el170
-rw-r--r--lisp/erc/erc-networks.el25
-rw-r--r--lisp/erc/erc-pcomplete.el2
-rw-r--r--lisp/erc/erc-speedbar.el28
-rw-r--r--lisp/erc/erc-stamp.el50
-rw-r--r--lisp/erc/erc-track.el2
-rw-r--r--lisp/erc/erc.el859
-rw-r--r--lisp/eshell/em-basic.el24
-rw-r--r--lisp/eshell/em-dirs.el3
-rw-r--r--lisp/eshell/em-glob.el36
-rw-r--r--lisp/eshell/em-tramp.el22
-rw-r--r--lisp/eshell/em-unix.el26
-rw-r--r--lisp/eshell/esh-arg.el7
-rw-r--r--lisp/eshell/esh-cmd.el54
-rw-r--r--lisp/eshell/esh-ext.el6
-rw-r--r--lisp/eshell/esh-mode.el35
-rw-r--r--lisp/eshell/esh-opt.el62
-rw-r--r--lisp/eshell/esh-proc.el2
-rw-r--r--lisp/eshell/esh-util.el51
-rw-r--r--lisp/eshell/esh-var.el97
-rw-r--r--lisp/faces.el4
-rw-r--r--lisp/ffap.el7
-rw-r--r--lisp/files-x.el27
-rw-r--r--lisp/files.el295
-rw-r--r--lisp/filesets.el48
-rw-r--r--lisp/follow.el5
-rw-r--r--lisp/format-spec.el6
-rw-r--r--lisp/forms.el2
-rw-r--r--lisp/generic-x.el1
-rw-r--r--lisp/gnus/gnus-agent.el13
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/gnus/gnus-cite.el36
-rw-r--r--lisp/gnus/gnus-dired.el9
-rw-r--r--lisp/gnus/gnus-group.el8
-rw-r--r--lisp/gnus/gnus-msg.el4
-rw-r--r--lisp/gnus/gnus-notifications.el46
-rw-r--r--lisp/gnus/gnus-score.el11
-rw-r--r--lisp/gnus/gnus-start.el18
-rw-r--r--lisp/gnus/gnus-sum.el10
-rw-r--r--lisp/gnus/gnus-util.el3
-rw-r--r--lisp/gnus/gnus.el30
-rw-r--r--lisp/gnus/legacy-gnus-agent.el260
-rw-r--r--lisp/gnus/mm-view.el1
-rw-r--r--lisp/gnus/nnheader.el2
-rw-r--r--lisp/help-fns.el230
-rw-r--r--lisp/help-macro.el275
-rw-r--r--lisp/help-mode.el20
-rw-r--r--lisp/help.el96
-rw-r--r--lisp/htmlfontify.el1
-rw-r--r--lisp/ibuffer.el238
-rw-r--r--lisp/icomplete.el6
-rw-r--r--lisp/ielm.el29
-rw-r--r--lisp/iimage.el1
-rw-r--r--lisp/image-mode.el5
-rw-r--r--lisp/image.el295
-rw-r--r--lisp/image/image-dired-dired.el2
-rw-r--r--lisp/image/image-dired-tags.el1
-rw-r--r--lisp/info-look.el5
-rw-r--r--lisp/info-xref.el8
-rw-r--r--lisp/info.el200
-rw-r--r--lisp/international/emoji.el11
-rw-r--r--lisp/international/fontset.el14
-rw-r--r--lisp/international/mule-cmds.el11
-rw-r--r--lisp/international/ogonek.el4
-rw-r--r--lisp/international/quail.el8
-rw-r--r--lisp/international/titdic-cnv.el119
-rw-r--r--lisp/isearch.el9
-rw-r--r--lisp/jsonrpc.el67
-rw-r--r--lisp/keymap.el14
-rw-r--r--lisp/language/japan-util.el4
-rw-r--r--lisp/language/japanese.el2
-rw-r--r--lisp/ldefs-boot.el2466
-rw-r--r--lisp/leim/quail/cyrillic.el4
-rw-r--r--lisp/leim/quail/indian.el2
-rw-r--r--lisp/leim/quail/latin-post.el50
-rw-r--r--lisp/leim/quail/persian.el2
-rw-r--r--lisp/leim/quail/vnvni.el54
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/locate.el6
-rw-r--r--lisp/macros.el4
-rw-r--r--lisp/mail/mail-extr.el2
-rw-r--r--lisp/mail/mailabbrev.el12
-rw-r--r--lisp/mail/rmail.el188
-rw-r--r--lisp/mail/rmailkwd.el2
-rw-r--r--lisp/mail/rmailsum.el24
-rw-r--r--lisp/mail/supercite.el6
-rw-r--r--lisp/man.el6
-rw-r--r--lisp/menu-bar.el22
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-search.el2
-rw-r--r--lisp/mh-e/mh-utils.el2
-rw-r--r--lisp/minibuffer.el165
-rw-r--r--lisp/mouse.el21
-rw-r--r--lisp/mpc.el13
-rw-r--r--lisp/mwheel.el173
-rw-r--r--lisp/net/browse-url.el25
-rw-r--r--lisp/net/dbus.el6
-rw-r--r--lisp/net/dictionary.el44
-rw-r--r--lisp/net/dns.el2
-rw-r--r--lisp/net/eww.el294
-rw-r--r--lisp/net/imap.el8
-rw-r--r--lisp/net/shr.el91
-rw-r--r--lisp/net/sieve.el2
-rw-r--r--lisp/net/tramp-adb.el45
-rw-r--r--lisp/net/tramp-androidsu.el561
-rw-r--r--lisp/net/tramp-archive.el4
-rw-r--r--lisp/net/tramp-cache.el105
-rw-r--r--lisp/net/tramp-cmds.el2
-rw-r--r--lisp/net/tramp-compat.el16
-rw-r--r--lisp/net/tramp-container.el60
-rw-r--r--lisp/net/tramp-gvfs.el7
-rw-r--r--lisp/net/tramp-integration.el2
-rw-r--r--lisp/net/tramp-message.el4
-rw-r--r--lisp/net/tramp-sh.el93
-rw-r--r--lisp/net/tramp-sshfs.el4
-rw-r--r--lisp/net/tramp-sudoedit.el2
-rw-r--r--lisp/net/tramp.el108
-rw-r--r--lisp/net/trampver.el6
-rw-r--r--lisp/notifications.el2
-rw-r--r--lisp/obarray.el25
-rw-r--r--lisp/obsolete/eieio-compat.el5
-rw-r--r--lisp/obsolete/iswitchb.el4
-rw-r--r--lisp/obsolete/longlines.el14
-rw-r--r--lisp/obsolete/pgg.el4
-rw-r--r--lisp/obsolete/quickurl.el2
-rw-r--r--lisp/obsolete/rcompile.el14
-rw-r--r--lisp/org/ob-calc.el2
-rw-r--r--lisp/org/org-agenda.el2
-rw-r--r--lisp/org/org-element.el2
-rw-r--r--lisp/org/org-fold-core.el2
-rw-r--r--lisp/org/org-macro.el9
-rw-r--r--lisp/org/org-macs.el4
-rw-r--r--lisp/org/org.el29
-rw-r--r--lisp/org/ox-beamer.el5
-rw-r--r--lisp/org/ox-koma-letter.el4
-rw-r--r--lisp/org/ox-latex.el18
-rw-r--r--lisp/org/ox.el2
-rw-r--r--lisp/outline.el30
-rw-r--r--lisp/pcmpl-git.el2
-rw-r--r--lisp/pcmpl-linux.el4
-rw-r--r--lisp/pcomplete.el2
-rw-r--r--lisp/play/cookie1.el2
-rw-r--r--lisp/play/decipher.el6
-rw-r--r--lisp/proced.el48
-rw-r--r--lisp/profiler.el74
-rw-r--r--lisp/progmodes/bug-reference.el2
-rw-r--r--lisp/progmodes/c-ts-common.el9
-rw-r--r--lisp/progmodes/c-ts-mode.el134
-rw-r--r--lisp/progmodes/cc-defs.el4
-rw-r--r--lisp/progmodes/cc-engine.el24
-rw-r--r--lisp/progmodes/cc-fonts.el2
-rw-r--r--lisp/progmodes/cc-langs.el34
-rw-r--r--lisp/progmodes/cc-mode.el22
-rw-r--r--lisp/progmodes/cmake-ts-mode.el54
-rw-r--r--lisp/progmodes/compile.el60
-rw-r--r--lisp/progmodes/cperl-mode.el64
-rw-r--r--lisp/progmodes/csharp-mode.el9
-rw-r--r--lisp/progmodes/dockerfile-ts-mode.el49
-rw-r--r--lisp/progmodes/eglot.el220
-rw-r--r--lisp/progmodes/elisp-mode.el59
-rw-r--r--lisp/progmodes/elixir-ts-mode.el58
-rw-r--r--lisp/progmodes/etags-regen.el431
-rw-r--r--lisp/progmodes/etags.el7
-rw-r--r--lisp/progmodes/flymake.el30
-rw-r--r--lisp/progmodes/gdb-mi.el6
-rw-r--r--lisp/progmodes/go-ts-mode.el6
-rw-r--r--lisp/progmodes/gud.el12
-rw-r--r--lisp/progmodes/heex-ts-mode.el12
-rw-r--r--lisp/progmodes/hideif.el16
-rw-r--r--lisp/progmodes/hideshow.el3
-rw-r--r--lisp/progmodes/idlw-help.el2
-rw-r--r--lisp/progmodes/idlw-shell.el6
-rw-r--r--lisp/progmodes/idlwave.el2
-rw-r--r--lisp/progmodes/java-ts-mode.el15
-rw-r--r--lisp/progmodes/js.el36
-rw-r--r--lisp/progmodes/json-ts-mode.el2
-rw-r--r--lisp/progmodes/lua-ts-mode.el80
-rw-r--r--lisp/progmodes/modula2.el47
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/perl-mode.el11
-rw-r--r--lisp/progmodes/project.el49
-rw-r--r--lisp/progmodes/prolog.el4
-rw-r--r--lisp/progmodes/python.el298
-rw-r--r--lisp/progmodes/ruby-ts-mode.el30
-rw-r--r--lisp/progmodes/rust-ts-mode.el2
-rw-r--r--lisp/progmodes/sh-script.el11
-rw-r--r--lisp/progmodes/typescript-ts-mode.el367
-rw-r--r--lisp/progmodes/verilog-mode.el116
-rw-r--r--lisp/progmodes/vhdl-mode.el108
-rw-r--r--lisp/progmodes/which-func.el4
-rw-r--r--lisp/progmodes/xref.el2
-rw-r--r--lisp/register.el50
-rw-r--r--lisp/replace.el6
-rw-r--r--lisp/server.el10
-rw-r--r--lisp/shell.el8
-rw-r--r--lisp/simple.el165
-rw-r--r--lisp/speedbar.el2
-rw-r--r--lisp/sqlite.el7
-rw-r--r--lisp/startup.el242
-rw-r--r--lisp/subr.el140
-rw-r--r--lisp/tab-bar.el77
-rw-r--r--lisp/tempo.el13
-rw-r--r--lisp/term.el15
-rw-r--r--lisp/term/android-win.el186
-rw-r--r--lisp/term/pc-win.el2
-rw-r--r--lisp/textmodes/bibtex.el2
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/textmodes/flyspell.el31
-rw-r--r--lisp/textmodes/html-ts-mode.el13
-rw-r--r--lisp/textmodes/page.el8
-rw-r--r--lisp/textmodes/pixel-fill.el68
-rw-r--r--lisp/textmodes/refill.el4
-rw-r--r--lisp/textmodes/reftex-vars.el5
-rw-r--r--lisp/textmodes/rst.el8
-rw-r--r--lisp/textmodes/tex-mode.el61
-rw-r--r--lisp/textmodes/text-mode.el21
-rw-r--r--lisp/textmodes/toml-ts-mode.el2
-rw-r--r--lisp/textmodes/yaml-ts-mode.el28
-rw-r--r--lisp/thingatpt.el61
-rw-r--r--lisp/time.el4
-rw-r--r--lisp/tool-bar.el19
-rw-r--r--lisp/touch-screen.el4
-rw-r--r--lisp/transient.el300
-rw-r--r--lisp/treesit.el233
-rw-r--r--lisp/url/url-cache.el2
-rw-r--r--lisp/url/url-cid.el11
-rw-r--r--lisp/url/url-http.el2
-rw-r--r--lisp/url/url-ldap.el10
-rw-r--r--lisp/url/url-mailto.el17
-rw-r--r--lisp/url/url-util.el2
-rw-r--r--lisp/use-package/use-package-ensure-system-package.el1
-rw-r--r--lisp/vc/diff-mode.el179
-rw-r--r--lisp/vc/log-edit.el169
-rw-r--r--lisp/vc/vc-cvs.el4
-rw-r--r--lisp/vc/vc-git.el58
-rw-r--r--lisp/vc/vc-hooks.el87
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-svn.el4
-rw-r--r--lisp/vc/vc.el45
-rw-r--r--lisp/vcursor.el2
-rw-r--r--lisp/visual-wrap.el204
-rw-r--r--lisp/whitespace.el4
-rw-r--r--lisp/wid-browse.el34
-rw-r--r--lisp/wid-edit.el482
-rw-r--r--lisp/windmove.el2
-rw-r--r--lisp/window.el108
-rw-r--r--lisp/winner.el3
-rw-r--r--lisp/woman.el3
-rw-r--r--lisp/xt-mouse.el31
-rw-r--r--m4/00gnulib.m410
-rw-r--r--m4/absolute-header.m44
-rw-r--r--m4/acl.m46
-rw-r--r--m4/alloca.m44
-rw-r--r--m4/assert_h.m46
-rw-r--r--m4/canonicalize.m426
-rw-r--r--m4/clock_time.m44
-rw-r--r--m4/codeset.m44
-rw-r--r--m4/copy-file-range.m441
-rw-r--r--m4/d-type.m43
-rw-r--r--m4/dirent_h.m49
-rw-r--r--m4/dirfd.m413
-rw-r--r--m4/dup2.m47
-rw-r--r--m4/filemode.m43
-rw-r--r--m4/fstatat.m44
-rw-r--r--m4/fsusage.m43
-rw-r--r--m4/getgroups.m49
-rw-r--r--m4/getline.m44
-rw-r--r--m4/getloadavg.m414
-rw-r--r--m4/getopt.m46
-rw-r--r--m4/getrandom.m46
-rw-r--r--m4/gettime.m47
-rw-r--r--m4/gettimeofday.m47
-rw-r--r--m4/gnulib-common.m4132
-rw-r--r--m4/gnulib-comp.m412
-rw-r--r--m4/group-member.m43
-rw-r--r--m4/include_next.m410
-rw-r--r--m4/largefile.m44
-rw-r--r--m4/lstat.m46
-rw-r--r--m4/malloc.m49
-rw-r--r--m4/manywarnings.m410
-rw-r--r--m4/mempcpy.m44
-rw-r--r--m4/memrchr.m44
-rw-r--r--m4/memset_explicit.m46
-rw-r--r--m4/mktime.m414
-rw-r--r--m4/nanosleep.m419
-rw-r--r--m4/ndk-build.m4354
-rw-r--r--m4/nstrftime.m48
-rw-r--r--m4/open.m44
-rw-r--r--m4/pathmax.m44
-rw-r--r--m4/pthread_sigmask.m414
-rw-r--r--m4/readutmp.m46
-rw-r--r--m4/realloc.m47
-rw-r--r--m4/regex.m410
-rw-r--r--m4/sig2str.m43
-rw-r--r--m4/ssize_t.m43
-rw-r--r--m4/stat-time.m44
-rw-r--r--m4/stdalign.m412
-rw-r--r--m4/stdint.m410
-rw-r--r--m4/stdlib_h.m44
-rw-r--r--m4/string_h.m44
-rw-r--r--m4/strnlen.m44
-rw-r--r--m4/strtoimax.m417
-rw-r--r--m4/strtoll.m47
-rw-r--r--m4/time_h.m46
-rw-r--r--m4/timespec.m43
-rw-r--r--m4/unistd_h.m43
-rw-r--r--m4/utimens.m415
-rw-r--r--m4/utimensat.m45
-rw-r--r--m4/utimes.m412
-rw-r--r--m4/warnings.m46
-rwxr-xr-xmake-dist2
-rw-r--r--msdos/sedleim.inp4
-rw-r--r--nt/cmdproxy.c8
-rw-r--r--nt/gnulib-cfg.mk1
-rw-r--r--src/.gdbinit4
-rw-r--r--src/alloc.c217
-rw-r--r--src/android.c431
-rw-r--r--src/android.h19
-rw-r--r--src/androidfns.c132
-rw-r--r--src/androidgui.h49
-rw-r--r--src/androidmenu.c2
-rw-r--r--src/androidselect.c321
-rw-r--r--src/androidterm.c138
-rw-r--r--src/androidterm.h15
-rw-r--r--src/androidvfs.c322
-rw-r--r--src/bidi.c18
-rw-r--r--src/buffer.c126
-rw-r--r--src/buffer.h7
-rw-r--r--src/bytecode.c84
-rw-r--r--src/category.c8
-rw-r--r--src/ccl.c23
-rw-r--r--src/ccl.h2
-rw-r--r--src/charset.c28
-rw-r--r--src/charset.h75
-rw-r--r--src/coding.c53
-rw-r--r--src/coding.h25
-rw-r--r--src/comp.c95
-rw-r--r--src/composite.c67
-rw-r--r--src/composite.h70
-rw-r--r--src/conf_post.h10
-rw-r--r--src/data.c117
-rw-r--r--src/dired.c2
-rw-r--r--src/dispextern.h69
-rw-r--r--src/dispnew.c6
-rw-r--r--src/disptab.h8
-rw-r--r--src/doc.c58
-rw-r--r--src/dosfns.c5
-rw-r--r--src/editfns.c89
-rw-r--r--src/emacs-module.c20
-rw-r--r--src/emacs.c7
-rw-r--r--src/emacsgtkfixed.h4
-rw-r--r--src/eval.c371
-rw-r--r--src/fileio.c12
-rw-r--r--src/fns.c1459
-rw-r--r--src/font.h26
-rw-r--r--src/fontset.c12
-rw-r--r--src/frame.c3
-rw-r--r--src/frame.h10
-rw-r--r--src/gtkutil.c4
-rw-r--r--src/haiku_select.cc4
-rw-r--r--src/image.c19
-rw-r--r--src/inotify.c10
-rw-r--r--src/insdel.c13
-rw-r--r--src/intervals.c2
-rw-r--r--src/intervals.h4
-rw-r--r--src/json.c1478
-rw-r--r--src/keyboard.c132
-rw-r--r--src/keyboard.h27
-rw-r--r--src/lisp.h710
-rw-r--r--src/lread.c564
-rw-r--r--src/macfont.h4
-rw-r--r--src/macfont.m105
-rw-r--r--src/macros.c54
-rw-r--r--src/macros.h5
-rw-r--r--src/marker.c18
-rw-r--r--src/minibuf.c164
-rw-r--r--src/msdos.c14
-rw-r--r--src/nsfont.m4
-rw-r--r--src/nsterm.h6
-rw-r--r--src/nsterm.m25
-rw-r--r--src/pdumper.c300
-rw-r--r--src/pdumper.h2
-rw-r--r--src/pgtkterm.c11
-rw-r--r--src/pgtkterm.h2
-rw-r--r--src/print.c128
-rw-r--r--src/process.c41
-rw-r--r--src/profiler.c485
-rw-r--r--src/puresize.h2
-rw-r--r--src/regex-emacs.c30
-rw-r--r--src/sfnt.c726
-rw-r--r--src/sfnt.h6
-rw-r--r--src/sfntfont-android.c6
-rw-r--r--src/sfntfont.c57
-rw-r--r--src/sort.c481
-rw-r--r--src/sqlite.c17
-rw-r--r--src/sysdep.c25
-rw-r--r--src/term.c32
-rw-r--r--src/termhooks.h4
-rw-r--r--src/textconv.c41
-rw-r--r--src/thread.c39
-rw-r--r--src/thread.h11
-rw-r--r--src/timefns.c12
-rw-r--r--src/treesit.c4
-rw-r--r--src/verbose.mk.in29
-rw-r--r--src/w16select.c2
-rw-r--r--src/w32.c7
-rw-r--r--src/w32console.c29
-rw-r--r--src/w32fns.c135
-rw-r--r--src/w32font.c4
-rw-r--r--src/w32notify.c6
-rw-r--r--src/w32term.c7
-rw-r--r--src/w32term.h3
-rw-r--r--src/w32uniscribe.c12
-rw-r--r--src/w32xfns.c28
-rw-r--r--src/window.c146
-rw-r--r--src/window.h22
-rw-r--r--src/xdisp.c646
-rw-r--r--src/xfaces.c86
-rw-r--r--src/xselect.c6
-rw-r--r--src/xterm.c98
-rw-r--r--src/xterm.h6
-rw-r--r--src/xwidget.c10
-rw-r--r--test/Makefile.in4
-rw-r--r--test/infra/Dockerfile.emba2
-rw-r--r--test/lisp/abbrev-tests.el4
-rw-r--r--test/lisp/auth-source-tests.el173
-rw-r--r--test/lisp/calc/calc-tests.el27
-rw-r--r--test/lisp/calendar/icalendar-tests.el2
-rw-r--r--test/lisp/completion-preview-tests.el15
-rw-r--r--test/lisp/dom-tests.el10
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el37
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el13
-rw-r--r--test/lisp/emacs-lisp/comp-cstr-tests.el413
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el22
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el28
-rw-r--r--test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js2
-rw-r--r--test/lisp/emacs-lisp/ert-font-lock-tests.el153
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el41
-rw-r--r--test/lisp/emacs-lisp/hierarchy-tests.el5
-rw-r--r--test/lisp/emacs-lisp/macroexp-resources/vk.el2
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el14
-rw-r--r--test/lisp/emacs-lisp/pp-tests.el49
-rw-r--r--test/lisp/emacs-lisp/tabulated-list-tests.el41
-rw-r--r--test/lisp/erc/erc-button-tests.el3
-rw-r--r--test/lisp/erc/erc-dcc-tests.el6
-rw-r--r--test/lisp/erc/erc-fill-tests.el5
-rw-r--r--test/lisp/erc/erc-goodies-tests.el280
-rw-r--r--test/lisp/erc/erc-networks-tests.el49
-rw-r--r--test/lisp/erc/erc-scenarios-base-chan-modes.el58
-rw-r--r--test/lisp/erc/erc-scenarios-base-renick.el8
-rw-r--r--test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el46
-rw-r--r--test/lisp/erc/erc-scenarios-keep-place-indicator.el6
-rw-r--r--test/lisp/erc/erc-scenarios-misc-commands.el90
-rw-r--r--test/lisp/erc/erc-scenarios-misc.el2
-rw-r--r--test/lisp/erc/erc-scenarios-services-misc.el2
-rw-r--r--test/lisp/erc/erc-stamp-tests.el26
-rw-r--r--test/lisp/erc/erc-tests.el344
-rw-r--r--test/lisp/erc/resources/base/modes/speaker-status.eld69
-rw-r--r--test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld87
-rw-r--r--test/lisp/erc/resources/commands/amsg-barnet.eld54
-rw-r--r--test/lisp/erc/resources/commands/amsg-foonet.eld56
-rw-r--r--test/lisp/erc/resources/erc-d/resources/basic.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld2
-rw-r--r--test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld2
-rw-r--r--test/lisp/erc/resources/erc-d/resources/dynamic.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/eof.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/fuzzy.eld4
-rw-r--r--test/lisp/erc/resources/erc-d/resources/incremental.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/linger.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/no-block.eld7
-rw-r--r--test/lisp/erc/resources/erc-d/resources/no-match.eld5
-rw-r--r--test/lisp/erc/resources/erc-d/resources/unexpected.eld5
-rw-r--r--test/lisp/erc/resources/erc-scenarios-common.el5
-rw-r--r--test/lisp/erc/resources/erc-tests-common.el6
-rw-r--r--test/lisp/erc/resources/fill/snapshots/merge-01-start.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/merge-02-right.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld2
-rw-r--r--test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld2
-rw-r--r--test/lisp/eshell/em-basic-tests.el34
-rw-r--r--test/lisp/eshell/em-cmpl-tests.el12
-rw-r--r--test/lisp/eshell/em-dirs-tests.el22
-rw-r--r--test/lisp/eshell/em-glob-tests.el30
-rw-r--r--test/lisp/eshell/em-tramp-tests.el89
-rw-r--r--test/lisp/eshell/esh-arg-tests.el14
-rw-r--r--test/lisp/eshell/esh-cmd-tests.el22
-rw-r--r--test/lisp/eshell/esh-opt-tests.el24
-rw-r--r--test/lisp/eshell/esh-var-tests.el15
-rw-r--r--test/lisp/eshell/eshell-tests.el2
-rw-r--r--test/lisp/filenotify-tests.el53
-rw-r--r--test/lisp/files-tests.el51
-rw-r--r--test/lisp/files-x-tests.el43
-rw-r--r--test/lisp/help-fns-tests.el10
-rw-r--r--test/lisp/image-tests.el144
-rw-r--r--test/lisp/info-tests.el10
-rw-r--r--test/lisp/info-xref-tests.el10
-rw-r--r--test/lisp/international/mule-tests.el4
-rw-r--r--test/lisp/man-tests.el18
-rw-r--r--test/lisp/minibuffer-tests.el95
-rw-r--r--test/lisp/net/eww-tests.el247
-rw-r--r--test/lisp/net/shr-resources/blockquote.html2
-rw-r--r--test/lisp/net/shr-resources/blockquote.txt3
-rw-r--r--test/lisp/net/shr-tests.el72
-rw-r--r--test/lisp/net/tramp-archive-tests.el4
-rw-r--r--test/lisp/net/tramp-tests.el222
-rw-r--r--test/lisp/obarray-tests.el31
-rw-r--r--test/lisp/progmodes/c-ts-mode-resources/indent.erts2
-rw-r--r--test/lisp/progmodes/compile-tests.el31
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el35
-rw-r--r--test/lisp/progmodes/csharp-mode-resources/indent.erts19
-rw-r--r--test/lisp/progmodes/csharp-mode-tests.el30
-rw-r--r--test/lisp/progmodes/elixir-ts-mode-resources/indent.erts2
-rw-r--r--test/lisp/progmodes/java-ts-mode-resources/indent.erts31
-rw-r--r--test/lisp/progmodes/lua-ts-mode-resources/indent.erts106
-rw-r--r--test/lisp/progmodes/python-tests.el252
-rw-r--r--test/lisp/progmodes/typescript-ts-mode-resources/indent.erts14
-rw-r--r--test/lisp/progmodes/typescript-ts-mode-tests.el3
-rw-r--r--test/lisp/ses-tests.el4
-rw-r--r--test/lisp/sqlite-tests.el51
-rw-r--r--test/lisp/textmodes/page-tests.el6
-rw-r--r--test/lisp/thingatpt-tests.el9
-rw-r--r--test/lisp/vc/log-edit-tests.el210
-rw-r--r--test/lisp/vc/vc-git-tests.el47
-rwxr-xr-xtest/manual/indent/shell.sh7
-rw-r--r--test/src/comp-resources/comp-test-funcs.el7
-rw-r--r--test/src/comp-tests.el33
-rw-r--r--test/src/data-tests.el42
-rw-r--r--test/src/emacs-module-resources/mod-test.c4
-rw-r--r--test/src/emacs-module-tests.el15
-rw-r--r--test/src/eval-tests.el84
-rw-r--r--test/src/fns-tests.el271
-rw-r--r--test/src/keymap-tests.el17
-rw-r--r--test/src/minibuf-tests.el14
-rw-r--r--test/src/print-tests.el7
-rw-r--r--test/src/treesit-tests.el2
886 files changed, 38913 insertions, 21775 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index e087aa89cd1..b34949ae961 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -3,11 +3,17 @@
((nil . ((tab-width . 8)
(sentence-end-double-space . t)
- (fill-column . 70)
- (emacs-lisp-docstring-fill-column . 65)
+ (fill-column . 72)
+ (emacs-lisp-docstring-fill-column . 72)
(vc-git-annotate-switches . "-w")
(bug-reference-url-format . "https://debbugs.gnu.org/%s")
(diff-add-log-use-relative-names . t)
+ (etags-regen-regexp-alist
+ .
+ ((("c" "objc") .
+ ("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/"
+ "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/"))))
+ (etags-regen-ignores . ("test/manual/etags/"))
(vc-prepare-patches-separately . nil)))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
@@ -17,16 +23,20 @@
(electric-quote-string . nil)
(indent-tabs-mode . t)
(mode . bug-reference-prog)))
+ (java-mode . ((c-file-style . "GNU")
+ (electric-quote-comment . nil)
+ (electric-quote-string . nil)
+ (indent-tabs-mode . t)
+ (mode . bug-reference-prog)))
(objc-mode . ((c-file-style . "GNU")
(electric-quote-comment . nil)
(electric-quote-string . nil)
(mode . bug-reference-prog)))
- (c-ts-mode . ((c-ts-mode-indent-style . gnu)
- (indent-tabs-mode . t)
- (mode . bug-reference-prog)))
+ (c-ts-mode . ((c-ts-mode-indent-style . gnu))) ;Inherits `c-mode' settings.
(log-edit-mode . ((log-edit-font-lock-gnu-style . t)
(log-edit-setup-add-author . t)
- (vc-git-log-edit-summary-target-len . 50)))
+ (vc-git-log-edit-summary-target-len . 50)
+ (fill-column . 64)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
(mode . bug-reference)))
diff --git a/.gitignore b/.gitignore
index b9dfdc4579e..903d4f7f97d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -381,7 +381,10 @@ _gdb_history
# Files ignored in exec/.
exec/aclocal.m4
+exec/config.guess
+exec/config.sub
exec/config.status
+exec/install-sh
exec/loader
exec/test
exec/exec1
diff --git a/.mailmap b/.mailmap
index 5d80e4aa082..c9bdede6c73 100644
--- a/.mailmap
+++ b/.mailmap
@@ -28,6 +28,7 @@ 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>
Artur Malabarba <bruce.connor.am@gmail.com> Artur Malabarba <address@hidden>
+Basil L. Contovounesios <basil@contovou.net> <contovob@tcd.ie>
Bastien Guerry <bzg@gnu.org>
Bastien Guerry <bzg@gnu.org> <bastien1@free.fr>
Bastien Guerry <bzg@gnu.org> <bzg@altern.org>
@@ -115,6 +116,7 @@ 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>
+Liu Hui <liuhui1610@gmail.com> <ilupin@users.noreply.github.com>
Ludovic CourtĆØs <ludo@gnu.org>
Luke Lee <luke.yx.lee@gmail.com>
Martin Rudalics <rudalics@gmx.at>
@@ -128,7 +130,7 @@ 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>
+Morgan 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>
@@ -145,8 +147,7 @@ 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>
+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>
@@ -163,8 +164,8 @@ 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>
+Simen HeggestĆøyl <simenheg@runbox.com> <simenheg@ifi.uio.no>
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>
diff --git a/BUGS b/BUGS
index ee473213c89..f23faa7c756 100644
--- a/BUGS
+++ b/BUGS
@@ -21,6 +21,10 @@ If necessary, you can read the manual without an info program:
cat info/emacs* | more "+/^File: emacs.*, Node: Bugs,"
+If you think you may have found a critical security issue that needs
+to be communicated privately, please contact the GNU Emacs maintainers
+directly. See admin/MAINTAINERS for their contact details.
+
Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to
make sure it isn't a known issue.
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 70b9760bb99..7c5c07771eb 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -115,9 +115,10 @@ mode after hiding the body of each entry.
Doc-strings should be updated together with the code.
-New defcustom's should always have a ':version' tag stating the first
-Emacs version in which they will appear. Likewise with defcustom's
-whose value is changed -- update their ':version' tag.
+New defcustom's and defface's should always have a ':version' tag
+stating the first Emacs version in which they will appear. Likewise
+with defcustom's or defface's whose value is changed -- update their
+':version' tag.
Think about whether your change requires updating the manuals. If you
know it does not, mark the NEWS entry with "---" before the entry. If
@@ -170,9 +171,9 @@ test 'out-of-tree' builds as well, i.e.:
** Commit messages
-Ordinarily, a change you commit should contain a log entry in its
-commit message and should not touch the repository's ChangeLog files.
-Here is an example commit message (indented):
+Ordinarily, a changeset you commit should contain a description of the
+changes in its commit message and should not touch the repository's
+ChangeLog files. Here is an example commit message (indented):
Deactivate shifted region
@@ -184,8 +185,9 @@ Here is an example commit message (indented):
Deactivate the mark.
Occasionally, commit messages are collected and prepended to a
-ChangeLog file, where they can be corrected. It saves time to get
-them right the first time, so here are guidelines for formatting them:
+generated ChangeLog file, where they can be corrected. It saves time
+to get them right the first time, so here are guidelines for
+formatting them:
- Start with a single unindented summary line explaining the change;
do not end this line with a period. If possible, try to keep the
@@ -194,9 +196,10 @@ them right the first time, so here are guidelines for formatting them:
contexts.
If the summary line starts with a semicolon and a space "; ", the
- commit message will be ignored when generating the ChangeLog file.
- Use this for minor commits that do not need separate ChangeLog
- entries, such as changes in etc/NEWS.
+ commit message will be skipped and not added to the generated
+ ChangeLog file. Use this for minor commits that do not need to be
+ mentioned in the ChangeLog file, such as changes in etc/NEWS, typo
+ fixes, etc.
- After the summary line, there should be an empty line.
@@ -211,8 +214,9 @@ them right the first time, so here are guidelines for formatting them:
enforced by a commit hook.
- If only a single file is changed, the summary line can be the normal
- file first line (starting with the asterisk). Then there is no
- individual files section.
+ first line of a ChangeLog entry (starting with the asterisk). Then
+ there will be no individual ChangeLog entries beyond the one in the
+ summary line.
- If the commit has more than one author, the commit message should
contain separate lines to mention the other authors, like the
@@ -233,6 +237,8 @@ them right the first time, so here are guidelines for formatting them:
particular, gnu.org and fsf.org URLs should start with "https:".
- Commit messages should contain only printable UTF-8 characters.
+ However, we ask that non-ASCII characters be used only if strictly
+ necessary, not just for aesthetic purposes.
- Commit messages should not contain the "Signed-off-by:" lines that
are used in some other projects.
@@ -243,12 +249,12 @@ them right the first time, so here are guidelines for formatting them:
- Explaining the rationale for a design choice is best done in comments
in the source code. However, sometimes it is useful to describe just
the rationale for a change; that can be done in the commit message
- between the summary line and the file entries.
+ between the summary line and the following ChangeLog entries.
-- Emacs generally follows the GNU coding standards for ChangeLogs: see
- https://www.gnu.org/prep/standards/html_node/Change-Logs.html
- or run 'info "(standards)Change Logs"'. One exception is that
- commits still sometimes quote `like-this' (as the standards used to
+- Emacs follows the GNU coding standards for ChangeLog entries: see
+ https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run
+ 'info "(standards)Change Logs"'. One exception is that commits
+ still sometimes quote `like-this' (as the standards used to
recommend) rather than 'like-this' or ā€˜like thisā€™ (as they do now),
as `...' is so widely used elsewhere in Emacs.
@@ -261,9 +267,9 @@ them right the first time, so here are guidelines for formatting them:
in Emacs; that includes spelling and leaving 2 blanks between
sentences.
- They are preserved indefinitely, and have a reasonable chance of
- being read in the future, so it's better that they have good
- presentation.
+ The ChangeLog entries are preserved indefinitely, and have a
+ reasonable chance of being read in the future, so it's better that
+ they have good presentation.
- Use the present tense; describe "what the change does", not "what
the change did".
diff --git a/ChangeLog.3 b/ChangeLog.3
index dc712df43ad..7db4986410d 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -137530,7 +137530,7 @@
Bind `enable-local-variables' in `hack-connection-local-variables'
* lisp/files-x.el (hack-connection-local-variables):
- Bind `enable-local-variables', instead of re-declaring
+ Bind `enable-local-variables', instead of redeclaring
`safe-local-variable-p'.
2019-03-23 Eli Zaretskii <eliz@gnu.org>
@@ -163179,7 +163179,7 @@
Quieten compilation of octave.el
- * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare.
+ * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare.
2018-02-28 Glenn Morris <rgm@gnu.org>
diff --git a/ChangeLog.4 b/ChangeLog.4
index 3d794e86b99..86fd1eb10d8 100644
--- a/ChangeLog.4
+++ b/ChangeLog.4
@@ -1,3 +1,2148 @@
+2024-03-24 Ihor Radchenko <yantar92@posteo.net>
+
+ org--confirm-resource-safe: Fix prompt when prompting in non-file Org buffers
+
+ * lisp/org/org.el (org--confirm-resource-safe): When called from
+ non-file buffer, do not put stray "f" in the prompt.
+
+ org-file-contents: Consider all remote files unsafe
+
+ * lisp/org/org.el (org-file-contents): When loading files, consider all
+ remote files (like TRAMP-fetched files) unsafe, in addition to URLs.
+
+ org-latex-preview: Add protection when `untrusted-content' is non-nil
+
+ * lisp/org/org.el (org--latex-preview-when-risky): New variable
+ controlling how to handle LaTeX previews in Org files from untrusted
+ origin.
+ (org-latex-preview): Consult `org--latex-preview-when-risky' before
+ generating previews.
+ This patch adds a layer of protection when LaTeX preview is requested
+ for an email attachment, where `untrusted-content' is set to non-nil.
+
+ * lisp/gnus/mm-view.el (mm-display-inline-fontify): Mark contents untrusted.
+ * lisp/files.el (untrusted-content): New variable.
+
+ The new variable is to be used when buffer contents comes from untrusted
+ source.
+
+ org-macro--set-templates: Prevent code evaluation
+
+ * lisp/org/org-macro.el (org-macro--set-templates): Get rid of any
+ risk to evaluate code when `org-macro--set-templates' is called as a
+ part of major mode initialization. This way, no code evaluation is
+ ever triggered when user merely opens the file or when
+ `mm-display-org-inline' invokes Org major mode to fontify mime part
+ preview in email messages.
+
+2024-03-24 Eli Zaretskii <eliz@gnu.org>
+
+ * admin/authors.el (authors-aliases): Add ignored authors.
+
+ * etc/NEWS: Update for Emacs 29.3
+
+2024-03-21 Andrea Corallo <akrl@sdf.org>
+
+ * Fix missing `comp-files-queue' update (bug#63415).
+
+ * lisp/emacs-lisp/comp.el (native--compile-async): Update
+ `comp-files-queue' for real.
+
+2024-03-21 Basil L. Contovounesios <basil@contovou.net>
+
+ Clarify description of format-spec truncation
+
+ * doc/lispref/strings.texi (Custom Format Strings): Mention that
+ precision specifier affects both '<' and '>' truncation (bug#69822).
+ * lisp/format-spec.el (format-spec, format-spec--do-flags): Use same
+ terminology as 'format', especially when referring to its behavior.
+
+2024-03-21 Eli Zaretskii <eliz@gnu.org>
+
+ More accurate documentation of 'rmail-mail-new-frame'
+
+ * doc/emacs/rmail.texi (Rmail Reply): More accurate documentation
+ of the effects of 'rmail-mail-new-frame'. (Bug#69738)
+
+2024-03-20 Eli Zaretskii <eliz@gnu.org>
+
+ Fix documentation of M-SPC in user manual
+
+ * doc/emacs/killing.texi (Deletion): Fix documentation of
+ 'cycle-spacing'. (Bug#69905)
+
+2024-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * admin/notes/bugtracker: Minor copyedit.
+
+2024-03-16 Theodor Thornhill <theo@thornhill.no>
+
+ Tweak regexp for object initializers in csharp-mode (bug#69571)
+
+ * lisp/progmodes/csharp-mode.el (csharp-guess-basic-syntax): Add
+ handling to not consider ended statements as object init openers.
+ * test/lisp/progmodes/csharp-mode-resources/indent.erts: New test
+ resources.
+ * test/lisp/progmodes/csharp-mode-tests.el: Add test for this particular
+ issue.
+
+2024-03-16 Konstantin Kharlamov <Hi-Angel@yandex.ru>
+
+ `term-mode': mention the keymap to add keybindings to
+
+ A user typically expects a keymap for mode `foo' to be called
+ `foo-mode-map'. term-mode has `term-mode-map' too, but for
+ user-defined bindings to have effect they have to be put to
+ `term-raw-map' instead. So let's mention that.
+ * lisp/term.el (term-mode) (term-mode-map) (term-raw-map): Mention
+ the keymaps to add keybindings to for `term-mode'. (Bug#69786)
+
+2024-03-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'shortdoc-copy-function-as-kill'
+
+ * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill):
+ Fix handling of functions with no arguments. (Bug#69720)
+
+2024-03-16 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'edebug-print-*' variables
+
+ * lisp/emacs-lisp/edebug.el (edebug-print-length)
+ (edebug-print-level): Fix doc strings and customization labels.
+ Suggested by Matt Trzcinski <matt@excalamus.com>. (Bug#69745)
+
+2024-03-11 F. Jason Park <jp@neverwas.me>
+
+ Fix 'with-sqlite-transaction'
+
+ * lisp/sqlite.el (with-sqlite-transaction): Tuck misplaced body
+ of else form back into feature-test control structure whence it
+ escaped. (Bug#67142)
+
+ * test/lisp/sqlite-tests.el: New file to accompany
+ test/src/sqlite-tests.el.
+
+2024-03-01 Dan Jacobson <jidanni@jidanni.org> (tiny change)
+
+ Fix typos in vnvni.el.
+
+ * lisp/leim/quail/vnvni.el ("vietnamese-vni"): Fix typos. (Bug#69485)
+
+2024-02-27 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violations in bidi.c
+
+ * src/bidi.c (bidi_resolve_brackets): Move assertion about
+ 'resolved_level' to where it belongs. This avoids unnecessary
+ aborts when the character is not a bracket type and doesn't need
+ BPA resolution. (Bug#69421)
+
+2024-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/files.el (hack-one-local-variable): Use `set-auto-mode-0`
+
+ This fixes bug#69373.
+
+2024-02-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix infinite recursion in gdb-mi.el
+
+ * lisp/progmodes/gdb-mi.el: (gdb-clear-partial-output)
+ (gdb-clear-inferior-io): Set inhibit-read-only, to avoid
+ signaling errors in process filter. (Bug#69327)
+
+2024-02-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'help-quick-toggle'
+
+ * lisp/help.el (help-quick-sections): Fix "kill-region" command.
+ Add a doc string. (Bug#69345)
+
+2024-02-21 Juri Linkov <juri@linkov.net>
+
+ * doc/lispref/modes.texi (Tabulated List Mode): Update.
+
+ In the description of 'tabulated-list-format' document
+ the missing value 'props' that was added long ago.
+
+2024-02-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294)
+
+2024-02-17 Dmitry Gutov <dmitry@gutov.dev>
+
+ java-ts-mode: Indentation for opening brace on a separate line
+
+ * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules):
+ Support putting the opening brace on a separate line (bug#67556).
+
+ * test/lisp/progmodes/java-ts-mode-resources/indent.erts:
+ Add a test.
+
+2024-02-17 Philip Kaludercic <philipk@posteo.net>
+
+ Removed decommissioned PGP keyservers
+
+ * lisp/epa-ks.el (epa-keyserver): Update the user option type of
+ `epa-keyserver'.
+
+ See https://mail.gnu.org/archive/html/emacs-devel/2023-11/msg00857.html.
+
+2024-02-17 Ihor Radchenko <yantar92@posteo.net>
+
+ org: Fix security prompt for downloading remote resource
+
+ * lisp/org/org.el (org--confirm-resource-safe): Do not assume that
+ resource is safe when user replies "n" (do not download).
+
+ Reported-by: Max Nikulin <manikulin@gmail.com>
+ Link: https://orgmode.org/list/upj6uk$b7o$1@ciao.gmane.io
+
+2024-02-17 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Update to Org 9.6.19"
+
+ This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309.
+ It was installed by mistake.
+
+2024-02-17 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.6.19
+
+2024-02-15 Philipp Stephani <p.stephani2@gmail.com>
+
+ Remove references to phst@google.com.
+
+ I don't work for Google any more, so I'll use my private address going
+ forward.
+
+ * .mailmap: Remove references to phst@google.com.
+
+2024-02-14 Stefan Kangas <stefankangas@gmail.com>
+
+ * BUGS: Note how to report critical security issues.
+
+2024-02-14 Stefan Kangas <stefankangas@gmail.com>
+
+ Add cross-reference to ELisp manual Caveats
+
+ * doc/lispref/intro.texi (Caveats): Add cross-reference to Emacs manual.
+ Talking about "contributing code" makes little sense in a section about
+ reporting mistakes in the ELisp manual, so skip that part.
+
+2024-02-14 Joseph Turner <joseph@breatheoutbreathe.in>
+
+ Improve directory prompt used by package-vc-checkout
+
+ * lisp/emacs-lisp/package-vc.el (package-vc--read-package-name): Use
+ read-directory-name instead of read-file-name. (Bug#66114)
+
+2024-02-14 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor Tramp doc adaption
+
+ * doc/misc/tramp.texi (Frequently Asked Questions): Be more
+ precise with FIDO2 keys.
+
+ * lisp/net/tramp.el: Adapt comments.
+
+2024-02-12 Daniel MartĆ­n <mardani29@yahoo.es>
+
+ ;; Fix typo in the Tramp documentation
+
+2024-02-11 Andrea Corallo <acorallo@gnu.org>
+
+ * Improve reproducibility of inferred values by native comp
+
+ * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Do not try to
+ reorder conses using 'sxhash-equal' as its behavior is not reproducible
+ over different sessions.
+
+2024-02-10 LoĆÆc LemaĆ®tre <loic.lemaitre@gmail.com> (tiny change)
+
+ Handle typescript ts grammar breaking change for function_expression
+
+ Starting from version 0.20.4 of the typescript/tsx grammar, "function"
+ becomes "function_expression". The right expression is used depending
+ on the grammar version.
+
+ * lisp/progmodes/typescript-ts-mode.el
+ (tsx-ts-mode--font-lock-compatibility-function-expression):
+ New function (bug#69024).
+ (typescript-ts-mode--font-lock-settings): Use it.
+
+2024-02-10 Eli Zaretskii <eliz@gnu.org>
+
+ Don't quote 't' in doc strings
+
+ * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix.
+ Patch by Arash Esbati <arash@gnu.org>. (Bug#69012)
+
+2024-02-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Tramp: Handle PIN requests from security keys (don't merge)
+
+ * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry.
+
+ * lisp/net/tramp-sh.el (tramp-actions-before-shell)
+ (tramp-actions-copy-out-of-band):
+ Use `tramp-security-key-pin-regexp'.
+
+ * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom.
+ (tramp-action-otp-password, tramp-read-passwd): Trim password prompt.
+ (tramp-action-show-and-confirm-message): Expand for PIN requests.
+
+2024-02-08 Stefan Kangas <stefankangas@gmail.com>
+
+ * admin/notes/kind-communication: New file.
+
+2024-02-08 Eli Zaretskii <eliz@gnu.org>
+
+ Don't skip links to "." and ".." in Dired when marking files
+
+ * lisp/dired.el (dired-mark): Skip "." and "..", but not symlinks
+ to those two. (Bug#38729) (Bug#68814)
+
+2024-02-06 Joseph Turner <joseph@breatheoutbreathe.in>
+
+ Pass unquoted filename to user-supplied MUSTMATCH predicate
+
+ * lisp/minibuffer.el (read-file-name-default): Pass REQUIRE-MATCH
+ argument through substitute-in-file-name.
+ * lisp/minibuffer.el (read-file-name): Update docstring.
+
+ Resolves bug#68815.
+
+2024-02-04 Juri Linkov <juri@linkov.net>
+
+ * doc/lispref/parsing.texi (Retrieving Nodes): Improve documentation.
+
+ Update optional arguments 'predicate' and 'include-node'
+ of 'treesit-node-top-level'.
+
+2024-02-03 Vincenzo Pupillo <v.pupillo@gmail.com>
+
+ Fix incompatibility with tree-sitter-javascript >= 0.20.2
+
+ Starting from version 0.20.2 the grammar's primary expression
+ "function" has been renamed to "function_expression". A new
+ function checks if the new primary expression is available,
+ and if so, it returns the correct rules.
+ * lisp/progmodes/js.el
+ (js--treesit-font-lock-compatibility-definition-feature): New
+ function.
+ (js--treesit-font-lock-settings): Use it. (Bug#68879)
+
+2024-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid signaling errors from 'pixel-fill-region'
+
+ * lisp/textmodes/pixel-fill.el (pixel-fill-region): Make sure the
+ selected window displays the current buffer. This is important
+ when this function is called inside 'with-current-buffer' or
+ similar forms which temporarily change the buffer displayed in the
+ selected window. (Bug#67791)
+
+2024-02-02 nibon7 <nibon7@163.com>
+
+ eglot: Add nushell language server
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell
+ language server. (Bug#68823)
+
+2024-02-02 Piotr Kwiecinski <piotr.kwiecinski@codemanufacture.com> (tiny change)
+
+ eglot: Add php-ts-mode to eglot-server-programs
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Add
+ php-ts-mode. (Bug#68870)
+
+2024-02-02 dalu <mou.tong@outlook.com> (tiny change)
+
+ Support kotlin-ts-mode in Eglot
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Support
+ kotlin-ts-mode. (Bug#68865)
+
+2024-02-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix stale cache in Tramp (do not merge with master)
+
+ * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
+ Flush file properties when needed. (Bug#68805)
+
+2024-02-01 Ulrich MĆ¼ller <ulm@gentoo.org>
+
+ * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bug#68842)
+
+ Do not merge to master.
+
+2024-02-01 Stefan Kangas <stefankangas@gmail.com>
+
+ Improve `desktop-save-mode` docstring
+
+ * lisp/desktop.el (desktop-save-mode): Improve docstring.
+
+2024-01-28 Joseph Turner <joseph@breatheoutbreathe.in>
+
+ Fix completing-read functional REQUIRE-MATCH behavior
+
+ * lisp/minibuffer.el (completion--complete-and-exit): If
+ minibuffer-completion-confirm is a function which returns nil,
+ immediately fail to complete.
+
+ See bug#66187.
+
+2024-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ Fix "emacs -nw" on MS-Windows
+
+ * src/w32term.c (w32_flip_buffers_if_dirty): Do nothing if F is
+ not a GUI frame. This avoids rare crashes in "emacs -nw".
+ * src/w32console.c (initialize_w32_display): Set the
+ ENABLE_EXTENDED_FLAGS bit in 'prev_console_mode'.
+
+ (cherry picked from commit e1970c99f097715fc5bb3b88154799bfe13de90f)
+
+2024-01-28 Michael Albinus <michael.albinus@gmx.de>
+
+ Handle wrong login program in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Exit remote
+ shell when login fails.
+
+2024-01-27 Jim Porter <jporterbugs@gmail.com>
+
+ * doc/lispref/package.texi (Multi-file Packages): Document ".elpaignore".
+
+ (cherry picked from commit 744a10a4d722a361bc21561b4162045e4ec97ed6)
+
+2024-01-27 Eshel Yaron <me@eshelyaron.com>
+
+ Avoid signaling errors in emoji.el on empty input
+
+ * lisp/international/emoji.el (emoji--read-emoji): Signal
+ user-error on empty input. (Bug#68671)
+
+ Do not merge to master.
+
+2024-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix description of when "\xNNN" is considered a unibyte character
+
+ * doc/lispref/objects.texi (Non-ASCII in Strings): More accurate
+ description of when a hexadecimal escape sequence yields a unibyte
+ character. (Bug#68751)
+
+2024-01-26 Randy Taylor <dev@rjt.dev>
+
+ Simplify imenu setup for {cmake,dockerfile}-ts-modes
+
+ * lisp/progmodes/cmake-ts-mode.el (treesit-induce-sparse-tree,
+ treesit-node-child, treesit-node-start, cmake-ts-mode--imenu,
+ cmake-ts-mode--imenu-1): Remove.
+ (treesit-search-subtree): Declare.
+ (cmake-ts-mode--function-name): New function.
+ (cmake-ts-mode): Use it.
+
+ * lisp/progmodes/dockerfile-ts-mode.el (treesit-induce-sparse-tree,
+ treesit-node-start, dockerfile-ts-mode--imenu,
+ dockerfile-ts-mode--imenu-1): Remove.
+ (dockerfile-ts-mode--stage-name): New function.
+ (dockerfile-ts-mode): Use it.
+
+2024-01-24 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of profiler commands
+
+ * doc/lispref/debugging.texi (Profiling): Document more commands.
+ Improve indexing. (Bug#68693)
+
+2024-01-23 Basil L. Contovounesios <contovob@tcd.ie>
+
+ Fix broken links to Freedesktop notifications spec
+
+ * doc/lispref/os.texi (Desktop Notifications):
+ * lisp/notifications.el: Replace broken developer.gnome.org links
+ with specifications.freedesktop.org (bug#67939).
+
+2024-01-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix nasty cut'n'waste error in Tramp
+
+ * lisp/net/tramp.el (tramp-parse-passwd): Use `tramp-parse-passwd-group'.
+ Reported by Tim Landscheidt <tim@tim-landscheidt.de>.
+
+2024-01-21 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix image-dired-tags-db-file void variable error
+
+ * lisp/image/image-dired-tags.el (image-dired-sane-db-file):
+ Require 'image-dired'. (Bug#68636)
+
+2024-01-21 Matthew Smith <matthew@gentoo.org> (tiny change)
+
+ typescript-ts-mode: Skip test if tsx grammar missing
+
+ typescript-ts-mode-test-indentation depends on both the tree-sitter
+ typescript grammar, and the tree-sitter tsx grammar. If only the
+ typescript is installed, the tests will run and then fail unexpectedly
+ after tsx fails to load.
+
+ * test/lisp/progmodes/typescript-ts-mode-tests.el
+ (typescript-ts-mode-test-indentation): Skip test if tsx grammar is
+ missing.
+
+2024-01-20 Stefan Kangas <stefankangas@gmail.com>
+
+ * admin/README: Document the run-codespell script.
+
+ * admin/README: Fix entry on coccinelle subdirectory.
+
+2024-01-20 Stefan Kangas <stefankangas@gmail.com>
+
+ Add script admin/run-codespell and supporting files
+
+ * admin/codespell/README:
+ * admin/codespell/codespell.dictionary:
+ * admin/codespell/codespell.exclude:
+ * admin/codespell/codespell.ignore:
+ * admin/codespell/codespell.rc:
+ * admin/run-codespell: New files.
+
+2024-01-20 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.6.3-pre (don't merge with master)
+
+ * doc/misc/tramp.texi (Obtaining @value{tramp}): Mention the ELPA
+ Tramp manual.
+ (Remote processes): Adapt index.
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el (tramp-version): Set to "2.6.3-pre".
+
+ * lisp/net/tramp.el (tramp-local-host-regexp): Extend. Adapt :version.
+ (tramp-signal-process): PROCESS can also be a string.
+ (tramp-skeleton-directory-files):
+ * lisp/net/tramp-cache.el (with-tramp-saved-file-property)
+ (with-tramp-saved-file-properties)
+ (with-tramp-saved-connection-property)
+ (with-tramp-saved-connection-properties): Use `setf' but `setq' in macro.
+
+ * lisp/net/tramp-compat.el (tramp-compat-funcall): Declare debug.
+
+ * lisp/net/tramp-crypt.el (tramp-crypt-file-name-p): Exclude lock files.
+ (tramp-crypt-file-name-handler-alist): Use `identity' for
+ `abbreviate-file-name'.
+ (tramp-crypt-add-directory, tramp-crypt-remove-directory):
+ Adapt docstrings.
+ (tramp-crypt-cleanup-connection): New defun. Add it to
+ `tramp-cleanup-connection-hook'
+
+ * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions):
+ Handle "." and "..".
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions):
+ * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions):
+ Remove special handling of "." an "..".
+
+ * lisp/net/tramp-sh.el (tramp-pipe-stty-settings): New defcustom.
+ (tramp-sh-handle-make-process): Use it. (Bug#62093)
+
+ * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes):
+ Adapt test.
+ (tramp-test31-signal-process): Extend.
+
+2024-01-20 Eli Zaretskii <eliz@gnu.org> (tiny change)
+
+ Update Polish translation of tutorial
+
+ * etc/tutorials/TUTORIAL.pl: Update text about scroll bar. New
+ text by Christopher Yeleighton <giecrilj@stegny.2a.pl>.
+ (Bug#68599)
+
+2024-01-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/gnus.texi (Summary Mail Commands): Fix command name.
+
+2024-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ Bump Emacs version to 29.2.50.
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp:
+ * etc/NEWS: Bump Emacs version to 29.2.50.
+
+2024-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ * Update etc/HISTORY and ChangeLog.4 for 29.2 release.
+
+2024-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ Bump Emacs version to 29.2
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Bump Emacs version to 29.2.
+
+2024-01-18 Eli Zaretskii <eliz@maintain0p.gnu.org>
+
+ * Version 29.2 released.
+
+ * ChangeLog.4:
+ * etc/HISTORY: Update for Emacs 29.2.
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Bump Emacs version to 29.2.
+
+2024-01-17 Dmitry Gutov <dmitry@gutov.dev>
+
+ diff-mode: Support committing diff with file deletions
+
+ * lisp/vc/diff-mode.el (diff-vc-deduce-fileset):
+ Remove nil elements from the result (bug#68443).
+
+2024-01-16 Juri Linkov <juri@linkov.net>
+
+ * lisp/net/eww.el (eww-retrieve): Fix args of eww-render for sync (bug#68336).
+
+ Suggested by Phil Sainty <psainty@orcon.net.nz>.
+
+2024-01-16 Mike Kupfer <kupfer@rawbw.com>
+
+ Fix folder creation error (Bug#67361)
+
+ * lisp/mh-e/mh-funcs.el (mh-kill-folder)
+ * lisp/mh-e/mh-search.el (mh-index-new-folder)
+ * lisp/mh-e/mh-utils.el (mh-prompt-for-folder):
+ Check for existence of 'speedbar-buffer' rather than
+ 'mh-speed-folder-map'. The latter can exist if
+ 'mh-speed' has only been loaded but not displayed.
+
+ (cherry picked from commit e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366)
+
+2024-01-15 Gregory Heytings <gregory@heytings.org>
+
+ Simplify 'without-restriction'
+
+ This simplification is symmetrical to 01fb898420.
+
+ * src/editfns.c: (Finternal__labeled_widen): Add a call to
+ 'Fwiden', and rename from 'internal--unlabel-restriction'.
+ (unwind_labeled_narrow_to_region): Use the renamed function, and
+ remove the call to 'Fwiden'.
+ (syms_of_editfns): Rename the symbol.
+
+ * lisp/subr.el (internal--without-restriction): Use the renamed
+ function.
+
+ (cherry picked from commit 9e9e11648d3d5514de85edfb69f0949a062f4716)
+
+2024-01-14 Gregory Heytings <gregory@heytings.org>
+
+ Fix blunder in labeled_narrow_to_region
+
+ * src/editfns.c (labeled_narrow_to_region): Record point before,
+ instead of after, calling narrow-to-region; otherwise point may
+ already have been changed. Fixes bug#66764.
+
+2024-01-14 Daniel MartĆ­n <mardani29@yahoo.es>
+
+ Fix documentation of icon-elements
+
+ * lisp/emacs-lisp/icons.el (icon-elements): The plist key it returns
+ is `image', not `display'. (Bug#68451)
+
+2024-01-14 Stefan Kangas <stefankangas@gmail.com>
+
+ Improve two docstrings in ox-latex
+
+ * lisp/org/ox-latex.el (org-latex-src-block-backend)
+ (org-latex-engraved-theme): Improve docstring; mention that
+ engrave-faces is a GNU ELPA package.
+
+2024-01-14 Stefan Kangas <stefankangas@gmail.com>
+
+ Doc fix in auth-source-read-char-choice
+
+ * lisp/auth-source.el (auth-source-read-char-choice): Don't
+ document 'dropdown-list', which was removed in 2011.
+
+2024-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix info-xref-tests
+
+ * doc/lispintro/emacs-lisp-intro.texi (How let Binds Variables):
+ Fix cross-reference. (Bug#68428)
+
+ * test/lisp/info-xref-tests.el (info-xref-test-write-file): Fix
+ test on MS-Windows when run from MSYS Bash.
+
+2024-01-13 Juri Linkov <juri@linkov.net>
+
+ Add @kindex in manuals for existing keybindings on 'C-x x/w' (bug#13167)
+
+ * doc/emacs/buffers.texi (Misc Buffer): Add @kindex for 'C-x x r',
+ 'C-x x u', 'C-x x i'.
+
+ * doc/emacs/display.texi (Line Truncation): Add @kindex for 'C-x x t'.
+
+ * doc/emacs/files.texi (Reverting): Add @kindex for 'C-x x g'.
+
+ * doc/emacs/windows.texi (Change Window): Use new keybinding 'C-x w 0'
+ instead of 'M-x delete-windows-on'.
+
+ * doc/misc/info.texi (Create Info buffer): Add @kindex for 'C-x x n'.
+
+2024-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'emacs_function' in modules
+
+ * doc/lispref/internals.texi (Module Functions): Warn about
+ accessing the ARGS array in module functions.
+
+2024-01-12 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of Ispell commands
+
+ * doc/emacs/fixit.texi (Spelling): Document "C-u M-$" and warn
+ against modifications in recursive-edit. (Bug#14192)
+
+2024-01-11 Stefan Kangas <stefankangas@gmail.com>
+
+ Don't recommend inverse-video for debugging
+
+ * etc/DEBUG: Don't recommend 'inverse-video', which has been broken
+ for 20 years, give or take. (Bug#11430)
+
+2024-01-11 Xiyue Deng <manphiz@gmail.com>
+
+ Fix typo in lispref "Creating Strings" section
+
+ * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375).
+
+2024-01-11 Xiyue Deng <manphiz@gmail.com> (tiny change)
+
+ Fix count of no-op functions (bug#68375)
+
+ It looks like there are actually three kinds of no-op functions.
+
+ * doc/lispref/functions.texi (Calling Functions): Fix count and
+ plural of no-op functions.
+
+2024-01-11 Xiyue Deng <manphiz@gmail.com> (tiny change)
+
+ Wrap @pxref of Abbrevs in parentheses (bug#68375)
+
+ * doc/lispref/symbols.texi (Shorthands): Wrap `@pxref{Abbrevs}' in
+ parentheses.
+
+2024-01-10 Mauro Aranda <maurooaranda@gmail.com>
+
+ Add examples to the Widget manual
+
+ * doc/misc/widget.texi (Widget Gallery, Defining New Widgets): Add
+ examples. (Bug#66229)
+
+2024-01-10 Mauro Aranda <maurooaranda@gmail.com>
+
+ Implement missing functions for custom-icon widget
+
+ * lisp/cus-edit.el (custom-icon-reset-saved, custom-icon-mark-to-save)
+ (custom-icon-state-set-and-redraw, custom-icon-reset-standard)
+ (custom-icon-mark-to-reset-standard): New functions.
+ (custom-icon, custom-icon-extended-menu): Register and add them to the
+ menu. (Bug#66947)
+
+2024-01-10 Stephen Berman <stephen.berman@gmx.net>
+
+ Fix fontification of cgroup2 in fstab (bug#68367)
+
+ * lisp/generic-x.el (etc-fstab-generic-mode): Add cgroup2.
+
+2024-01-10 Philip Kaludercic <philipk@posteo.net>
+
+ Handle package versions that are not version strings
+
+ * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore
+ any errors raised by 'version-to-list', thus falling back to the
+ default version list. (Bug#68317)
+
+ (cherry picked from commit eb913c7501489e1eae475cae843fccdf14cc24d8)
+
+2024-01-09 Jim Porter <jporterbugs@gmail.com>
+
+ Introduce 'let' using lexical binding in the Lisp Introduction
+
+ * doc/lispintro/emacs-lisp-intro.texi (Prevent confusion): Rework the
+ explanation to discuss how things work under lexical binding.
+ (How let Binds Variables): Describe the differences between lexical
+ and dynamic binding (including how to configure it).
+ (defvar): Mention that 'defvar' declares variables as always
+ dynamically-bound (bug#66756).
+
+2024-01-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'rmail-summary-by-thread'
+
+ * lisp/mail/rmailsum.el (rmail-summary-by-thread): Call
+ 'rmail-new-summary' from the original buffer, not from
+ 'rmail-buffer' to avoid failing the logic in 'rmail-new-summary'
+ that decides whether to pop up a new window. Reported by Andrea
+ Monaco <andrea.monaco@autistici.org>.
+
+2024-01-06 Jean-Christophe Helary <jean.christophe.helary@traductaire-libre.org>
+
+ * doc/emacs/back.texi: Fix a typo.
+
+2024-01-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix icons.el when icon does not exist as a file
+
+ * lisp/emacs-lisp/icons.el (icons--create): Handle the case when
+ ICON is a file that doesn't exists or is unreadable. Suggested by
+ David Ponce <da_vid@orange.fr>. (Bug#66846)
+
+2024-01-05 Juri Linkov <juri@linkov.net>
+
+ * lisp/isearch.el (isearch-search-and-update): Let-bind 'isearch-cmds'.
+
+ When 'isearch-wrap-pause' is 'no' or 'no-ding', let-bind 'isearch-cmds'
+ to avoid changing it by 'isearch-push-state' in 'isearch-repeat',
+ so that a later DEL (isearch-delete-char) doesn't stop at the
+ intermediate failing state (bug#68158).
+
+2024-01-04 Andrea Corallo <acorallo@gnu.org>
+
+ * src/comp.c (Fcomp__compile_ctxt_to_file): Fix hash table Qunbound use.
+
+2024-01-04 Eli Zaretskii <eliz@gnu.org>
+
+ Provide decent documentation for 'help-quick'
+
+ * lisp/help.el (help-quick, help-quick-toggle): Doc fix.
+
+ * doc/emacs/help.texi (Help Summary, Misc Help): Document
+ 'help-quick-toggle'.
+
+2024-01-02 Dmitry Gutov <dmitry@gutov.dev>
+
+ treesit--pre-syntax-ppss: Fix args-out-of-range in internal--syntax-propertize
+
+ * lisp/treesit.el (treesit--pre-syntax-ppss): Make sure the lower
+ bound is still within the current restriction (bug#67977).
+
+2024-01-01 Mike Kupfer <kupfer@rawbw.com>
+
+ Fix mangled Subject header field when forwarding (Bug#67360)
+
+ * lisp/mh-e/mh-comp.el (mh-forward): Overwrite subject when
+ forwarding.
+
+2024-01-01 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.6.15
+
+2023-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ * doc/emacs/custom.texi (Modifier Keys): Fix markup (bug#68164).
+
+ Suggested by Jens Quade <jq@qdevelop.de>.
+
+2023-12-30 Stefan Kangas <stefankangas@gmail.com>
+
+ org-protocol: Minor copy-edits to Commentary
+
+ * lisp/org/org-protocol.el: Minor copy-edits to Commentary.
+
+2023-12-30 Denis Zubarev <dvzubarev@yandex.ru>
+
+ Improve syntax highlighting for python-ts-mode
+
+ Fix fontification of strings inside of f-strings interpolation, e.g. for
+ f"beg {'nested'}" - 'nested' was not fontified as string. Do not
+ override the face of builtin functions (all, bytes etc.) with the
+ function call face. Add missing assignment expressions (:= *=).
+ Fontify built-ins (dict,list,etc.) as types when they are used in type
+ hints. Highlight union types (type1|type2). Highlight base class names
+ in the class definition. Fontify class patterns in case statements.
+ Highlight the second argument as a type in isinstance/issubclass call.
+ Highlight dotted decorator names.
+
+ * lisp/progmodes/python.el (python--treesit-keywords): Add compound
+ keyword "is not".
+ (python--treesit-builtin-types): New variable that stores all python
+ built-in types.
+ (python--treesit-type-regex): New variable. Regex matches if text is
+ either built-in type or text starts with capital letter.
+ (python--treesit-builtins): Extract built-in types to other variable.
+ (python--treesit-fontify-string): fix f-string interpolation. Enable
+ interpolation highlighting only if string-interpolation is presented
+ on the enabled levels of treesit-font-lock-feature-list.
+ (python--treesit-fontify-string-interpolation): Remove function.
+ (python--treesit-fontify-union-types): Fontify nested union types.
+ (python--treesit-fontify-union-types-strict): Fontify nested union
+ types, only if type identifier matches against
+ python--treesit-type-regex.
+ (python--treesit-fontify-dotted-decorator): Fontify all parts of
+ dotted decorator name.
+ (python--treesit-settings): Change/add rules. (Bug#67061)
+
+ * test/lisp/progmodes/python-tests.el
+ (python-ts-tests-with-temp-buffer): Function for setting up test
+ buffer.
+ (python-ts-mode-compound-keywords-face)
+ (python-ts-mode-named-assignement-face-1)
+ (python-ts-mode-assignement-face-2)
+ (python-ts-mode-nested-types-face-1)
+ (python-ts-mode-union-types-face-1)
+ (python-ts-mode-union-types-face-2)
+ (python-ts-mode-types-face-1)
+ (python-ts-mode-types-face-2)
+ (python-ts-mode-types-face-3)
+ (python-ts-mode-isinstance-type-face-1)
+ (python-ts-mode-isinstance-type-face-2)
+ (python-ts-mode-isinstance-type-face-3)
+ (python-ts-mode-superclass-type-face)
+ (python-ts-mode-class-patterns-face)
+ (python-ts-mode-dotted-decorator-face-1)
+ (python-ts-mode-dotted-decorator-face-2)
+ (python-ts-mode-builtin-call-face)
+ (python-ts-mode-interpolation-nested-string)
+ (python-ts-mode-disabled-string-interpolation)
+ (python-ts-mode-interpolation-doc-string): Add tests.
+
+2023-12-29 Yuan Fu <casouri@gmail.com>
+
+ Revert "Fix treesit-node-field-name and friends (bug#66674)"
+
+ This reverts commit 9874561f39e62c1c9fada6c2e013f93d9ea65729.
+
+ See bug#67990. Basically our original code is correct, the error is
+ in libtree-sitter, which only manifests in certain cases.
+
+ https://github.com/tree-sitter/tree-sitter/pull/2104
+
+2023-12-25 Stefan Kangas <stefankangas@gmail.com>
+
+ Explain status "r" in `epa-list-keys`
+
+ * lisp/epa.el (epa-list-keys): Add revoked status to description.
+ Suggested by CHENG Gao <chenggao@icloud.com>.
+
+2023-12-25 Jared Finder <jared@finder.org>
+
+ Fix mouse clicks on directory line in Dired
+
+ The option 'dired-kill-when-opening-new-dired-buffer' should be
+ also honored when clicking the mouse to kill prev buffer.
+ * lisp/dired.el (dired--make-directory-clickable): Call
+ 'dired--find-possibly-alternative-file' instead of 'dired', in
+ the click callback. (Bug#67856)
+
+2023-12-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'split-root-window-right' and 'split-root-window-below'
+
+ * lisp/window.el (split-root-window-right)
+ (split-root-window-below): Fix the 'interactive' spec to avoid
+ misbehaving when invoked with no prefix argument. (Bug#67452)
+
+2023-12-24 Stefan Kangas <stefankangas@gmail.com>
+
+ Mark icalendar.el as maintained by emacs-devel
+
+ * lisp/calendar/icalendar.el: Mark emacs-devel as the maintainer.
+ Ref: https://debbugs.gnu.org/34315#152
+
+2023-12-24 Xiyue Deng <manphiz@gmail.com>
+
+ Fix usage of `setq-default' and offer more suggestions
+
+ cd61af0 changed from default-major-mode to major-mode in the first
+ code sample but didn't change the rest. This patch fixes this and add
+ some explanations of why use `setq-default' instead of `setq'. In
+ addition, it gives background on suggesting using text-mode as default
+ mode and suggest other alternatives.
+
+ * doc/lispintro/emacs-lisp-intro.texi (Text and Auto-fill): Fix usage
+ of `setq-default' and offer more suggestions. (Bug#67848)
+
+2023-12-23 Yuan Fu <casouri@gmail.com>
+
+ Fix python-ts-mode triple quote syntax (bug#67262)
+
+ * lisp/progmodes/python.el (python--treesit-syntax-propertize): New function.
+ (python-ts-mode): Activate python--treesit-syntax-propertize.
+
+2023-12-23 Yuan Fu <casouri@gmail.com>
+
+ Increment parser timestamp when narrowing changes (bug#67977)
+
+ When narrowing changes, parse reparses, so the timestamp should
+ definitely increment, just like in ts_record_changes.
+
+ Failing to increment this timestamp, outdated nodes would think they
+ are still up-to-date, and try to print their type name. Printing
+ their type name involves accessing the old parse tree, which is
+ already freed during the last reparse.
+
+ I also found that we don't increment timestamp when changing parser
+ ranges and fixed that as well.
+
+ * src/treesit.c (treesit_sync_visible_region):
+ (Ftreesit_parser_set_included_ranges): Increment timestamp.
+ * src/treesit.h (Lisp_TS_Parser): Add some comments.
+
+2023-12-23 Dmitry Gutov <dmitry@gutov.dev>
+
+ ruby-ts-mode: Fix indentation for string_array closer
+
+ * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules):
+ Fix indentation for string_array closer.
+
+2023-12-23 Dmitry Gutov <dmitry@gutov.dev>
+
+ treesit-major-mode-setup: Use 'treesit--syntax-propertize-notifier'
+
+ * lisp/treesit.el (treesit-major-mode-setup): Make sure
+ 'treesit--syntax-propertize-notifier' is used (bug#66732)
+
+2023-12-23 Dmitry Gutov <dmitry@gutov.dev>
+
+ ruby-ts-mode: Fix an out-of-bounds error with heredoc at eob
+
+ * lisp/progmodes/ruby-ts-mode.el (ruby-ts--syntax-propertize):
+ Fix an out-of-bounds error with heredoc at eob.
+
+2023-12-23 Yuan Fu <casouri@gmail.com>
+
+ Correctly refontify changed region in tree-sitter modes (bug#66732)
+
+ We already have treesit--font-lock-notifier that should mark changed
+ regions to be refontified, but it's called too late in the redsiplay &
+ fontification pipeline. Here we add treesit--pre-redisplay that
+ forces reparse and calls notifier functions in
+ pre-redisplay-functions, which is early enough for the marking to take
+ effect.
+
+ Similarly, we force reparse in
+ syntax-propertize-extend-region-functions so syntax-ppss will have the
+ up-to-date syntax information when it scans the buffer text. We also
+ record the lowest start position of the affected regions, and make
+ sure next syntex-propertize starts from that position.
+
+ * lisp/treesit.el (treesit--pre-redisplay-tick):
+ (treesit--syntax-propertize-start): New variable.
+ (treesit--syntax-propertize-notifier):
+ (treesit--pre-redisplay):
+ (treesit--pre-syntax-ppss): New functions.
+ (treesit-major-mode-setup): Add hooks.
+
+ * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Remove notifier.
+ (ruby-ts--parser-after-change): Remove notifier function.
+
+2023-12-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/man/emacsclient.1: Fix --tramp option.
+
+2023-12-23 Peter Oliver <git@mavit.org.uk> (tiny change)
+
+ * doc/man/emacsclient.1: Add missing sections (bug#66598)
+
+2023-12-23 Xiyue Deng <manphiz@gmail.com>
+
+ Add explanation for extra parentheses in ELisp Introduction
+
+ * doc/lispintro/emacs-lisp-intro.texi (fwd-para while): Add
+ a note to explain the extra parentheses. (Bug#67820)
+
+2023-12-23 Xiyue Deng <manphiz@gmail.com>
+
+ Add sample code to the "let*" section in "forward-paragraph"
+
+ * doc/lispintro/emacs-lisp-intro.texi (fwd-para let): Add code
+ sample. (Bug#67817)
+
+2023-12-23 Denis Zubarev <dvzubarev@yandex.ru>
+
+ Fix treesit test (bug#67117)
+
+ * test/src/treesit-tests.el (treesit-search-subtree-forward-1):
+ (treesit-search-subtree-backward-1): Replace treesit--thing-at with
+ treesit-query-capture (treesit--thing-at isn't available in Emacs 29).
+
+2023-12-23 Yuan Fu <casouri@gmail.com>
+
+ Fix c++-ts-mode indentation (bug#67975)
+
+ * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Make indent
+ rule match precise so it doesn't match declaration_list.
+
+2023-12-22 Stefan Kangas <stefankangas@gmail.com>
+
+ Recommend customizing eglot for python-base-mode
+
+ * doc/misc/eglot.texi (Project-specific configuration): Recommend
+ setting directory local variables for 'python-base-mode' instead of
+ 'python-mode'. This makes any customizations effective also for
+ 'python-ts-mode'.
+
+2023-12-22 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of new native-compilation commands
+
+ * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-menu)
+ (emacs-lisp-native-compile, emacs-lisp-native-compile-and-load):
+ Doc fixes.
+
+ * doc/lispref/compile.texi (Native-Compilation Functions):
+ Document 'emacs-lisp-native-compile' and
+ 'emacs-lisp-native-compile-and-load'.
+
+2023-12-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ doc/lispintro: Don't mention `set` (bug#67734)
+
+ * doc/lispintro/emacs-lisp-intro.texi (Using set): Delete.
+ (Using setq): Adjust accordingly.
+ (setq): Rename from "set & setq" and don't refer to `set` any more.
+ (Review): Don't mention `set` any more.
+
+2023-12-20 Eli Zaretskii <eliz@gnu.org>
+
+ Fix script for some characters
+
+ * lisp/international/characters.el (char-script-table): Fix script
+ for 2 characters.
+
+ * admin/unidata/blocks.awk: Fix script for Yijing Hexagram
+ Symbols. (Bug#67924)
+
+2023-12-18 Denis Zubarev <dvzubarev@yandex.ru>
+
+ Fix an issue when searching subtree backward (bug#67117)
+
+ * src/treesit.c (treesit_traverse_child_helper):
+ Do not call treesit_traverse_sibling_helper when the named node is
+ required and the last child is the named node.
+ Otherwise treesit_traverse_sibling_helper will move cursor to the
+ previous sibling and last node will be skipped.
+ * test/src/treesit-tests.el (treesit-search-subtree-forward-1):
+ (treesit-search-subtree-backward-1):
+ Add tests.
+
+2023-12-18 Christophe Deleuze <christophe.deleuze@free.fr> (tiny change)
+
+ Fix passive mode for tnftp client in ange-ftp.el.
+
+ * lisp/net/ange-ftp.el (ange-ftp-passive-mode): Fix passive mode
+ result string for tnftp client. (Bug#67865)
+
+2023-12-16 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix using disabled command without a docstring
+
+ * lisp/novice.el (disabled-command-function): Fix error when the
+ disable command has no docstring. (Bug#67835)
+
+2023-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of text properties handling when yanking
+
+ * doc/lispref/text.texi (Text Properties): Mention special
+ handling of text properties while yanking.
+
+2023-12-16 skykanin <3789764+skykanin@users.noreply.github.com> (tiny change)
+
+ Eglot: Add Uiua language server
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Add Uiua language
+ server. (Bug#67850)
+
+2023-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix shaping of Sinhala text
+
+ * lisp/language/sinhala.el (composition-function-table): Allow
+ U+200D U+0DCA as well as U+0DCA U+200D between consonants.
+ Suggested by Richard Wordingham <richard.wordingham@ntlworld.com>.
+ (Bug#67828)
+
+2023-12-16 Jeremy Bryant <jb@jeremybryant.net>
+ Eli Zaretskii <eliz@gnu.org>
+
+ Add use cases of (fn) documentation facility.
+
+ * doc/lispref/functions.texi (Function Documentation): Add examples.
+ (Bug#67499)
+
+2023-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix pasting into terminal-mode on term.el
+
+ * lisp/term.el (term--xterm-paste): Read pasted text from the
+ input event. Suggested by Jared Finder <jared@finder.org>.
+ (Bug#49253)
+
+2023-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix opening directory trees from Filesets menu
+
+ In bug#976, the code was fixed, but the cautious condition in
+ the original author's code, which catered to invoking
+ 'filelists-open' from the menu-bar menu, was omitted, which made
+ that invocation, which did work before, broken.
+ * lisp/filesets.el (filesets-get-filelist): Fix opening directory
+ trees from the Filesets menu-bar menu. (Bug#67658)
+
+2023-12-16 Niall Dooley <dooleyn@gmail.com> (tiny change)
+
+ Eglot: Add ruff-lsp as an alternative Python server
+
+ ruff-lsp [1] is an LSP server for Ruff [2], [3], a fast Python linter
+ and code formatter.
+
+ It supports surfacing Ruff diagnostics and providing Code Actions to
+ fix them, but is intended to be used alongside another Python LSP in
+ order to support features like navigation and autocompletion.
+
+ [1]: https://github.com/astral-sh/ruff-lsp
+ [2]: https://github.com/astral-sh/ruff
+ [3]: https://docs.astral.sh/ruff/
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Add ruff-lsp.
+
+2023-12-14 Adam Porter <adam@alphapapa.net>
+
+ Fix symbol name in Multisession Variables examples
+
+ * doc/lispref/variables.texi (Multisession Variables): Fix symbol
+ name. (Bug#67823)
+
+2023-12-12 Dmitry Gutov <dmitry@gutov.dev>
+
+ js-ts-mode: Fix font-lock rules conflict
+
+ * lisp/progmodes/js.el (js--treesit-font-lock-settings): Move
+ 'property' to after 'jsx'. Stop using predicate (bug#67684).
+ (js--treesit-property-not-function-p): Delete.
+
+2023-12-11 Noah Peart <noah.v.peart@gmail.com>
+
+ Add indentation rules for bracketless statements in js-ts-mode
+
+ * lisp/progmodes/js.el (js--treesit-indent-rules): Add indentation
+ rules to handle bracketless statements (bug#67758).
+ * test/lisp/progmodes/js-tests.el (js-ts-mode-test-indentation):
+ New test for js-ts-mode indentation.
+ * test/lisp/progmodes/js-resources/js-ts-indents.erts: New file
+ with indentation tests for js-ts-mode.
+
+2023-12-10 Yuan Fu <casouri@gmail.com>
+
+ Fix c-ts-mode bracketless indentation for BSD style (bug#66152)
+
+ * lisp/progmodes/c-ts-mode.el:
+ (c-ts-mode--indent-styles): Make sure the BSD rules only apply to
+ opening bracket (compound_statement), then bracketless statements will
+ fallback to common rules.
+ * test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts: Copy the
+ bracketless test from indent.erts to here.
+
+2023-12-10 Augustin ChƩneau <btuin@mailo.com>
+
+ Add missing indent rules in c-ts-mode (bug#66152)
+
+ Example:
+
+ static myttype *
+ variable_name;
+
+ * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add rules.
+
+2023-12-10 Yuan Fu <casouri@gmail.com>
+
+ Fix treesit-default-defun-skipper (bug#66711)
+
+ * lisp/treesit.el:
+ (treesit-default-defun-skipper): Add bol to the rx pattern.
+
+2023-12-10 Yuan Fu <casouri@gmail.com>
+
+ Fix treesit-node-field-name and friends (bug#66674)
+
+ So turns out ts_node_field_name_for_child takes a named node index,
+ but we were passing it normal index that counts both named and
+ anonymous nodes. That's what makes the field name all wrong in
+ treesit explorer.
+
+ * doc/lispref/parsing.texi:
+ (Accessing Node Information): Update docstring.
+ * lisp/treesit.el (treesit-node-index): Add some unrelated comment.
+ (treesit-node-field-name): Get named node index rather than all node
+ index.
+ * src/treesit.c (Ftreesit_node_field_name_for_child): Update
+ docstring, use ts_node_named_child_count.
+
+2023-12-10 Maciej Kalandyk <m.kalandyk@outlook.com>
+
+ python-ts-mode: Highlight default parameters
+
+ * lisp/progmodes/python.el (python--treesit-settings):
+ Highlight default parameters (bug#67703).
+
+2023-12-10 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.6.13
+
+2023-12-10 Yuan Fu <casouri@gmail.com>
+
+ Fix c-ts-mode indent heuristic (bug#67417)
+
+ This is a continuation of the first two patches for bug#67417. The
+ c-ts-mode--prev-line-match heuristic we added is too broad, so for now
+ we are just adding a very specific heuristic for the else case.
+
+ * lisp/progmodes/c-ts-mode.el:
+ (c-ts-mode--prev-line-match): Remove function.
+ (c-ts-mode--else-heuristic): New function.
+ (c-ts-mode--indent-styles): Use c-ts-mode--else-heuristic.
+
+2023-12-10 nverno <noah.v.peart@gmail.com>
+
+ Fix c-ts-mode indentation (bug#67357)
+
+ 1. In a compund_statement, we indent the first sibling against the
+ parent, and the rest siblings against their previous sibling. But
+ this strategy falls apart when the first sibling is not on its own
+ line. We should regard the first sibling that is on its own line as
+ the "first sibling"", and indent it against the parent.
+
+ 2. In linux style, in a do-while statement, if the do-body is
+ bracket-less, the "while" keyword is indented to the same level as the
+ do-body. It should be indented to align with the "do" keyword
+ instead.
+
+ * lisp/progmodes/c-ts-mode.el:
+ (c-ts-mode--no-prev-standalone-sibling): New function.
+ (c-ts-mode--indent-styles): Use
+ c-ts-mode--no-prev-standalone-sibling. Add while keyword indent rule.
+ * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New tests.
+
+2023-12-09 nverno <noah.v.peart@gmail.com>
+
+ Add font-locking for hash-bang lines in typescript-ts-mode.
+
+ * lisp/progmodes/typescript-ts-mode.el
+ (typescript-ts-mode--font-lock-settings):
+ Add font-lock for hash bang line.
+
+2023-12-09 nverno <noah.v.peart@gmail.com>
+
+ Add font-locking for hash-bang lines in js-ts-mode
+
+ * lisp/progmodes/js.el (js--treesit-font-lock-settings):
+ Add font-lock for hash bang line.
+
+2023-12-09 Dmitry Gutov <dmitry@gutov.dev>
+
+ ruby-mode: Better detect regexp vs division (bug#67569)
+
+ * lisp/progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Add grouping around methods from the whitelist.
+ (ruby-syntax-propertize): Also look for spaces around the slash.
+
+2023-12-09 Jared Finder <jared@finder.org>
+
+ Fix dragging mode line on text terminals with a mouse (bug#67457)
+
+ * lisp/xt-mouse.el (xterm-mouse-translate-1): Fix the 'event-kind'
+ property of mouse-movement symbols emitted by xt-mouse.
+ * lisp/term/linux.el (terminal-init-linux): Call 'gpm-mouse-mode'
+ to set up the terminal for the mouse, if needed.
+
+2023-12-08 Christophe TROESTLER <Christophe.TROESTLER@umons.ac.be>
+
+ (rust-ts-mode): Set electric-indent-chars
+
+ * lisp/progmodes/rust-ts-mode.el (rust-ts-mode):
+ Set electric-indent-chars (bug#67701).
+
+2023-12-07 Dmitry Gutov <dmitry@gutov.dev>
+
+ js-ts-mode: Highlight function parameters inside destructuring
+
+ * lisp/progmodes/js.el (js--treesit-font-lock-settings):
+ Highlight function parameters declared using destructuring syntax.
+
+2023-12-07 Dmitry Gutov <dmitry@gutov.dev>
+
+ js-ts-mode: Highlight property shorthands in assignments
+
+ * lisp/progmodes/js.el (js--treesit-lhs-identifier-query): Match
+ property shorthands (which turn into variable reference).
+ (js--treesit-fontify-assignment-lhs): Use the matches.
+
+2023-12-07 Dmitry Gutov <dmitry@gutov.dev>
+
+ (js--treesit-font-lock-settings): Highlight parameters in function expression
+
+ * lisp/progmodes/js.el (js--treesit-font-lock-settings):
+ Highlight parameters in a function expression (the node type
+ 'function'). Make the matcher for 'formal_parameters' independent
+ of the parent, that just created duplication.
+
+2023-12-07 Dmitry Gutov <dmitry@gutov.dev>
+
+ (js--treesit-font-lock-settings): Remove some duplicates
+
+ * lisp/progmodes/js.el (js--treesit-font-lock-settings):
+ Remove queries from 'function' that duplicate entries in
+ 'definition' (one of them with a typo).
+
+2023-12-04 Philipp Stephani <p.stephani2@gmail.com>
+
+ Don't claim to signal an error when deleting a nonexisting file.
+
+ The behavior has changed in commit
+ 1a65afb7ecc2a52127d6164bad19313440237f9d to no longer signal an error
+ on ENOENT.
+
+ * doc/lispref/files.texi (Changing Files): Fix documentation about
+ error reporting.
+
+2023-12-04 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/indent.el (indent-rigidly): Improve prompt (bug#67620).
+
+2023-12-03 Christophe Troestler <Christophe.Troestler@umons.ac.be>
+
+ rust-ts-mode--comment-docstring: Handle block doc comments
+
+ * lisp/progmodes/rust-ts-mode.el
+ (rust-ts-mode--comment-docstring): Handle block doc comments.
+ Inhibit match-data modification.
+
+2023-12-02 Christophe TROESTLER <Christophe.TROESTLER@umons.ac.be>
+
+ rust-ts-mode--comment-docstring: Fix/improve the previous change
+
+ * lisp/progmodes/rust-ts-mode.el
+ (rust-ts-mode--comment-docstring): Match also "inner" line docs.
+ Stop rebinding 'end' and use the argument's value in the
+ 'treesit-fontify-with-override' call.
+
+2023-12-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'Info-goto-node-web' when NODE is given in various forms
+
+ * lisp/info.el (Info-goto-node-web): Support all forms of node
+ input, per 'Info-read-node-name's documentation, and extract
+ FILENAME from NODE if given there. Default NODE to "Top" if not
+ provided by the user. (Bug#67531)
+ (Info-url-for-node): Support browsing the "Top" node.
+
+2023-12-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix setting cursor when the window's op line has 'line-prefix'
+
+ * src/xdisp.c (set_cursor_from_row): Skip glyphs that come from a
+ string if their 'avoid_cursor_p' flag is set. (Bug#67486)
+
+2023-12-02 Xiyue Deng <manphiz@gmail.com> (tiny change)
+
+ Drop extra parenthesis in example code in Emacs Lisp Introduction
+
+ * doc/lispintro/emacs-lisp-intro.texi (Small buffer case): Drop
+ trailing unmatched parenthesis. (Bug#67576)
+
+2023-12-01 Christophe Troestler <Christophe.Troestler@umons.ac.be>
+
+ rust-ts-mode: appropriately fontify doc strings
+
+ * lisp/progmodes/rust-ts-mode.el
+ (rust-ts-mode--comment-docstring): New function.
+ (rust-ts-mode--font-lock-settings): Use it
+ (https://lists.gnu.org/archive/html/emacs-devel/2023-12/msg00019.html).
+
+2023-12-01 Xiyue Deng <manphiz@gmail.com> (tiny change)
+
+ Fix example code in Emacs Lisp Introduction manual
+
+ * doc/lispintro/emacs-lisp-intro.texi (Optional Arguments): Fix
+ indentation in an example. (Bug#67559)
+
+2023-12-01 Eli Zaretskii <eliz@gnu.org>
+
+ Fix example in Emacs Lisp Intro manual
+
+ * doc/lispintro/emacs-lisp-intro.texi (beginning-of-buffer opt
+ arg): Fix indentation in example. Reported by Xiyue Deng
+ <manphiz@gmail.com>. (Bug#67560)
+
+2023-12-01 Jeremy Bryant <jb@jeremybryant.net>
+
+ Elisp manual: Mention 'write-region' for saving the buffer
+
+ * doc/emacs/files.texi (Save Commands): Mention
+ 'write-region'. (Bug#67313)
+
+2023-11-30 Michael Albinus <michael.albinus@gmx.de>
+
+ Document, that PROCESS of signal-process can be a string
+
+ * doc/lispref/processes.texi (Signals to Processes) [signal-process]:
+ * src/process.c (Fsignal_process): Document, that PROCESS can be a
+ string.
+
+2023-11-29 nverno <noah.v.peart@gmail.com>
+
+ Fix typescript-ts-mode indentation for switch statements
+
+ * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode): Add
+ indentation rule for switch case and default keywords. (Bug#67488)
+
+2023-11-29 Aymeric Agon-Rambosson <aymeric.agon@yandex.com> (tiny change)
+
+ Repair `tab-first-completion` (bug#67158)
+
+
+ * lisp/indent.el (indent-for-tab-command): Use `syntax-class` to fix
+ longstanding thinko introduced back in 2020 in commit 64c851166442.
+ Rework the check for `syn` because TAB always completed when
+ `tab-first-completion` had value `word-or-paren` or `word-or-paren-or-punct`.
+
+ (cherry picked from commit c20226a1ef5fbdfd3e71e2ef8654ee19994c0f2f)
+
+2023-11-29 Eli Zaretskii <eliz@gnu.org>
+
+ Fix behavior of 'split-root-window-*' with 'C-u'
+
+ * lisp/window.el (split-root-window-below)
+ (split-root-window-right): Fix the 'interactive' form to work with
+ raw 'C-u' as well. (Bug#67459)
+ (split-window-below, split-window-right, split-root-window-below)
+ (split-root-window-right): Doc fix.
+
+2023-11-29 Xiyue Deng <manphiz@gmail.com> (tiny change)
+
+ Add more text to clarify the behavior of 'with-current-buffer'
+
+ * doc/lispintro/emacs-lisp-intro.texi (copy-to-buffer): Expand
+ description of 'with-current-buffer'. (Bug#67521)
+
+2023-11-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix example in Emacs user manual
+
+ * doc/emacs/custom.texi (Init Rebinding): Fix syntax of example.
+ Reported by silarakta <silarakta@protonmail.com>. (Bug#67474)
+
+2023-11-27 Michael Albinus <michael.albinus@gmx.de>
+
+ Mention Titankey in Tramp, which has passed the tests
+
+ * doc/misc/tramp.texi (Frequently Asked Questions):
+ * lisp/net/tramp.el (tramp-security-key-confirm-regexp):
+ Mention also Titankey.
+
+2023-11-26 Yuan Fu <casouri@gmail.com>
+
+ Fix c-ts-mode indentation after if/else (bug#67417)
+
+ * lisp/progmodes/c-ts-mode.el:
+ (c-ts-mode--prev-line-match): New function.
+ (c-ts-mode--indent-styles): Add a rule for the empty line after
+ if/else/for/etc.
+
+2023-11-26 Yuan Fu <casouri@gmail.com>
+
+ Fix indentation for else clause in c-ts-mode (bug#67417)
+
+ * lisp/progmodes/c-ts-mode.el:
+ (c-ts-mode--indent-styles): Add indentation for children of
+ else_clause.
+ * test/lisp/progmodes/c-ts-mode-resources/indent.erts:
+ (Name): Add test for else-break. Also make the test such that it
+ needs to indent correctly from scratch (rather than maintaining the
+ already correct indentation.)
+
+2023-11-26 Joseph Turner <joseph@breatheoutbreathe.in>
+
+ Ensure that directory is expanded in package-vc-checkout
+
+ * lisp/emacs-lisp/package-vc.el (package-vc-checkout): Expand
+ DIRECTORY. (Bug#66115)
+
+2023-11-25 Ulrich MĆ¼ller <ulm@gentoo.org>
+
+ * etc/PROBLEMS: Add entry about pinentry with gpgsm. (Bug#67012)
+
+2023-11-24 nverno <noah.v.peart@gmail.com>
+
+ typescript-ts-mode: Add missing 'operator' to treesit-font-lock-features
+
+ * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode):
+ Add operator to treesit-font-lock-feature-list (bug#67433).
+
+2023-11-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Extend D-Bus doc and test
+
+ * doc/misc/dbus.texi (Register Objects): Adapt doc of
+ dbus-unregister-service.
+
+ * test/lisp/net/dbus-tests.el (dbus--test-register-service):
+ Extend test.
+
+2023-11-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Do not unregister a D-Bus service which is a unique name
+
+ * lisp/net/dbus.el (dbus-unregister-service): Check, whether
+ SERVICE is a known name. (Bug#67386)
+
+2023-11-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix byte-compilation warnings about 'sqlite-rollback'
+
+ * lisp/sqlite.el (sqlite-transaction, sqlite-commit)
+ (sqlite-rollback): Declare.
+ * lisp/emacs-lisp/multisession.el (sqlite-commit)
+ (sqlite-transaction): Remove declaration.
+
+2023-11-23 Dmitry Gutov <dmitry@gutov.dev>
+
+ Make python-ts-mode's syntax-highlighting more standardized
+
+ This was brought up in a Reddit discussion.
+
+ * lisp/progmodes/python.el (python--treesit-fontify-variable):
+ Use font-lock-variable-use-face (since it applies to references).
+ (python-ts-mode): Move 'property' from 3rd to 4th
+ treesit-font-lock-level.
+
+2023-11-23 George Kuzler <gkuzler@gmail.com> (tiny change)
+
+ Fix "Text is read-only" on backspacing initial Calc input
+
+ Immediately after `calc-mode' opens the minibuffer for input
+ (because you typed a digit, "e", etc), pressing backspace
+ should clear the minibuffer and return you to the *Calculator*
+ buffer. Instead, it leaves the minibuffer as-is and prints the
+ message "Text is read-only"; this is because the function used,
+ `erase-buffer', tries to erase the read-only minibuffer prompt.
+ Using `delete-minibuffer-contents' fixes this, since it doesn't
+ attempt to delete the prompt.
+ * lisp/calc/calc.el (calcDigit-backspace): Use
+ `delete-minibuffer-contents' instead of `erase-buffer'. (Bug#67395)
+
+2023-11-23 Jeremy Bryant <jb@jeremybryant.net>
+
+ Add a doc string to simple.el (bug#67355)
+
+ * lisp/simple.el (kill-buffer--possibly-save): Add doc string.
+
+2023-11-23 Eli Zaretskii <eliz@gnu.org>
+
+ Mention "visual line" in user manual
+
+ * doc/emacs/display.texi (Visual Line Mode):
+ * doc/emacs/basic.texi (Continuation Lines, Moving Point): Mention
+ "visual line". (Bug#67382)
+
+2023-11-23 Eli Zaretskii <eliz@gnu.org>
+
+ Allow listing Emoji from a read-only buffer
+
+ * lisp/international/emoji.el (emoji-list): Don't barf here if the
+ original buffer is read-inly...
+ (emoji-list-select): ...barf here instead. (Bug#67400)
+ (emoji-list): Doc fix.
+
+2023-11-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix CRLF handling in Tramp (don't merge)
+
+ * lisp/net/tramp-sh.el (tramp-send-command-and-read): Use 'space'
+ instead of 'blank' in rx expression, in order to handle also CR
+ and alike. Reported by Dominique Quatravaux
+ <dominique@quatravaux.org>.
+
+2023-11-21 Dmitry Gutov <dmitry@gutov.dev>
+
+ Annotate java-ts-mode-test-movement with expected result
+
+ Do not merge to master.
+
+2023-11-21 Theodor Thornhill <theo@thornhill.no>
+
+ Backport: Add more java indentation tests
+
+ * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Use default
+ indent offset, and tweak the indentation examples.
+
+ (cherry picked from commit dbe7803aa1e8249bd70f67f25f19aedabeb9cc22)
+
+2023-11-21 Theodor Thornhill <theo@thornhill.no>
+
+ Backport: Add test for java indentation (bug#61115)
+
+ * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add new test
+ case.
+
+ (cherry picked from commit 229d0772e235f51812ed8020a31f9a8de366c7ba)
+
+2023-11-21 Noah Peart <noah.v.peart@gmail.com>
+
+ typescript-ts-mode: Support indentation for conditionals without braces
+
+ * lisp/progmodes/typescript-ts-mode.el
+ (typescript-ts-mode--indent-rules): Support indentation for
+ conditionals without braces (bug#67031).
+
+ * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
+ (Statement indentation without braces): New test.
+
+2023-11-21 Theodor Thornhill <theo@thornhill.no>
+
+ Backport: Add some basic tests for java-ts-mode and typescript-ts-mode
+
+ * test/lisp/progmodes/java-ts-mode-resources/indent.erts: New file
+ with tests for indentation.
+ * test/lisp/progmodes/java-ts-mode-resources/movement.erts: New file
+ with tests for movement.
+ * test/lisp/progmodes/java-ts-mode-tests.el: New tests.
+ * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: New
+ file with tests for indentation.
+ * test/lisp/progmodes/typescript-ts-mode-tests.el: New tests.
+
+ (cherry picked from commit c8dd37b16c574beda900d4ee48ac7b4ab4a2ee56)
+
+2023-11-21 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'with-sqlite-transaction' when BODY fails
+
+ * lisp/sqlite.el (with-sqlite-transaction): Don't commit changes
+ if BODY errors out. Roll back the transaction if committing
+ fails. (Bug#67142)
+
+ * etc/NEWS:
+ * doc/lispref/text.texi (Database): Document the error handling in
+ 'with-sqlite-transaction'.
+
+2023-11-19 Richard Stallman <rms@gnu.org>
+
+ Fix wording in ELisp Intro manual
+
+ * doc/lispintro/emacs-lisp-intro.texi (Lisp macro): Improve
+ wording in description of 'unless'. (Bug#67185)
+
+2023-11-18 Yuan Fu <casouri@gmail.com>
+
+ Add missing python-ts-mode keyword (bug#67015)
+
+ * lisp/progmodes/python.el (python--treesit-keywords): Add "not in".
+
+2023-11-18 Dmitry Gutov <dmitry@gutov.dev>
+
+ Fix string-pixel-width with global setting of display-line-numbers
+
+ * lisp/emacs-lisp/subr-x.el (string-pixel-width):
+ Instead of checking for display-line-numbers-mode, set the
+ display-line-numbers variable to nil (bug#67248).
+
+2023-11-18 Eli Zaretskii <eliz@gnu.org>
+
+ Document changes in 'edmacro-parse-keys'
+
+ * lisp/edmacro.el (edmacro-parse-keys): Add a comment for forcing
+ output to be a vector.
+ (read-kbd-macro): Adjust the doc string to changes in
+ 'edmacro-parse-keys'. (Bug#67182)
+
+2023-11-18 Eli Zaretskii <eliz@gnu.org>
+
+ Add 2 SQLite extensions to allow-list.
+
+ * src/sqlite.c (Fsqlite_load_extension): Add 2 Free Software
+ extensions to the allow-list. For the details, see
+ https://lists.gnu.org/archive/html/emacs-devel/2023-11/msg00234.html.
+
+2023-11-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): Be more verbose.
+
+2023-11-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Make Tramp aware of completion-regexp-list (don't merge)
+
+ * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions):
+ New defmacro.
+ (tramp-completion-handle-file-name-all-completions):
+ * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions):
+ * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions):
+ * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions):
+ * lisp/net/tramp-sudoedit.el
+ (tramp-sudoedit-handle-file-name-all-completions): Use it.
+
+2023-11-17 Jeremy Bryant <jb@jeremybryant.net>
+
+ Add 5 docstrings to abbrev.el (bug#67153)
+
+ * lisp/abbrev.el (prepare-abbrev-list-buffer, add-abbrev)
+ (inverse-add-abbrev, abbrev--describe)
+ (abbrev--possibly-save): Add doc strings.
+
+2023-11-15 Morgan Smith <Morgan.J.Smith@outlook.com>
+
+ Fix CBZ file detection in doc-view-mode
+
+ * lisp/doc-view.el (doc-view-set-doc-type): Fix CBZ file
+ detection. (Bug#67133)
+
+ This fix is almost identical to the previous fix for ODF file
+ detection in bug#54947 which resulted in commit
+ b3ff4905388834994ff26d9d033d6bc62b094c1c
+
+2023-11-15 JoĆ£o TĆ”vora <joaotavora@gmail.com>
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Fix previous commit.
+
+ (cherry picked from commit 58d9e735e721ecf0187a5e15eefc7641112ace0b)
+
+2023-11-14 JoĆ£o TĆ”vora <joaotavora@gmail.com>
+
+ Eglot: Send standard :language-id for typescript-language-server
+
+ bug#67150
+
+ * lisp/progmodes/eglot.el (eglot-server-programs): Update
+ language-id for languages handled by typescript-language-server.
+
+ (cherry picked from commit 1fe949888057b0275da041288709bd5690501974)
+
+2023-11-14 Zajcev Evgeny <zevlg@yandex.ru>
+
+ Typofix in the doc/lispref/modes.texi
+
+2023-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix spell-checking email message with citations
+
+ This became broken 7 years ago, when the 'boundp condition was
+ removed, and with it an important unrelated part of the code.
+ * lisp/textmodes/ispell.el (ispell-message): Fix cite-regexp.
+
+2023-11-12 Xiaoyue Chen <xchen@vvvu.org> (tiny change)
+
+ Pass only the local parts of Eshell's $PATH to 'tramp-remote-path'
+
+ * lisp/eshell/esh-proc.el (eshell-gather-process-output): Get the
+ local part of the $PATH (bug#67126).
+
+ Do not merge to master.
+
+2023-11-12 Jeremy Bryant <jb@jeremybryant.net>
+
+ Add two doc strings to cl-extra.el
+
+ * lisp/emacs-lisp/cl-extra.el (cl--random-time)
+ (cl-find-class): Add docstrings. (Bug#66949)
+
+2023-11-11 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of read syntax and printed representation
+
+ * doc/lispref/objects.texi (Syntax for Strings): Describe in more
+ detail how to specify special characters in string literals.
+ (Printed Representation, Character Type, Nonprinting Characters):
+ Improve information and add cross-references about printed
+ representation and read syntax. (Bug#67033)
+
+2023-11-09 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of signaling errors in batch mode
+
+ * doc/lispref/control.texi (Signaling Errors)
+ (Processing of Errors):
+ * doc/lispref/os.texi (Batch Mode):
+ * doc/lispref/debugging.texi (Invoking the Debugger):
+ * lisp/emacs-lisp/debug.el (debug):
+ * src/eval.c (Fsignal):
+ * lisp/subr.el (error): Document more prominently that signaling
+ an unhandled error in batch mode kills Emacs. Better
+ documentation of backtrace in batch mode.
+
+2023-11-09 Yuan Fu <casouri@gmail.com>
+
+ Fix treesit-simple-indent-presets docstring (bug#67007)
+
+ * lisp/treesit.el (treesit-simple-indent-presets): Fix docstring.
+ * doc/lispref/modes.texi (Parser-based Indentation): Fix example.
+
+2023-11-08 Stephen Berman <stephen.berman@gmx.net>
+
+ Prevent an infinite loop in todo-mode (bug#66994)
+
+ * lisp/calendar/todo-mode.el (todo-item-start): Moving an item to
+ a todo file (with `C-u m') that had not yet been read into a
+ buffer puts point at the beginning of the file, from where it is
+ impossible to reach todo-item-start by this function, so don't try
+ in that case.
+
+2023-11-08 Randy Taylor <dev@rjt.dev>
+
+ Fix cmake-ts-mode indentation (Bug#66845)
+
+ * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--indent-rules):
+ Support versions v0.3.0 and v0.4.0 of the grammar.
+ (cmake-ts-mode--font-lock-compatibility-fe9b5e0): Fix docstring.
+
+2023-11-05 Kyle Meyer <kyle@kyleam.com>
+
+ Update to Org 9.6.11
+
+2023-11-04 Mattias EngdegƄrd <mattiase@acm.org>
+
+ Suggest alternative reason for ERT test duplication error
+
+ * lisp/emacs-lisp/ert.el (ert-set-test): Amend error message;
+ maybe the redefinition was caused by a file loaded twice.
+ (Bug#66782)
+
+ Suggested by Xiyue Deng.
+
+ (cherry picked from commit 425d23fbeaede81ab4f50b4073949cc1c8a3fbd0)
+
+2023-11-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix description of 'Package-Requires' library header
+
+ * doc/lispref/tips.texi (Library Headers): Update the description
+ of the 'Package-Requires' header. (Bug#66677)
+
+2023-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-lib.el (cl--defalias): Improve&fix docstring
+
+2023-10-30 Jeremy Bryant <jb@jeremybryant.net>
+
+ Add two docstrings in cl-lib.el
+
+ * lisp/emacs-lisp/cl-lib.el (cl--set-buffer-substring)
+ (cl--defalias): Add docstrings. (Bug#66828)
+
+2023-10-27 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Tramp (don't merge)
+
+ * lisp/net/tramp.el (tramp-read-id-output): Identifiers can contain "-".
+
+2023-10-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (don't merge)
+
+2023-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (Don't merge)
+
+2023-10-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix guessing commands for zstandard archives in Dired
+
+ * lisp/dired-aux.el (dired-guess-shell-alist-default): Fix
+ zstdandard commands. (Bug#66532)
+
+2023-10-25 Matthew Woodcraft <matthew@woodcraft.me.uk> (tiny change)
+
+ Fix eglot.texi (JSONRPC objects in Elisp) example
+
+ * doc/misc/eglot.texi (JSONRPC objects in Elisp): Correct the
+ example. (Bug#66569)
+
+2023-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/man/emacsclient.1: Fix --tramp option.
+
+2023-10-24 Stefan Kangas <stefankangas@gmail.com>
+
+ Improve `nsm-protocol-check--3des-cipher` docstring
+
+ * lisp/net/nsm.el (nsm-protocol-check--3des-cipher): Update
+ docstring to reflect current NIST policy.
+
+2023-10-24 Lassi Kortela <lassi@lassi.io>
+
+ Recognize backslash in `dns-mode` quoted values
+
+ * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Recognize
+ backslash as an escape character. (Bug#66660)
+
+ (cherry picked from commit e6f05e189db73a0f0b29f987381ffef61a409232)
+
+2023-10-24 Stefan Kangas <stefankangas@gmail.com>
+
+ Make `dns-mode` fontify quoted values correctly
+
+ * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Fontify
+ quoted values correctly. (Bug#62214)
+ Suggested by Trent W. Buck <trentbuck@gmail.com>.
+
+ (cherry picked from commit c586d984f279aa61de4f5dfc4f6df660188dd0f6)
+
+2023-10-23 Stefan Kangas <stefankangas@gmail.com>
+
+ Change news.gmane.org to news.gmane.io
+
+ * admin/notes/emba:
+ * doc/misc/gnus.texi (Group Parameters)
+ (Non-ASCII Group Names, Filling In Threads)
+ (Selection Groups, Spam Package Configuration Examples)
+ (Terminology):
+ * lisp/gnus/gnus-group.el (gnus-useful-groups):
+ * lisp/gnus/gnus-sum.el (gnus-fetch-old-headers):
+ * lisp/gnus/spam-report.el (spam-report-gmane-use-article-number)
+ (spam-report-gmane-internal):
+ * test/lisp/gnus/gnus-group-tests.el (gnus-short-group-name):
+ Change news.gmane.org to news.gmane.io.
+ Ref: https://news.gmane.io/
+
+2023-10-23 Mauro Aranda <maurooaranda@gmail.com>
+
+ Fix minor defcustom issues in Gnus (Bug#66715)
+
+ * lisp/gnus/gnus-art.el (gnus-button-prefer-mid-or-mail): Allow
+ function and add :tag to const values.
+ * lisp/gnus/gnus-bookmark.el (gnus-bookmark-bookmark-inline-details):
+ Fix docstring.
+ * lisp/gnus/gnus-sum.el (gnus-simplify-subject-fuzzy-regexp): Allow a
+ single regexp as value.
+ * lisp/gnus/message.el (message-indent-citation-function): Allow a
+ single function as value.
+ (message-mail-alias-type): Allow for a list of options as value.
+ (message-dont-reply-to-names): Allow a function as value.
+ * lisp/gnus/spam-report.el (spam-report-url-ping-function): Fix
+ default value for the function widget.
+
+2023-10-23 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor connection-local variables fixes
+
+ * doc/emacs/custom.texi (Connection Variables): Warn about
+ specifying the same variable twice.
+
+ * lisp/files-x.el (connection-local-get-profiles): Normalize criteria.
+
+2023-10-23 Stefan Kangas <stefankangas@gmail.com>
+
+ Make Dired honor `insert-directory-programĀ“ with globs
+
+ Starting with commit 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7
+ (Bug#27631), Dired stopped respecting the value of
+ 'insert-directory-program' when using directory wildcards/globs.
+
+ * lisp/dired.el (dired-insert-directory): Honor the value of
+ 'insert-directory-program' when using directory wildcards.
+
+2023-10-22 Morgan J. Smith <Morgan.J.Smith@outlook.com>
+
+ Fix typo in url-privacy-level :type
+
+ * lisp/url/url-vars.el (url-privacy-level): Fix typo in
+ :type. (Bug#66613)
+
+2023-10-22 Juri Linkov <juri@linkov.net>
+
+ * lisp/vc/log-view.el (log-view-mode-menu): Quote derived modes (bug#66686).
+
+2023-10-22 Petteri Hintsanen <petterih@iki.fi>
+
+ * lisp/tab-bar.el: Fix the close button with auto-width (bug#66678).
+
+ (tab-bar-auto-width): Take into account the length of tab-bar-close-button
+ more than one character: " x".
+ Don't merge to master.
+
+2023-10-22 Mauro Aranda <maurooaranda@gmail.com>
+
+ Fix State button for customize-icon (Bug#66635)
+
+ * lisp/cus-edit.el (custom-icon-action): New function.
+ (custom-icon): Use it as the :action. Otherwise, clicking the State
+ button is a noop. Remove irrelevant stuff from the docstring and
+ comment out some copy-pasta.
+ (custom-icon-extended-menu): New variable, the menu to show upon
+ :action.
+ (custom-icon-set): Really redraw the widget with the new settings.
+ Comment out strange call to custom-variable-backup-value.
+ (custom-icon-save): New function.
+
+ * lisp/emacs-lisp/icons.el (icons--merge-spec): Fix call to plist-get
+ and avoid infloop.
+
+2023-10-22 Yuan Fu <casouri@gmail.com>
+
+ Fix the use of adaptive-fill-regexp in treesit indent preset
+
+ * lisp/treesit.el (treesit-simple-indent-presets):
+ adaptive-fill-regexp don't have a capture group (the group in the
+ default value is supposed to be a non-capture group), so don't use the
+ group. Also, in the second diff hunk, replace looking-at with
+ looking-at-p so it doesn't override match data that we use later.
+
+2023-10-21 nverno <noah.v.peart@gmail.com>
+
+ Fix treesit-install-language-grammar (bug#66673)
+
+ * lisp/treesit.el (treesit-install-language-grammar): Take out the
+ language symbol when storing the recipe.
+
+2023-10-21 Yuan Fu <casouri@gmail.com>
+
+ Fix treesit-explore-mode (bug#66431)
+
+ * lisp/treesit.el (treesit-explore-mode): Reset
+ treesit--explorer-last-node before calling treesit--explorer-refresh,
+ so that in the rare case described in the bug report, the explorer
+ buffer don't show the outdated node.
+
+2023-10-21 Dmitry Gutov <dmitry@gutov.dev>
+
+ tsx-ts-mode--font-lock-compatibility-bb1f97b: Re-fix the previous fix
+
+ * lisp/progmodes/typescript-ts-mode.el
+ (tsx-ts-mode--font-lock-compatibility-bb1f97b): Make sure the
+ tested query is actually valid in the new grammar (bug#66646).
+
+2023-10-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Update Tramp version (don't merge with master)
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.6.2.29.2".
+ (customize-package-emacs-version-alist):
+ Adapt Tramp version integrated in Emacs 29.2.
+
+2023-10-19 Eli Zaretskii <eliz@gnu.org>
+
+ Bump Emacs version
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version to 29.1.90.
+
2023-10-16 Po Lu <luangruo@yahoo.com>
Correctly register focus events concomitant with alpha changes
@@ -119361,7 +121506,7 @@
This file records repository revisions from
commit f2ae39829812098d8269eafbc0fcb98959ee5bb7 (exclusive) to
-commit d9e1605122b4ba70a55f7b168505b7d7f8d2bdd6 (inclusive).
+commit 8d8253f89915f1d9b45791d46cf974c6bdcc1457 (inclusive).
See ChangeLog.3 for earlier changes.
;; Local Variables:
diff --git a/GNUmakefile b/GNUmakefile
index 16064672c65..58c0281e895 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -27,6 +27,8 @@
# newly-built Makefile. If the source tree is already configured,
# this file defers to the existing Makefile.
+. :=
+
# If you want non-default build options, or if you want to build in an
# out-of-source tree, you should run 'configure' before running 'make'.
# But run 'autogen.sh' first, if the source was checked out directly
@@ -36,30 +38,30 @@
ifeq (help,$(filter help,$(MAKECMDGOALS)))
help:
- $(info $ NOTE: This is a brief summary of some common make targets.)
- $(info $ For more detailed information, please read the files INSTALL,)
- $(info $ INSTALL.REPO, Makefile or visit this URL:)
- $(info $ https://www.gnu.org/prep/standards/html_node/Standard-Targets.html)
- $(info $ )
- $(info $ make all -- compile and build Emacs)
- $(info $ make install -- install Emacs)
- $(info $ make TAGS -- update tags tables)
- $(info $ make clean -- delete built files but preserve configuration)
- $(info $ make mostlyclean -- like 'make clean', but leave those files that)
- $(info $ usually do not need to be recompiled)
- $(info $ make distclean -- delete all build and configuration files,)
- $(info $ leave only files included in source distribution)
- $(info $ make maintainer-clean -- delete almost everything that can be regenerated)
- $(info $ make extraclean -- like maintainer-clean, and also delete)
- $(info $ backup and autosave files)
- $(info $ make bootstrap -- delete all compiled files to force a new bootstrap)
- $(info $ from a clean slate, then build in the normal way)
- $(info $ make uninstall -- remove files installed by 'make install')
- $(info $ make check -- run the Emacs test suite)
- $(info $ make docs -- generate Emacs documentation in info format)
- $(info $ make html -- generate documentation in html format)
- $(info $ make ps -- generate documentation in ps format)
- $(info $ make pdf -- generate documentation in pdf format )
+ $(info $.NOTE: This is a brief summary of some common make targets.)
+ $(info $.For more detailed information, please read the files INSTALL,)
+ $(info $.INSTALL.REPO, Makefile or visit this URL:)
+ $(info $.https://www.gnu.org/prep/standards/html_node/Standard-Targets.html)
+ $(info $.)
+ $(info $.make all -- compile and build Emacs)
+ $(info $.make install -- install Emacs)
+ $(info $.make TAGS -- update tags tables)
+ $(info $.make clean -- delete built files but preserve configuration)
+ $(info $.make mostlyclean -- like 'make clean', but leave those files that)
+ $(info $. usually do not need to be recompiled)
+ $(info $.make distclean -- delete all build and configuration files,)
+ $(info $. leave only files included in source distribution)
+ $(info $.make maintainer-clean -- delete almost everything that can be regenerated)
+ $(info $.make extraclean -- like maintainer-clean, and also delete)
+ $(info $. backup and autosave files)
+ $(info $.make bootstrap -- delete all compiled files to force a new bootstrap)
+ $(info $. from a clean slate, then build in the normal way)
+ $(info $.make uninstall -- remove files installed by 'make install')
+ $(info $.make check -- run the Emacs test suite)
+ $(info $.make docs -- generate Emacs documentation in info format)
+ $(info $.make html -- generate documentation in html format)
+ $(info $.make ps -- generate documentation in ps format)
+ $(info $.make pdf -- generate documentation in pdf format )
@:
.PHONY: help
diff --git a/Makefile.in b/Makefile.in
index 5f3227a9ad5..20394cb333d 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -812,6 +812,7 @@ install-info: info
done; \
(cd "$${thisdir}"; \
${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \
+ cp elisp_type_hierarchy* $(DESTDIR)${infodir}/; \
done; \
fi
@@ -954,6 +955,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc uninstall-gsettings-schemas
ext=.gz; else ext=; fi; \
rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \
done; \
+ rm -f elisp_type_hierarchy.jpg elisp_type_hierarchy.txt; \
fi)
(if [ -n "${GZIP_PROG}" ]; then \
ext=.gz; else ext=; fi; \
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 06986ec8f48..c07fdc487ee 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -25,6 +25,9 @@ SOLARIS2
USG
USG5_4
HAIKU Compiling on Haiku.
+__ANDROID__ Compiling for the Android operating system.
+__ANDROID_API__ A numerical "API level" indicating the version of
+ Android being compiled for; see http://apilevels.com.
** Distinguishing GUIs **
@@ -35,10 +38,14 @@ NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API.
HAVE_X11 Compile support for the X11 GUI.
HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs.
HAVE_HAIKU Compile support for the Haiku window system.
-HAVE_X_WINDOWS Compile support for X Window system
- (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must
- be, and vice versa. At least, this is true for configure, and
- msdos; not sure about nt.)
+HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11.
+HAVE_ANDROID Compiling the Android GUI interface. Enough of this
+ code is compiled for the build machine cross-compiling
+ the Android port to produce an Emacs binary that can
+ run Lisp code in batch mode, for the purpose of running
+ the byte-compiler.
+ANDROID_STUBIFY The Android GUI interface is being compiled for the build
+ machine, as above.
** X Windows features **
HAVE_X11R6 Whether or not the system has X11R6. (Always defined.)
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index f59c684e81f..4fa65a8df24 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -360,6 +360,9 @@ Po Lu
X11 and GTK xwidget support in src/xwidget.c
Precision pixel scrolling in lisp/pixel-scroll.el
+Daniel Pettersson
+ lisp/jsonrpc.el
+
==============================================================================
3. Externally maintained packages.
==============================================================================
@@ -378,9 +381,7 @@ Tramp
Modus themes
Maintainer: Protesilaos Stavrou
- Repository: https://git.sr.ht/~protesilaos
- Mailing list: https://lists.sr.ht/~protesilaos/modus-themes
- Bug Reports: M-x modus-themes-report-bug
+ Repository: https://github.com/protesilaos/modus-themes
doc/misc/modus-themes.org
etc/themes/modus*.el
diff --git a/admin/README b/admin/README
index c7dec63875a..419039b4fba 100644
--- a/admin/README
+++ b/admin/README
@@ -39,6 +39,11 @@ Build Emacs in various ways.
Install emacs quickly ("incrementally").
+** run-codespell
+
+Run the codespell tool on the Emacs sources. Requires codespell to be
+installed first.
+
** alloc-colors.c
A utility program that allocates a given number of colors on X. Can
@@ -57,15 +62,16 @@ Tests for custom types and load problems.
Show files added/removed between two tar files.
-Brief description of sub-directories:
+* Brief description of sub-directories.
charsets scripts for generating charset map files
in ../etc/charsets
-coccinelle patches to make coccinelle work with
- the latest Emacs version. Since they
- apply a few minor changes in Emacs internals
- in multiple places, they are trivial for
- copyright purposes.
+coccinelle semantic patches for use with the static code
+ analyzer coccinelle. Since they apply a few
+ minor changes in Emacs internals in multiple
+ places, they are trivial for copyright
+ purposes.
+codespell supporting files for the run-codespell script.
grammars wisent and bovine grammars, used to produce
files in lisp/cedet/.
notes miscellaneous notes related to administrative
diff --git a/admin/authors.el b/admin/authors.el
index 9fa8036ff23..da9f4257153 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -175,6 +175,11 @@ files.")
("Michalis V" "^mvar")
("Miha RihtarŔič" "Miha Rihtarsic")
("Mikio Nakajima" "Nakajima Mikio")
+ (nil "montag451@laposte\\.net")
+ ("Morgan Smith" "Morgan J\\. Smith")
+ ("Mou Tong" "mou\\.tong@outlook\\.com")
+ (nil "na@aisrntairetnraoitn")
+ (nil "nibon7@163\\.com")
("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
("Noah Peart" "noah\\.v\\.peart@gmail\\.com")
("Noorul Islam" "Noorul Islam K M")
@@ -218,6 +223,8 @@ files.")
("Simen HeggestĆøyl" "simenheg@gmail.com")
(nil "prime.wizard")
("Shun-ichi Goto" "Shun-ichi GOTO")
+ ;; The trailing dash is a kludge, so this contributor is not ignored.
+ ("skykanin-" "skykanin@users\\.noreply\\.github\\.com")
;; There are other Stefans.
;;; ("Stefan Monnier" "Stefan")
("Steven L. Baur" "SL Baur" "Steven L Baur")
diff --git a/admin/coccinelle/alloc_cast.cocci b/admin/coccinelle/alloc_cast.cocci
new file mode 100644
index 00000000000..91810dbc7e4
--- /dev/null
+++ b/admin/coccinelle/alloc_cast.cocci
@@ -0,0 +1,6 @@
+// Remove redundant casts from memory allocation functions.
+@@
+type T;
+@@
+-(T *)
+ \(xmalloc\|xzalloc\|xrealloc\|xpalloc\|xnrealloc\)(...)
diff --git a/admin/coccinelle/build_string.cocci b/admin/coccinelle/build_string.cocci
index d47727018dd..9421a140658 100644
--- a/admin/coccinelle/build_string.cocci
+++ b/admin/coccinelle/build_string.cocci
@@ -4,3 +4,9 @@ identifier I;
@@
- make_string (I, strlen (I))
+ build_string (I)
+
+@@
+constant C;
+@@
+- make_string (C, strlen (C))
++ build_string (C)
diff --git a/admin/coccinelle/nilp.cocci b/admin/coccinelle/nilp.cocci
new file mode 100644
index 00000000000..ccebbbe1c80
--- /dev/null
+++ b/admin/coccinelle/nilp.cocci
@@ -0,0 +1,6 @@
+// Prefer NILP (x) to EQ (x, Qnil)
+@@
+expression X;
+@@
+- EQ (X, Qnil)
++ NILP (X)
diff --git a/admin/coccinelle/unibyte_string.cocci b/admin/coccinelle/unibyte_string.cocci
index 0ff8cafa15d..97f87e5a4ca 100644
--- a/admin/coccinelle/unibyte_string.cocci
+++ b/admin/coccinelle/unibyte_string.cocci
@@ -4,3 +4,9 @@ identifier I;
@@
- make_unibyte_string (I, strlen (I))
+ build_unibyte_string (I)
+
+@@
+constant C;
+@@
+- make_unibyte_string (C, strlen (C))
++ build_unibyte_string (C)
diff --git a/admin/coccinelle/xsave.cocci b/admin/coccinelle/xsave.cocci
deleted file mode 100644
index 5172bb55b33..00000000000
--- a/admin/coccinelle/xsave.cocci
+++ /dev/null
@@ -1,11 +0,0 @@
-// Adjust users of XSAVE_POINTER and XSAVE_INTEGER.
-@@
-expression E;
-@@
-(
-- XSAVE_POINTER (E)
-+ XSAVE_POINTER (E, 0)
-|
-- XSAVE_INTEGER (E)
-+ XSAVE_INTEGER (E, 1)
-)
diff --git a/admin/codespell/README b/admin/codespell/README
new file mode 100644
index 00000000000..fcc5e3b41d0
--- /dev/null
+++ b/admin/codespell/README
@@ -0,0 +1,27 @@
+This directory contains supporting files for running codespell.
+See the ./admin/run-codespell script.
+
+codespell.dictionary
+
+ This file contains additional, Emacs-specific corrections. When
+ fixing typos in Emacs, consider adding them to this file.
+
+codespell.exclude
+
+ This file contains lines that are correct and should be ignored by
+ codespell. Add any false positives to this file.
+
+ The lines must match lines in the Emacs source tree exactly,
+ including any whitespace.
+
+codespell.ignore
+
+ This file contains any words that are correct in the context of
+ Emacs, or that we otherwise choose to ignore. Use your best
+ judgment when adding words to this file. Common typos that are
+ only correct in highly specific contexts should probably be in
+ codespell.exclude instead.
+
+codespell.rc
+
+ This file contains the Emacs specific codespell configuration.
diff --git a/admin/codespell/codespell.dictionary b/admin/codespell/codespell.dictionary
new file mode 100644
index 00000000000..b082a48fe99
--- /dev/null
+++ b/admin/codespell/codespell.dictionary
@@ -0,0 +1,17 @@
+alis->alist, alias, alas, axis, alms,
+boostrap-clean->bootstrap-clean
+brunches->branches
+defalis->defalias
+defalises->defaliases
+ecmacs->emacs
+ehsell->eshell
+emcs->emacs
+finis->finish
+firs->first
+file-writeable-p->file-writable-p
+hep->help
+least-favourite->least-favorite
+lien->line
+liens->lines
+mecas->emacs
+sehell->eshell, shell,
diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude
new file mode 100644
index 00000000000..6413a73701b
--- /dev/null
+++ b/admin/codespell/codespell.exclude
@@ -0,0 +1,1587 @@
+ say "And this happens inbetween";
+ @ture)
+ ($sig,$na,@ture)
+($sig,$na,@ture)
+@ture)
+((squery 10 "SQUERY alis :help list")
+ (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES"))
+ (0.04 ":Alis@hub.uk NOTICE tester :[...]")
+ (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]")
+ (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel")
+ (erc-scenarios-common-say "/SQUERY alis help list")
+ (should (equal '((regexp . "(string-match-p \"^[fo]+\" \"foobar\")\n => 0"))
+ (or "comm" "comma" "comman" "command" "commands"
+ (when (and (not (or skipp erc-timestamp-format))
+ (unless skipp
+ (skipp (or (and erc-stamp--skip-when-invisible invisible)
+;; if you type "foo", but typing just "fo" doesn't show the preview.
+ (Emacs main thre), pid 32619 (org.gnu.emacs)
+F DEBUG : pid: 32619, tid: 32644, name: Emacs main thre >>> org.gnu.emacs <<<
+ bnez $t2, .filld # start filling longs
+ j .filld # fill either doubleword or byte
+.filld:
+
+ (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.")
+ interger intger lits bool boolen constant filename
+ with typess = (sort (mapcar #'comp-supertypes
+ for types in typess
+;; FIXME: normalise `seq', both the construct and implicit sequences,
+;; `intersection', we may end up normalising subtrees multiple times
+;; One way to avoid this is to aggressively normalise the entire tree
+;; Such normalisation could normalise synonyms, eliminate `minimal-match'
+ ;; Normalise the constructor to `or' and the args recursively.
+ "Intersection of the normalised FORMS, as an interval set."
+FORM must be normalised (from `rx--normalise-char-pattern')."
+ "Optimise `or' arguments. Return a new rx form.
+Each element of ARGS should have been normalised using
+ (search-forward "retur") ; leaves point before the "n"
+with typess = (sort (mapcar #'comp-supertypes
+ (font-spec :registry "iso10646-1" :otf '(khmr nil (pres)))))
+(0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.")
+ (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his."))
+ (funcall expect 1 "Entirely honour"))
+ (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :You have paid the heavens your function, and the prisoner the very debt of your calling. I have laboured for the poor gentleman to the extremest shore of my modesty; but my brother justice have I found so severe, that he hath forced me to tell him he is indeed Justice.")
+ (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.")
+ (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd."))
+ integer integer list bool boolean constant filename
+ "def" "defi" "defin" "define"
+ "doc" "docu" "docum" "docume" "documen" "document"
+ case Aadd : overflow = ckd_add (&a, accum, next); break;
+ And this the second, again with the same distinction therefrom.
+Bonus: Return a cons cell: (COMPILED . UPTODATE).
+Bonus: Return a cons cell: (COMPILED . UPTODATE)."
+(defun semantic-grammar-create-package (&optional force uptodate)
+If the Lisp code seems up to date, do nothing (if UPTODATE
+ (if uptodate (setq output nil)))
+;; Updated by the RIPE Network Coordination Center.
+;; Thanks to jond@miter.org (Jonathan Doughty) for help with code for
+ \"VHDL Modeling Guidelines\".
+# PCRE LICENSE
+# General Purpose Licence (GPL), or Lesser General Purpose Licence (LGPL),
+# then the terms of that licence shall supersede any condition above with
+ Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research
+ Luo et al. "Uniform colour spaces based on CIECAM02 colour appearance
+ "[o]utput/save MIME part; save [a]ll parts; \n"
+;; Jari Aalto <jaalto@tre.tele.nokia.fi>
+;; Alon Albert <alon@milcse.rtsg.mot.com>
+;; Jari Aalto <jaalto@tre.tele.nokia.fi>.
+ ("IRCnet: EU, AT, Linz" IRCnet "linz.irc.at" ((6666 6668)))
+ ["Januar" "Februar" "MƤrz" "April" "Mai" "Juni" "Juli" "August"
+Both types of item should be moved en bloc to the new category,
+ return dum// -7-
+ struct Dum {
+ mutable a::b::Foo::Dum dumdum;
+ "Mot de Passe :" ; localized (Bug#29729)
+ (leapyear, ydhms_diff, guess_time_tm, __mktime_internal): Use it.
+ * config.bat: Build-in the first step towards X11 support with
+ * configure.ac (emacs_config_features): Donā€™t worry about GIR.
+ * configure.ac (WEBKIT, GIR, CAIRO): Use EMACS_CHECK_MODULES, not PKG_.
+ * configure.ac (emacs_config_features): Add XWIDGETS, WEBKIT, GIR.
+1995-04-20 Kevin Rodgers <kevinr@ihs.com>
+(seq-mapn #'concat '("moskito" "bite") ["bee" "sting"])
+Steven E. Harris (seh at panix.com),
+Kevin Rodgers (kevin.rodgers at ihs.com),
+plot,x,alog(x+5*sin(x) + 2),
+be shown. On positions 3,4, and 7, the @samp{alog} function will be
+As is my wont, I started hacking on it almost immediately. I first
+The latter criterion is the "je ne sais quoi" of the artistic aspect of
+order but are now listed consecutively en bloc.
+ "mot de passe" "Mot de passe")
+ Reported by Mor Zahavi <morzahavi@me.com>. (Bug#51271)
+ * etc/refcards/fr-refcard.tex (section{Formater}): Remove mention
+ Reported by Ture PĆ„lsson.
+ 9261a219ec * doc/emacs/windows.texi (Window Convenience): Describe mor...
+ 650a664ccd Let imenu to work on the menu bar when its list is a singl...
+ "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'"
+ ;; Move done items en bloc to top of done items section.
+ * erc-complete.el: * added docfixes (thanks ore)
+ (interactive "DDelete directory from file cache: ")
+ some Agian scripts. */
+ Rename from "Gnus Maintainance Guide".
+ * gnus-coding.texi (Gnus Maintainance Guide): Update to mention Emacs
+ * gnus-coding.texi (Gnus Maintainance Guide): Fix title typo.
+ * gnus-coding.texi (Gnus Maintainance Guide): Update conventions for
+2005-10-23 Lars Hansen <larsh@soem.dk>
+1998-07-17 Gordon Matzigkeit <gord@fig.org>
+1998-04-26 James Troup <J.J.Troup@scm.brad.ac.uk>
+2003-06-11 Daniel NĆ©ri <done@mayonnaise.net>
+2001-07-26 10:00:00 Steven E. Harris <seh@speakeasy.org>
+2001-01-15 Jack Twilley <jmt@tbe.net>
+ matching LAMDA as a word. Noted by Stefan Monnier.
+ completion variant for every "LAMDA" name (bug#30513).
+ "foto"
+ ("foto" . 0.375)
+ Add configury for GMP library
+ Include w32inevt.h, basetyps.h and unknwn.h.
+ * make-docfile.c (write_c_args): Correctly handle prefixes of "defalt".
+ * hexl.c [DOSNT]: Include fcntl.h.
+ * make-docfile.c (write_c_args): Print an argument named "defalt"
+2003-03-07 Kevin Rodgers <kevin.rodgers@ihs.com> (tiny change)
+2003-03-06 Kevin Rodgers <kevin.rodgers@ihs.com> (tiny change)
+ "Speedwave", "Simili", "Synopsys Design Compiler", "Cadence NC",
+ with-parsed-tramp-file-name macro which is wont to produce such stuff.
+2004-12-29 Sanghyuk Suh <han9kin@mac.com>
+2007-02-28 Lars Hansen <larsh@soem.dk>
+2006-11-24 Lars Hansen <larsh@soem.dk>
+2006-10-29 Lars Hansen <larsh@soem.dk>
+2006-09-12 Lars Hansen <larsh@soem.dk>
+2006-06-23 Lars Hansen <larsh@soem.dk>
+2006-05-14 Lars Hansen <larsh@soem.dk>
+2006-05-13 Lars Hansen <larsh@soem.dk>
+2006-02-09 Lars Hansen <larsh@soem.dk>
+2006-02-06 Lars Hansen <larsh@soem.dk>
+2005-11-22 Lars Hansen <larsh@soem.dk>
+2005-11-08 Lars Hansen <larsh@soem.dk>
+2005-11-03 Lars Hansen <larsh@soem.dk>
+2005-11-02 Lars Hansen <larsh@soem.dk>
+2005-10-08 Lars Hansen <larsh@soem.dk>
+2005-08-10 Lars Hansen <larsh@soem.dk>
+2005-07-12 Lars Hansen <larsh@soem.dk>
+2011-02-22 Seppo Sade <sepposade1@gmail.com> (tiny change)
+2012-09-21 Joel Bion <jpbion@westvi.com> (tiny change)
+ * rmail.el: Major changes from Bob Weiner <weiner@pts.mot.com>
+ * rmailsum.el: Big rewrite from weiner@pts.mot.com.
+1995-05-19 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+1994-08-29 Tom Tromey (tromey@creche.colorado.edu)
+1994-07-11 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+1994-06-17 Kevin Rodgers (kevinr@ihs.com) (tiny change)
+1995-12-13 Kevin Rodgers <kevinr@ihs.com>
+1995-11-10 Kevin Rodgers <kevinr@ihs.com>
+1995-06-30 Kevin Rodgers <kevinr@ihs.com>
+1998-07-07 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+1998-06-03 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+1997-12-22 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+1997-11-02 Kevin Rodgers <kevinr@ihs.com>
+1997-10-21 Brad Howes <bhowes@cssun3.corp.mot.com>
+1997-06-22 Howard Melman <melman@absolut.osf.org>
+1997-03-24 Kevin Rodgers <kevinr@ihs.com>
+1996-11-04 Kevin Rodgers <kevinr@ihs.com>
+1996-10-20 Kevin Rodgers <kevinr@ihs.com>
+1996-09-12 Kevin Rodgers <kevinr@ihs.com>
+1999-11-16 Reto Zimmermann <reto@synopsys.com>
+1999-06-12 Reto Zimmermann <reto@synopsys.com>
+1999-05-15 Reto Zimmermann <reto@Synopsys.COM>
+1998-08-26 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+ directories. From Kevin Rodgers <kevinr@ihs.com>.
+ "du Radis" "de la Ruche" "du Gainier"
+ Iinclude string.h, stdlib.h unconditionally.
+2006-04-23 Lars Hansen <larsh@soem.dk>
+2006-04-20 Lars Hansen <larsh@soem.dk>
+2005-11-10 Lars Hansen <larsh@soem.dk>
+ explicitly sets the defalt value.
+ Unexpect wait_object in case of x errors (memory leak).
+ (receive_incremental_selection): Don't unexpect wait_object when done
+ append "CCL: Quitted" when the CCL program is quitted.
+ the loop. When quitted, show a proper error message.
+ (read_minibuf_noninteractive): If defalt is cons, set val to its car.
+ (read_minibuf): If defalt is cons, set histstring to its car.
+ (Fcompleting_read): If defalt is cons, set val to its car.
+ but it still has blocs in it, don't return it to the system,
+ any, in the DEFALT argument into the root of the Emacs build or
+ * fileio.c (Fexpand_file_name): Default DEFALT at beginning,
+1992-03-03 Wilson H. Tien (wtien@urbana.mcd.mot.com)
+ * fileio.c (Fexpand_file_name): Pass DEFALT through
+ * ralloc.c (relocate_some_blocs): Handle BLOC == NIL_BLOC.
+ malloc heap, zero it out even if we don't have any blocs in the
+ (r_alloc_sbrk): Provide hysteresis in relocating the blocs.
+ (get_bloc): Return zero if we can't allocate the new bloc.
+ * ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
+ original bloc, just expand the original block. This saves a copy
+ If string quotes don't match up, don't take value from OFROM;
+ Globally replaced INTERRUPTABLE with INTERRUPTIBLE.
+ * fileio.c (Fread_file_name): If defalt is nil and user tries to use
+1995-03-23 Kevin Rodgers <kevinr@ihs.com> (tiny change)
+ * fileio.c (Fexpand_file_name): Look for a handler for defalt.
+1994-09-21 Tom Tromey <tromey@creche.colorado.edu>
+ (r_alloc_sbrk): Refuse to move blocs, if frozen.
+1994-08-26 Kevin Rodgers <kevinr@ihs.com>
+ (Fcall_process_region) [DOSNT]: Canonicalize slashes in filename.
+ * minibuf.c (read_minibuf): Do use DEFALT in place of empty input
+ * minibuf.c (read_minibuf): Return DEFALT here, if minibuffer is empty.
+ (read_minibuf): Now static. New arg DEFALT. Callers changed.
+ CHAR_TABLE_ORDINARY_SLOTS for top, defalt, parent, and purpose.
+ is moved before `contents' so that XCHAT_TABLE (val)->defalt can
+ for an ASCII font, not defalt slot.
+ /* And if the configury during frame creation has been
+ Bob Desinger <hpsemc!bd@hplabs.hp.com>
+/* Calculate the checksum of a SOM header record. */
+ to preserve. Then we map these VAs to the section entries in the
+#include <unknwn.h>
+ /* weiner@footloose.sps.mot.com reports that this causes
+ (VARN+1 SLOTN+1))
+dum@dots{} Nice tune, that@dots{} la la la@dots{} What, you're back?
+C'est la vie.
+ ("gnus-warning" "duplicat\\(e\\|ion\\) of message" "duplicate")
+James Troup,
+@cindex @code{multline}, AMS-LaTeX environment
+@code{align}, @code{gather}, @code{multline}, @code{flalign},
+ \openin 1 #1.pdf \ifeof 1
+ \openin 1 #1.PDF \ifeof 1
+ \openin 1 #1.png \ifeof 1
+ \openin 1 #1.jpg \ifeof 1
+ \openin 1 #1.jpeg \ifeof 1
+ \openin 1 #1.JPG \ifeof 1
+ \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks}
+ \openin 1 \jobname.\indexname s
+ % If the index file exists but is empty, then \openin leaves \ifeof
+\setbox\balancedcolumns=\vbox{shouldnt see this}%
+ \openin 1 \tocreadfilename\space
+ \openin 1 \jobname.aux
+\openin 1 = epsf.tex
+ \openin 1 txi-#1.tex
+ \openin 1 txi-#1.tex
+ @openin 1 texinfo.cnf
+ '("En" "To" "Tre"))
+=project.clj=, =build.boot= or =deps.edn=, falling back on
+ ("(.H)J" (1 :otf=beng=half+))
+- (".H" :otf=beng=blwf,half,vatu+)
++ (".+H" :otf=beng=blwf,half,vatu+)
+ \quad \B{p}art: a)uthor (from), s)ubject, x)refs (cross-post), d)ate, l)ines,
+ message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\*
+\key{show subtree in indirect buffer, ded.\ frame}{C-c C-x b}
+@tindex alog
+mode setting. With the Inverse flag [@code{alog}], this command is
+@r{ a b@: I B @: @: 2 @:alog@:(a,b) b^a}
+@r{ a b@: I f I @: @: 2 @:alog@:(a,b) b^a}
+ Change comment about the iif hook to reflect the actual reason.
+ "\\`I' + \\`E' (ln), \\`L' (exp), \\`B' (alog: B^X); \\`f E' (lnp1), \\`f L' (expm1)"
+ (let (numer denom)
+ (setq numer (car (math-read-expr-list)))
+ (if (and (Math-num-integerp numer)
+ (list 'frac numer denom)
+ (list '/ numer denom))))
+ (calc-binary-op "alog" 'calcFunc-alog arg)
+ (let ((dum (math-lud-pivot-check sum)))
+ (if (or (math-zerop big) (Math-lessp big dum))
+ (setq big dum
+ (calc-pop-push-record-list 0 "larg"
+ (interactive "NNumber of columns = ")
+ (calc-binary-op "cros" 'calcFunc-cross arg)))
+ (calc-binary-op "unio" 'calcFunc-vunion arg '(vec) 'calcFunc-rdup)))
+ (calc-tabular-command 'calcFunc-table "Index" "tabl"
+ (ptd (file-truename pd)))
+ (string-match (concat "^" (regexp-quote ptd)) ftn)))
+ (let ((aci (autoconf-parameters-for-macro "AC_INIT"))
+ ((> (length aci) 1)
+ (setq name (nth 0 aci)
+ ver (nth 1 aci)
+ bugrep (nth 2 aci)))
+ (princ "\nKnown members of ")
+ (peom (save-excursion (c-end-of-macro) (point))))
+ (when (> (point) peom)
+ (let ((larg (car args))
+ (if (stringp larg)
+ (setq larg (semantic-tag-new-variable
+ larg nil nil)))
+ (srecode-semantic-tag (semantic-tag-name larg)
+ :prime larg)
+ (princ "\n--------------------------------------------\n\nNumber of tables: ")
+;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip.
+ (args docstring interactive orig &optional befores arounds afters)
+and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
+ (dolist (advice befores)
+ (let* ((nam (buffer-substring (match-beginning 2) (match-end 2)))
+ (setq nmlst (cons nam nmlst)
+ "If we are in an rmail summary buffer, then chart out the froms."
+ (let* ((nam (buffer-substring (match-beginning 1) (match-end 1)))
+ (m (member nam nmlst)))
+ (message "Scanned username %s" nam)
+ (setq nmlst (cons nam nmlst)
+ ((memq word '(concat concating))
+ (crypted (cl-loop with str = (make-string (* 2 (length orig-name)) 0)
+ for c-sym = (concat prefix crypted "_" human-readable "_"
+ (concat prefix crypted "_" human-readable "_0"))))
+ (let* ((acces (plist-get soptions :accessor))
+ (when acces
+ (push `(cl-defmethod (setf ,acces) (value (this ,name))
+ (push `(cl-defmethod ,acces ((this ,name))
+ (push `(cl-defmethod ,acces ((this (subclass ,name)))
+;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>"
+G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W |
+;; lisp example from Jari Aalto <jaalto@tre.tele.nokia.fi>
+;; perl example from Jari Aalto <jaalto@tre.tele.nokia.fi>
+;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face)
+ "define\\|e\\(?:l\\(?:if\\|se\\)\\|ndif\\|rror\\)\\|file\\|i\\(?:f\\(?:n?def\\)?\\|mport\\|nclude\\)\\|line\\|pragma\\|undef\\|warning"
+2003-06-11 Daniel NĆ©ri <dne@mayonnaise.net>
+ (lambda (valu symb)
+ (let ((anumber (string-to-number
+ (< anumber bnumber)))))
+ (curren . 164)
+ ;; Now we must merge the Dows with the Doms. To do that, we
+ (dows dow-list)
+ ;; second add all possible dows
+ (while (setq day (pop dows))
+;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
+ didnt nnmaildir--file nnmaildir-article-file-name
+ (setq didnt (cons (nnmaildir--art-num article) didnt)))
+ (setq didnt (cons (nnmaildir--art-num article) didnt))
+ didnt)))
+ (insert "\nKnown Certificates:\n"))))
+;; We could use `symbol-file' but this is a wee bit more efficient.
+ (beng . bengali)
+ (maka . makasar)
+ ,(font-spec :registry "iso10646-1" :otf '(beng nil (rphf))))
+ (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))
+ ("wee" . "Latin-2") ; MS Windows Lower Sorbian
+ ;; Unicode uses the spelling "lamda" in character
+ (string-match "\\<LAMDA\\>" new-name))
+ "WINDOWS-1258 (Viet Nam)"
+ "mot de passe" ; fr
+Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy
+W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac
+ przekodowuj/a zaznaczony fragment wzgl/ednie ca/ly buffor.
+ Poni/zsze przyk/lady powinny wyja/sni/c, jakich parametr/ow
+ Funkcje biblioteki odwo/luj/a si/e do pi/eciu zmiennych, kt/ore
+ ("capetown" "Cape Town, South Africa")
+ (progn (error msg "preced") 0)))
+ <larsh@soem.dk> 2005-08-10.
+ (dolist (slot '(answers authorities additionals))
+ queries answers authorities additionals)
+ (setq additionals (dns-read-bytes 2))
+ (additionals ,additionals))
+ [nil ; 1 ACI Item N
+ ("&curren;" . "(#)")
+;; Author: Alon Albert <alon@milcse.rtsg.mot.com>
+ "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer),
+l(ines)."
+ (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)")
+ "Verify spelling for the objects specified by char UNIT : [b(uffer),
+ (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)")
+sWith: " )
+(defun org-babel-perl--var-to-perl (var &optional varn)
+ (if varn
+ (concat "my $" (symbol-name varn) "=" (when lvar "\n")
+ (if org-agenda-entry-text-mode " ETxt" "")
+ ("curren" "\\textcurrency{}" nil "&curren;" "curr." "Ā¤" "Ā¤")
+ (interactive "nNumber of clones to produce: ")
+N is the number of WHATs to shift.
+multlinewidth The width of the multline environment.
+ (list :tag "multlinewidth (width to use for the multline environment)"
+ "align" "gather" "multline" "flalign" "alignat"
+ ("ca" :default "Autor")
+ ("cs" :default "Autor")
+ ("de" :default "Autor")
+ ("es" :default "Autor")
+ ("et" :default "Autor")
+ ("pl" :default "Autor")
+ ("pt_BR" :default "Autor")
+ ("ro" :default "Autor")
+ ("sl" :default "Seznam tabel")
+ ("nl" :default "Zie tabel %s"
+ :html "Zie tabel&nbsp;%s" :latex "Zie tabel~%s")
+ ("et" :default "Tabel")
+ ("nl" :default "Tabel")
+ ("ro" :default "Tabel")
+ ("ro" :default "Tabele")
+ ("da" :default "Tabel %d")
+ ("et" :default "Tabel %d")
+ ("nl" :default "Tabel %d:" :html "Tabel&nbsp;%d:")
+ ("ro" :default "Tabel %d")
+ ("pl" :html "Spis tre&#x015b;ci")
+ (thier their (their))
+ (whats up) (whats new) (what\'s up) (what\'s new)
+ refer refered referred refers
+ (c++-mode . "#\\(assert\\|cpu\\|define\\|endif\\|el\\(if\\|se\\)\\|i\\(dent\\|f\\(def\\|ndef\\)?\\|mport\\|nclude\\(_next\\)?\\)\\|line\\|machine\\|pragma\\|system\\|un\\(assert\\|def\\)\\|warning\\)\\>"))
+ "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
+: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
+ "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
+ "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
+ \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
+ "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
+ "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
+ ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
+ (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
+ "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ;FRMAT
+ (insert "\n[U]nknown conditionals: ")
+ (struc info file tags-file &optional view where)
+STRUC is an `ebrowse-bs' structure (or a structure including that)
+FILE is not taken out of STRUC here because the filename in STRUC
+ (ebrowse-bs-name struc)))
+ (setf ebrowse-temp-position-to-view struc
+ (ebrowse-find-pattern struc info))))
+ "cexp" "log" "alog" "dlog" "clog" "log10"
+ '("ASCII" "addto" "also" "and" "angle" "atleast" "batchmode"
+ "bre~ak" "bti~tle" "c~hange" "cl~ear" "col~umn" "conn~ect"
+ "repf~ooter" "reph~eader" "r~un" "sav~e" "sho~w" "shutdown"
+ "copyc~ommit" "copytypecheck" "def~ine" "describe"
+That is, all code between \"// synopsys translate_off\" and
+\"// synopsys translate_on\" is highlighted using a different background color
+option to intermix between input/output/inouts.
+ :help "Help on AUTOINOUT - adding inouts from cells"]
+ (eval-when-compile (verilog-regexp-words '("Outputs" "Inouts" "Inputs" "Interfaces" "Interfaced"))))
+ '("surefire" "0in" "auto" "leda" "rtl_synthesis" "synopsys"
+ (structres nil)
+ (setq structres (verilog-in-struct-nested-p))
+ (cond ((not structres) nil)
+ ;;((and structres (equal (char-after) ?\})) (throw 'nesting 'struct-close))
+ ((> structres 0) (throw 'nesting 'nested-struct))
+ ((= structres 0) (throw 'nesting 'block))
+ (list 'block structres))
+// Created : <credate>
+ (search-forward "<credate>") (replace-match "" t t)
+Return an array of [outputs inouts inputs wire reg assign const gparam intf]."
+ (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+Return an array of [ outputs inouts inputs ] signals for modules that are
+ (while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t)
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ "// Inouts"
+ Inouts are not supported, as assignments must be unidirectional.
+ (verilog-auto-inst-port-list "// Inouts\n"
+ This ONLY detects inouts of AUTOINSTants (see `verilog-read-sub-decls').
+ // Beginning of automatic inouts
+ // Inouts
+from only extracting inouts starting with i:
+ (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n")
+ // Beginning of automatic in/out/inouts
+ (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
+ // Beginning of automatic in/out/inouts (from modport)
+ (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n")
+finds all inputs and inouts in the module, and if that input is not otherwise
+First, parameters are built into an enumeration using the synopsys enum
+ \"synopsys enum\" may be used in place of \"auto enum\".
+ default: state_ascii_r = \"%Erro\";
+ `verilog-auto-inout' for AUTOINOUT making hierarchy inouts
+ `verilog-auto-unused' for AUTOUNUSED unused inputs/inouts
+ ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
+ ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
+ ;; ERROR: test.vhd(14): Unknown identifier: positiv
+ ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
+ ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
+ ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
+ ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
+ ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
+ ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
+(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
+ (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
+ (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
+;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
+;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
+;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
+;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
+;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
+;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
+;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
+;; Ralf Brown's Interrupt List. file INTERRUP.F, D-2138, Table 01400
+ ("portugues" ; Portuguese mode
+ ("portugues" "pt_PT")
+;; of the document. If WRAPP is true then wrap the search to the
+(defun reftex-isearch-switch-to-next-file (crt-buf &optional wrapp)
+ (if wrapp
+f / c Toggle follow mode / Toggle display of [c]ontext.
+ F t c Toggle: [F]ile borders, [t]able of contents, [c]ontext
+\\`l' \\`i' \\`c' \\`F' Toggle display of [l]abels, [i]ndex, [c]ontext, [F]ile borders.
+ ;; OK, get the makro name
+ ("multline" ?e nil nil t)
+ "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect"
+;; |ment\|
+;; horizontale disigatan fenestron, si- horizontally split window similar to
+;; ^jus anta^ue faris C-x C-f. file if you just did C-x C-f.
+;; per C-x u kaj plue modifu la du continue to edit the two buffers.
+;; Programistoj eble ^satus la eblecon Programmers might like the ability
+;; iliajn finojn dum redaktado. won't see their end during editing.
+ "news:" "nfs://" "nntp://" "opaquelocktoken:" "pop://" "pres:"
+;; Bob Weiner <weiner@footloose.sps.mot.com>,
+ control whether we try to do keep-alives for our connections.
+ keep-alives to time out on cached documents with no known
+ ;; seconds for the keep-alives to time out on some servers.
+ msglen = ccl->quit_silently ? 0 : sprintf (msg, "\nCCL: Quitted.");
+ Quitted" to the generated text when
+ CCL program is quitted. */
+ followings. */
+ /* Followings are target of code detection. */
+ /* Followings are NOT target of code detection. */
+ /* The followings are extra attributes for each type. */
+ Aadd,
+ case Aadd : accum += next; break;
+ case Aadd : mpz_add (mpz[0], *accum, *next); break;
+ case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break;
+ return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
+ /* The followings are used only for a font-entity and a font-object. */
+ /* The followings are used only for a font-object. */
+ /* We have already tried this element and the followings
+/* According to RBIL (INTERRUP.A, V-1000), 160 is the maximum possible
+ hole between the first bloc and the end of malloc storage. */
+ /* First bloc in this heap. */
+ /* Last bloc in this heap. */
+ struct heap *heap; /* Heap this bloc is in. */
+/* Find the bloc referenced by the address in PTR. Returns a pointer
+ callers that always expect a bloc to be returned should abort
+/* Allocate a bloc of SIZE bytes and append it to the chain of blocs.
+ Returns a pointer to the new bloc, or zero if we couldn't allocate
+ /* Put this bloc on the doubly-linked list of blocs. */
+/* Calculate new locations of blocs in the list beginning with BLOC,
+in the quitted window.
+ trough color and main window's background color.
+ means the truck and arrow colors, and "trough" means the
+ bg[ACTIVE] = "blue"@ @ @ @ # @r{Trough color.}
+also for the trough of a scroll bar, i.e., @code{bg[ACTIVE] = "red"}
+sets the scroll bar trough to red. Buttons that have been armed
+ (while (search-forward "nam" nil t)
+ (search-forward "som")
+ (search-forward "Nam")
+ (0 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :[09:17:51] u thur?")
+ (0.01 ":alice/foonet PRIVMSG #chan/foonet :bob: Sir, his wife some two months since fled from his house: her pretence is a pilgrimage to Saint Jaques le Grand; which holy undertaking with most austere sanctimony she accomplished; and, there residing, the tenderness of her nature became as a prey to her grief; in fine, made a groan of her last breath, and now she sings in heaven.")
+ "sav"
+ (if valu
+ (cons symb valu)))
+ (sample-text . "Er is een aantal manieren waarop je dit kan doen")
+Tai Daeng (also known as Red Tai or Tai Rouge),
+ ;; Ith character and the followings matches precomposable
+ sprintf (css, "scrollbar trough { background-color: #%06x; }",
+ OFROM[I] is position of the earliest comment-starter seen
+ sprintf (css, "scrollbar trough { background-color: #%02x%02x%02x; }",
+ /* Note: "background" is the thumb color, and "trough" is the color behind
+ (uptodate t))
+ (while (and files uptodate)
+ (setq uptodate nil)))))
+ uptodate)))
+ ptrdiff_t acount = 0; /* The # of consecutive times A won. */
+ acount = 0;
+ ++acount;
+ if (acount >= min_gallop)
+ acount = k;
+ } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN);
+ ptrdiff_t acount = 0; /* The # of consecutive times A won. */
+ ++acount;
+ if (acount >= min_gallop)
+ acount = 0;
+ acount = k;
+ } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN);
+ 154cd116be (origin/emacs-27) * admin/release-process: Adapt bug numbe...
+ a38da0d cc-mode.texi: Work around makeinfo alignment bug. Fix proble...
+ fd35804971 (origin/emacs-26) * doc/lispref/strings.texi (Case Convers...
+ be in line with the raison d'ĆŖtre of compiling printer which is speed.
+mace <mace@kirjakaapeli.lib.hel.fi>
+at that position, the result is @samp{fro!b}, with point between the
+doesnt
+minimize(xfit(gaus(a,b,c,d,x), x, [a,b,c], data)_5, d, guess)
+where @code{gaus} represents the Gaussian model with background,
+* Score Decays:: It can be useful to let scores wither away.
+providers if they were to do this---their @emph{raison d'ĆŖtre} is to
+While this design may be internally consistent with the raison d'ĆŖtre of
+Finally, just to whet your appetite for what can be done with the
+Wedler, Alan Williams, Roland Winkler, Hans-Christoph Wirth, Eli
+ "Some Place\nIn some City\nSome country.")
+@c andrewm@@optimation.co.nz
+Emacs Macht Alle Computer Schoen
+GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3.
+ \quad \B{A}ction: I)ncrease, L)ower;\\*
+ (calc-unary-op "flor" 'calcFunc-ffloor arg)
+ (calc-unary-op "flor" 'calcFunc-floor arg)))))
+ ["de la Vertu" "du GĆ©nie" "du Travail" "de la Raison" "des RĆ©compenses"
+ "de la Cuve" "de la Pomme de terre" "de l'Immortelle"
+ "de la Raison" "des RĆ©compenses" "de la RĆ©volution"]
+ (string-match "config\\(ure\\.\\(in\\|ac\\)\\|\\.status\\)?$" f)
+ ("\\.\\(dll\\|drv\\|386\\|vxd\\|fon\\|fnt\\|fot\\|ttf\\|grp\\)$" . t)
+ (insert (format "\nIn %s:\n" form)))
+ (format "\nIn macro %s:" (cadr form)))
+ (format "\nIn variable %s:" (cadr form)))
+ (insert "\nIn " package)
+ "\nIn order to use version `%s' of gnus, you will need to set\n"
+znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
+ oraz ich warto/sci domy/slne s/a nast/epuj/ace:
+ (insert "\nIn " (emacs-version))
+ "[n]ew messages; [']ticked messages; [s]earch;\n"
+ (?/ "Limit to [c]c, ran[g]e, fro[m], [s]ubject, [t]o; [w]iden")
+ (dictionary-send-command "show strat")
+r(egion), s(tring), w(ord) ]."
+ "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
+ (theyre they\'re (they are))
+ (insert "\n[K]nown conditionals: ")
+ "[T]rue Face" "[F]alse Face" "[W]rite"))
+ "[ \t]*in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}")))
+ (let ((siz (cond ((numberp size)
+ (and (< siz 0)
+ siz))
+ "\tHow to report bugs and contribute improvements to Emacs\n"
+ "\tHow to obtain the latest version of Emacs\n"
+ (insert "\tHow to report bugs and contribute improvements to Emacs\n\n")
+ (insert "\tHow to get the latest version of GNU Emacs\n")
+ ("/mod\\(?:ules\\|probe\\)\\.conf" . "alias\\|in\\(?:clude\\|stall\\)\\|options\\|remove")
+ ("/dictionary\\.lst\\'" . "DICT\\|HYPH\\|THES")
+ ;; use-mark sizeA dateA sizeB dateB filename
+;; nin, nil are placeholders. See ediff-make-new-meta-list-element in
+;; Andrew McRae <andrewm@optimation.co.nz>
+ * xmenu.c (apply_systemfont_to_menu): *childs was incorrectly used.
+DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
+ defsubr (&Scatch);
+DEFUN ("elt", Felt, Selt, 2, 2, 0,
+ defsubr (&Selt);
+ (should (equal (string-truncate-left "longstring" 8) "...tring")))
+ (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Lady, I will commend you to mine own heart.")
+ (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3."
+ (rxp "Error: Mismatched end tag: expected </geroup>, got </group>\nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml"
+ (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml"
+ (string= (python-util-strip-string "\n str \nin \tg \n\r") "str \nin \tg"))
+ (insert "hel")
+ (format "\nIn function %s:" (cadr form)))
+ (t "\nIn top level expression:"))))
+ All suggested by Ned Ludd.
+;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd.
+;; Ned Ludd.
+To: Ned Freed <ned@innosoft.com>
+@strong{Te Deum}
+ If the termcap entry does not define the "ti" or "te" string,
+ and the "te" string is used to set it back on exit.
+ (te (solar-time-equation date ut)))
+ (setq ut (- ut te))
+ (let ((te (semantic-tag-end aftertag)))
+ (when (not te)
+ (goto-char te)
+ ("te" . "Telugu")
+ ("\\.te?xt\\'" . text-mode)
+ ("\\.te?xi\\'" . texinfo-mode)
+ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
+ ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
+ (not (string-match "\\.te?xi\\'" name)) ;; not .texi
+ (?\į‰° "te")
+ (?\į‰“ "tE")
+ (?\įŒ  "Te")
+ (?\įŒ¤ "TE")
+ (?\āˆƒ "TE")
+ (?\恦 "te")
+ (?\惆 "Te")
+ ("te" "Telugu" utf-8) ; Telugu
+ "ą°øą°‚ą°•ą±‡ą°¤ą°Ŗą°¦ą°®ą±" ; te
+ * org-clock.el (org-clocktable-steps): Allow ts and te to be day
+ issue face m te ts dt ov)
+ te nil ts nil)
+ te (match-string 3)
+ te (float-time (org-time-string-to-time te))
+ dt (- te ts))))
+ (setq tlend (or te tlend) tlstart (or ts tlstart))
+ ts te s h m remove)
+ (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
+ (org-time-string-to-time te)
+ te (org-duration-from-minutes (+ (* 60 h) m)))
+ (te (float-time
+ (dt (- (if tend (min te tend) te)
+ (te (plist-get params :tend))
+ te (nth 1 cc)))
+ (unless (or block (and ts te))
+ (te (plist-get params :tend))
+ te (nth 1 cc)))
+ (when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
+ (when (and te (listp te))
+ (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
+ (if te (setq te (org-matcher-time te)))
+ (org-clock-sum ts te
+ ts te h m s neg)
+ te (match-string 3))
+ (apply #'encode-time (org-parse-time-string te)))
+;; Emulate more complete preprocessor support for tbl (.TS/.TE)
+This applies to text between .TE and .TS directives.
+ ;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page)
+ (set-marker to (woman-find-next-control-line "TE"))
+ tty->TS_end_termcap_modes = tgetstr ("te", address);
+ const char *TS_end_termcap_modes; /* "te" */
+ (0 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :[09:19:19] mike: Chi non te vede, non te pretia.")
+ (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.")
+ "un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 bi=\n"
+ "ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire ils te f=\n"
+ "abriquent pour te la vendre une =C3=A2me vulgaire."))
+ "un moyen, et te trompant ainsi sur la route Ć  suivre les voilĆ  bi"
+ "entƓt qui te dƩgradent, car si leur musique est vulgaire ils te f"
+ "abriquent pour te la vendre une Ć¢me vulgaire."))
+ (".TS" . ".TE")
+ (define-key vhdl-template-map "te" #'vhdl-template-terminal)
+ ("te" "telugu")
+ (format "%s.TE\n"
+:NR:te=\\E[47l:ti=\\E[47h\
+ ;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
+ nil nil nil nil "FA" "C." "dP" "TE" "~TE" "/0"
+(defalias 'woman2-TE #'woman2-fi)
+;;; Preliminary table support (.TS/.TE)
+ ;; ".TE -- End of table code for the tbl processor."
+ 8804ac857b * src/buffer.c (syms_of_buffer) <ctl-arrow>: Doc fix. (Bu...
+ da00a6f317 Fix Xaw widget text disappearing when built with cairo (bu...
+2020-11-10 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-23 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-11 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-10 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-09 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-07 Andrew G Cohen <cohen@andy.bu.edu>
+2020-09-05 Andrew G Cohen <cohen@andy.bu.edu>
+2020-08-29 Andrew G Cohen <cohen@andy.bu.edu>
+2020-08-27 Andrew G Cohen <cohen@andy.bu.edu>
+ 121be3e118 ; * etc/NEWS: Remove temporary note on documentation. (Bu...
+ 224e8d1464 Make call_process call signal_after_change. This fixes bu...
+ 891f7de8ed * test/lisp/simple-tests.el: Full path to Emacs binary (bu...
+ 8b7c776 * lisp/simple.el (kill-do-not-save-duplicates): Doc fix. (Bu...
+ beb4eac * doc/lispref/display.texi (Showing Images): Fix a typo. (Bu...
+ 60b5c10 Provide more details in doc-string of 'delete-windows-on' (Bu...
+ 57bcdc7 Don't call XGetGeometry for frames without outer X window (Bu...
+ f64c277 (origin/emacs-26) Let bookmark-jump override window-point (Bu...
+ 4bd43b0 Increase max-lisp-eval-depth adjustment while in debugger (bu...
+ 55c9bb9f3c Fix comint-get-old-input-default for output field case (Bu...
+ e244fed Clarify that nil doesn't match itself as a cl-case clause (Bu...
+ e21f018 * doc/lispref/functions.texi (Inline Functions): Fix typo (Bu...
+ c59ecb005e New customization variable for python-mode indentation (Bu...
+ a36a090 * lisp/progmodes/verilog-mode.el (verilog-mode): Fix typo (Bu...
+ 98ca7d5 Improve edit-kbd-macro prompting in case of remapped keys (Bu...
+ 804b37ca63 Save and restore text-pixel height and width of frames (Bu...
+ 9715317dfd * lisp/dired.el (dired-find-alternate-file): Doc fix. (Bu...
+ 234b1e3864 Flymake backends must check proc obsoleteness in source bu...
+ dc8812829b Remove resizable attribute on macOS undecorated frames (bu...
+ 43fac3beae Make "unsafe directory" error message more informative (Bu...
+2017-04-25 Andrew G Cohen <cohen@andy.bu.edu>
+2017-04-23 Andrew G Cohen <cohen@andy.bu.edu>
+ dbb3410 python.el: Fix detection of native completion in Python 3 (bu...
+ 4b2d77d * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Fix (bu...
+ d59bcbc Handle mouse leaving initial window in `mouse-set-region' (Bu...
+ 586b213 * lisp/url/url.el (url-retrieve-synchronously): Doc fix. (Bu...
+ f3653ec * configure.ac (HAVE_MODULES): Treat gnu like gnu-linux. (Bu...
+2010-12-15 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-14 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-13 Andrew Cohen <cohen@andy.bu.edu>
+;; Author: Joe Wells <jbw@bigbird.bu.edu>
+ (define-key calc-mode-map "bu" 'calc-unpack-bits)
+ (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
+2002-03-31 Andrew Cohen <cohen@andy.bu.edu> (tiny change)
+2013-05-04 Andrew Cohen <cohen@bu.edu>
+2013-04-25 Andrew Cohen <cohen@bu.edu>
+2013-04-24 Andrew Cohen <cohen@bu.edu>
+2013-04-14 Andrew Cohen <cohen@bu.edu>
+2013-04-10 Andrew Cohen <cohen@bu.edu>
+2013-04-04 Andrew Cohen <cohen@bu.edu>
+2013-04-01 Andrew Cohen <cohen@bu.edu>
+2013-03-31 Andrew Cohen <cohen@bu.edu>
+2013-03-30 Andrew Cohen <cohen@bu.edu>
+2013-03-29 Andrew Cohen <cohen@bu.edu>
+2013-03-27 Andrew Cohen <cohen@bu.edu>
+2013-03-26 Andrew Cohen <cohen@bu.edu>
+2012-07-22 Andrew Cohen <cohen@bu.edu>
+2011-09-12 Andrew Cohen <cohen@andy.bu.edu>
+2011-09-05 Andrew Cohen <cohen@andy.bu.edu>
+2011-09-01 Andrew Cohen <cohen@andy.bu.edu>
+2011-08-11 Andrew Cohen <cohen@andy.bu.edu>
+2011-08-05 Andrew Cohen <cohen@andy.bu.edu>
+2011-08-04 Andrew Cohen <cohen@andy.bu.edu>
+2011-08-03 Andrew Cohen <cohen@andy.bu.edu>
+2011-08-02 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-24 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-23 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-20 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-14 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-02 Andrew Cohen <cohen@andy.bu.edu>
+2011-07-01 Andrew Cohen <cohen@andy.bu.edu>
+2011-06-30 Andrew Cohen <cohen@andy.bu.edu>
+2011-06-21 Andrew Cohen <cohen@andy.bu.edu>
+2011-02-22 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-17 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-16 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-10 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-08 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-07 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-06 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-05 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-04 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-03 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-02 Andrew Cohen <cohen@andy.bu.edu>
+2010-12-01 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-29 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-28 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-27 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-23 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-21 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-17 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-11 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-06 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-04 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-03 Andrew Cohen <cohen@andy.bu.edu>
+2010-11-01 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-31 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-30 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-22 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-18 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-16 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-15 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-14 Andrew Cohen <cohen@andy.bu.edu>
+2010-10-10 Andrew Cohen <cohen@andy.bu.edu>
+2010-09-25 Andrew Cohen <cohen@andy.bu.edu> (tiny change)
+2010-09-23 Andrew Cohen <cohen@andy.bu.edu>
+2004-02-26 Andrew Cohen <cohen@andy.bu.edu>
+ <cohen@andy.bu.edu>.
+ syntax table here. Reported by Andrew Cohen <cohen@andy.bu.edu>.
+ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
+;; Author: Andrew Cohen <cohen@andy.bu.edu>
+ (?\į‰” "bu")
+ (?\恶 "bu")
+ (?\惖 "Bu")
+;; Author: Joe Wells <jbw@cs.bu.edu>
+;; Tue Mar 23 21:23:18 1993 Joe Wells (jbw at csd.bu.edu)
+;; Mon Mar 22 21:20:56 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Mon Mar 22 20:16:57 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Mon Mar 22 00:46:12 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Sun Mar 21 21:41:06 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Sun Mar 21 14:39:38 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Mon Feb 1 22:23:31 1993 Joe Wells (jbw at bigbird.bu.edu)
+;; Mon Apr 6 23:59:09 1992 Joe Wells (jbw at bigbird.bu.edu)
+;; Sun Apr 5 19:39:08 1992 Joe Wells (jbw at bigbird.bu.edu)
+;; Sun Feb 2 14:45:24 1992 Joe Wells (jbw at bigbird.bu.edu)
+ " --------Unsent Message below:" ; from sendmail at BU
+;; Mostly rewritten by Andrew Cohen <cohen@bu.edu> from 2010
+ ((string= "*" bullet) "\\(bu")
+ (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
+ ("bu" "*" "\267" . t) ; bullet
+ '("+l" "#s" "#bu")))
+ da6234e2df Make sure pixel sizes are zero when setting window size fo...
+ d38fd9229c0 Narrow scope of modification hook renabling in org-src fo...
+is the last word in the buffer that starts with @samp{fo}. A numeric
+after the first @samp{FO}; the @samp{F} in that @samp{FO} might not be
+expression @samp{fo}, which matches only the string @samp{fo}. To do
+expression. Thus, @samp{fo*} has a repeating @samp{o}, not a repeating
+@samp{fo}. It matches @samp{f}, @samp{fo}, @samp{foo}, and so on.
+$ ls -li fo*
+(file-name-all-completions "fo" "")
+ nil t "fo")
+Complete a foo: fo@point{}
+and @samp{o} to get the regular expression @samp{fo}, which matches only
+the string @samp{fo}. Still trivial. To do something more powerful, you
+fo
+@samp{fo#.el} matches @file{f.el}, @file{fo.el}, @file{foo.el}, etc.
+@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el},
+ <style:text-properties fo:background-color="#ff0000"/>
+ <style:paragraph-properties fo:break-before="page"/>
+ \futurelet\next\fo@t
+M-f Fo Alias (keep?)
+% | fo |
+ fo ;; List of final overloaded functions
+ (if (get s 'constant-flag) fo ov))
+ (when fo
+ (mapc #'mode-local-print-binding fo))
+ :eval (string-match-p "^[fo]+" "foobar"))
+ :eval (and (string-match "^\\([fo]+\\)b" "foobar")
+ ("fo" . "Faroese")
+ (?\įŽ "fo")
+ ("fo" . "Latin-1") ; Faroese
+ ("fo" "Faroe Islands")
+ M-f -> Fo Alias (keep?)
+ ;; quotes (for example), we end up completing "fo" to "foobar and throwing
+ ;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
+ <style:table-properties style:rel-width=\"%s%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
+ <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
+ <style:text-properties fo:color=\"%s\"/>
+ (format " fo:min-width=\"%0.2fcm\"" (or width .2))))
+ (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
+ <style:text-properties fo:color=\"%s\"/>
+ ;; Are we coalescing two tokens together, e.g. "fo o"
+ ;; user from completing "fo" to "foo/" when she
+;; | | | fo | | fo | | |
+page-height == bm + print-height + tm - fo - fh
+ ("fo+bar" nil "2nd")
+ ("fo*bar" nil "3rd")))
+ (should (equal (ert--abbreviate-string "foo" 2 nil) "fo"))
+ (should (equal (string-limit "foo" 2) "fo"))
+ (should (equal (string-limit "foĆ³" 10 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³" 3 nil 'utf-8) "fo"))
+ (should (equal (string-limit "foĆ³" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³a" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³Ć”" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³a" 4 nil 'iso-8859-1) "fo\363a"))
+ (should (equal (string-limit "foĆ³Ć”" 4 nil 'iso-8859-1) "fo\363\341"))
+ (should (equal (string-limit "foĆ³" 10 t 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³" 4 t 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foĆ³a" 4 t 'iso-8859-1) "fo\363a"))
+ (should (equal (string-limit "foĆ³Ć”" 4 t 'iso-8859-1) "fo\363\341"))
+ " fo"))
+ (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure?
+ (non-directories '("/abso-folder/fo" "rela-folder/fo"
+ "/testdir/Mail/rela-folder/fo"
+ (format "+%s/fo" mh-test-rel-folder) nil 'lambda)))))
+ (format "+%s/fo" mh-test-abs-folder) nil 'lambda)))))
+ (should (equal (file-name-completion "fo" tmp-name) "foo."))
+ (sort (file-name-all-completions "fo" tmp-name) #'string-lessp)
+ (should (equal (file-name-completion "fo" tmp-name) "foo"))
+ (equal (file-name-all-completions "fo" tmp-name) '("foo")))
+ (should (equal (file-name-completion "fo" tmp-name) "foo"))
+ (should (equal (string-replace "fo" "bar" "lafofofozot")
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) (point-max))
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) 14)
+ (should-error (replace-regexp-in-region "fo+" "new" (point-min) 30)))
+ (should (= (replace-regexp-in-region "Fo+" "new" (point-min))
+ (should-not (yank-media--utf-16-p "fo"))
+ (should (equal (fns-tests--with-region base64-encode-region "fo") "Zm8="))
+ (should (equal (base64-encode-string "fo") "Zm8="))
+ (should (equal (fns-tests--with-region base64url-encode-region "fo") "Zm8="))
+ (should (equal (fns-tests--with-region base64url-encode-region "fo" t) "Zm8"))
+ (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "fo" 50) t)
+ (should (equal (base64url-encode-string "fo") "Zm8="))
+ (should (equal (base64url-encode-string "fo" t) "Zm8"))
+ (should (equal (base64url-encode-string (fns-tests--string-repeat "fo" 50) t) (concat (fns-tests--string-repeat "Zm9mb2Zv" 16) "Zm9mbw")))
+ (should (equal (base64-decode-string "Zm8=") "fo"))
+ (should (equal (base64-decode-string "Zm8" t) "fo"))
+ (should (equal (base64-decode-string "Zm8=" t) "fo"))
+ (fns-tests--string-repeat "fo" 50)))
+@samp{o} (oblique), @samp{ri} (reverse italic), or @samp{ot} (other).
+@deffn Method project-update-version :AFTER ot
+The @code{:version} of the project @var{OT} has been updated.
+@deffn Method project-remove-file :AFTER ot fnnd
+Remove the current buffer from project target @var{OT}.
+@deffn Method project-delete-target :AFTER ot
+Delete the current target @var{OT} from its parent project.
+@deffn Method project-edit-file-target :AFTER ot
+Edit the target @var{OT} associated with this file.
+@deffn Method project-add-file :AFTER ot file
+Add the current buffer into project target @var{OT}.
+- (font (nil phetsarath\ ot unicode-bmp)))
+ "Remove the current buffer from project target OT.
+(cl-defmethod project-update-version ((ot ede-project))
+ "The :version of the project OT has been updated.
+ (error "project-update-version not supported by %s" (eieio-object-name ot)))
+ ;; no so ea we ne se nw sw up do in ot
+ ;; no so ea we ne se nw sw up do in ot
+ (define-key vhdl-template-map "ot" #'vhdl-template-others)
+ { 200, { "italic" ,"i", "ot" }},
+(cl-defmethod oclosure-interactive-form ((ot oclosure-test))
+ (let ((snd (oclosure-test--snd ot)))
+ (math-simplify-divisor): Only bind math-simplify-divisor-[nd]over
+ @result{} Nd
+ "s section[eg- emacs / p4-blame]:\nD source-dir: \nD output-dir: ")
+(define-key ctl-x-map "nd" 'narrow-to-defun)
+ (aref ["th" "st" "nd" "rd"] (% n 10))))
+ (let* ((nd date)
+ (setq nd (list (car date) (1+ (cadr date))
+ (setq nd (list (car date) (1- (cadr date))
+ (setq nd (calendar-gregorian-from-absolute ; date standardization
+ (calendar-absolute-from-gregorian nd)))
+ (list nd ut)))
+ (interactive "*P\nd")
+ (interactive "^p\nd")
+ (interactive "^p\nd\nd")
+ (if (string= "" nd)
+ (concat "\\`" (regexp-quote nd)))
+ (nd (file-name-nondirectory auto-save-list-file-prefix)))
+ ((= digit 2) "nd")
+ \"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \")
+ (interactive "D source directory: \nD output directory: ")
+(defun mailcap-parse-mailcap-extras (st nd)
+ (narrow-to-region st nd)
+ ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd")
+ '(Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd
+(xsdre-def-derived-category 'N '(union Nd Nl No))
+ "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
+p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence),
+;; - an ordinal suffix (st, nd, rd, th) for the year
+ - an ordinal suffix (st, nd, rd, th) for the year
+ '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?"
+ "\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>")
+ "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
+ (interactive "P\nd")
+ (interactive "*p\nd")
+ Right (tty) = tgetstr ("nd", address);
+ "c\nd\n")))
+ (insert "a\nb\nc\nd\ne\nf")
+ (insert "a\nb\nc\nd\ne")
+ (interactive "i\nd\nP")
+ * lisp/term.el (term-termcap-format): Fix a typo in the "ue="
+Urban Engberg (ue at cci.dk),
+ * quail/latin-post.el ("german-postfix"): Do not translate ue to
+ (define-key calc-mode-map "ue" 'calc-explain-units)
+ le ue pe)
+ (bindat--make :ue ,(bindat--toplevel 'unpack type)
+ Trivial patch from Urban Engberg <ue@ccieurope.com>.
+ ("Ć¼" "ue")
+ ("Ɯ" "Ue")
+;; AE -> Ƅ OE -> Ɩ UE -> Ɯ
+;; ae -> Ƥ oe -> ƶ ue -> Ć¼ ss -> Ɵ
+;; AEE -> AE OEE -> OE UEE -> UE
+;; aee -> ae oee -> oe uee -> ue sss -> ss"
+;; ("UE" ?Ɯ)
+;; ("ue" ?Ć¼)
+;; ("UEE" "UE")
+;; ("uee" "ue")
+ ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ɯ" "Ɯ")
+ ("uuml" "\\\"{u}" nil "&uuml;" "ue" "Ć¼" "Ć¼")
+:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
+ (("\"U" "\\\"U") . "Ue") ; "U,\"U -> Ue
+ (("\"u" "\\\"u") . "ue") ; "u,\"u -> ue
+/^#undef INTERNAL_TERMINAL *$/s,^.*$,#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display::co#80:li#25:Co#16:pa#256:km:ms:cm=<CM>:cl=<CL>:ce=<CE>::se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>::AB=<BG %d>:AF=<FG %d>:op=<DefC>:",
+ * s/msdos.h (INTERNAL_TERMINAL): Add capabilities se, so, us, ue,
+ tty->TS_exit_underline_mode = tgetstr ("ue", address);
+:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\
+ const char *TS_enter_underline_mode; /* "ue" -- end underlining. */
+ ((equal (aref (car lines) 0) "fpr")
+ (let* ((fpr (epg-sub-key-fingerprint subkey))
+ (candidates (epg-list-keys context fpr 'secret))
+ (error "Found %d secret keys with same fingerprint %s" candno fpr))
+ (fpr (epg-sub-key-fingerprint primary)))
+ (string-match-p (concat fingerprint "$") fpr)
+ (dolist (fpr signer-fprs nil)
+ fpr
+ (substring fpr -16 nil)))
+ (let ((fpr (if (eq protocol 'OpenPGP)
+ (should (string-match-p (concat "-r " fpr) match))))
+ time. The reverse is true in Ireland, where standard time "IST"
+(e.g., especially with l(ist) and k(ill)).
+;; <http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.6421&rep=rep1&type=pdf>
+ ;; <http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.6421&rep=rep1&type=pdf>.
+ ("ist" "Ä°stanbul, Turkey")
+ consistency (e.g., esp. with l(ist) and k(ill).
+ (?F "[l]ist; [v]isit folder;\n"
+ "[s]equences, [l]ist,\n"
+ "exec~ute" "exit" "get" "help" "ho~st" "[$]" "i~nput" "l~ist"
+ (calendar-standard-time-zone-name "IST")
+ "1972-07-01 05:29:59.999 +0530 (IST)"))
+ (let ((thi (if (math-lessp hi '(float -2 0))
+ (math-float lo) (math-float thi) 'inf)
+ lo thi)))
+Joakim Hove wrote @file{html2text.el}, a html to plain text converter.
+Hove, Denis Howe, Lars Ingebrigtsen, Andrew Innes, Seiichiro Inoue,
+ * html2text.el: New file from Joakim Hove <hove@phys.ntnu.no>.
+;; Author: Joakim Hove <hove@phys.ntnu.no>
+Damon Anton Permezel wrote @file{hanoi.el}, an animated demonstration of
+Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per
+;; Author: Damon Anton Permezel
+; Author (a) 1985, Damon Anton Permezel
+;; JAVE I preferred ecmascript-mode.
+;;JAVE break needs labels
+;JAVE this just instantiates a default empty ebrowse struct?
+JAVE: stub for needs-refresh, because, how do we know if BROWSE files
+;JAVE what it actually seems to do is split the original tree in "tables" associated with files
+ ;(semantic-fetch-tags) ;JAVE could this go here?
+JAVE this thing would need to be recursive to handle java and csharp"
+; (re-search-forward (concat "/\\*" indicator "\\*/")); JAVE this isn't generic enough for different languages
+ clen cidx)
+ (setq clen (length lao-consonant))
+ str (if (= clen 1)
+ * bidi.c (bidi_level_of_next_char): clen should be EMACS_NT, not int.
+ if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0)
+ if (! NILP (XCHAR_TABLE (table)->defalt))
+ Fcopy_sequence (XCHAR_TABLE (table)->defalt));
+make_sub_char_table (int depth, int min_char, Lisp_Object defalt)
+ XSUB_CHAR_TABLE (table)->contents[i] = defalt;
+ set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt);
+ val = tbl->defalt;
+ Lisp_Object defalt, bool is_uniprop, bool is_subtable)
+ defalt, is_uniprop);
+ val = defalt;
+ Lisp_Object defalt, bool is_uniprop)
+ defalt, is_uniprop, true);
+ defalt, is_uniprop, true);
+ tbl->defalt, is_uniprop, false);
+ tbl->defalt, is_uniprop, false);
+ val = XCHAR_TABLE (char_table)->defalt;
+ this = XCHAR_TABLE (top)->defalt;
+ ? (dp)->defalt \
+decode_env_path (const char *evarname, const char *defalt, bool empty)
+ path = ns_relocate (defalt);
+ path = defalt;
+ (name, defalt)
+ if (NILP (defalt))
+ CHECK_STRING (defalt);
+ if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
+ (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
+ The size counts the defalt, parent, purpose, ascii,
+ Lisp_Object defalt;
+ val = tbl->defalt;
+ counts the ordinary slots and the top, defalt, parent, and purpose
+verify (offsetof (struct Lisp_Char_Table, defalt) == header_size);
+ XCHAR_TABLE (table)->defalt = val;
+ string, and DEFALT is a string, read from DEFALT instead of VAL. */
+string_to_object (Lisp_Object val, Lisp_Object defalt)
+ if (STRINGP (defalt))
+ else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
+ Lisp_Object defalt)
+ val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
+ DEFALT specifies the default value for the sake of history commands.
+ Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt,
+ specbind (Qminibuffer_default, defalt);
+ val = read_minibuf_noninteractive (prompt, expflag, defalt);
+ else if (STRINGP (defalt))
+ else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
+ val = string_to_object (val, defalt);
+ Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
+ if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt))))
+ val = dp->defalt;
+ Lisp_Object name, defalt;
+ defalt = current_buffer->directory;
+ newdir = SDATA (defalt);
+ val = defalt;
+ val = XCAR (defalt);
+ histstring = defalt;
+ histstring = XCAR (defalt);
+ EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior
+ Change the implementation of `:initform` to better match the CLOS semantics,
+ (CLOS compatibility, Wish List): Adjust to new featureset.
+@cindex CLOS
+(@acronym{CLOS}), this support is based on @dfn{generic functions}.
+The Emacs generic functions closely follow @acronym{CLOS}, including
+use of similar names, so if you have experience with @acronym{CLOS},
+ * eieio.texi (Accessing Slots, CLOS compatibility): Adjust wording
+ (Method Invocation, CLOS compatibility):
+ * eieio.texi (Class Values, CLOS compatibility):
+ EIEIO and CLOS from 'Building Classes' to here.
+ (Class Values, CLOS compatibility): Mention that
+ * eieio.texi (top): Make clear that EIEIO is not a full CLOS
+to Emacs Lisp programmers. CLOS and Common Lisp streams are fine
+a subset of CLOS functionality. @xref{Top, , Introduction, eieio, EIEIO}.)
+The Common Lisp Object System (CLOS) is not implemented,
+CLOS functionality.
+bugs in @ede{}. A knowledge of Emacs Lisp, and some @eieio{}(CLOS) is
+@ede{} uses @eieio{}, the CLOS package for Emacs, to define two object
+concepts of the Common Lisp Object System (CLOS). It provides a
+* CLOS compatibility:: What are the differences?
+Lisp Object System (CLOS) and also differs from it in several aspects,
+on the other hand you are already familiar with CLOS, you should be
+aware that @eieio{} does not implement the full CLOS specification and
+@pxref{CLOS compatibility}).
+and methods using inheritance similar to CLOS.
+Method definitions similar to CLOS.
+Public and private classifications for slots (extensions to CLOS)
+Customization support in a class (extension to CLOS)
+Due to restrictions in the Emacs Lisp language, CLOS cannot be
+setf. Here are some important CLOS features that @eieio{} presently
+This CLOS method tag is non-functional.
+will use the list as a value. This is incompatible with CLOS (which would
+This option is in the CLOS spec, but is not fully compliant in @eieio{}.
+This option is specific to Emacs, and is not in the CLOS spec.
+what CLOS does when a monotonic class structure is defined.
+Unsupported CLOS option. Enables the use of a different base class other
+Unsupported CLOS option. Specifies a list of initargs to be used when
+@xref{CLOS compatibility}, for more details on CLOS tags versus
+The following accessors are defined by CLOS to reference or modify
+This is not a CLOS function. It is therefore
+of CLOS.
+objects. In CLOS, this would be named @code{STANDARD-CLASS}, and that
+This function takes arguments in a different order than in CLOS.
+In @var{clos}, the argument list is (@var{class} @var{object} @var{slot-name}), but
+@node CLOS compatibility
+@chapter CLOS compatibility
+CLOS.
+CLOS supports the @code{describe} command, but @eieio{} provides
+@eieio{} is an incomplete implementation of CLOS@. Finding ways to
+improve the compatibility would help make CLOS style programs run
+@c LocalWords: cb cdr charquote checkcache cindex CLOS
+System (CLOS). It is used by the other CEDET packages.
+CLOS class and slot documentation.
+ "Convert a list of CLOS class slot PARTLIST to `variable' tags."
+C++ and CLOS can define methods that are not in the body of a class
+Some languages such as C++ and CLOS permit the declaration of member
+the class. C++ and CLOS both permit methods of a class to be defined
+;; Standard CLOS name.
+This may prevent classes from CLOS applications from being used with EIEIO
+since EIEIO does not support all CLOS tags.")
+ ;; not by CLOS and is mildly inconsistent with the :initform thingy, so
+ ;; (but not CLOS) but is a bad idea (for one: it's slower).
+ "Abstractly modify a CLOS object."
+ "Instance of a CLOS class."
+;; CLOS, the Common Lisp Object System. In addition, EIEIO also adds
+The following are extensions on CLOS:
+Options in CLOS not supported in EIEIO:
+ ;; test, so we can let typep have the CLOS documented behavior
+;;; Handy CLOS macros
+;; CLOS name, maybe?
+The CLOS function `class-direct-superclasses' is aliased to this function."
+The CLOS function `class-direct-subclasses' is aliased to this function."
+;; Official CLOS functions.
+;;; CLOS queries into classes and slots
+;; FIXME: CLOS uses "&rest INITARGS" instead.
+In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
+;;; Unimplemented functions from CLOS
+ ;; CLOS and EIEIO
+ ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
+ ;; EIEIO's :initform is not 100% compatible with CLOS in
+;; Also test behavior of `call-next-method'. From clos.org:
+ ;; CLOS form of make-instance
+ (interactive "p\nd\nd")
+ (interactive "p\nd")
+ (let (st nd pt)
+ (setq nd (match-beginning 0)
+ pt nd)
+ (setq nd (match-beginning 0)
+ (setq nd (match-beginning 0))))
+ (setq nd (match-beginning 0)))
+ (or st nd))))
+ (narrow-to-region (or st (point-min)) (or nd (point-max)))
+ (when nd
+ (goto-char nd)
+ (fortran-blink-match "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b"
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
+ (make-directory nd t)
+ (speedbar-goto-this-file nd)
+ (let ((nd (file-name-nondirectory file)))
+ (concat "] \\(" (regexp-quote nd)
+:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
+(defun url-http-content-length-after-change-function (_st nd _length)
+ (funcall byte-count-to-string-function (- nd url-http-end-of-headers))
+ (url-percentage (- nd url-http-end-of-headers)
+ (funcall byte-count-to-string-function (- nd url-http-end-of-headers))
+ (url-percentage (- nd url-http-end-of-headers)
+ (if (> (- nd url-http-end-of-headers) url-http-content-length)
+(defun url-http-chunked-encoding-after-change-function (st nd length)
+ url-http-chunked-counter st nd length)
+ (if (> nd (+ url-http-chunked-start url-http-chunked-length))
+ nd))
+(defun url-http-wait-for-headers-change-function (_st nd _length)
+ (setq nd (- nd (url-http-clean-headers)))))
+ (when (> nd url-http-end-of-headers)
+ (marker-position url-http-end-of-headers) nd
+ (- nd url-http-end-of-headers))))
+ ((> nd url-http-end-of-headers)
+ nd
+ (- nd url-http-end-of-headers)))
+ Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
+ const char *cm_right; /* right (nd) */
+ (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
+ (insert "a\nb\nc\nd\n")
+ (insert "a\nb\nc\nd\n")
+ (should (string= (buffer-string) "Abc\nd efg\n(h ijk)."))))
+ (nd (read-directory-name "Create directory: "
+DESCRIPTION:In this meeting\\, we will cover topics from product and enginee
+@item @samp{.crate} ---
+@cindex @file{crate} file archive suffix
+@cindex file archive suffix @file{crate}
+;; * ".crate" - Cargo (Rust) packages
+ "crate" ;; Cargo (Rust) packages. Not in libarchive testsuite.
+ ;; RFC5546 refers to uninvited attendees as "party crashers".
+That includes both spelling (e.g., "behavior", not "behaviour") and
+ * doc/lispref/control.texi (Signalling Errors)
+Re "behavior" vs "behaviour", etc.
++ [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08)
++ [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14)
++ [[https://protesilaos.com/codelog/2021-01-11-modus-themes-review-select-faint-colours/][Modus themes: review of select "faint" colours]] (2021-01-11)
++ [[https://protesilaos.com/codelog/2022-01-02-review-modus-themes-org-habit-colours/][Modus themes: review of the org-habit graph colours]] (2022-01-02)
++ [[https://protesilaos.com/codelog/2022-04-20-modus-themes-case-study-avy/][Modus themes: case study on Avy faces and colour combinations]] (2022-04-20)
++ [[https://protesilaos.com/codelog/2022-04-21-modus-themes-colour-theory/][Emacs: colour theory and techniques used in the Modus themes]] (2022-04-21)
+ * :- initialise
+ * :- finalise
+ "initialise", "finalise", "mutable", "module", "interface", "implementation",
+;;; ( A cancelled ) Ignore this cache entry;
+ (.DEFAULT): Use $(FLAVOUR) instead of $@ for clarity.
+1998-04-26 Justin Sheehy <justin@linus.mitre.org>
+1997-10-25 David S. Goldberg <dsg@linus.mitre.org>
+;; Updated by the RIPE Network Coordination Centre.
+;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
+ (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
+"all" "analyse" "analyze" "and" "array" "asc" "as" "asymmetric"
+ \"VHDL Modelling Guidelines\".
+ {WSAECANCELLED , "Operation cancelled"}, /* not sure */
+ {WSA_E_CANCELLED , "Operation already cancelled"}, /* really not sure */
+ 2013-09-26 dup2, dup3: work around another cygwin crasher
+ cc3ad9a ; * CONTRIBUTE: Clarify rules for committing to release branc...
+Paul Raines (raines at slack.stanford.edu),
+ \qquad date: b)efore, a)t, n)this,\\*
+place an (I)nstall flag on the available version and a (D)elete flag
+ Improved verbiage of prompt. Aliases are now inserted "[b]efore"
+ or "[a]fter" the existing alias instead of "[i]nsert" or
+ "[b]efore or [a]fter: ")
+ (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
+ (mark_image): Move from allo.c.
+Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked?
+ (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
+ (org-time-string-to-time te)
+ (te (org-time-string-to-seconds se))
+ (dt (- (if tend (min te tend) te)
+ te (match-string 3))
+ (setq s (- (org-time-string-to-seconds te)
+ ("te" :babel-ini-only "telugu" :polyglossia "telugu" :lang-name "Telugu")
+2016-09-10 Toke HĆøiland-JĆørgensen <toke@toke.dk> (tiny change)
+ Reported by Toke HĆøiland-JĆørgensen <toke@toke.dk>.
+2012-07-17 Toke HĆøiland-JĆørgensen <toke@toke.dk> (tiny change)
+2012-06-17 Toke HĆøiland-JĆørgensen <toke@toke.dk> (tiny change)
+(doctor-put-meaning toke 'toke)
+ "\\|" ; per toke.c
+ const struct sockaddr *to, int tolen);
+2014-11-26 Toke HĆøiland-JĆørgensen <toke@toke.dk> (tiny change)
+ ptrdiff_t tolen = strlen (key_symbols[i].to);
+ eassert (tolen <= fromlen);
+ memcpy (match, key_symbols[i].to, tolen);
+ memmove (match + tolen, match + fromlen,
+ len -= fromlen - tolen;
+ p = match + tolen;
+ const struct sockaddr * to, int tolen);
+ const struct sockaddr * to, int tolen)
+ int rc = pfn_sendto (SOCK_HANDLE (s), buf, len, flags, to, tolen);
+Put dialogue in buffer."
+ "Function called by ], the ket. View registers and call ]]."
+;; Matches a char which is a constituent of a variable or number, or a ket
+(defun verilog-expand-vector-internal (bra ket)
+ "Given start brace BRA, and end brace KET, expand one line into many lines."
+ (regexp-quote ket)
+ (int-to-string (car vec)) ket sig-tail "\n"))
+ m | mo | mot | moti | motif ) val=motif ;;
+ i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;;
+2001-04-23 Kahlil Hodgson <kahlil@discus.anu.edu.au>
+ (funcall expect 20 "ingenuous")))))
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us."))
+ (search-forward "return te")
+ "fn test() -> i32 { let test=3; return te; }"))))
+ ts te h m s neg)
+ te (match-string 3))
+ (setq s (- (org-time-string-to-seconds te)
+ Rename from whitespace-skipping-for-quotes-not-ouside.
+ (whitespace-skipping-for-quotes-not-ouside)
+Thread-Modell: posix
+(ert-deftest indent-sexp-cant-go ()
+(ert-deftest thunk-let-bound-vars-cant-be-set-test ()
+ (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org")))
+ (let ((p-e-fprs (mml-secure-cust-fpr-lookup
+ (p-s-fprs (mml-secure-cust-fpr-lookup
+ (let ((s-e-fprs (mml-secure-cust-fpr-lookup
+ (s-s-fprs (mml-secure-cust-fpr-lookup
+(ert-deftest doesnt-time-out ()
+(ert-deftest json-el-cant-serialize-this ()
+ (should (equal (try-completion "B-hel" subvtable)
+ (should (equal (all-completions "B-hel" subvtable) '("-hello")))
+ (should (equal (completion-boundaries "B-hel" subvtable
+(ert-deftest ruby-regexp-doesnt-start-in-string ()
+ Rename from wisent-inaccessable-symbols, fixing a misspelling.
+ ("calc-math" calcFunc-alog calcFunc-arccos
+ ( ?B 2 calcFunc-alog )
+ (change-log-function-face, change-log-acknowledgement-face):
+ (bs-appearance) <defgroup>: Renamed from bs-appearence.
+ typo `fortran-strip-sqeuence-nos'.
+ * progmodes/fortran.el (fortran-strip-sqeuence-nos): Doc fix.
+ (fortran-strip-sqeuence-nos): Make arg optional. Fix regexp and
+1999-06-01 Jae-youn Chung <jay@compiler.kaist.ac.kr>
+doc/emacs/docstyle.texi:14: fied ==> field
+(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1")
+(define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1")
+(define-obsolete-function-alias 'hfy-colour #'hfy-color "27.1")
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilities
+ setenv ("TZ", "IST-02IDT-03,M4.1.6/00:00,M9.5.6/01:00", 0);
+ "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
+ (internal--after-with-selected-window): Fix typo seleted->selected.
+ * subr.el (internal--before-with-seleted-window)
+ (internal--after-with-seleted-window): New functions.
+ * follow.el (follow-inactive-menu): Rename from follow-deactive-menu.
+ * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((Ī» ...) ...).
+ (feedmail-sendmail-f-doesnt-sell-me-out)
+ Respect feedmail-sendmail-f-doesnt-sell-me-out.
+ * terminal.el (te-get-char, te-tic-sentinel):
+from server-external-socket-initialised, since it should be
+ * lisp/server.el: (server-external-socket-initialised): New
+ Rename from help-fns--analyse-function.
+ c-ambiguous-overloadable-or-identifier-prefices. Caller changed.
+ * lisp/progmodes/cc-langs.el (c-ambiguous-overloadable-or-identifier-prefices)
+ Rename from nndiary-last-occurence.
+ Rename from nndiary-next-occurence. All uses changed.
+ lisp/textmodes/flyspell.el (flyspell-ajust-cursor-point): Rename to
+ * test/file-organization.org: Rename from test/file-organisation.org.
+ character class (namely ā€˜foā€™ leaving ā€˜oā€™ in the string), but since the
+ change-log-acknowledgement-face):
+ 9daf1cf * etc/NEWS: Improve wording of vc-git-log-output-coding-syste...
+ a05fb21 * lisp/emacs-lisp/package.el (package-install-selected-packag...
+ 5cc6919 Fix a caching bug, which led to inordinately slow c-beginnin...
+ (mml-secure-cust-usage-lookup, mml-secure-cust-fpr-lookup)
+ * test/file-organisation.org: New file.
+ ("test/file-organisation.org" . "file-organization.org")
+ `message-insert-formated-citation-line'.
+ info.addons = (\"hald-addon-acpi\")
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ (org-detach-overlay): Rename from `org-detatch-overlay'.
+ (change-log-acknowledgement): Remove "-face" suffix from face names.
+ (appt-visible): Rename from appt-visable.
+ (pascal-seperator-keywords): Renamed to pascal-separator-keywords.
+ mouse-union-first-prefered.
+ * sc.el (sc-consistent-cite-p): Renamed from sc-consistant-cite-p.
+ bibtex-name-alignement.
+ "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
+ (erc-coding-sytem-for-target): Removed.
+ (erc-coding-sytem-for-target): New.
+Paul Raines (raines at slac.stanford.edu),
+ "union" "unsafe" "use" "where" "while" (crate) (self) (super)
+ term-ansi-face-alredy-done.
+ (ebnf-syntactic): Change group name and tag from "ebnf-syntatic".
+ "ebnf-syntatic".
+ Rename from ucs-input-inactivate.
+ Rename from hangul-input-method-inactivate.
+ * terminal.el (te-create-terminfo): Use make-temp-file
+ (org-detatch-overlay, org-move-overlay, org-overlay-put):
+ 'gnus-score-find-favourite-words
+ 'nndiary-last-occurence
+ 'nndiary-next-occurence
+(define-obsolete-function-alias 'org-truely-invisible-p
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
+ ("`fo" . "format" )
+(define-obsolete-function-alias 'rtree-normalise-range
+ `org-attch-delete'. Add a security query before deleting the
+ `org-toggel-region-headings'.
+ "3 Oktober 2000 16:30 multiline
+ "September" "Oktober" "November" "Dezember"])
+ "de la CognƩe" "de l'EllƩbore" "du Brocoli"
+ 1fe596d89f (origin/emacs-27) Fix another compilation problem in a bui...
+ "du Buis" "du Lichen" "de l'If"
+ if (c == BIG) { /* caint get thar from here */
+ Christoph Groth <cwg@falma.de> and Liu Xin <x_liu@neusoft.com>.
+ "passord" ; nb
+ (should (equal (rfc6068-unhexify-string "caf%C3%A9") "cafƩ")))
+ (equal (rfc6068-parse-mailto-url "mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9")
+;; Paul Lew <paullew@cisco.com> suggested implementing fixed width
+ (TUNG@WAIF.MIT.EDU <8704130324.AA10879@prep.ai.mit.edu>)
+ (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
+(doctor-put-meaning cunt 'sexnoun)
+(doctor-put-meaning cunts 'sexnoun)
+(doctor-put-meaning skool 'school)
+ Add ".crate" to Tramp archive file suffixes.
+ * lisp/net/tramp-archive.el (tramp-archive-suffixes): Add ".crate".
+2021-11-10 Benj <Benjamin.Schwerdtner@gmail.com> (tiny change)
+ allow party crashers to respond to ical events
+ calling those respondents "party crashers".
+2019-12-17 Antoine Kalmbach <ane@iki.fi> (tiny change)
+2014-02-18 Matus Goljer <dota.keys@gmail.com>
+2014-02-13 Matus Goljer <dota.keys@gmail.com>
+2004-05-20 Magnus Henoch <mange@freemail.hu>
+2004-11-14 Magnus Henoch <mange@freemail.hu>
+2006-10-16 Magnus Henoch <mange@freemail.hu>
+2006-11-01 Magnus Henoch <mange@freemail.hu>
+2006-11-08 Magnus Henoch <mange@freemail.hu>
+2006-11-15 Magnus Henoch <mange@freemail.hu>
+2006-11-26 Magnus Henoch <mange@freemail.hu>
+2006-12-08 Magnus Henoch <mange@freemail.hu>
+2007-01-14 Magnus Henoch <mange@freemail.hu>
+2007-10-28 Magnus Henoch <mange@freemail.hu>
+2007-12-03 Magnus Henoch <mange@freemail.hu>
+2008-02-04 Magnus Henoch <mange@freemail.hu>
+2008-03-09 Magnus Henoch <mange@freemail.hu>
+2008-09-30 Magnus Henoch <mange@freemail.hu>
+ (secnd (cdr (cadr dlist))))
+ (car secnd))) ; fetch_date
+ secnd (cdr secnd))
+ (car secnd))) ; Keep_flag
+ (car secnd))) ; NOV_entry_position
+@c LocalWords: DesBrisay Dcc devel dir dired docstring filll forw
+Older versions of the themes provided options ~grayscale~ (or ~greyscale~)
+ > The requestor should delete [...] the property specified in the
+ We are not the requestor, so we should not be deleting this property
+ needs to remain available as the requestor will generally want to read
+ [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
+ (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
+;; -grey Render in greyscale as 8bits/pixel.
+ -grey Render in greyscale as 8bits/pixel.
+ (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)")
+ "\\=p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\>[^_]" nil t)
+ "\\(p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|more\\)\\>"
+ * sysdep.c (WRITABLE): Renamed from WRITEABLE.
+DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
+ defsubr (&Scond);
+ /* XXX: who is wrong, the requestor or the implementation? */
+ /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
+ /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
+ (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Good gentleman, go your gait, and let poor volk pass. An chud ha' bin zwaggered out of my life, 'twould not ha' bin zo long as 'tis by a vortnight. Nay, come not near th' old man; keep out, che vor ye, or ise try whether your costard or my ballow be the harder. Chill be plain with you.")
+ db "create table if not exists test10 (col1 text, col2 blob, col3 numbre)")
+ (const :format "[%v] %t\n" :tag "Alias for `gray-background'" greyscale)
+2008-09-11 Magnus Henoch <mange@freemail.hu>
+ <mange@freemail.hu>.
+2006-10-07 Magnus Henoch <mange@freemail.hu>
+2006-09-07 Magnus Henoch <mange@freemail.hu>
+ Reported by Magnus Henoch <mange@freemail.hu>.
+2005-09-24 Magnus Henoch <mange@freemail.hu>
+2005-09-17 Magnus Henoch <mange@freemail.hu>
+2005-09-10 Magnus Henoch <mange@freemail.hu>
+2005-08-09 Magnus Henoch <mange@freemail.hu>
+2008-10-16 Magnus Henoch <mange@freemail.hu>
+2008-10-01 Magnus Henoch <mange@freemail.hu>
+2008-07-02 Magnus Henoch <mange@freemail.hu>
+2008-04-23 Magnus Henoch <mange@freemail.hu>
+2008-03-28 Magnus Henoch <mange@freemail.hu>
+ * bibtex.el (bibtex-entry): Add OPTkey/annote. If OPTcrossref set
+;; :booktitle :month :annote :abstract
+ (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
+ :annote (or (cdr (assoc "annote" entry)) "[no annotation]")
+ '(("annote" "Personal annotation (ignored)"))
+ (r2b-put-field "annote" r2bv-annote)
+2006-10-29 Magnus Henoch <mange@freemail.hu>
+2006-10-28 Magnus Henoch <mange@freemail.hu>
+2006-10-27 Magnus Henoch <mange@freemail.hu>
+2006-10-12 Magnus Henoch <mange@freemail.hu>
+2006-10-11 Magnus Henoch <mange@freemail.hu>
+2006-10-09 Magnus Henoch <mange@freemail.hu>
+2007-12-31 Magnus Henoch <mange@freemail.hu>
+2007-12-05 Magnus Henoch <mange@freemail.hu>
+ (ENUMABLE): Remove; no longer needed.
+ * lisp.h (ENUMABLE) [!_AIX]: Don't define to 0 merely because we're
+ * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros.
+ * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): Delete macros.
+2023-06-29 Andrew G Cohen <cohen@andy.bu.edu>
+2023-05-07 Andrew G Cohen <cohen@andy.bu.edu>
+ C-x b fo
+ avoid failures due to MS-Windows "numeric tails" (mis)feature and
+2022-04-07 Andrew G Cohen <cohen@andy.bu.edu>
+2022-04-03 Andrew G Cohen <cohen@andy.bu.edu>
+2022-03-22 Andrew G Cohen <cohen@andy.bu.edu>
+2022-03-20 Andrew G Cohen <cohen@andy.bu.edu>
+2022-03-17 Andrew G Cohen <cohen@andy.bu.edu>
+2022-03-04 Andrew G Cohen <cohen@andy.bu.edu>
+2022-02-18 Andrew G Cohen <cohen@andy.bu.edu>
+2022-02-11 Andrew G Cohen <cohen@andy.bu.edu>
+2022-02-08 Andrew G Cohen <cohen@andy.bu.edu>
+2022-02-03 Andrew G Cohen <cohen@andy.bu.edu>
+2021-12-21 Andrew G Cohen <cohen@andy.bu.edu>
+2021-12-18 Andrew G Cohen <cohen@andy.bu.edu>
+ 6d5886e780 * test/lisp/repeat-tests.el (repeat-tests-call-b): Test fo...
+ 0771d8939a * etc/PROBLEMS: Mention problems with regexp matcher. (Bu...
+ 59df93e2dd * lisp/help.el (help--analyze-key): Add new arg BUFFER (bu...
+ 3832b983cf In Fdelete_other_windows_internal fix new total window siz...
+ 3a9d5f04fb Mention ffap-file-name-with-spaces in the ffap doc strin
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+@item Unform
+J. Otto Tennant,
+extern struct servent *hes_getservbyname (/* char *, char * */);
+ struct servent *servent;
+ servent = hes_getservbyname (service, "tcp");
+ if (servent)
+ servent = getservbyname (service, "tcp");
+ struct servent *srv = getservbyname (service, protocol);
+2003-04-10 Sebastian Tennant <seb@albert.vcisp.net> (tiny change)
+ Reported by Sebastian Tennant <sebyte@smolny.plus.com>.
+ causing truncation of AUTOWIRE signals. Reported by Bruce Tennant.
+ Tennant.
+1997-10-21 Jens Lautenbacher <jens@metrix.de>
+ unform Use unformatted display: add(a, mul(b,c)).
+ (memq calc-language '(nil flat unform))
+ (memq calc-language '(nil flat unform)))
+ '(flat big unform))))
+;; Sebastian Tennant <sebyte@smolny.plus.com>
+ (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (vai #xA500)
+ (vai\ . vai)
+ ts te h m s neg)
+ te (match-string 3))
+ (setq s (- (org-time-string-to-seconds te)
+(defun dun-listify-string (strin)
+ (while (setq end-pos (string-match "[ ,:;]" (substring strin pos)))
+ (substring strin pos end-pos))))))
+(defun dun-listify-string2 (strin)
+ (while (setq end-pos (string-search " " (substring strin pos)))
+"any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit"
+ "attribute" "(d)eclaration or (s)pecification?" t) ?s)
+ "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
+ "Spacify table frame.
+ ("\\oint" . ?āˆ®)
+struct servent * sys_getservbyname (const char * name, const char * proto);
+ Supplement, Latin Extended-A/B, Vai, Supplemental Punctuation, Tai
+ Remove the "mis;tak-+;;" line from the code; apparently this
+ it->dpvec_char_len if dpend reached.
+ 3:000MSTRIN[0]STRIN[1]STRIN[2]
+ [2:000MSTRIN[0]STRIN[1]STRIN[2]]
+ Lisp_Object *dpvec, *dpend;
+ struct servent *svc_info
+struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto);
+struct servent *
+ struct servent * serv;
+ struct servent *srv = sys_getservbyname (service, protocol);
+ /* Reset bits 4 (Phonetic), 12 (Vai), 14 (Nko), 27 (Balinese). */
+ DEFSYM (Qvai, "vai");
+ it->dpend = v->contents + v->header.size;
+ it->dpend = default_invis_vector + 3;
+ it->dpend = v->contents + v->header.size;
+ it->dpend = it->dpvec + ctl_len;
+ if (it->dpvec + it->current.dpvec_index >= it->dpend)
+ if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */
+ if (it->current.dpvec_index < it->dpend - it->dpvec - 1)
+ && it->dpvec + it->current.dpvec_index + 1 >= it->dpend)))
+ && it->dpvec + it->current.dpvec_index != it->dpend);
+VERY VERY LONG STRIN | VERY VERY LONG STRIN
+ (ert-info ("Joined by bouncer to #foo, pal persent")
+ (ert-info ("Joined by bouncer to #chan@foonet, pal persent")
+ (ert-info ("Joined by bouncer to #chan@barnet, pal persent")
+.UE .
+ (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.")
+ (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.")
diff --git a/admin/codespell/codespell.ignore b/admin/codespell/codespell.ignore
new file mode 100644
index 00000000000..34de02e969b
--- /dev/null
+++ b/admin/codespell/codespell.ignore
@@ -0,0 +1,41 @@
+acknowledgements
+afile
+ake
+analogue
+ans
+bloc
+blocs
+callint
+clen
+crossreference
+crossreferences
+debbugs
+dedented
+dependant
+doas
+ede
+grey
+gud
+ifset
+inout
+keypair
+keyserver
+keyservers
+lightening
+mapp
+master
+mimicks
+mitre
+msdos
+ot
+parm
+parms
+reenable
+reenabled
+requestor
+sie
+spawnve
+statics
+stdio
+texline
+typdef
diff --git a/admin/codespell/codespell.rc b/admin/codespell/codespell.rc
new file mode 100644
index 00000000000..9ef5f40369c
--- /dev/null
+++ b/admin/codespell/codespell.rc
@@ -0,0 +1,4 @@
+[codespell]
+skip=.git/*,*.elc,*.eln,*.gpg,*.gz,*.icns,*.jpg,*.kbx,*.key,*.pbm,*.png,*.rnc,*.so,*.tiff,*.tit,*.xml,*.xpm,*.zip,*random_seed
+builtin=clear,rare,en-GB_to_en-US
+quiet-level=35
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 37ff4a7e9c5..10d6e34358d 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -146,7 +146,7 @@ Names should be as they appear in loaddefs.el.")
(defvar cus-test-errors nil
"List of problematic variables found by `cus-test-apropos'.
-Each element is (VARIABLE . PROBLEM); see `cus-test--format-problem'.")
+Each element is (VARIABLE . PROBLEM); see `cus-test--format-error'.")
(defvar cus-test-tested-variables nil
"List of options tested by last call of `cus-test-apropos'.")
@@ -424,7 +424,12 @@ in the Emacs source directory."
(mapatoms
;; This code is mainly from `custom-load-symbol'.
(lambda (symbol)
- (let ((custom-load-recursion t))
+ (let ((custom-load-recursion t)
+ (load-path
+ (cons
+ (expand-file-name
+ "quail" (file-name-directory (locate-library leim-list-file-name)))
+ load-path)))
(dolist (load (get symbol 'custom-loads))
(cond
((symbolp load)
diff --git a/admin/git-bisect-start b/admin/git-bisect-start
index 069f66515ba..f9933b3ae4d 100755
--- a/admin/git-bisect-start
+++ b/admin/git-bisect-start
@@ -84,7 +84,7 @@ done
# SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100
## The list below is the exhaustive list of all commits between Dec 1
-## 2016 and Oct 2 2023 on which building Emacs with the default
+## 2016 and Jan 13 2024 on which building Emacs with the default
## options, on a GNU/Linux computer and with GCC, fails. It is
## possible (though unlikely) that building Emacs with non-default
## options, with other compilers, or on other platforms, would succeed
@@ -1788,3 +1788,9 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE ' | sed 's/^# SKIP-SINGLE
# SKIP-SINGLE f7fd21b06865d20a16c11e20776e843db24d4b14
# SKIP-SINGLE 35fbf6f15830f576fd1909f4a8d30e7ba1d777bd
# SKIP-SINGLE 0e44ab5f061c81874dd8298a0f3318f14ef95a24
+# SKIP-SINGLE 4675aff76828b0747d1ac900d65d4a92a457ebf5
+# SKIP-SINGLE bf4d4ab4ddecffbee6d740f9c271dcca514d6a3d
+# SKIP-SINGLE 2a8e6c8c84ed33674e525625644d5ce84ee8c59a
+# SKIP-SINGLE fa5f06c1251ff717d661f05fcd240b4792054aae
+# SKIP-SINGLE d3cefd3e98354929d96c9396e5920e8a123784dc
+# SKIP-SINGLE 486094126ba77e45c50acb87f5ad3e4147608446
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index 7c815c729e5..32d5c3c1bea 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -111,10 +111,10 @@ If nil, the function `gitmerge-default-branch' guesses.")
(defvar gitmerge-mode-font-lock-keywords
`((,gitmerge-log-regexp
- (1 font-lock-warning-face)
- (2 font-lock-constant-face)
- (3 font-lock-builtin-face)
- (4 font-lock-comment-face))))
+ (1 'font-lock-warning-face)
+ (2 'font-lock-constant-face)
+ (3 'font-lock-builtin-face)
+ (4 'font-lock-comment-face))))
(defvar gitmerge--commits nil)
(defvar gitmerge--from nil)
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 6378a5f9a22..41531d573b0 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -52,8 +52,8 @@ GNULIB_MODULES='
'
AVOIDED_MODULES='
- btowc chmod close crypto/af_alg dup fchdir fstat
- iswblank iswctype iswdigit iswxdigit langinfo lock
+ access btowc chmod close crypto/af_alg dup fchdir fstat
+ iswblank iswctype iswdigit iswxdigit langinfo localename-unsafe-limited lock
mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo
openat-die opendir pthread-h raise
save-cwd select setenv sigprocmask stat stdarg
@@ -107,9 +107,6 @@ test -x "$gnulib_srcdir"/gnulib-tool || {
# gnulib-tool has problems with a bare checkout (Bug#32452#65).
test -f configure || ./autogen.sh || exit
-# Old caches can confuse autoconf when some Gnulib-related changes take effect.
-rm -fr autom4te.cache || exit
-
avoided_flags=
for module in $AVOIDED_MODULES; do
avoided_flags="$avoided_flags --avoid=$module"
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index b47061884d6..419d91ae854 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -430,8 +430,8 @@ reassign 123 spam
*** To change the title of a bug:
retitle 123 Some New Title
-*** To change the submitter address:
-submitter 123 none@example.com
+*** To change the submitter name and address:
+submitter 123 J. Hacker <none@example.com>
Note that it does not seem to work to specify "Submitter:" in the
pseudo-header when first reporting a bug.
diff --git a/admin/notes/java b/admin/notes/java
index 891096cd406..e10f09f780f 100644
--- a/admin/notes/java
+++ b/admin/notes/java
@@ -445,7 +445,7 @@ loaded by the special invocation:
where ``static'' defines a section of code which will be run upon the
object (containing class) being loaded. This is like:
- __attribute__((constructor))
+ __attribute__ ((constructor))
on systems where shared object constructors are supported.
diff --git a/admin/notes/kind-communication b/admin/notes/kind-communication
new file mode 100644
index 00000000000..80b2afb27b2
--- /dev/null
+++ b/admin/notes/kind-communication
@@ -0,0 +1,21 @@
+The GNU Project encourages contributions from anyone who wishes to
+advance the development of the GNU system, regardless of gender, race,
+ethnic group, physical appearance, religion, cultural background, and
+any other demographic characteristics, as well as personal political
+views.
+
+People are sometimes discouraged from participating in GNU development
+because of certain patterns of communication that strike them as
+unfriendly, unwelcoming, rejecting, or harsh. This discouragement
+particularly affects members of disprivileged demographics, but it is
+not limited to them. Therefore, we ask all contributors to make a
+conscious effort, in GNU Project discussions, to communicate in ways
+that avoid that outcome ā€” to avoid practices that will predictably and
+unnecessarily risk putting some contributors off.
+
+The GNU Kind Communications Guidelines suggest specific ways to
+accomplish that goal. You can find the latest version at
+https://www.gnu.org/philosophy/kind-communication.html
+
+When sending messages to Emacs mailing lists, we ask you to read and
+respect these guidelines.
diff --git a/admin/notes/tree-sitter/build-module/batch.sh b/admin/notes/tree-sitter/build-module/batch.sh
index 9988d1eae4e..012b5882e83 100755
--- a/admin/notes/tree-sitter/build-module/batch.sh
+++ b/admin/notes/tree-sitter/build-module/batch.sh
@@ -18,6 +18,7 @@ languages=(
'json'
'lua'
'python'
+ 'ruby'
'rust'
'toml'
'tsx'
diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh
index 969187b7f92..9a567bb094d 100755
--- a/admin/notes/tree-sitter/build-module/build.sh
+++ b/admin/notes/tree-sitter/build-module/build.sh
@@ -43,7 +43,7 @@ case "${lang}" in
org="phoenixframework"
;;
"lua")
- org="MunifTanjim"
+ org="tree-sitter-grammars"
;;
"typescript")
sourcedir="tree-sitter-typescript/typescript/src"
diff --git a/admin/run-codespell b/admin/run-codespell
new file mode 100755
index 00000000000..991b72073b2
--- /dev/null
+++ b/admin/run-codespell
@@ -0,0 +1,68 @@
+#!/bin/bash
+### run-codespell - run codespell on Emacs
+
+## Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+## Author: Stefan Kangas <stefankangas@gmail.com>
+
+## This file is part of GNU Emacs.
+
+## GNU Emacs is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+
+## GNU Emacs is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+
+## You should have received a copy of the GNU General Public License
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+### Commentary:
+
+## Run codespell on the Emacs source tree.
+##
+## codespell 2.2.2 or later is recommended. Earlier versions had a
+## bug where the line count was incorrect for files containing "^L"
+## characters.
+
+source "${0%/*}/emacs-shell-lib"
+
+CODESPELL_DIR="${PD}/codespell"
+
+CODESPELL_RC="${CODESPELL_DIR}/codespell.rc"
+CODESPELL_EXCLUDE="${CODESPELL_DIR}/codespell.exclude"
+CODESPELL_IGNORE="${CODESPELL_DIR}/codespell.ignore"
+CODESPELL_DICTIONARY="${CODESPELL_DIR}/codespell.dictionary"
+
+emacs_run_codespell ()
+{
+ git ls-files |\
+ grep -v -E -e '^(lib|m4)/.*' |\
+ grep -v -E -e '^admin/(charsets|codespell|unidata)/.*' |\
+ grep -v -E -e '^doc/misc/texinfo.tex$' |\
+ grep -v -E -e '^etc/(AUTHORS|HELLO|publicsuffix.txt)$' |\
+ grep -v -E -e '^etc/refcards/(cs|de|fr|pl|pt|sk)-.+.tex$' |\
+ grep -v -E -e '^etc/tutorials/TUTORIAL\..+' |\
+ grep -v -E -e '^leim/(MISC|SKK)-DIC/.*' |\
+ grep -v -E -e '^lisp/language/ethio-util.el' |\
+ grep -v -E -e '^lisp/ldefs-boot.el' |\
+ grep -v -E -e '^lisp/leim/.*' |\
+ grep -v -E -e '^test/lisp/net/puny-resources/IdnaTestV2.txt' |\
+ grep -v -E -e '^test/manual/(etags|indent)/.*' |\
+ grep -v -E -e '^test/src/regex-resources/.*' |\
+ xargs codespell \
+ --config "$CODESPELL_RC" \
+ --exclude-file "$CODESPELL_EXCLUDE" \
+ --ignore-words "$CODESPELL_IGNORE" \
+ --disable-colors \
+ --write-changes \
+ $@
+}
+
+emacs_run_codespell
+emacs_run_codespell --dictionary "$CODESPELL_DICTIONARY"
+
+exit 0
diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el
new file mode 100644
index 00000000000..bfbbbc45aa4
--- /dev/null
+++ b/admin/syncdoc-type-hierarchy.el
@@ -0,0 +1,133 @@
+;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <acorallo@gnu.org>
+;; Keywords: documentation
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file is used to keep the type hierarchy representation present
+;; in the elisp manual in sync with the current type hierarchy. This
+;; is specified in `cl--direct-supertypes-of-type' in cl-preloaded.el, so each
+;; time `cl--direct-supertypes-of-type' is modified
+;; `syncdoc-update-type-hierarchy' must be run before the
+;; documentation is regenerated.
+
+;; We do not call this directly from make docs in order not to add a
+;; dependency on the tool "dot".
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defconst syncdoc-file (or (macroexp-file-name) buffer-file-name))
+
+(defconst syncdoc-emacs-repo-dir
+ (expand-file-name "../" (file-name-directory syncdoc-file)))
+
+(defconst syncdoc-lispref-dir
+ (expand-file-name "doc/lispref/" syncdoc-emacs-repo-dir))
+
+(defconst syncdoc-all-types
+ (let (res)
+ (mapatoms (lambda (type)
+ (when (cl-find-class type)
+ (push type res)))
+ obarray)
+ (nreverse
+ (merge-ordered-lists
+ (sort
+ (mapcar (lambda (type) (cl--class-allparents (cl-find-class type)))
+ res)
+ (lambda (ts1 ts2) (> (length ts1) (length ts2)))))))
+ "List of all types.")
+
+(defconst syncdoc-hierarchy
+ (progn
+ ;; Require it here so we don't load it before `syncdoc-all-types' is
+ ;; computed.
+ (cl-loop
+ with h = (make-hash-table :test #'eq)
+ for type in syncdoc-all-types
+ do (puthash type (mapcar #'cl--class-name
+ (cl--class-parents (cl-find-class type)))
+ h)
+ finally return h)))
+
+(defun syncdoc-insert-dot-content (rankdir)
+ (maphash (lambda (child parents)
+ (cl-loop for parent in parents
+ do (insert " \"" (symbol-name child) "\" -> \""
+ (symbol-name parent) "\";\n")))
+ syncdoc-hierarchy)
+ (sort-lines nil (point-min) (point-max))
+
+ (goto-char (point-min))
+ (insert "digraph {\n rankdir=\"" rankdir "\";\n")
+ (goto-char (point-max))
+ (insert "}\n"))
+
+(defun syncdoc-make-type-table (file)
+ (with-temp-file file
+ (insert "|Type| Derived Types|\n|-\n")
+ (let ((subtypes ()))
+ ;; First collect info from the "builtin" types.
+ (maphash (lambda (type parents)
+ (dolist (parent parents)
+ (push type (alist-get parent subtypes))))
+ syncdoc-hierarchy)
+ (sort subtypes
+ (lambda (x1 x2)
+ (< (length (memq (car x2) syncdoc-all-types))
+ (length (memq (car x1) syncdoc-all-types)))))
+ (cl-loop for (type . children) in subtypes
+ do (insert "|" (symbol-name type) " |")
+ do (cl-loop with x = 0
+ for child in children
+ for child-len = (length (symbol-name child))
+ when (> (+ x child-len 2) 60)
+ do (progn
+ (insert "|\n||")
+ (setq x 0))
+ do (insert (symbol-name child) " ")
+ do (cl-incf x (1+ child-len)) )
+ do (insert "\n")))
+ (require 'org-table)
+ (declare-function 'org-table-align "org")
+ (org-table-align)))
+
+(defun syncdoc-update-type-hierarchy0 ()
+ "Update the type hierarchy representation used by the elisp manual."
+ (with-temp-buffer
+ (syncdoc-insert-dot-content "LR")
+ (with-demoted-errors "%S" ;In case "dot" is not found!
+ (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o"
+ (expand-file-name "elisp_type_hierarchy.jpg"
+ syncdoc-lispref-dir))))
+ (syncdoc-make-type-table (expand-file-name "elisp_type_hierarchy.txt"
+ syncdoc-lispref-dir)))
+
+(defun syncdoc-update-type-hierarchy ()
+ "Update the type hierarchy representation used by the elisp manual."
+ (interactive)
+ (call-process (expand-file-name "src/emacs" syncdoc-emacs-repo-dir)
+ nil t t "-Q" "--batch" "-l" syncdoc-file
+ "-f" "syncdoc-update-type-hierarchy0"))
+
+;;; syncdoc-type-hierarchy.el ends here
diff --git a/autogen.sh b/autogen.sh
index be41771cae7..f56966ae0d1 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -239,6 +239,16 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .'
fi # do_check
+ # Stale caches can confuse autoconf.
+ rm -fr autom4te.cache exec/autom4te.cache || exit
+
+ # In build-aux save config.guess, config.sub and install-sh
+ # in case autoreconf overwrites them, as we rely on the copies
+ # in Git, which are updated by admin/merge-gnulib.
+ for file in config.guess config.sub install-sh; do
+ cp -p build-aux/$file build-aux/$file.tmp || exit
+ done
+
# Build aclocal.m4 here so that autoreconf need not use aclocal.
# aclocal is part of Automake and might not be installed, and
# autoreconf skips aclocal if aclocal.m4 is already supplied.
@@ -269,6 +279,12 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .'
# Now, run autoreconf inside the exec directory to generate its
# configure script.
autoreconf -fi exec || exit
+
+ # Restore config.guess etc. in build-aux, and copy them to exec.
+ for file in config.guess config.sub install-sh; do
+ cp build-aux/$file.tmp exec/$file &&
+ mv build-aux/$file.tmp build-aux/$file || exit
+ done
fi
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 405d53d9785..f6d217a49f8 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -4,7 +4,7 @@
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2023-07-20'
+timestamp='2024-01-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
@@ -60,7 +60,7 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2023 Free Software Foundation, Inc.
+Copyright 1992-2024 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -155,6 +155,9 @@ Linux|GNU|GNU/*)
set_cc_for_build
cat <<-EOF > "$dummy.c"
+ #if defined(__ANDROID__)
+ LIBC=android
+ #else
#include <features.h>
#if defined(__UCLIBC__)
LIBC=uclibc
@@ -162,6 +165,8 @@ Linux|GNU|GNU/*)
LIBC=dietlibc
#elif defined(__GLIBC__)
LIBC=gnu
+ #elif defined(__LLVM_LIBC__)
+ LIBC=llvm
#else
#include <stdarg.h>
/* First heuristic to detect musl libc. */
@@ -169,6 +174,7 @@ Linux|GNU|GNU/*)
LIBC=musl
#endif
#endif
+ #endif
EOF
cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`
eval "$cc_set_libc"
@@ -904,7 +910,7 @@ EOF
fi
;;
*:FreeBSD:*:*)
- UNAME_PROCESSOR=`/usr/bin/uname -p`
+ UNAME_PROCESSOR=`uname -p`
case $UNAME_PROCESSOR in
amd64)
UNAME_PROCESSOR=x86_64 ;;
@@ -1589,6 +1595,9 @@ EOF
*:Unleashed:*:*)
GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
;;
+ *:Ironclad:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ironclad
+ ;;
esac
# Do we have a guess based on uname results?
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 183b3cc627b..2c6a07ab3c3 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -4,7 +4,7 @@
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2023-07-31'
+timestamp='2024-01-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
@@ -76,7 +76,7 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2023 Free Software Foundation, Inc.
+Copyright 1992-2024 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -1181,7 +1181,7 @@ case $cpu-$vendor in
case $cpu in
1750a | 580 \
| a29k \
- | aarch64 | aarch64_be \
+ | aarch64 | aarch64_be | aarch64c | arm64ec \
| abacus \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \
@@ -1200,6 +1200,7 @@ case $cpu-$vendor in
| d10v | d30v | dlx | dsp16xx \
| e2k | elxsi | epiphany \
| f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \
+ | javascript \
| h8300 | h8500 \
| hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
| hexagon \
@@ -1221,6 +1222,7 @@ case $cpu-$vendor in
| moxie \
| mt \
| msp430 \
+ | nanomips* \
| nds32 | nds32le | nds32be \
| nfp \
| nios | nios2 | nios2eb | nios2el \
@@ -1252,6 +1254,7 @@ case $cpu-$vendor in
| ubicom32 \
| v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \
| vax \
+ | vc4 \
| visium \
| w65 \
| wasm32 | wasm64 \
@@ -1284,11 +1287,12 @@ esac
# Decode manufacturer-specific aliases for certain operating systems.
-if test x$basic_os != x
+if test x"$basic_os" != x
then
# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just
# set os.
+obj=
case $basic_os in
gnu/linux*)
kernel=linux
@@ -1488,10 +1492,16 @@ case $os in
os=eabi
;;
*)
- os=elf
+ os=
+ obj=elf
;;
esac
;;
+ aout* | coff* | elf* | pe*)
+ # These are machine code file formats, not OSes
+ obj=$os
+ os=
+ ;;
*)
# No normalization, but not necessarily accepted, that comes below.
;;
@@ -1510,12 +1520,15 @@ else
# system, and we'll never get to this point.
kernel=
+obj=
case $cpu-$vendor in
score-*)
- os=elf
+ os=
+ obj=elf
;;
spu-*)
- os=elf
+ os=
+ obj=elf
;;
*-acorn)
os=riscix1.2
@@ -1525,28 +1538,35 @@ case $cpu-$vendor in
os=gnu
;;
arm*-semi)
- os=aout
+ os=
+ obj=aout
;;
c4x-* | tic4x-*)
- os=coff
+ os=
+ obj=coff
;;
c8051-*)
- os=elf
+ os=
+ obj=elf
;;
clipper-intergraph)
os=clix
;;
hexagon-*)
- os=elf
+ os=
+ obj=elf
;;
tic54x-*)
- os=coff
+ os=
+ obj=coff
;;
tic55x-*)
- os=coff
+ os=
+ obj=coff
;;
tic6x-*)
- os=coff
+ os=
+ obj=coff
;;
# This must come before the *-dec entry.
pdp10-*)
@@ -1568,19 +1588,24 @@ case $cpu-$vendor in
os=sunos3
;;
m68*-cisco)
- os=aout
+ os=
+ obj=aout
;;
mep-*)
- os=elf
+ os=
+ obj=elf
;;
mips*-cisco)
- os=elf
+ os=
+ obj=elf
;;
- mips*-*)
- os=elf
+ mips*-*|nanomips*-*)
+ os=
+ obj=elf
;;
or32-*)
- os=coff
+ os=
+ obj=coff
;;
*-tti) # must be before sparc entry or we get the wrong os.
os=sysv3
@@ -1589,7 +1614,8 @@ case $cpu-$vendor in
os=sunos4.1.1
;;
pru-*)
- os=elf
+ os=
+ obj=elf
;;
*-be)
os=beos
@@ -1670,10 +1696,12 @@ case $cpu-$vendor in
os=uxpv
;;
*-rom68k)
- os=coff
+ os=
+ obj=coff
;;
*-*bug)
- os=coff
+ os=
+ obj=coff
;;
*-apple)
os=macos
@@ -1691,10 +1719,11 @@ esac
fi
-# Now, validate our (potentially fixed-up) OS.
+# Now, validate our (potentially fixed-up) individual pieces (OS, OBJ).
+
case $os in
# Sometimes we do "kernel-libc", so those need to count as OSes.
- musl* | newlib* | relibc* | uclibc*)
+ llvm* | musl* | newlib* | relibc* | uclibc*)
;;
# Likewise for "kernel-abi"
eabi* | gnueabi*)
@@ -1702,6 +1731,9 @@ case $os in
# VxWorks passes extra cpu info in the 4th filed.
simlinux | simwindows | spe)
;;
+ # See `case $cpu-$os` validation below
+ ghcjs)
+ ;;
# Now accept the basic system types.
# The portable systems comes first.
# Each alternative MUST end in a * to match a version number.
@@ -1719,11 +1751,11 @@ case $os in
| mirbsd* | netbsd* | dicos* | openedition* | ose* \
| bitrig* | openbsd* | secbsd* | solidbsd* | libertybsd* | os108* \
| ekkobsd* | freebsd* | riscix* | lynxos* | os400* \
- | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
- | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
+ | bosx* | nextstep* | cxux* | oabi* \
+ | ptx* | ecoff* | winnt* | domain* | vsta* \
| udi* | lites* | ieee* | go32* | aux* | hcos* \
| chorusrdb* | cegcc* | glidix* | serenity* \
- | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
+ | cygwin* | msys* | moss* | proelf* | rtems* \
| midipix* | mingw32* | mingw64* | mint* \
| uxpv* | beos* | mpeix* | udk* | moxiebox* \
| interix* | uwin* | mks* | rhapsody* | darwin* \
@@ -1736,71 +1768,115 @@ case $os in
| onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
| midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
| nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \
- | fiwix* | mlibc* | cos* | mbr* )
+ | fiwix* | mlibc* | cos* | mbr* | ironclad* )
;;
# This one is extra strict with allowed versions
sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
# Don't forget version if it is 3.2v4 or newer.
;;
+ # This refers to builds using the UEFI calling convention
+ # (which depends on the architecture) and PE file format.
+ # Note that this is both a different calling convention and
+ # different file format than that of GNU-EFI
+ # (x86_64-w64-mingw32).
+ uefi)
+ ;;
none)
;;
kernel* | msvc* )
# Restricted further below
;;
+ '')
+ if test x"$obj" = x
+ then
+ echo "Invalid configuration '$1': Blank OS only allowed with explicit machine code file format" 1>&2
+ fi
+ ;;
*)
echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
exit 1
;;
esac
+case $obj in
+ aout* | coff* | elf* | pe*)
+ ;;
+ '')
+ # empty is fine
+ ;;
+ *)
+ echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the constraint that a (synthetic) cpu and os are
+# valid only in combination with each other and nowhere else.
+case $cpu-$os in
+ # The "javascript-unknown-ghcjs" triple is used by GHC; we
+ # accept it here in order to tolerate that, but reject any
+ # variations.
+ javascript-ghcjs)
+ ;;
+ javascript-* | *-ghcjs)
+ echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 1>&2
+ exit 1
+ ;;
+esac
+
# As a final step for OS-related things, validate the OS-kernel combination
# (given a valid OS), if there is a kernel.
-case $kernel-$os in
- linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \
- | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc* )
+case $kernel-$os-$obj in
+ linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \
+ | linux-mlibc*- | linux-musl*- | linux-newlib*- \
+ | linux-relibc*- | linux-uclibc*- )
;;
- uclinux-uclibc* )
+ uclinux-uclibc*- )
;;
- managarm-mlibc* | managarm-kernel* )
+ managarm-mlibc*- | managarm-kernel*- )
;;
- windows*-gnu* | windows*-msvc*)
+ windows*-msvc*-)
;;
- -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* )
+ -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \
+ | -uclibc*- )
# These are just libc implementations, not actual OSes, and thus
# require a kernel.
echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2
exit 1
;;
- -kernel* )
+ -kernel*- )
echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2
exit 1
;;
- *-kernel* )
+ *-kernel*- )
echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2
exit 1
;;
- *-msvc* )
+ *-msvc*- )
echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2
exit 1
;;
- kfreebsd*-gnu* | kopensolaris*-gnu*)
+ kfreebsd*-gnu*- | kopensolaris*-gnu*-)
;;
- vxworks-simlinux | vxworks-simwindows | vxworks-spe)
+ vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-)
;;
- nto-qnx*)
+ nto-qnx*-)
;;
- os2-emx)
+ os2-emx-)
;;
- *-eabi* | *-gnueabi*)
+ *-eabi*- | *-gnueabi*-)
;;
- none-coff* | none-elf*)
+ none--*)
# None (no kernel, i.e. freestanding / bare metal),
- # can be paired with an output format "OS"
+ # can be paired with an machine code file format
;;
- -*)
+ -*-)
# Blank kernel with real OS is always fine.
;;
- *-*)
+ --*)
+ # Blank kernel and OS with real machine code file format is always fine.
+ ;;
+ *-*-*)
echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2
exit 1
;;
@@ -1884,7 +1960,7 @@ case $vendor in
;;
esac
-echo "$cpu-$vendor-${kernel:+$kernel-}$os"
+echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}"
exit
# Local variables:
diff --git a/build-aux/install-sh b/build-aux/install-sh
index ec298b53740..7c56c9c0151 100755
--- a/build-aux/install-sh
+++ b/build-aux/install-sh
@@ -1,7 +1,7 @@
#!/bin/sh
# install - install a program, script, or datafile
-scriptversion=2020-11-14.01; # UTC
+scriptversion=2023-11-23.18; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@@ -124,9 +124,9 @@ it's up to you to specify -f if you want it.
If -S is not specified, no backups are attempted.
-Email bug reports to bug-automake@gnu.org.
-Automake home page: https://www.gnu.org/software/automake/
-"
+Report bugs to <bug-automake@gnu.org>.
+GNU Automake home page: <https://www.gnu.org/software/automake/>.
+General help using GNU software: <https://www.gnu.org/gethelp/>."
while test $# -ne 0; do
case $1 in
diff --git a/build-aux/ndk-build-helper-1.mk b/build-aux/ndk-build-helper-1.mk
index 5681728154c..490064b6e32 100644
--- a/build-aux/ndk-build-helper-1.mk
+++ b/build-aux/ndk-build-helper-1.mk
@@ -94,7 +94,7 @@ endef
# dependencies can be ignored while building a shared library, as they
# will be linked in to the resulting shared object file later.
-SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid
+SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES) $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-includes,$(module))))
diff --git a/build-aux/ndk-build-helper-2.mk b/build-aux/ndk-build-helper-2.mk
index 1c2409cfd57..e696fcbdade 100644
--- a/build-aux/ndk-build-helper-2.mk
+++ b/build-aux/ndk-build-helper-2.mk
@@ -87,7 +87,7 @@ endef
# Resolve additional dependencies based on LOCAL_STATIC_LIBRARIES and
# LOCAL_SHARED_LIBRARIES.
-SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ log liblog android libandroid
+SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-a-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index 6d56e48fdb1..ea3e46fe60f 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -138,7 +138,7 @@
eval 'exec perl -wSx -0777 -pi "$0" "$@"'
if 0;
-my $VERSION = '2023-06-18.01:14'; # UTC
+my $VERSION = '2024-01-15.18:30'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
@@ -146,6 +146,7 @@ my $VERSION = '2023-06-18.01:14'; # UTC
use strict;
use warnings;
+use re 'eval';
my $copyright_re = 'Copyright';
my $circle_c_re = '(?:\([cC]\)|@copyright\{}|\\\\\(co|&copy;|Ā©)';
@@ -169,14 +170,13 @@ if (!$this_year || $this_year !~ m/^\d{4}$/)
# Unless the file consistently uses "\r\n" as the EOL, use "\n" instead.
my $eol = /(?:^|[^\r])\n/ ? "\n" : "\r\n";
-my $leading;
-my $prefix;
-my $ws_re;
my $stmt_re;
-while (/(^|\n)(.{0,$prefix_max})$copyright_re/g)
+my $found;
+while (/(^|\n)(.{0,$prefix_max})$copyright_re/cg)
{
- $leading = "$1$2";
- $prefix = $2;
+ my $pos=pos();
+ my $leading = "$1$2";
+ my $prefix = $2;
if ($prefix =~ /^(\s*\/)\*(\s*)$/)
{
$prefix =~ s,/, ,;
@@ -187,7 +187,7 @@ while (/(^|\n)(.{0,$prefix_max})$copyright_re/g)
$prefix = $prefix_ws;
}
}
- $ws_re = '[ \t\r\f]'; # \s without \n
+ my $ws_re = '[ \t\r\f]'; # \s without \n
$ws_re =
"(?:$ws_re*(?:$ws_re|\\n" . quotemeta($prefix) . ")$ws_re*)";
my $holder_re = $holder;
@@ -198,96 +198,97 @@ while (/(^|\n)(.{0,$prefix_max})$copyright_re/g)
. "((?:\\d\\d)?\\d\\d)$ws_re$holder_re";
if (/\G$stmt_remainder_re/)
{
+ $found = 1;
$stmt_re =
quotemeta($leading) . "($copyright_re$stmt_remainder_re)";
- last;
- }
- }
-if (defined $stmt_re)
- {
- /$stmt_re/ or die; # Should never die.
- my $stmt = $1;
- my $final_year_orig = $2;
- # Handle two-digit year numbers like "98" and "99".
- my $final_year = $final_year_orig;
- $final_year <= 99
- and $final_year += 1900;
+ /$stmt_re/ or die; # Should never die.
+ my $stmt = $1;
+ my $final_year_orig = $2;
- if ($final_year != $this_year)
- {
- # Update the year.
- $stmt =~ s/(^|[^\d])$final_year_orig\b/$1$final_year, $this_year/;
- }
- if ($final_year != $this_year || $ENV{'UPDATE_COPYRIGHT_FORCE'})
- {
- # Normalize all whitespace including newline-prefix sequences.
- $stmt =~ s/$ws_re/ /g;
+ # Handle two-digit year numbers like "98" and "99".
+ my $final_year = $final_year_orig;
+ $final_year <= 99
+ and $final_year += 1900;
- # Put spaces after commas.
- $stmt =~ s/, ?/, /g;
-
- # Convert 2-digit to 4-digit years.
- $stmt =~ s/(\b\d\d\b)/19$1/g;
-
- # Make the use of intervals consistent.
- if (!$ENV{UPDATE_COPYRIGHT_USE_INTERVALS})
+ if ($final_year != $this_year)
{
- $stmt =~ s/(\d{4})$ndash_re(\d{4})/join(', ', $1..$2)/eg;
+ # Update the year.
+ $stmt =~ s/(^|[^\d])$final_year_orig\b/$1$final_year, $this_year/;
}
- else
+ if ($final_year != $this_year || $ENV{'UPDATE_COPYRIGHT_FORCE'})
{
- my $ndash = ($ARGV =~ /\.tex(i(nfo)?)?$/ ? "--"
- : $ARGV =~ /\.(\d[a-z]*|man)$/ ? "\\(en"
- : "-");
+ # Normalize all whitespace including newline-prefix sequences.
+ $stmt =~ s/$ws_re/ /g;
- $stmt =~
- s/
- (\d{4})
- (?:
- (,\ |$ndash_re)
- ((??{
- if ($2 ne ', ') { '\d{4}'; }
- elsif (!$3) { $1 + 1; }
- else { $3 + 1; }
- }))
- )+
- /$1$ndash$3/gx;
+ # Put spaces after commas.
+ $stmt =~ s/, ?/, /g;
- # When it's 2, emit a single range encompassing all year numbers.
- $ENV{UPDATE_COPYRIGHT_USE_INTERVALS} == 2
- and $stmt =~ s/(^|[^\d])(\d{4})\b.*(?:[^\d])(\d{4})\b/$1$2$ndash$3/;
- }
+ # Convert 2-digit to 4-digit years.
+ $stmt =~ s/(\b\d\d\b)/19$1/g;
- # Format within margin.
- my $stmt_wrapped;
- my $text_margin = $margin - length($prefix);
- if ($prefix =~ /^(\t+)/)
- {
- $text_margin -= length($1) * ($tab_width - 1);
- }
- while (length $stmt)
- {
- if (($stmt =~ s/^(.{1,$text_margin})(?: |$)//)
- || ($stmt =~ s/^([\S]+)(?: |$)//))
+ # Make the use of intervals consistent.
+ if (!$ENV{UPDATE_COPYRIGHT_USE_INTERVALS})
{
- my $line = $1;
- $stmt_wrapped .= $stmt_wrapped ? "$eol$prefix" : $leading;
- $stmt_wrapped .= $line;
+ $stmt =~ s/(\d{4})$ndash_re(\d{4})/join(', ', $1..$2)/eg;
}
else
{
- # Should be unreachable, but we don't want an infinite
- # loop if it can be reached.
- die;
+ my $ndash = ($ARGV =~ /\.tex(i(nfo)?)?$/ ? "--"
+ : $ARGV =~ /\.(\d[a-z]*|man)$/ ? "\\(en"
+ : "-");
+
+ $stmt =~
+ s/
+ (\d{4})
+ (?:
+ (,\ |$ndash_re)
+ ((??{
+ if ($2 ne ', ') { '\d{4}'; }
+ elsif (!$3) { $1 + 1; }
+ else { $3 + 1; }
+ }))
+ )+
+ /$1$ndash$3/gx;
+
+ # When it's 2, emit a single range encompassing all year numbers.
+ $ENV{UPDATE_COPYRIGHT_USE_INTERVALS} == 2
+ and $stmt =~ s/(^|[^\d])(\d{4})\b.*(?:[^\d])(\d{4})\b/$1$2$ndash$3/;
}
- }
- # Replace the old copyright statement.
- s/$stmt_re/$stmt_wrapped/g;
+ # Format within margin.
+ my $stmt_wrapped;
+ my $text_margin = $margin - length($prefix);
+ if ($prefix =~ /^(\t+)/)
+ {
+ $text_margin -= length($1) * ($tab_width - 1);
+ }
+ while (length $stmt)
+ {
+ if (($stmt =~ s/^(.{1,$text_margin})(?: |$)//)
+ || ($stmt =~ s/^([\S]+)(?: |$)//))
+ {
+ my $line = $1;
+ $stmt_wrapped .= $stmt_wrapped ? "$eol$prefix" : $leading;
+ $stmt_wrapped .= $line;
+ }
+ else
+ {
+ # Should be unreachable, but we don't want an infinite
+ # loop if it can be reached.
+ die;
+ }
+ }
+
+ # Replace the old copyright statement.
+ my $p = pos();
+ s/$stmt_re/$stmt_wrapped/g;
+ pos() = $p;
+ }
}
}
-else
+
+if (!$found)
{
print STDERR "$ARGV: warning: copyright statement not found\n";
}
diff --git a/configure.ac b/configure.ac
index 90b3cde0d18..bd678ea52a3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -171,7 +171,6 @@ AS_IF([test "$XCONFIGURE" = "android"],[
# Make sure to pass through the CFLAGS, as older versions of the
# NDK require them to be able to find system includes.
with_ndk_path="$android_ndk_path"
- with_ndk_cxx_shared="$android_ndk_cxx_shared"
with_ndk_cxx="$android_ndk_cxx"
ndk_INIT([$android_abi], [$ANDROID_SDK], [cross/ndk-build],
[$ANDROID_CFLAGS])
@@ -1231,8 +1230,9 @@ package will likely install on older systems but crash on startup.])
passthrough="$passthrough --with-mailutils=$with_mailutils"
passthrough="$passthrough --with-pop=$with_pop"
passthrough="$passthrough --with-harfbuzz=$with_harfbuzz"
+ passthrough="$passthrough --with-threads=$with_threads"
- # Now pass through some checking options.
+ # Now pass through some checking-related options.
emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type"
passthrough="$passthrough $emacs_val"
@@ -1242,7 +1242,6 @@ package will likely install on older systems but crash on startup.])
AS_IF([XCONFIGURE=android ANDROID_CC="$ANDROID_CC" \
ANDROID_SDK="$android_sdk" android_abi=$android_abi \
android_ndk_path="$with_ndk_path" \
- android_ndk_cxx_shared="$with_ndk_cxx_shared" \
android_ndk_cxx="$android_ndk_cxx" \
$CONFIG_SHELL $0 $passthrough], [],
[AC_MSG_ERROR([Failed to cross-configure Emacs for android.])])
@@ -1321,6 +1320,7 @@ if test "$ANDROID" = "yes"; then
with_pop=no
with_harfbuzz=no
with_native_compilation=no
+ with_threads=no
fi
with_rsvg=no
@@ -1331,7 +1331,6 @@ if test "$ANDROID" = "yes"; then
with_gpm=no
with_dbus=no
with_gsettings=no
- with_threads=no
with_ns=no
# zlib is available in android.
@@ -1569,7 +1568,13 @@ AC_DEFUN_ONCE([gl_STDLIB_H],
# Initialize gnulib right after choosing the compiler.
dnl Amongst other things, this sets AR and ARFLAGS.
gl_EARLY
-ndk_LATE
+
+# ndk_LATE must be enclosed in this conditional to prevent the
+# AC_PROG_CXX it indirectly requires from being expanded at top level.
+if test "$ndk_INITIALIZED" = "yes"; then
+ ndk_LATE_EARLY
+ ndk_LATE
+fi
if test "$ac_test_CFLAGS" != set; then
# It's helpful to have C macros available to GDB, so prefer -g3 to -g
@@ -2336,6 +2341,7 @@ fi
AC_DEFUN([AC_TYPE_SIZE_T])
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
AC_DEFUN([AC_TYPE_UID_T])
+ac_cv_type_gid_t=yes # AC_TYPE_GETGROUPS needs this in Autoconf 2.72.
# Check for all math.h functions that Emacs uses; on some platforms,
# -lm is needed for some of these functions.
@@ -4086,16 +4092,16 @@ case $with_file_notification,$opsys in
fi ;;
esac
-dnl inotify is available only on GNU/Linux.
+dnl inotify is available only on Linux-kernel based systems.
case $with_file_notification,$NOTIFY_OBJ in
inotify, | yes,)
AC_CHECK_HEADER([sys/inotify.h])
if test "$ac_cv_header_sys_inotify_h" = yes ; then
- AC_CHECK_FUNC([inotify_init1])
- if test "$ac_cv_func_inotify_init1" = yes; then
+ AC_CHECK_FUNCS([inotify_init inotify_init1])
+ if test "$ac_cv_func_inotify_init" = yes; then
AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.])
NOTIFY_OBJ=inotify.o
- NOTIFY_SUMMARY="yes -lglibc (inotify)"
+ NOTIFY_SUMMARY="yes (inotify)"
fi
fi ;;
esac
@@ -5905,13 +5911,15 @@ pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
endpwent getgrent endgrent \
-renameat2 \
cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \
pthread_set_name_np])
# getpwent is not present in older versions of Android. (bug#65319)
gl_CHECK_FUNCS_ANDROID([getpwent], [[#include <pwd.h>]])
+# renameat2 is not present in older versions of Android.
+gl_CHECK_FUNCS_ANDROID([renameat2], [[#include <stdio.h>]])
+
if test "$ac_cv_func_cfmakeraw" != "yes"; then
# On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS
# cannot find it. Check if some code including termios.h and using
@@ -7097,9 +7105,6 @@ AC_DEFINE_UNQUOTED([COPYRIGHT], ["$copyright"],
[Short copyright string for this version of Emacs.])
AC_SUBST([copyright])
-# This is needed for gnulib's printf modules.
-CFLAGS="$CFLAGS -DHAVE_CONFIG_H"
-
### Specify what sort of things we'll be editing into Makefile and config.h.
### Use configuration here uncanonicalized to avoid exceeding size limits.
AC_SUBST([version])
@@ -7466,6 +7471,8 @@ case "$opsys" in
mingw32)
## Is it any better under MinGW64 to relocate emacs into higher addresses?
+ ## If the values of -image-base are modified, the corresponding
+ ## values of DEFAULT_IMAGE_BASE in w32fns.c should be kept in sync.
case "$canonical" in
x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x400000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;;
*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;;
diff --git a/cross/ndk-build/Makefile.in b/cross/ndk-build/Makefile.in
index 8ba2d356f27..0970a765b45 100644
--- a/cross/ndk-build/Makefile.in
+++ b/cross/ndk-build/Makefile.in
@@ -24,15 +24,17 @@
srcdir = @srcdir@
# This is a list of Android.mk files which provide targets.
-NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
- NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
- NDK_BUILD_ABI = @NDK_BUILD_ABI@
- NDK_BUILD_SDK = @NDK_BUILD_SDK@
- NDK_BUILD_CC = @NDK_BUILD_CC@
- NDK_BUILD_CXX = @NDK_BUILD_CXX@
- NDK_BUILD_AR = @NDK_BUILD_AR@
- NDK_BUILD_NASM = @NDK_BUILD_NASM@
- NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
+ NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
+ NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
+ NDK_BUILD_ABI = @NDK_BUILD_ABI@
+ NDK_BUILD_SDK = @NDK_BUILD_SDK@
+ NDK_BUILD_CC = @NDK_BUILD_CC@
+ NDK_BUILD_CXX = @NDK_BUILD_CXX@
+ NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
+NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
+ NDK_BUILD_AR = @NDK_BUILD_AR@
+ NDK_BUILD_NASM = @NDK_BUILD_NASM@
+ NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
# This is a list of targets to build.
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
@@ -58,8 +60,10 @@ NDK_BUILD_ANDROID_MK := $(call uniqify,$(NDK_BUILD_ANDROID_MK))
NDK_BUILD_MODULES := $(call uniqify,$(NDK_BUILD_MODULES))
# Define CFLAGS for compiling C++ code; this involves removing all
-# -std=NNN options.
-NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS))
+# -std=NNN options and inserting compilation options for the C++
+# library.
+NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS)) \
+ $(NDK_BUILD_CXX_STL)
define subr-1
diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in
index 6c85ff5044e..ea1be5af6f1 100644
--- a/cross/ndk-build/ndk-build.mk.in
+++ b/cross/ndk-build/ndk-build.mk.in
@@ -22,6 +22,8 @@
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
NDK_BUILD_CXX_SHARED = @NDK_BUILD_CXX_SHARED@
+NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
+NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@
NDK_BUILD_SHARED =
NDK_BUILD_STATIC =
diff --git a/cross/ndk-build/ndk-resolve.mk b/cross/ndk-build/ndk-resolve.mk
index d3b398bca62..4d8ecf8667a 100644
--- a/cross/ndk-build/ndk-resolve.mk
+++ b/cross/ndk-build/ndk-resolve.mk
@@ -20,7 +20,7 @@
# which actually builds targets.
# List of system libraries to ignore.
-NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid
+NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
# Save information.
NDK_LOCAL_PATH_$(LOCAL_MODULE) := $(LOCAL_PATH)
@@ -90,11 +90,35 @@ endif
# Likewise for libstdc++.
ifeq ($(strip $(1)),libstdc++)
-NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
-ifeq ($(strip $(1)),dl)
-NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
+ifeq ($(strip $(1)),stdc++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libstlport)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),stlport)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libgnustl)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),gnustl)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libc++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),c++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
# Likewise for liblog.
diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android
index 958cf237c58..7b9af76404b 100644
--- a/cross/verbose.mk.android
+++ b/cross/verbose.mk.android
@@ -44,12 +44,13 @@ have_working_info = $(filter notintermediate,$(value .FEATURES))
# The workaround is done only for AM_V_ELC and AM_V_ELN,
# since the bug is not annoying elsewhere.
-AM_V_AR = @$(info $ AR $@)
+. :=
+AM_V_AR = @$(info $. AR $@)
AM_V_at = @
-AM_V_CC = @$(info $ CC $@)
-AM_V_CXX = @$(info $ CXX $@)
-AM_V_CCLD = @$(info $ CCLD $@)
-AM_V_CXXLD = @$(info $ CXXLD $@)
-AM_V_GEN = @$(info $ GEN $@)
+AM_V_CC = @$(info $. CC $@)
+AM_V_CXX = @$(info $. CXX $@)
+AM_V_CCLD = @$(info $. CCLD $@)
+AM_V_CXXLD = @$(info $. CXXLD $@)
+AM_V_GEN = @$(info $. GEN $@)
AM_V_NO_PD = --no-print-directory
endif
diff --git a/debian/changelog b/debian/changelog
index 2cecc85a937..e937393b552 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+emacs-snapshot (30.1~git20240330.1) unstable; urgency=medium
+
+ * Package git snapshot.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Mon, 01 Apr 2024 18:49:21 +0800
+
emacs-snapshot (30.1~git20240103.1~bpo12+1~athena1) bookworm-backports; urgency=medium
* Rebuild for athena apt repository.
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 0ea96d91492..01732961998 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -143,11 +143,13 @@ that if that Emacs in turn does not start the Emacs server, subsequent
attempts to open the file with the wrapper will fail.
@cindex /content/by-authority directory, android
+@cindex /content/by-authority-named directory, android
Some files are given to Emacs as ``content identifiers'' that the
system provides access to outside the normal filesystem APIs. Emacs
-uses a pseudo-directory named @file{/content/by-authority} to access
-those files. Do not make any assumptions about the contents of this
-directory, or try to open files in it yourself.
+uses pseudo-directories named @file{/content/by-authority} and
+@file{/content/by-authority-named} to access those files. Do not make
+any assumptions about the contents of this directory, or try to open
+files in it yourself.
This feature is not provided on Android 4.3 and earlier, in which
case such files are copied to a temporary directory before being
@@ -474,33 +476,200 @@ version of Android being used:
@itemize @bullet
@item
Under more or less recent releases of Android, such as Android 6.0 and
-later, Emacs only receives the following permissions upon
-installation:
+later, Emacs only receives the following permissions upon installation,
+subject to the presence or absence of individual permissions in the
+version of Android installed:
@itemize @minus
@item
-@code{android.permission.VIBRATE}
+@code{android.permission.ACCESS_ADSERVICES_AD_ID}
+@item
+@code{android.permission.ACCESS_ADSERVICES_ATTRIBUTION}
+@item
+@code{android.permission.ACCESS_ADSERVICES_CUSTOM_AUDIENCE}
+@item
+@code{android.permission.ACCESS_ADSERVICES_TOPICS}
+@item
+@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS}
@item
@code{android.permission.ACCESS_NETWORK_STATE}
@item
+@code{android.permission.ACCESS_NOTIFICATION_POLICY}
+@item
+@code{android.permission.ACCESS_WIFI_STATE}
+@item
+@code{android.permission.AUTHENTICATE_ACCOUNTS}
+@item
+@code{android.permission.BLUETOOTH}
+@item
+@code{android.permission.BLUETOOTH_ADMIN}
+@item
+@code{android.permission.BROADCAST_STICKY}
+@item
+@code{android.permission.CALL_COMPANION_APP}
+@item
+@code{android.permission.CHANGE_NETWORK_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_MULTICAST_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_STATE}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_QUERY_CANDIDATE_CREDENTIALS}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_SET_ALLOWED_PROVIDERS}
+@item
+@code{android.permission.CREDENTIAL_MANAGER_SET_ORIGIN}
+@item
+@code{android.permission.DELIVER_COMPANION_MESSAGES}
+@item
+@code{android.permission.DETECT_SCREEN_CAPTURE}
+@item
+@code{android.permission.DISABLE_KEYGUARD}
+@item
+@code{android.permission.ENFORCE_UPDATE_OWNERSHIP}
+@item
+@code{android.permission.EXPAND_STATUS_BAR}
+@item
+@code{android.permission.FLASHLIGHT}
+@item
+@code{android.permission.FOREGROUND_SERVICE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_CAMERA}
+@item
+@code{android.permission.FOREGROUND_SERVICE_CONNECTED_DEVICE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_DATA_SYNC}
+@item
+@code{android.permission.FOREGROUND_SERVICE_FILE_MANAGEMENT}
+@item
+@code{android.permission.FOREGROUND_SERVICE_HEALTH}
+@item
+@code{android.permission.FOREGROUND_SERVICE_LOCATION}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MEDIA_PLAYBACK}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MEDIA_PROJECTION}
+@item
+@code{android.permission.FOREGROUND_SERVICE_MICROPHONE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_PHONE_CALL}
+@item
+@code{android.permission.FOREGROUND_SERVICE_REMOTE_MESSAGING}
+@item
+@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_SYSTEM_EXEMPTED}
+@item
+@code{android.permission.GET_PACKAGE_SIZE}
+@item
+@code{android.permission.GET_TASKS}
+@item
+@code{android.permission.HIDE_OVERLAY_WINDOWS}
+@item
+@code{android.permission.HIGH_SAMPLING_RATE_SENSORS}
+@item
@code{android.permission.INTERNET}
@item
-@code{android.permission.SET_WALLPAPER}
+@code{android.permission.KILL_BACKGROUND_PROCESSES}
+@item
+@code{android.permission.MANAGE_ACCOUNTS}
+@item
+@code{android.permission.MANAGE_OWN_CALLS}
+@item
+@code{android.permission.MODIFY_AUDIO_SETTINGS}
@item
@code{android.permission.NFC}
@item
+@code{android.permission.NFC_PREFERRED_PAYMENT_INFO}
+@item
+@code{android.permission.NFC_TRANSACTION_EVENT}
+@item
+@code{android.permission.PERSISTENT_ACTIVITY}
+@item
+@code{android.permission.QUERY_ALL_PACKAGES}
+@item
+@code{android.permission.READ_BASIC_PHONE_STATE}
+@item
+@code{android.permission.READ_INSTALL_SESSIONS}
+@item
+@code{android.permission.READ_NEARBY_STREAMING_POLICY}
+@item
+@code{android.permission.READ_PROFILE}
+@item
+@code{android.permission.READ_SOCIAL_STREAM}
+@item
+@code{android.permission.READ_SYNC_SETTINGS}
+@item
+@code{android.permission.READ_SYNC_STATS}
+@item
+@code{android.permission.READ_USER_DICTIONARY}
+@item
+@code{android.permission.RECEIVE_BOOT_COMPLETED}
+@item
+@code{android.permission.REORDER_TASKS}
+@item
+@code{android.permission.REQUEST_COMPANION_PROFILE_GLASSES}
+@item
+@code{android.permission.REQUEST_COMPANION_PROFILE_WATCH}
+@item
+@code{android.permission.REQUEST_COMPANION_RUN_IN_BACKGROUND}
+@item
+@code{android.permission.REQUEST_COMPANION_START_FOREGROUND_SERVICES_FROM_BACKGROUND}
+@item
+@code{android.permission.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND}
+@item
+@code{android.permission.REQUEST_DELETE_PACKAGES}
+@item
+@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS}
+@item
+@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE}
+@item
+@code{android.permission.REQUEST_PASSWORD_COMPLEXITY}
+@item
+@code{android.permission.RESTART_PACKAGES}
+@item
+@code{android.permission.RUN_USER_INITIATED_JOBS}
+@item
+@code{android.permission.SET_WALLPAPER}
+@item
+@code{android.permission.SET_WALLPAPER_HINTS}
+@item
+@code{android.permission.SUBSCRIBED_FEEDS_READ}
+@item
+@code{android.permission.SUBSCRIBED_FEEDS_WRITE}
+@item
@code{android.permission.TRANSMIT_IR}
@item
+@code{android.permission.UPDATE_PACKAGES_WITHOUT_USER_ACTION}
+@item
+@code{android.permission.USE_BIOMETRIC}
+@item
+@code{android.permission.USE_CREDENTIALS}
+@item
+@code{android.permission.USE_EXACT_ALARM}
+@item
+@code{android.permission.USE_FINGERPRINT}
+@item
+@code{android.permission.USE_FULL_SCREEN_INTENT}
+@item
+@code{android.permission.VIBRATE}
+@item
@code{android.permission.WAKE_LOCK}
@item
-@code{android.permission.FOREGROUND_SERVICE}
+@code{android.permission.WRITE_PROFILE}
@item
-@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE}
+@code{android.permission.WRITE_SMS}
+@item
+@code{android.permission.WRITE_SOCIAL_STREAM}
+@item
+@code{android.permission.WRITE_SYNC_SETTINGS}
+@item
+@code{android.permission.WRITE_USER_DICTIONARY}
@end itemize
-Other permissions must be granted by the user through the system
-settings application. Consult the manufacturer of your device for
-more details, as how to do this varies by device.
+Other permissions must be granted by the user from the system settings
+application. Consult the manufacturer of your device for more details,
+as how to do this varies by device.
@item
On Android 5.1 and earlier, Emacs automatically receives the following
@@ -508,59 +677,139 @@ permissions it has requested upon being installed:
@itemize @minus
@item
-@code{android.permission.READ_CONTACTS}
+@code{android.permission.ACCESS_COARSE_LOCATION}
@item
-@code{android.permission.WRITE_CONTACTS}
+@code{android.permission.ACCESS_FINE_LOCATION}
@item
-@code{android.permission.VIBRATE}
+@code{android.permission.BODY_SENSORS}
@item
-@code{android.permission.ACCESS_COARSE_LOCATION}
+@code{android.permission.CALL_PHONE}
@item
-@code{android.permission.ACCESS_NETWORK_STATE}
+@code{android.permission.CAMERA}
@item
-@code{android.permission.INTERNET}
+@code{android.permission.CAPTURE_CONSENTLESS_BUGREPORT_ON_USERDEBUG_BUILD}
@item
-@code{android.permission.SET_WALLPAPER}
+@code{android.permission.GET_ACCOUNTS}
+@item
+@code{android.permission.POST_NOTIFICATIONS}
+@item
+@code{android.permission.PROCESS_OUTGOING_CALLS}
@item
@code{android.permission.READ_CALENDAR}
@item
-@code{android.permission.WRITE_CALENDAR}
+@code{android.permission.READ_CALL_LOG}
+@item
+@code{android.permission.READ_CELL_BROADCASTS}
+@item
+@code{android.permission.READ_CONTACTS}
@item
@code{android.permission.READ_EXTERNAL_STORAGE}
@item
-@code{android.permission.WRITE_EXTERNAL_STORAGE}
+@code{android.permission.READ_PHONE_NUMBERS}
@item
-@code{android.permission.SEND_SMS}
+@code{android.permission.READ_PHONE_STATE}
@item
-@code{android.permission.RECEIVE_SMS}
+@code{android.permission.READ_SMS}
@item
@code{android.permission.RECEIVE_MMS}
@item
-@code{android.permission.WRITE_SMS}
+@code{android.permission.RECEIVE_SMS}
@item
-@code{android.permission.READ_SMS}
+@code{android.permission.RECEIVE_WAP_PUSH}
+@item
+@code{android.permission.RECORD_AUDIO}
+@item
+@code{android.permission.REQUEST_INSTALL_PACKAGES}
+@item
+@code{android.permission.SEND_SMS}
+@item
+@code{android.permission.SMS_FINANCIAL_TRANSACTIONS}
+@item
+@code{android.permission.SYSTEM_ALERT_WINDOW}
+@item
+@code{android.permission.WRITE_CALENDAR}
+@item
+@code{android.permission.WRITE_CALL_LOG}
+@item
+@code{android.permission.WRITE_CONTACTS}
+@item
+@code{android.permission.WRITE_EXTERNAL_STORAGE}
+@item
+@code{android.permission.WRITE_SETTINGS}
+@item
+@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS}
+@item
+@code{android.permission.ACCESS_NETWORK_STATE}
+@item
+@code{android.permission.ACCESS_WIFI_STATE}
+@item
+@code{android.permission.BLUETOOTH}
+@item
+@code{android.permission.BLUETOOTH_ADMIN}
+@item
+@code{android.permission.BROADCAST_STICKY}
+@item
+@code{android.permission.CHANGE_NETWORK_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_MULTICAST_STATE}
+@item
+@code{android.permission.CHANGE_WIFI_STATE}
+@item
+@code{android.permission.DISABLE_KEYGUARD}
+@item
+@code{android.permission.EXPAND_STATUS_BAR}
+@item
+@code{android.permission.FLASHLIGHT}
+@item
+@code{android.permission.GET_PACKAGE_SIZE}
+@item
+@code{android.permission.GET_TASKS}
+@item
+@code{android.permission.INTERNET}
+@item
+@code{android.permission.KILL_BACKGROUND_PROCESSES}
+@item
+@code{android.permission.MODIFY_AUDIO_SETTINGS}
@item
@code{android.permission.NFC}
@item
-@code{android.permission.TRANSMIT_IR}
+@code{android.permission.PERSISTENT_ACTIVITY}
@item
-@code{android.permission.READ_PHONE_STATE}
+@code{android.permission.QUERY_ALL_PACKAGES}
@item
-@code{android.permission.WAKE_LOCK}
+@code{android.permission.READ_BASIC_PHONE_STATE}
@item
-@code{android.permission.FOREGROUND_SEVICE}
+@code{android.permission.READ_SYNC_SETTINGS}
@item
-@code{android.permission.REQUEST_INSTALL_PACKAGES}
+@code{android.permission.READ_SYNC_STATS}
+@item
+@code{android.permission.READ_USER_DICTIONARY}
+@item
+@code{android.permission.RECEIVE_BOOT_COMPLETED}
+@item
+@code{android.permission.REORDER_TASKS}
@item
@code{android.permission.REQUEST_DELETE_PACKAGES}
@item
-@code{android.permission.SYSTEM_ALERT_WINDOW}
+@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS}
@item
-@code{android.permission.RECORD_AUDIO}
+@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE}
@item
-@code{android.permission.CAMERA}
+@code{android.permission.RESTART_PACKAGES}
@item
-@code{android.permission.POST_NOTIFICATIONS}
+@code{android.permission.SET_WALLPAPER}
+@item
+@code{android.permission.SET_WALLPAPER_HINTS}
+@item
+@code{android.permission.TRANSMIT_IR}
+@item
+@code{android.permission.VIBRATE}
+@item
+@code{android.permission.WAKE_LOCK}
+@item
+@code{android.permission.WRITE_SYNC_SETTINGS}
+@item
+@code{android.permission.WRITE_USER_DICTIONARY}
@end itemize
While most of these permissions are left unused by Emacs itself, they
@@ -609,12 +858,30 @@ When the user closes the window created during application startup,
and the window was not previously closed by the system in order to
save resources, Emacs deletes any frame displayed within that window.
+However, on Android 7.0 and later, such frames are not deleted if the
+window is closed four or more hours after the window moves into the
+background, as the system automatically removes open windows once a
+certain period of inactivity elapses when the number of windows retained
+by the window manager surpasses a specific threshold, and window
+deletion by this mechanism is indistinguishable from window deletion by
+the user. Emacs begins to ignore window deletion after two hours less
+than the default value of this threshold both to err on the side of
+caution, in case the system's record of inactivity and Emacs's differ,
+and for the reason that this threshold is open to customization by OS
+distributors.
+
@item
When the user or the system closes any window created by Emacs on
behalf of a specific frame, Emacs deletes the frame displayed within
that window.
@end itemize
+ When the system predates Android 5.0, the window manager will not
+accept more than one user-created Emacs window. If frame creation gives
+rise to windows in excess of this limit, the window manager will
+arbitrarily select one of their number to display, with the rest
+remaining invisible until that window is destroyed with its frame.
+
@cindex windowing limitations, android
@cindex frame parameters, android
Emacs only supports a limited subset of GUI features on Android; the
diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi
index b8094c6cf36..ff6905d8b02 100644
--- a/doc/emacs/back.texi
+++ b/doc/emacs/back.texi
@@ -78,7 +78,7 @@ And much more!
Emacs comes with an introductory online tutorial available in many
languages, and this nineteenth edition of the manual picks up where
that tutorial ends. It explains the full range of the power of Emacs,
-now up to @strong[version 27.2,} and contains reference material
+now up to @strong{version 27.2,} and contains reference material
useful to expert users. It also includes appendices with specific
material about X and GTK resources, and with details for users of
macOS and Microsoft Windows.
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index f64b3995d25..a2a934ff243 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -406,8 +406,8 @@ Delete the character before point, or the region if it is active
(@code{delete-backward-char}).
@item @key{Delete}
-Delete the character after point, or the region if it is active
-(@code{delete-forward-char}).
+Delete the character or grapheme cluster after point, or the region if
+it is active (@code{delete-forward-char}).
@item C-d
Delete the character after point (@code{delete-char}).
@@ -438,11 +438,18 @@ with the @key{Delete} key; we will discuss @key{Delete} momentarily.)
On some text terminals, Emacs may not recognize the @key{DEL} key
properly. @xref{DEL Does Not Delete}, if you encounter this problem.
+@cindex grapheme cluster, deletion
+@cindex delete entire grapheme cluster
The @key{Delete} (@code{delete-forward-char}) command deletes in the
opposite direction: it deletes the character after point, i.e., the
character under the cursor. If point was at the end of a line, this
joins the following line onto this one. Like @kbd{@key{DEL}}, it
deletes the text in the region if the region is active (@pxref{Mark}).
+If the character after point is composed with following characters and
+displayed as a single display unit, a so-called @dfn{grapheme cluster}
+representing the entire sequence, @key{Delete} deletes the entire
+sequence in one go. This is in contrast to @key{DEL} which always
+deletes a single character, even if the character is composed.
@kbd{C-d} (@code{delete-char}) deletes the character after point,
similar to @key{Delete}, but regardless of whether the region is
@@ -630,6 +637,21 @@ before they get too long, by inserting newlines. If you prefer, you
can make Emacs insert a newline automatically when a line gets too
long, by using Auto Fill mode. @xref{Filling}.
+@cindex continuation lines, visual wrap prefix
+@findex visual-wrap-prefix-mode
+@findex global-visual-wrap-prefix-mode
+ Normally, the first character of each continuation line is
+positioned at the beginning of the screen line where it is displayed.
+The minor mode @code{visual-wrap-prefix-mode} and its global
+(@pxref{Minor Modes}) counterpart
+@code{global-visual-wrap-prefix-mode} arranges that continuation lines
+be prefixed by slightly adjusted versions of the fill prefixes
+(@pxref{Fill Prefix}) of their respective logical lines, so that
+indentation characters or the prefixes of source code comments are
+replicated across every continuation line, and the appearance of such
+comments or indentation is not broken. These prefixes are only shown
+on display, and does not change the buffer text in any way.
+
Sometimes, you may need to edit files containing many long logical
lines, and it may not be practical to break them all up by adding
newlines. In that case, you can use Visual Line mode, which enables
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 8b093078edd..2786ff6ad65 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -205,7 +205,7 @@ Here is an example of a buffer list:
@smallexample
CRM Buffer Size Mode File
-. * .emacs 3294 Emacs-Lisp ~/.emacs
+. * .emacs 3294 ELisp/l ~/.emacs
% *Help* 101 Help
search.c 86055 C ~/cvs/emacs/src/search.c
% src 20959 Dired by name ~/cvs/emacs/src/
@@ -223,8 +223,10 @@ the directory @file{~/cvs/emacs/src/}. You can list only buffers that
are visiting files by giving the command a prefix argument, as in
@kbd{C-u C-x C-b}.
- @code{list-buffers} omits buffers whose names begin with a space,
-unless they visit files: such buffers are used internally by Emacs.
+ By default, @code{list-buffers} omits buffers whose names begin with a
+space, unless they visit files: such buffers are used internally by
+Emacs (but the @kbd{I} command countermands that, @pxref{Several
+Buffers}).
@node Misc Buffer
@section Miscellaneous Buffer Operations
@@ -262,12 +264,14 @@ non-@code{nil}. If you change the option @code{view-read-only} to a
non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q}
also enables View mode in the buffer (@pxref{View Mode}).
+@kindex C-x x r
@findex rename-buffer
@kbd{C-x x r} (@code{rename-buffer} changes the name of the current
buffer. You specify the new name as a minibuffer argument; there is
no default. If you specify a name that is in use for some other
buffer, an error happens and no renaming is done.
+@kindex C-x x u
@findex rename-uniquely
@kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to
a similar name with a numeric suffix added to make it both different
@@ -282,6 +286,7 @@ buffers with particular names. (With some of these features, such as
buffer before using the command again, otherwise it will reuse the
current buffer despite the name change.)
+@kindex C-x x i
The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i}
(@code{insert-buffer}) can also be used to copy text from one buffer
to another. @xref{Accumulating Text}.
@@ -398,57 +403,57 @@ cursor motion commands can be used in this buffer. The following
commands apply to the buffer described on the current line:
@table @kbd
-@item d
@findex Buffer-menu-delete
@kindex d @r{(Buffer Menu)}
+@item d
Flag the buffer for deletion (killing), then move point to the next
line (@code{Buffer-menu-delete}). The deletion flag is indicated by
the character @samp{D} on the line, before the buffer name. The
deletion occurs only when you type the @kbd{x} command (see below).
-@item C-d
@findex Buffer-menu-delete-backwards
@kindex C-d @r{(Buffer Menu)}
+@item C-d
Like @kbd{d}, but move point up instead of down
(@code{Buffer-menu-delete-backwards}).
-@item s
@findex Buffer-menu-save
@kindex s @r{(Buffer Menu)}
+@item s
Flag the buffer for saving (@code{Buffer-menu-save}). The save flag
is indicated by the character @samp{S} on the line, before the buffer
name. The saving occurs only when you type @kbd{x}. You may request
both saving and deletion for the same buffer.
-@item x
@findex Buffer-menu-execute
@kindex x @r{(Buffer Menu)}
+@item x
Perform all flagged deletions and saves (@code{Buffer-menu-execute}).
-@item u
@findex Buffer-menu-unmark
@kindex u @r{(Buffer Menu)}
+@item u
Remove all flags from the current line, and move down
(@code{Buffer-menu-unmark}). With a prefix argument, moves up after
removing the flags.
-@item @key{DEL}
@findex Buffer-menu-backup-unmark
@kindex DEL @r{(Buffer Menu)}
+@item @key{DEL}
Move to the previous line and remove all flags on that line
(@code{Buffer-menu-backup-unmark}).
-@item M-@key{DEL}
@findex Buffer-menu-unmark-all-buffers
@kindex M-DEL @r{(Buffer Menu)}
+@item M-@key{DEL}
Remove a particular flag from all lines
(@code{Buffer-menu-unmark-all-buffers}). This asks for a single
character, and unmarks buffers marked with that character; typing
@key{RET} removes all marks.
-@item U
@findex Buffer-menu-unmark-all
@kindex U @r{(Buffer Menu)}
+@item U
Remove all flags from all the lines
(@code{Buffer-menu-unmark-all}).
@end table
@@ -462,21 +467,21 @@ the current line. They also accept a numeric argument as a repeat
count.
@table @kbd
-@item ~
@findex Buffer-menu-not-modified
@kindex ~ @r{(Buffer Menu)}
+@item ~
Mark the buffer as unmodified (@code{Buffer-menu-not-modified}).
@xref{Save Commands}.
-@item %
@findex Buffer-menu-toggle-read-only
@kindex % @r{(Buffer Menu)}
+@item %
Toggle the buffer's read-only status
(@code{Buffer-menu-toggle-read-only}). @xref{Misc Buffer}.
-@item t
@findex Buffer-menu-visit-tags-table
@kindex t @r{(Buffer Menu)}
+@item t
Visit the buffer as a tags table
(@code{Buffer-menu-visit-tags-table}). @xref{Select Tags Table}.
@end table
@@ -484,63 +489,63 @@ Visit the buffer as a tags table
The following commands are used to select another buffer or buffers:
@table @kbd
-@item q
@findex quit-window
@kindex q @r{(Buffer Menu)}
+@item q
Quit the Buffer Menu (@code{quit-window}). The most recent formerly
visible buffer is displayed in its place.
-@item @key{RET}
-@itemx f
@findex Buffer-menu-this-window
@kindex f @r{(Buffer Menu)}
@kindex RET @r{(Buffer Menu)}
+@item @key{RET}
+@itemx f
Select this line's buffer, replacing the @file{*Buffer List*} buffer
in its window (@code{Buffer-menu-this-window}).
-@item o
@findex Buffer-menu-other-window
@kindex o @r{(Buffer Menu)}
+@item o
Select this line's buffer in another window, as if by @kbd{C-x 4 b},
leaving @file{*Buffer List*} visible
(@code{Buffer-menu-other-window}).
-@item C-o
@findex Buffer-menu-switch-other-window
@kindex C-o @r{(Buffer Menu)}
+@item C-o
Display this line's buffer in another window, without selecting it
(@code{Buffer-menu-switch-other-window}).
-@item 1
@findex Buffer-menu-1-window
@kindex 1 @r{(Buffer Menu)}
+@item 1
Select this line's buffer in a full-frame window
(@code{Buffer-menu-1-window}).
-@item 2
@findex Buffer-menu-2-window
@kindex 2 @r{(Buffer Menu)}
+@item 2
Set up two windows on the current frame, with this line's buffer
selected in one, and a previously current buffer (aside from
@file{*Buffer List*}) in the other (@code{Buffer-menu-2-window}).
-@item b
@findex Buffer-menu-bury
@kindex b @r{(Buffer Menu)}
+@item b
Bury this line's buffer (@code{Buffer-menu-bury}) (i.e., move it to
the end of the buffer list).
-@item m
@findex Buffer-menu-mark
@kindex m @r{(Buffer Menu)}
+@item m
Mark this line's buffer to be displayed in another window if you exit
with the @kbd{v} command (@code{Buffer-menu-mark}). The display flag
is indicated by the character @samp{>} at the beginning of the line.
(A single buffer may not have both deletion and display flags.)
-@item v
@findex Buffer-menu-select
@kindex v @r{(Buffer Menu)}
+@item v
Select this line's buffer, and also display in other windows any
buffers flagged with the @kbd{m} command (@code{Buffer-menu-select}).
If you have not flagged any buffers, this command is equivalent to
@@ -550,31 +555,37 @@ If you have not flagged any buffers, this command is equivalent to
The following commands affect the entire buffer list:
@table @kbd
-@item S
@findex tabulated-list-sort
@kindex S @r{(Buffer Menu)}
+@item S
Sort the Buffer Menu entries according to their values in the column
at point. With a numeric prefix argument @var{n}, sort according to
the @var{n}-th column (@code{tabulated-list-sort}).
-@item @}
@kindex @} @r{(Buffer Menu)}
@findex tabulated-list-widen-current-column
+@item @}
Widen the current column width by @var{n} (the prefix numeric
argument) characters.
-@item @{
@kindex @{ @r{(Buffer Menu)}
@findex tabulated-list-narrow-current-column
+@item @{
Narrow the current column width by @var{n} (the prefix numeric
argument) characters.
-@item T
@findex Buffer-menu-toggle-files-only
@kindex T @r{(Buffer Menu)}
+@item T
Delete, or reinsert, lines for non-file buffers
(@code{Buffer-menu-toggle-files-only}). This command toggles the
inclusion of such buffers in the buffer list.
+
+@findex Buffer-menu-toggle-internal
+@kindex I @r{(Buffer Menu)}
+@item I
+Toggle display of internal buffers, those whose names begin with a
+space.
@end table
Normally, the buffer @file{*Buffer List*} is not updated
@@ -761,7 +772,7 @@ you first type @kbd{C-M-i}.
By default, when you press @kbd{C-M-i}, both Icomplete mode's
in-buffer display of possible completions and the @file{*Completions*}
buffer appear. If you are using @code{icomplete-in-buffer}, then you
-may wish to suppress this apperance of the @file{*Completions*}
+may wish to suppress this appearance of the @file{*Completions*}
buffer. To do that, add the following to your initialization file
(@pxref{Init File}):
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 9c8558c93a1..4725af0ee5f 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -188,14 +188,15 @@ find with @kbd{M-x customize-browse}.
the customization buffer:
@smallexample
-[Hide] Kill Ring Max: 60
+[Hide] Kill Ring Max: Integer (positive or zero): 120
[State]: STANDARD.
Maximum length of kill ring before oldest elements are thrown away.
@end smallexample
The first line shows that the variable is named
@code{kill-ring-max}, formatted as @samp{Kill Ring Max} for easier
-viewing. Its value is @samp{120}. The button labeled @samp{[Hide]},
+viewing, and also shows its expected type: a positive integer or zero.
+The default value is @samp{120}. The button labeled @samp{[Hide]},
if activated, hides the variable's value and state; this is useful to
avoid cluttering up the customization buffer with very long values
(for this reason, variables that have very long values may start out
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index e6a43bf74a8..bda57d2b30e 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1986,6 +1986,7 @@ the fringe indicates truncation at either end of the line. On text
terminals, this is indicated with @samp{$} signs in the rightmost
and/or leftmost columns.
+@kindex C-x x t
@vindex truncate-lines
@findex toggle-truncate-lines
Horizontal scrolling automatically causes line truncation
@@ -2209,6 +2210,14 @@ keys; its value is the number of seconds of pause required to cause echoing
to start, or zero, meaning don't echo at all. The value takes effect when
there is something to echo. @xref{Echo Area}.
+@vindex echo-keystrokes-help
+ If the variable @code{echo-keystrokes-help} is non-@code{nil} (the
+default), the multi-character key sequence echo shown according to
+@code{echo-keystrokes} will include a short help text about keys which
+will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show
+the list of commands for the prefix you already typed. For a related
+help facility, see @ref{which-key}.
+
@cindex mouse pointer
@cindex hourglass pointer display
@vindex display-hourglass
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 9c5305acf60..ccdeef414e2 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -779,6 +779,12 @@ operations typically break hard links, disconnecting the file name you
visited from any alternate names for the same file. This has nothing
to do with Emacs---the version control system does it.
+ Some file storage services support @dfn{file versioning}: they
+record history of previous versions of files, and allow reverting to
+those previous versions. If you want to be able to do that with files
+hosted by those services when editing them with Emacs, customize
+@code{backup-by-copying} to a non-@code{nil} value.
+
@node Customize Save
@subsection Customizing Saving of Files
@@ -1061,6 +1067,7 @@ revert it automatically if it has changed---provided the buffer itself
is not modified. (If you have edited the text, it would be wrong to
discard your changes.)
+@kindex C-x x g
@vindex revert-buffer-quick-short-answers
@findex revert-buffer-quick
The @kbd{C-x x g} keystroke is bound to the
@@ -2391,7 +2398,7 @@ multiply the size by the factor of @w{@code{1 + @var{n} / 10}}, so
@findex image-decrease-size
@kindex i - (Image mode)
@item i -
-Decrease the image size (@code{image-increase-size}) by 20%. Prefix
+Decrease the image size (@code{image-decrease-size}) by 20%. Prefix
numeric argument controls the decrement; the value of @var{n} means to
multiply the size by the factor of @w{@code{1 - @var{n} / 10}}, so
@w{@kbd{C-u 3 i -}} means to decrease the size by 30%.
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 638cc46608c..f3c876cf3f7 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -274,6 +274,9 @@ you can control which one is used by customizing the variable
@item M-$
Check and correct spelling of the word at point (@code{ispell-word}).
If the region is active, do it for all words in the region instead.
+@item C-u M-$
+If a previous spelling operation was interrupted, continue that
+operation (@code{ispell-continue}).
@item M-x ispell
Check and correct spelling of all words in the buffer. If the region
is active, do it for all words in the region instead.
@@ -305,12 +308,16 @@ Enable Flyspell mode for comments and strings only.
@kindex M-$
@findex ispell-word
+@findex ispell-continue
To check the spelling of the word around or before point, and
optionally correct it as well, type @kbd{M-$} (@code{ispell-word}).
If a region is active, @kbd{M-$} checks the spelling of all words
within the region. @xref{Mark}. (When Transient Mark mode is off,
@kbd{M-$} always acts on the word around or before point, ignoring the
-region; @pxref{Disabled Transient Mark}.)
+region; @pxref{Disabled Transient Mark}.) When invoked with a prefix
+argument, @kbd{C-u M-$}, this calls @code{ispell-continue}, which
+continues the spelling operation, if any, which was interrupted with
+@kbd{X} or @kbd{C-g}.
@findex ispell
@findex ispell-buffer
@@ -383,9 +390,9 @@ wildcard.
@item C-g
@itemx X
-Quit interactive spell-checking, leaving point at the word that was
-being checked. You can restart checking again afterward with @w{@kbd{C-u
-M-$}}.
+Interrupt the interactive spell-checking, leaving point at the word
+that was being checked. You can restart checking again afterward with
+@w{@kbd{C-u M-$}}.
@item x
Quit interactive spell-checking and move point back to where it was
@@ -394,6 +401,19 @@ when you started spell-checking.
@item q
Quit interactive spell-checking and kill the spell-checker subprocess.
+@item C-r
+Enter recursive-edit (@pxref{Recursive Edit}). When you exit
+recursive-edit with @kbd{C-M-c}, the interactive spell-checking will
+resume. This allows you to consult the buffer text without
+interrupting the spell-checking. Do @emph{not} modify the buffer in
+the recursive editing, and especially don't modify the misspelled
+word, as the edits will be undone when you exit recursive-edit. If
+you need to edit the misspelled word, use @kbd{r} or @kbd{R} instead,
+or use @kbd{X}, edit the buffer, then resume with @w{@kbd{C-u M-$}}.
+
+@item C-z
+Suspend Emacs or iconify the selected frame.
+
@item ?
Show the list of options.
@end table
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index e2f9f8a8c86..d60310456ff 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -115,6 +115,9 @@ Display a list of commands whose names match @var{topics}
Display all active key bindings; minor mode bindings first, then those
of the major mode, then global bindings (@code{describe-bindings}).
@xref{Misc Help}.
+@item C-h C-q
+Toggle display of a window showing popular commands and their key
+bindings. @xref{Misc Help}.
@item C-h c @var{key}
Show the name of the command that the key sequence @var{key} is bound
to (@code{describe-key-briefly}). Here @kbd{c} stands for
@@ -257,6 +260,11 @@ by these buttons, Emacs provides the @code{button-describe} and
@code{widget-describe} commands, that should be run with point over
the button.
+@anchor{which-key}
+@kbd{M-x which-key} is a global minor mode which helps in discovering
+ keymaps. It displays keybindings following your currently entered
+ incomplete command (prefix), in a popup.
+
@node Name Help
@section Help by Command or Variable Name
@@ -302,6 +310,13 @@ name is defined as a Lisp function. Type @kbd{C-g} to cancel the
@kbd{C-h f} command if you don't really want to view the
documentation.
+ The function's documentation displayed by @code{describe-function}
+includes more than just the documentation string and the signature of
+the function. It also shows auxiliary information such as its type, the
+file where it was defined, whether it has been declared obsolete, and
+yet further information is often reachable by clicking or typing
+@key{RET} on emphasized parts of the text.
+
@vindex help-enable-symbol-autoload
If you request help for an autoloaded function whose @code{autoload}
form (@pxref{Autoload,,, elisp, The Emacs Lisp Reference Manual})
@@ -710,6 +725,18 @@ displays the contents of the syntax table, with explanations of each
character's syntax (@pxref{Syntax Tables,, Syntax Tables, elisp, The
Emacs Lisp Reference Manual}).
+@kindex C-h C-q
+@findex help-quick-toggle
+@findex help-quick
+@cindex cheat sheet of popular Emacs commands
+ @kbd{C-h C-q} (@code{help-quick-toggle}) toggles on and off the
+display of a buffer showing the most popular Emacs commands and their
+respective key bindings (a.k.a.@: ``cheat sheet''). The contents of
+that buffer are created by the command @code{help-quick}. Each key
+binding shown in this buffer is a button: click on it with
+@kbd{mouse-1} or @kbd{mouse-2} to show the documentation of the
+command bound to that key sequence.
+
@findex describe-prefix-bindings
You can get a list of subcommands for a particular prefix key by
typing @kbd{C-h}, @kbd{?}, or @key{F1}
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 9717c02f782..57adc037cb7 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -91,9 +91,11 @@ Delete the next character (@code{delete-char}).
@item M-\
Delete spaces and tabs around point (@code{delete-horizontal-space}).
+@item M-x just-one-space
+Delete spaces and tabs around point, leaving one space.
@item M-@key{SPC}
-Delete spaces and tabs around point, leaving one space
-(@code{just-one-space}).
+Delete spaces and tabs around point in flexible ways
+(@code{cycle-spacing}).
@item C-x C-o
Delete blank lines around the current line (@code{delete-blank-lines}).
@item M-^
@@ -118,12 +120,13 @@ characters before and after point. With a prefix argument, this only
deletes spaces and tab characters before point.
@findex just-one-space
-@code{just-one-space} does likewise but leaves a single space before
-point, regardless of the number of spaces that existed previously
-(even if there were none before). With a numeric argument @var{n}, it
-leaves @var{n} spaces before point if @var{n} is positive; if @var{n}
-is negative, it deletes newlines in addition to spaces and tabs,
-leaving @minus{}@var{n} spaces before point.
+@kbd{M-x just-one-space} deletes tabs and spaces around point, but
+leaves a single space before point, regardless of the number of spaces
+that existed previously (even if there were none before). With a
+numeric argument @var{n}, it leaves @var{n} spaces before point if
+@var{n} is positive; if @var{n} is negative, it deletes newlines in
+addition to spaces and tabs, leaving @minus{}@var{n} spaces before
+point.
@kindex M-SPC
@findex cycle-spacing
@@ -131,7 +134,14 @@ leaving @minus{}@var{n} spaces before point.
The command @code{cycle-spacing} (@kbd{M-@key{SPC}}) acts like a more
flexible version of @code{just-one-space}. It performs different
space cleanup actions defined by @code{cycle-spacing-actions}, in a
-cyclic manner, if you call it repeatedly in succession.
+cyclic manner, if you call it repeatedly in succession. By default,
+the first invocation does the same as @code{just-one-space}, the
+second deletes all whitespace characters around point like
+@code{delete-horizontal-space}, and the third restores the original
+whitespace characters; then it cycles. If invoked with a prefix
+argument, each action is given that value of the argument. The user
+option @code{cycle-spacing-actions} can include other members; see the
+doc string of that option for the details.
@kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines
after the current line. If the current line is blank, it deletes all
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 8de9cf2c2f3..d3e06fa697b 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -2683,7 +2683,7 @@ use tags, separate from the @command{etags} facility.
@menu
* Tag Syntax:: Tag syntax for various types of code and text files.
-* Create Tags Table:: Creating a tags table with @command{etags}.
+* Create Tags Table:: Creating and updating tags tables with @command{etags}.
* Etags Regexps:: Create arbitrary tags using regular expressions.
@end menu
@@ -2999,6 +2999,38 @@ explanation. If followed by one or more @samp{--language=@var{lang}}
options, it outputs detailed information about how tags are generated for
@var{lang}.
+@findex etags-regen-mode
+ Instead of creating and updating the tags table by manually invoking
+@command{etags}, you can ask Emacs to do it for you automatically.
+The global minor mode @code{etags-regen-mode}, if enabled, generates
+tags tables automatically as needed, and takes care of updating them
+when you edit any of the source files that contribute tags. This mode
+uses the current project configuration (@pxref{Projects}) to determine
+which files to submit to @command{etags} for regenerating the tags
+table for the project. You can customize how this minor mode works
+using the following user options:
+
+@vtable @code
+@item etags-regen-program
+The program to regenerate tags table; defaults to @command{etags}.
+
+@item etags-regen-program-options
+Command-line options to pass to the program which regenerates tags
+tables.
+
+@item etags-regen-ignores
+List of glob patterns which specify files to ignore when regenerating
+tags tables.
+@end vtable
+
+@cindex tags-reset-tags-tables
+ If you select a tags table manually, with @kbd{M-x visit-tags-table}
+(@pxref{Select Tags Table}), @code{etags-regen-mode} effectively
+disables itself: it will no longer automatically create and update
+tags tables, assuming that you prefer managing your tags tables
+manually. You can cancel this effect of using @code{visit-tags-table}
+by invoking the command @code{tags-reset-tags-tables}.
+
@node Etags Regexps
@subsubsection Etags Regexps
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 30a61a02f06..aa7144610a6 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -709,7 +709,9 @@ will use just one column.
The @code{completions-sort} user option controls the order in which
the completions are sorted in the @samp{*Completions*} buffer. The
default is @code{alphabetical}, which sorts in alphabetical order.
-The value @code{nil} disables sorting. The value can also be a
+The value @code{nil} disables sorting; the value @code{historical}
+sorts alphabetically first, and then rearranges according to the order
+of the candidates in the minibuffer history. The value can also be a
function, which will be called with the list of completions, and
should return the list in the desired order.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 7eb28f56826..8f9ee317080 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -3009,6 +3009,15 @@ buffer, and lets you navigate to those pages by hitting @kbd{RET}.
It is bound to @kbd{H}.
+@vindex xwidget-webkit-disable-javascript
+@cindex disabling javascript in webkit buffers
+ JavaScript is enabled by default inside WebKit buffers, which could be
+undesirable, as Web sites often use it to track your online activity.
+You can disable JavaScript in WebKit buffers by customizing the variable
+@code{xwidget-webkit-disable-javascript} to a non-@code{nil} value.
+You must kill all WebKit buffers for this setting to take effect, after
+it is changed.
+
@node Browse-URL
@subsection Following URLs
@cindex World Wide Web
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index b00f116ee4e..861c0d90dc6 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -1182,12 +1182,23 @@ click-to-focus policy.
@end ifnottex
On Windows 10 (version 1809 and higher) and Windows 11, Emacs title
-bars and scroll bars will follow the system's Light or Dark mode,
-similar to other programs such as Explorer and Command Prompt. To
-change the color mode, select @code{Personalization} from
-@w{@code{Windows Settings}}, then
-@w{@code{Colors->Choose your color}} (or @w{@code{Choose your default
-app mode}}); then restart Emacs.
+bars and scroll bars by default follow the system's Light or Dark
+mode, similar to other programs such as Explorer and Command Prompt.
+To change the color mode, select @code{Personalization} from
+@w{@code{Windows Settings}}, then @w{@code{Colors->Choose your color}}
+(or @w{@code{Choose your default app mode}} or @w{@code{Choose your
+mode}}); then restart Emacs. On Windows 11, you can select separate
+default modes for Windows and for applications.
+
+@vindex w32-follow-system-dark-mode
+ If you don't want Emacs to follow the system's Dark mode setting,
+customize the variable @code{w32-follow-system-dark-mode} to a
+@code{nil} value; then Emacs will use the default Light mode
+regardless of system-wide settings. Changing the value of this
+variable affects only the Emacs frames created after the change, so
+you should set its value in your init file (@pxref{Init File}), either
+directly or via @kbd{M-x customize-variable}, which lets you save the
+customized value, see @ref{Saving Customizations}.
@ifnottex
@include msdos-xtra.texi
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index fdcddbbc739..cac5b32c566 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -71,6 +71,11 @@ by @code{insert-register} will only show registers whose values can be
inserted into the buffer, omitting registers which hold window
configurations, positions, and other un-insertable values.
+@item insist
+This value is like @code{t}, but in addition you can press the same
+key as the name of register one more time to exit the minibuffer,
+instead of pressing @key{RET}.
+
@item nil
This value requests behavior similar to @code{traditional}, but the
preview is shown without delay, and is filtered according to the
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 51bd6086ce0..f94708b08ac 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -875,7 +875,10 @@ already composing, or to alter a message you have sent.
If you set the variable @code{rmail-mail-new-frame} to a
non-@code{nil} value, then all the Rmail commands to start sending a
message create a new frame to edit it in. This frame is deleted when
-you send the message.
+you send the message (but not if it is the only visible frame on the
+current display, or if it's a text-mode frame). If this frame cannot
+be deleted when you send the message, Emacs will try to reuse it for
+composing subsequent messages.
@ignore
@c FIXME does not work with Message -> Kill Message
, or when you use the @samp{Cancel} item in the @samp{Mail} menu.
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 338bf014208..cb347d59948 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are contained in
chapters. This works as long as no other command starts with
@samp{@@chap}.
+@vindex outline-search-function
+ Instead of setting the variable @code{outline-regexp}, you can set
+the variable @code{outline-search-function} to a function that
+matches the current heading and searches for the next one
+(@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}).
+
@vindex outline-level
You can explicitly specify a rule for calculating the level of a
heading line by setting the variable @code{outline-level}. The value
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index f1f7a5b4b86..ad2225b5922 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -287,7 +287,7 @@ Delete all windows in the selected frame except the selected window
Delete the selected window and kill the buffer that was showing in it
(@code{kill-buffer-and-window}). The last character in this key
sequence is a zero.
-@item M-x delete-windows-on @key{RET} @var{buffer} @key{RET}
+@item C-x w 0 @key{RET} @var{buffer} @key{RET}
Delete windows showing the specified @var{buffer}.
@item C-x ^
Make selected window taller (@code{enlarge-window}).
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index 1e10f62104a..a06822ce539 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -3556,6 +3556,7 @@ and the two are not intended to refer to the same value. The
* Parts of let Expression::
* Sample let Expression::
* Uninitialized let Variables::
+* How let Binds Variables::
@end menu
@ifnottex
@@ -3569,24 +3570,26 @@ and the two are not intended to refer to the same value. The
@cindex @samp{variable, local}, defined
The @code{let} special form prevents confusion. @code{let} creates a
name for a @dfn{local variable} that overshadows any use of the same
-name outside the @code{let} expression. This is like understanding
-that whenever your host refers to ``the house'', he means his house, not
-yours. (Symbols used in argument lists work the same way.
+name outside the @code{let} expression (in computer science jargon, we
+call this @dfn{binding} the variable). This is like understanding
+that in your host's home, whenever he refers to ``the house'', he
+means his house, not yours. (The symbols used to name function
+arguments are bound as local variables in exactly the same way.
@xref{defun, , The @code{defun} Macro}.)
-Local variables created by a @code{let} expression retain their value
-@emph{only} within the @code{let} expression itself (and within
-expressions called within the @code{let} expression); the local
-variables have no effect outside the @code{let} expression.
-
-Another way to think about @code{let} is that it is like a @code{setq}
-that is temporary and local. The values set by @code{let} are
-automatically undone when the @code{let} is finished. The setting
-only affects expressions that are inside the bounds of the @code{let}
-expression. In computer science jargon, we would say the binding of
-a symbol is visible only in functions called in the @code{let} form;
-in Emacs Lisp, the default scoping is dynamic, not lexical. (The
-non-default lexical binding is not discussed in this manual.)
+Another way to think about @code{let} is that it defines a special
+region in your code: within the body of the @code{let} expression, the
+variables you've named have their own local meaning. Outside of the
+@code{let} body, they have other meanings (or they may not be defined
+at all). This means that inside the @code{let} body, calling
+@code{setq} for a variable named by the @code{let} expression will set
+the value of the @emph{local} variable of that name. However, outside
+of the @code{let} body (such as when calling a function that was
+defined elsewhere), calling @code{setq} for a variable named by the
+@code{let} expression will @emph{not} affect that local
+variable.@footnote{This describes the behavior of @code{let} when
+using a style called ``lexical binding'' (@pxref{How let Binds
+Variables}).}
@code{let} can create more than one variable at once. Also,
@code{let} gives each variable it creates an initial value, either a
@@ -3746,6 +3749,128 @@ number is printed in the message using a @samp{%d} rather than a
@samp{%s}.) The four variables as a group are put into a list to
delimit them from the body of the @code{let}.
+@node How let Binds Variables
+@subsection How @code{let} Binds Variables
+
+Emacs Lisp supports two different ways of binding variable names to
+their values. These ways affect the parts of your program where a
+particular binding is valid. For historical reasons, Emacs Lisp uses
+a form of variable binding called @dfn{dynamic binding} by default.
+However, in this manual we discuss the preferred form of binding,
+called @dfn{lexical binding}, unless otherwise noted (in the future,
+the Emacs maintainers plan to change the default to lexical binding).
+If you have programmed in other languages before, you're likely
+already familiar with how lexical binding behaves.
+
+In order to use lexical binding in a program, you should add this to
+the first line of your Emacs Lisp file:
+
+@example
+;;; -*- lexical-binding: t -*-
+@end example
+
+For more information about this, @pxref{Variable Scoping, , ,
+elisp, The Emacs Lisp Reference Manual}.
+
+@menu
+* Lexical & Dynamic Binding Differences::
+* Lexical vs. Dynamic Binding Example::
+@end menu
+
+@node Lexical & Dynamic Binding Differences
+@unnumberedsubsubsec Differences Between Lexical and Dynamic Binding
+
+@cindex Lexical binding
+@cindex Binding, lexical
+As we discussed before (@pxref{Prevent confusion}), when you create
+local variables with @code{let} under lexical binding, those variables
+are valid only within the body of the @code{let} expression. In other
+parts of your code, they have other meanings, so if you call a
+function defined elsewhere within the @code{let} body, that function
+would be unable to ``see'' the local variables you've created. (On
+the other hand, if you call a function that was defined within a
+@code{let} body, that function @emph{would} be able to see---and
+modify---the local variables from that @code{let} expression.)
+
+@cindex Dynamic binding
+@cindex Binding, dynamic
+Under dynamic binding, the rules are different: instead, when you use
+@code{let}, the local variables you've created are valid during
+execution of the @code{let} expression. This means that, if your
+@code{let} expression calls a function, that function can see these
+local variables, regardless of where the function is defined
+(including in another file entirely).
+
+Another way to think about @code{let} when using dynamic binding is
+that every variable name has a global ``stack'' of bindings, and
+whenever you use that variable's name, it refers to the binding on the
+top of the stack. (You can imagine this like a stack of papers on
+your desk with the values written on them.) When you bind a variable
+dynamically with @code{let}, it puts the new binding you've specified
+on the top of the stack, and then executes the @code{let} body. Once
+the @code{let} body finishes, it takes that binding off of the stack,
+revealing the one it had (if any) before the @code{let} expression.
+
+@node Lexical vs. Dynamic Binding Example
+@unnumberedsubsubsec Example of Lexical vs. Dynamic Binding
+In some cases, both lexical and dynamic binding behave identically.
+However, in other cases, they can change the meaning of your program.
+For example, see what happens in this code under lexical binding:
+
+@example
+;;; -*- lexical-binding: t -*-
+
+(setq x 0)
+
+(defun getx ()
+ x)
+
+(setq x 1)
+
+(let ((x 2))
+ (getx))
+ @result{} 1
+@end example
+
+@noindent
+Here, the result of @code{(getx)} is @code{1}. Under lexical binding,
+@code{getx} doesn't see the value from our @code{let} expression.
+That's because the body of @code{getx} is outside of the body of our
+@code{let} expression. Since @code{getx} is defined at the top,
+global level of our code (i.e.@: not inside the body of any @code{let}
+expression), it looks for and finds @code{x} at the global level as
+well. When executing @code{getx}, the current global value of
+@code{x} is @code{1}, so that's what @code{getx} returns.
+
+If we use dynamic binding instead, the behavior is different:
+
+@example
+;;; -*- lexical-binding: nil -*-
+
+(setq x 0)
+
+(defun getx ()
+ x)
+
+(setq x 1)
+
+(let ((x 2))
+ (getx))
+ @result{} 2
+@end example
+
+@noindent
+Now, the result of @code{(getx)} is @code{2}! That's because under
+dynamic binding, when executing @code{getx}, the current binding for
+@code{x} at the top of our stack is the one from our @code{let}
+binding. This time, @code{getx} doesn't see the global value for
+@code{x}, since its binding is below the one from our @code{let}
+expression in the stack of bindings.
+
+(Some variables are also ``special'', and they are always dynamically
+bound even when @code{lexical-binding} is @code{t}. @xref{defvar, ,
+Initializing a Variable with @code{defvar}}.)
+
@node if
@section The @code{if} Special Form
@findex if
@@ -9101,12 +9226,14 @@ In Emacs Lisp, a variable such as the @code{kill-ring} is created and
given an initial value by using the @code{defvar} special form. The
name comes from ``define variable''.
-The @code{defvar} special form is similar to @code{setq} in that it sets
-the value of a variable. It is unlike @code{setq} in two ways: first,
-it only sets the value of the variable if the variable does not already
-have a value. If the variable already has a value, @code{defvar} does
-not override the existing value. Second, @code{defvar} has a
-documentation string.
+The @code{defvar} special form is similar to @code{setq} in that it
+sets the value of a variable. It is unlike @code{setq} in three ways:
+first, it marks the variable as ``special'' so that it is always
+dynamically bound, even when @code{lexical-binding} is @code{t}
+(@pxref{How let Binds Variables}). Second, it only sets the value of
+the variable if the variable does not already have a value. If the
+variable already has a value, @code{defvar} does not override the
+existing value. Third, @code{defvar} has a documentation string.
(There is a related macro, @code{defcustom}, designed for variables
that people customize. It has more features than @code{defvar}.
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 476b8cf8fe6..0a228271be3 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -144,7 +144,15 @@ ps: $(PS_TARGETS)
${buildinfodir}:
${MKDIR_P} $@
-$(buildinfodir)/elisp.info: $(srcs) | ${buildinfodir}
+auxfiles = $(buildinfodir)/elisp_type_hierarchy.txt $(buildinfodir)/elisp_type_hierarchy.jpg
+
+$(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt | ${buildinfodir}
+ cp $< $@
+
+$(buildinfodir)/elisp_type_hierarchy.jpg: $(srcdir)/elisp_type_hierarchy.jpg | ${buildinfodir}
+ cp $< $@
+
+$(buildinfodir)/elisp.info: $(srcs) $(auxfiles) | ${buildinfodir}
$(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $<
elisp.dvi: $(srcs)
@@ -179,6 +187,7 @@ infoclean:
$(buildinfodir)/elisp.info \
$(buildinfodir)/elisp.info-[1-9] \
$(buildinfodir)/elisp.info-[1-9][0-9]
+ rm -f $(auxfiles)
bootstrap-clean maintainer-clean: distclean infoclean
rm -f TAGS
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 9b719145584..d89cec4bc2b 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -65,7 +65,7 @@ expanded in the buffer. For the user-level commands for abbrevs, see
@defun make-abbrev-table &optional props
This function creates and returns a new, empty abbrev table---an
-obarray containing no symbols. It is a vector filled with zeros.
+obarray containing no symbols.
@var{props} is a property list that is applied to the new table
(@pxref{Abbrev Table Properties}).
@end defun
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 6a5367c17ba..5375eb64155 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -371,6 +371,12 @@ See the related function @code{generate-new-buffer} in @ref{Creating
Buffers}.
@end defun
+@defun buffer-last-name &optional buffer
+This function returns the previous name of @var{buffer}, before it was
+killed or before the last time it was renamed. If nil or omitted,
+@var{buffer} defaults to the current buffer.
+@end defun
+
@node Buffer File Name
@section Buffer File Name
@cindex visited file
@@ -959,7 +965,7 @@ infinite recursion.
@defun buffer-match-p condition buffer-or-name &rest args
This function checks if a buffer designated by @code{buffer-or-name}
-satisfies the specified @code{condition}. Optional arguments
+satisfies the specified @var{condition}. Optional arguments
@var{args} are passed to the predicate function in @var{condition}. A
valid @var{condition} can be one of the following:
@itemize @bullet{}
@@ -985,10 +991,15 @@ Satisfied if @emph{any} condition in @var{conds} satisfies
Satisfied if @emph{all} the conditions in @var{conds} satisfy
@code{buffer-match-p}, with the same buffer and @code{args}.
@item derived-mode
-Satisfied if the buffer's major mode derives from @var{expr}.
+Satisfied if the buffer's major mode derives from @var{expr}. Note
+that this condition might fail to report a match if
+@code{buffer-match-p} is invoked before the major mode of the buffer
+has been established.
@item major-mode
Satisfied if the buffer's major mode is equal to @var{expr}. Prefer
-using @code{derived-mode} instead, when both can work.
+using @code{derived-mode} instead, when both can work. Note that this
+condition might fail to report a match if @code{buffer-match-p} is
+invoked before the major mode of the buffer has been established.
@end table
@item t
Satisfied by any buffer. A convenient alternative to @code{""} (empty
@@ -998,7 +1009,7 @@ string) or @code{(and)} (empty conjunction).
@defun match-buffers condition &optional buffer-list &rest args
This function returns a list of all buffers that satisfy the
-@code{condition}. If no buffers match, the function returns
+@var{condition}. If no buffers match, the function returns
@code{nil}. The argument @var{condition} is as defined in
@code{buffer-match-p} above. By default, all the buffers are
considered, but this can be restricted via the optional argument
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 10f47d736d2..4fe4969c0db 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2464,7 +2464,7 @@ buffer-local variable @code{text-conversion-style}, which determines
how an input method that wishes to make edits to buffer contents will
behave.
-This variable can have one of three values:
+This variable can have one of four values:
@table @code
@item nil
@@ -2475,6 +2475,13 @@ events will be sent instead of text conversion events.
This means that the input method will be enabled, but @key{RET} will
be sent whenever the input method wants to insert a new line.
+@item password
+This is largely identical to @code{action}, but also requests an input
+method capable of inserting ASCII characters, and instructs it not to
+save input in locations from which it might be subsequently retrieved
+by features of the input method that cannot handle sensitive
+information, such as text suggestions.
+
@item t
This, or any other value, means that the input method will be enabled
and make edits followed by @code{text-conversion} events.
@@ -2562,23 +2569,27 @@ non-@code{nil}.
@vindex mouse-wheel-up-event
@vindex mouse-wheel-down-event
The @code{wheel-up} and @code{wheel-down} events are generated only on
-some kinds of systems. On other systems, @code{mouse-4} and
-@code{mouse-5} are used instead. For portable code, use the variables
-@code{mouse-wheel-up-event}, @code{mouse-wheel-up-alternate-event},
-@code{mouse-wheel-down-event} and
-@code{mouse-wheel-down-alternate-event} defined in @file{mwheel.el} to
-determine what event types to expect from the mouse wheel.
+some kinds of systems. On other systems, other events like @code{mouse-4} and
+@code{mouse-5} are used instead. Portable code should handle both
+@code{wheel-up} and @code{wheel-down} events as well as the events
+specified in the variables @code{mouse-wheel-up-event} and
+@code{mouse-wheel-down-event}, defined in @file{mwheel.el}.
+Beware that for historical reasons the @code{mouse-wheel-@emph{up}-event}
+is the variable that holds an event that should be handled similarly to
+@code{wheel-@emph{down}} and vice versa.
@vindex mouse-wheel-left-event
@vindex mouse-wheel-right-event
-Similarly, some mice can generate @code{mouse-wheel-left-event} and
-@code{mouse-wheel-right-event} and can be used to scroll if
-@code{mouse-wheel-tilt-scroll} is non-@code{nil}. However, some mice
-also generate other events at the same time as they're generating
-these scroll events which may get in the way. The way to fix this is
-generally to unbind these events (for instance, @code{mouse-6} or
-@code{mouse-7}, but this is very hardware and operating system
-dependent).
+The same holds for the horizontal wheel movements which are usually
+represented by @code{wheel-left} and @code{wheel-right} events, but
+for which portable code should also obey the variables
+@code{mouse-wheel-left-event} and @code{mouse-wheel-right-event},
+defined in @file{mwheel.el}.
+However, some mice also generate other events at the same time as
+they're generating these scroll events which may get in the way.
+The way to fix this is generally to unbind these events (for instance,
+@code{mouse-6} or @code{mouse-7}, but this is very hardware and
+operating system dependent).
@cindex @code{pinch} event
@item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle})
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 98a01fb67f9..00602198da5 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -35,7 +35,6 @@ variable binding for @code{no-byte-compile} into it, like this:
* Speed of Byte-Code:: An example of speedup from byte compilation.
* Compilation Functions:: Byte compilation functions.
* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
* Eval During Compile:: Code to be evaluated when you compile.
* Compiler Errors:: Handling compiler error messages.
* Byte-Code Objects:: The data type used for byte-compiled functions.
@@ -289,71 +288,6 @@ stands for the name of this file, as a string. Do not use these
constructs in Lisp source files; they are not designed to be clear to
humans reading the file.
-@node Dynamic Loading
-@section Dynamic Loading of Individual Functions
-
-@cindex dynamic loading of functions
-@cindex lazy loading
- When you compile a file, you can optionally enable the @dfn{dynamic
-function loading} feature (also known as @dfn{lazy loading}). With
-dynamic function loading, loading the file doesn't fully read the
-function definitions in the file. Instead, each function definition
-contains a place-holder which refers to the file. The first time each
-function is called, it reads the full definition from the file, to
-replace the place-holder.
-
- The advantage of dynamic function loading is that loading the file
-should become faster. This is a good thing for a file which contains
-many separate user-callable functions, if using one of them does not
-imply you will probably also use the rest. A specialized mode which
-provides many keyboard commands often has that usage pattern: a user may
-invoke the mode, but use only a few of the commands it provides.
-
- The dynamic loading feature has certain disadvantages:
-
-@itemize @bullet
-@item
-If you delete or move the compiled file after loading it, Emacs can no
-longer load the remaining function definitions not already loaded.
-
-@item
-If you alter the compiled file (such as by compiling a new version),
-then trying to load any function not already loaded will usually yield
-nonsense results.
-@end itemize
-
- These problems will never happen in normal circumstances with
-installed Emacs files. But they are quite likely to happen with Lisp
-files that you are changing. The easiest way to prevent these problems
-is to reload the new compiled file immediately after each recompilation.
-
- @emph{Experience shows that using dynamic function loading provides
-benefits that are hardly measurable, so this feature is deprecated
-since Emacs 27.1.}
-
- The byte compiler uses the dynamic function loading feature if the
-variable @code{byte-compile-dynamic} is non-@code{nil} at compilation
-time. Do not set this variable globally, since dynamic loading is
-desirable only for certain files. Instead, enable the feature for
-specific source files with file-local variable bindings. For example,
-you could do it by writing this text in the source file's first line:
-
-@example
--*-byte-compile-dynamic: t;-*-
-@end example
-
-@defvar byte-compile-dynamic
-If this is non-@code{nil}, the byte compiler generates compiled files
-that are set up for dynamic function loading.
-@end defvar
-
-@defun fetch-bytecode function
-If @var{function} is a byte-code function object, this immediately
-finishes loading the byte code of @var{function} from its
-byte-compiled file, if it is not fully loaded already. Otherwise,
-it does nothing. It always returns @var{function}.
-@end defun
-
@node Eval During Compile
@section Evaluation During Compilation
@cindex eval during compilation
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index acf9be5c3ff..f9f3389c398 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2024 Free Software
+@c Copyright (C) 1990--2024 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Control Structures
@@ -323,7 +323,7 @@ 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}.
+(@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
@@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional
Example: @code{(= 42)}@*
In this example, the function is @code{=}, @var{n} is one, and
the actual function call becomes: @w{@code{(= 42 @var{expval})}}.
+
+@item function call with an @code{_} arg
+Call the function (the first element of the function call)
+with the specified arguments (the other elements) and replacing
+@code{_} with @var{expval}.
+
+Example: @code{(gethash _ memo-table)}
+In this example, the function is @code{gethash}, and
+the actual function call becomes: @w{@code{(gethash @var{expval}
+memo-table)}}.
@end table
@item (app @var{function} @var{pattern})
@@ -2293,6 +2303,123 @@ should be robust if one does occur. Note that this macro uses
@code{condition-case-unless-debug} rather than @code{condition-case}.
@end defmac
+Occasionally, we want to catch some errors and record some information
+about the conditions in which they occurred, such as the full
+backtrace, or the current buffer. This kinds of information is sadly
+not available in the handlers of a @code{condition-case} because the
+stack is unwound before running that handler, so the handler is run in
+the dynamic context of the @code{condition-case} rather than that of
+the place where the error was signaled. For those circumstances, you
+can use the following form:
+
+@defmac handler-bind handlers body@dots{}
+This special form runs @var{body} and if it executes without error,
+the value it returns becomes the value of the @code{handler-bind}
+form. In this case, the @code{handler-bind} has no effect.
+
+@var{handlers} should be a list of elements of the form
+@code{(@var{conditions} @var{handler})} where @var{conditions} is an
+error condition name to be handled, or a list of condition names, and
+@var{handler} should be a form whose evaluation should return a function.
+As with @code{condition-case}, condition names are symbols.
+
+Before running @var{body}, @code{handler-bind} evaluates all the
+@var{handler} forms and installs those handlers to be active during
+the evaluation of @var{body}. When an error is signaled,
+Emacs searches all the active @code{condition-case} and
+@code{handler-bind} forms for a handler that
+specifies one or more of these condition names. When the innermost
+matching handler is one installed by @code{handler-bind}, the
+@var{handler} function is called with a single argument holding the
+error description.
+
+Contrary to what happens with @code{condition-case}, @var{handler} is
+called in the dynamic context where the error happened. This means it
+is executed without unbinding any variable bindings or running any
+cleanups of @code{unwind-protect}, so that all those dynamic bindings
+are still in effect. There is one exception: while running the
+@var{handler} function, all the error handlers between the code that
+signaled the error and the @code{handler-bind} are temporarily
+suspended, meaning that when an error is signaled, Emacs will only
+search the active @code{condition-case} and @code{handler-bind} forms
+that are inside the @var{handler} function or outside of the current
+@code{handler-bind}. Note also that lexically-bound variables
+(@pxref{Lexical Binding}) are not affected, since they do not have
+dynamic extent.
+
+Like any normal function, @var{handler} can exit non-locally,
+typically via @code{throw}, or it can return normally.
+If @var{handler} returns normally, it means the handler
+@emph{declined} to handle the error and the search for an error
+handler is continued where it left off.
+
+For example, if we wanted to keep a log of all the errors that occur
+during the execution of a particular piece of code together with the
+buffer that's current when the error is signaled, but without
+otherwise affecting the behavior of that code, we can do it with:
+
+@example
+@group
+(handler-bind
+ ((error
+ (lambda (err)
+ (push (cons err (current-buffer)) my-log-of-errors))))
+ @var{body-forms}@dots{})
+@end group
+@end example
+
+This will log only those errors that are not caught internally to
+@var{body-forms}@dots{}, in other words errors that ``escape'' from
+@var{body-forms}@dots{}, and it will not prevent those errors from
+being passed on to surrounding @code{condition-case} handlers (or
+@code{handler-bind} handlers for that matter) since the above handler
+returns normally.
+
+We can also use @code{handler-bind} to replace an error with another,
+as in the code below which turns all errors of type @code{user-error}
+that occur during the execution of @var{body-forms}@dots{} into plain
+@code{error}:
+
+@example
+@group
+(handler-bind
+ ((user-error
+ (lambda (err)
+ (signal 'error (cdr err)))))
+ @var{body-forms}@dots{})
+@end group
+@end example
+
+We can get almost the same result with @code{condition-case}:
+
+@example
+@group
+(condition-case err
+ (progn @var{body-forms}@dots{})
+ (user-error (signal 'error (cdr err))))
+@end group
+@end example
+
+@noindent
+but with the difference that when we (re)signal the new error in
+@code{handler-bind}, the dynamic environment from the original error
+is still active, which means for example that if we enter the debugger
+at this point, it will show us a complete backtrace including the
+point where we signaled the original error:
+
+@example
+@group
+Debugger entered--Lisp error: (error "Oops")
+ signal(error ("Oops"))
+ (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops"))
+ user-error("Oops")
+ @dots{}
+ eval((handler-bind ((user-error (lambda (err) @dots{}
+@end group
+@end example
+
+@end defmac
+
@node Error Symbols
@subsubsection Error Symbols and Condition Names
@cindex error symbol
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 774fcaf68bf..47851be0f7c 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -1093,10 +1093,19 @@ argument (@kbd{C-u @key{RET}}) to see the whole call tree below a
function. Pressing @kbd{@key{RET}} again will collapse back to the
original state.
-Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function
-at point. Press @kbd{d} to view a function's documentation. You can
-save a profile to a file using @kbd{C-x C-w}. You can compare two
-profiles using @kbd{=}.
+@findex profiler-report-find-entry
+@findex profiler-report-describe-entry
+@findex profiler-find-profile
+@findex profiler-find-profile-other-window
+@findex profiler-report-compare-profile
+Press @kbd{j} (@code{profiler-report-find-entry}) or @kbd{mouse-2} to
+jump to the definition of a function at point. Press @kbd{d}
+(@code{profiler-report-describe-entry}) to view a function's
+documentation. You can save a profile to a file using @kbd{C-x C-w}
+(@code{profiler-report-write-profile}) and read a saved profile with
+@w{@kbd{M-x profiler-find-profile}} or @w{@kbd{M-x
+profiler-find-profile-other-window}}. You can compare two profiles
+using @kbd{=} (@code{profiler-report-compare-profile}).
@c FIXME reversed calltree?
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..b497967c445 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6048,6 +6048,7 @@ 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}.
+@findex image-compute-scaling-factor
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
@@ -6055,6 +6056,30 @@ 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.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
@end table
@defun image-mask-p spec &optional frame
@@ -6766,11 +6791,15 @@ from the file's name.
The remaining arguments, @var{props}, specify additional image
properties---for example,
-@c ':heuristic-mask' is not documented?
@example
-(create-image "foo.xpm" 'xpm nil :heuristic-mask t)
+(create-image "foo.xpm" 'xpm nil :mask 'heuristic)
@end example
+@noindent
+@xref{Image Descriptors}, for the list of supported properties. Some
+properties are specific to certain image types, and are described in
+subsections specific to those types.
+
The function returns @code{nil} if images of this type are not
supported. Otherwise it returns an image descriptor.
@end defun
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index a3ef8313f8e..71139db4359 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -300,6 +300,7 @@ Lisp Data Types
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
* Mutability:: Some objects should not be modified.
+* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects.
Programming Types
@@ -653,7 +654,6 @@ Byte Compilation
* Speed of Byte-Code:: An example of speedup from byte compilation.
* Compilation Functions:: Byte compilation functions.
* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
* Eval During Compile:: Code to be evaluated when you compile.
* Compiler Errors:: Handling compiler error messages.
* Byte-Code Objects:: The data type used for byte-compiled functions.
@@ -884,6 +884,7 @@ Major and Minor Modes
* Minor Modes:: Defining minor modes.
* Mode Line Format:: Customizing the text that appears in the mode line.
* Imenu:: Providing a menu of definitions made in a buffer.
+* Outline Minor Mode:: Outline mode to use with other major modes.
* Font Lock Mode:: How modes can highlight text according to syntax.
* Auto-Indentation:: How to teach Emacs to indent for a major mode.
* Desktop Save Mode:: How modes can have buffer state saved between
diff --git a/doc/lispref/elisp_type_hierarchy.jpg b/doc/lispref/elisp_type_hierarchy.jpg
new file mode 100644
index 00000000000..386954e1007
--- /dev/null
+++ b/doc/lispref/elisp_type_hierarchy.jpg
Binary files differ
diff --git a/doc/lispref/elisp_type_hierarchy.txt b/doc/lispref/elisp_type_hierarchy.txt
new file mode 100644
index 00000000000..bb93cd831b9
--- /dev/null
+++ b/doc/lispref/elisp_type_hierarchy.txt
@@ -0,0 +1,33 @@
+| Type | Derived Types |
+|---------------------+-----------------------------------------------------------|
+| t | sequence atom |
+| atom | number-or-marker array record symbol function |
+| | window-configuration font-object font-entity mutex |
+| | tree-sitter-node buffer overlay tree-sitter-parser thread |
+| | font-spec native-comp-unit tree-sitter-compiled-query |
+| | terminal window frame hash-table user-ptr obarray condvar |
+| | process |
+| sequence | array list |
+| list | null cons |
+| function | oclosure compiled-function module-function |
+| | interpreted-function |
+| symbol | boolean symbol-with-pos keyword |
+| compiled-function | subr byte-code-function |
+| oclosure | accessor advice--forward cconv--interactive-helper |
+| | cl--generic-nnm advice save-some-buffers-function |
+| record | cl-structure-object |
+| cl-structure-object | cl--class lisp-indent-state cl--random-state registerv |
+| | xref-elisp-location isearch--state cl-slot-descriptor |
+| | cl--generic-generalizer uniquify-item cl--generic-method |
+| | register-preview-info cl--generic |
+| cons | ppss decoded-time |
+| array | vector string char-table bool-vector |
+| number-or-marker | number integer-or-marker |
+| integer-or-marker | integer marker |
+| number | integer float |
+| cl--class | built-in-class cl-structure-class oclosure--class |
+| subr | subr-native-elisp subr-primitive |
+| accessor | oclosure-accessor |
+| vector | timer |
+| boolean | null |
+| integer | fixnum bignum |
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index f4c99640143..b42020f43af 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -844,11 +844,24 @@ function body forms, as well as explicit calls in Lisp code.
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.
+reached.
@end defopt
+@defopt lisp-eval-depth-reserve
+In order to be able to debug infinite recursion errors, when invoking the
+Lisp debugger, Emacs increases temporarily the value of
+@code{max-lisp-eval-depth}, if there is little room left, to make sure
+the debugger itself has room to execute. The same happens when
+running the handler of a @code{handler-bind}. @xref{Handling Errors}.
+
+The variable @code{lisp-eval-depth-reserve} bounds the extra depth
+that Emacs can add to @code{max-lisp-eval-depth} for those
+exceptional circumstances.
+
+The default value of this variable is 200.
+@end defopt
+
+
@defvar values
The value of this variable is a list of the values returned by all the
expressions that were read, evaluated, and printed from buffers
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 16c0432da3a..cf7fc7721c5 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4052,8 +4052,8 @@ programs. It takes two optional arguments, @var{type} and
The @var{data-type} argument specifies the form of data conversion to
use, to convert the raw data obtained from another program into Lisp
-data. @xref{X Selections}, for an enumeration of data types valid
-under X, and @xref{Other Selections} for those elsewhere.
+data. @xref{X Selections}, for an enumeration of data types valid under
+X, and @pxref{Other Selections} for those elsewhere.
@end defun
@defopt selection-coding-system
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 2b2c9287d91..ff635fc54b2 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -498,13 +498,12 @@ indentation of the following lines is inside the string; what looks
nice in the source code will look ugly when displayed by the help
commands.
- You may wonder how the documentation string could be optional, since
-there are required components of the function that follow it (the body).
-Since evaluation of a string returns that string, without any side effects,
-it has no effect if it is not the last form in the body. Thus, in
-practice, there is no confusion between the first form of the body and the
-documentation string; if the only body form is a string then it serves both
-as the return value and as the documentation.
+ A documentation string must always be followed by at least one Lisp
+expression; otherwise, it is not a documentation string at all but the
+single expression of the body and used as the return value.
+When there is no meaningful value to return from a function, it is
+standard practice to return @code{nil} by adding it after the
+documentation string.
The last line of the documentation string can specify calling
conventions different from the actual function arguments. Write
@@ -982,8 +981,8 @@ lists) and call them using @code{funcall} or @code{apply}. Functions
that accept function arguments are often called @dfn{functionals}.
Sometimes, when you call a functional, it is useful to supply a no-op
-function as the argument. Here are two different kinds of no-op
-function:
+function as the argument. Here are three different kinds of no-op
+functions:
@defun identity argument
This function returns @var{argument} and has no side effects.
@@ -2066,9 +2065,10 @@ code) obey the advice and other calls (from C code) do not.
@defmac define-advice symbol (where lambda-list &optional name depth) &rest body
This macro defines a piece of advice and adds it to the function named
-@var{symbol}. The advice is an anonymous function if @var{name} is
-@code{nil} or a function named @code{symbol@@name}. See
-@code{advice-add} for explanation of other arguments.
+@var{symbol}. If @var{name} is non-nil, the advice is named
+@code{@var{symbol}@@@var{name}} and installed with the name @var{name}; otherwise,
+the advice is anonymous. See @code{advice-add} for explanation of
+other arguments.
@end defmac
@defun advice-add symbol where function &optional props
@@ -2077,10 +2077,12 @@ Add the advice @var{function} to the named function @var{symbol}.
(@pxref{Core Advising Primitives}).
@end defun
-@defun advice-remove symbol function
+@deffn Command advice-remove symbol function
Remove the advice @var{function} from the named function @var{symbol}.
-@var{function} can also be the @code{name} of a piece of advice.
-@end defun
+@var{function} can also be the @code{name} of a piece of advice. When
+called interactively, prompt for both an advised @var{function} and
+the advice to remove.
+@end deffn
@defun advice-member-p function symbol
Return non-@code{nil} if the advice @var{function} is already in the named
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index ff9d1799a60..4270de664f1 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -121,32 +121,10 @@ referenced in the hash table are preserved from garbage collection.
@item :size @var{size}
This specifies a hint for how many associations you plan to store in the
hash table. If you know the approximate number, you can make things a
-little more efficient by specifying it this way. If you specify too
-small a size, the hash table will grow automatically when necessary, but
-doing that takes some extra time.
-
-The default size is 65.
-
-@item :rehash-size @var{rehash-size}
-When you add an association to a hash table and the table is full,
-it grows automatically. This value specifies how to make the hash table
-larger, at that time.
-
-If @var{rehash-size} is an integer, it should be positive, and the hash
-table grows by adding approximately that much to the nominal size. If
-@var{rehash-size} is floating point, it had better be greater
-than 1, and the hash table grows by multiplying the old size by
-approximately that number.
-
-The default value is 1.5.
-
-@item :rehash-threshold @var{threshold}
-This specifies the criterion for when the hash table is full (so
-it should be made larger). The value, @var{threshold}, should be a
-positive floating-point number, no greater than 1. The hash table is
-full whenever the actual number of entries exceeds the nominal size
-multiplied by an approximation to this value. The default for
-@var{threshold} is 0.8125.
+little more efficient by specifying it this way but since the hash
+table memory is managed automatically, the gain in speed is rarely
+significant.
+
@end table
@end defun
@@ -159,7 +137,7 @@ the following specifies a hash table containing the keys
(a symbol) and @code{300} (a number) respectively.
@example
-#s(hash-table size 30 data (key1 val1 key2 300))
+#s(hash-table data (key1 val1 key2 300))
@end example
Note, however, that when using this in Emacs Lisp code, it's
@@ -172,12 +150,11 @@ The printed representation for a hash table consists of @samp{#s}
followed by a list beginning with @samp{hash-table}. The rest of the
list should consist of zero or more property-value pairs specifying
the hash table's properties and initial contents. The properties and
-values are read literally. Valid property names are @code{size},
-@code{test}, @code{weakness}, @code{rehash-size},
-@code{rehash-threshold}, and @code{data}. The @code{data} property
+values are read literally. Valid property names are @code{test},
+@code{weakness} and @code{data}. The @code{data} property
should be a list of key-value pairs for the initial contents; the
other properties have the same meanings as the matching
-@code{make-hash-table} keywords (@code{:size}, @code{:test}, etc.),
+@code{make-hash-table} keywords (@code{:test} and @code{:weakness}),
described above.
Note that you cannot specify a hash table whose initial contents
@@ -229,6 +206,10 @@ This function calls @var{function} once for each of the associations in
@var{table}. The function @var{function} should accept two
arguments---a @var{key} listed in @var{table}, and its associated
@var{value}. @code{maphash} returns @code{nil}.
+
+@var{function} is allowed to call @code{puthash} to set a new value
+for @var{key} and @code{remhash} to remove @var{key}, but should not
+add, remove or modify other associations in @var{table}.
@end defun
@node Defining Hash
@@ -377,14 +358,7 @@ This function returns the @var{weak} value that was specified for hash
table @var{table}.
@end defun
-@defun hash-table-rehash-size table
-This returns the rehash size of @var{table}.
-@end defun
-
-@defun hash-table-rehash-threshold table
-This returns the rehash threshold of @var{table}.
-@end defun
-
@defun hash-table-size table
-This returns the current nominal size of @var{table}.
+This returns the current allocation size of @var{table}. Since hash table
+allocation is managed automatically, this is rarely of interest.
@end defun
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index a76bac011b7..4236fa75bf0 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -231,7 +231,7 @@ in the *Help* buffer."
(help-setup-xref (list 'describe-symbols pattern)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
- (mapcar describe-func (sort sym-list 'string<)))))
+ (mapcar describe-func (sort sym-list)))))
@end group
@end smallexample
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index ee3463a1fd6..a5480a9bf8a 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1374,6 +1374,15 @@ objects between Emacs and the module (@pxref{Module Values}). The
provides facilities for conversion between basic C data types and the
corresponding @code{emacs_value} objects.
+In the module function's body, do @emph{not} attempt to access
+elements of the @var{args} array beyond the index
+@code{@var{nargs}-1}: memory for the @var{args} array is allocated
+exactly to accommodate @var{nargs} values, and accessing beyond that
+will most probably crash your module. In particular, if the value of
+@var{nargs} passed to the function at run time is zero, it must not
+access @var{args} at all, as no memory will have been allocated for it
+in that case.
+
A module function always returns a value. If the function returns
normally, the Lisp code which called it will see the Lisp object
corresponding to the @code{emacs_value} value the function returned.
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 2062ae64866..486125acb0d 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -89,9 +89,9 @@ you are criticizing.
@cindex bugs
@cindex suggestions
-Please send comments and corrections using @kbd{M-x
-report-emacs-bug}. If you wish to contribute new code (or send a
-patch to fix a problem), use @kbd{M-x submit-emacs-patch}.
+Please send comments and corrections using @kbd{M-x report-emacs-bug}.
+For more details, @xref{Bugs,, Reporting Bugs, emacs, The GNU Emacs
+Manual}.
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index 3037790692c..a13edb02ae6 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -283,6 +283,14 @@ This function returns the position that @var{marker} points to, or
@code{nil} if it points nowhere.
@end defun
+@defun marker-last-position marker
+This function returns the last known position of @var{marker} in its
+buffer. It behaves like @code{marker-position} with one exception: if
+the buffer of @var{marker} has been killed, it returns the last position
+of @var{marker} in that buffer before the buffer was killed, instead of
+returning @code{nil}.
+@end defun
+
@defun marker-buffer marker
This function returns the buffer that @var{marker} points into, or
@code{nil} if it points nowhere.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 5c5edf62a8d..8f2d0d702f9 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -187,7 +187,8 @@ History}.
If the variable @code{minibuffer-allow-text-properties} is
non-@code{nil}, then the string that is returned includes whatever text
properties were present in the minibuffer. Otherwise all the text
-properties are stripped when the value is returned.
+properties are stripped when the value is returned. (By default this
+variable is @code{nil}.)
@vindex minibuffer-prompt-properties
The text properties in @code{minibuffer-prompt-properties} are applied
@@ -350,14 +351,15 @@ See @code{read-regexp} above for details of how these values are used.
@end defopt
@defvar minibuffer-allow-text-properties
-If this variable is @code{nil}, then @code{read-from-minibuffer}
-and @code{read-string} strip all text properties from the minibuffer
-input before returning it. However,
+If this variable is @code{nil}, the default, then
+@code{read-from-minibuffer} and @code{read-string} strip all text
+properties from the minibuffer input before returning it. However,
@code{read-no-blanks-input} (see below), as well as
@code{read-minibuffer} and related functions (@pxref{Object from
Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all
-functions that do minibuffer input with completion, remove the @code{face}
-property unconditionally, regardless of the value of this variable.
+functions that do minibuffer input with completion, remove the
+@code{face} property unconditionally, regardless of the value of this
+variable.
If this variable is non-@code{nil}, most text properties on strings
from the completion table are preserved---but only on the part of the
@@ -1878,10 +1880,31 @@ The value should be a list of completion styles (symbols).
The value should be a value for @code{completion-cycle-threshold}
(@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this
category.
+
+@item cycle-sort-function
+The function to sort entries when cycling.
+
+@item display-sort-function
+The function to sort entries in the @file{*Completions*} buffer.
+The possible values are: @code{nil}, which means to use either the
+sorting function from metadata or if that is @code{nil}, fall back to
+@code{completions-sort}; @code{identity}, which means not to sort at
+all, leaving the original order; or any other value out of those used
+in @code{completions-sort} (@pxref{Completion Options,,, emacs, The
+GNU Emacs Manual}).
+
+@item group-function
+The function to group completions.
+
+@item annotation-function
+The function to add annotations to completions.
+
+@item affixation-function
+The function to add prefixes and suffixes to completions.
@end table
@noindent
-Additional alist entries may be defined in the future.
+See @ref{Programmed Completion}, for a complete list of metadata entries.
@end defopt
@defvar completion-extra-properties
@@ -1891,6 +1914,12 @@ completion commands. Its value should be a list of property and value
pairs. The following properties are supported:
@table @code
+@item :category
+The value should be a symbol describing what kind of text the
+completion function is trying to complete. If the symbol matches one
+of the keys in @code{completion-category-overrides}, the usual
+completion behavior is overridden. @xref{Completion Variables}.
+
@item :annotation-function
The value should be a function to add annotations in the completions
buffer. This function must accept one argument, a completion, and
@@ -1907,6 +1936,15 @@ element of the returned list must be a three-element list, the
completion, a prefix string, and a suffix string. This function takes
priority over @code{:annotation-function}.
+@item :group-function
+The function to group completions.
+
+@item :display-sort-function
+The function to sort entries in the @file{*Completions*} buffer.
+
+@item :cycle-sort-function
+The function to sort entries when cycling.
+
@item :exit-function
The value should be a function to run after performing completion.
The function should accept two arguments, @var{string} and
@@ -2526,6 +2564,14 @@ times match.
The optional argument @var{default} specifies the default password to
return if the user enters empty input. If @var{default} is @code{nil},
then @code{read-passwd} returns the null string in that case.
+
+This function uses @code{read-passwd-mode}, a minor mode. It binds two
+keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents})
+deletes the password, and @kbd{TAB}
+(@code{read-passwd--toggle-visibility}) toggles the visibility of the
+password. There is also an additional icon in the mode-line. Clicking
+on this icon with @key{mouse-1} toggles the visibility of the password
+as well.
@end defun
@node Minibuffer Commands
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 8c5fd63918a..b034fecd77b 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables, see
* Minor Modes:: Defining minor modes.
* Mode Line Format:: Customizing the text that appears in the mode line.
* Imenu:: Providing a menu of definitions made in a buffer.
+* Outline Minor Mode:: Outline mode to use with other major modes.
* Font Lock Mode:: How modes can highlight text according to syntax.
* Auto-Indentation:: How to teach Emacs to indent for a major mode.
* Desktop Save Mode:: How modes can have buffer state saved between
@@ -508,6 +509,12 @@ variable @code{imenu-generic-expression}, for the two variables
@code{imenu-create-index-function} (@pxref{Imenu}).
@item
+The mode should specify how Outline minor mode should find the
+heading lines, by setting up a buffer-local value for the variables
+@code{outline-regexp} or @code{outline-search-function}, and also
+for the variable @code{outline-level} (@pxref{Outline Minor Mode}).
+
+@item
The mode can tell ElDoc mode how to retrieve different types of
documentation for whatever is at point, by adding one or more
buffer-local entries to the special hook
@@ -784,6 +791,39 @@ init file.)
@end smallexample
@end defvar
+@defvar major-mode-remap-defaults
+This variable contains an association list indicating which function
+to call to activate a given major mode. This is used for file formats
+that can be supported by various major modes, where this variable can be
+used to indicate which alternative should be used by default.
+
+For example, a third-party package providing a much improved Pascal
+major mode, can use the following to tell @code{normal-mode} to use
+@code{spiffy-pascal-mode} for all the files that would normally use @code{pascal-mode}:
+
+@smallexample
+@group
+(add-to-list 'major-mode-remap-defaults '(pascal-mode . spiffy-pascal-mode))
+@end group
+@end smallexample
+
+This variable has the same format as @code{major-mode-remap-alist}.
+If both lists match a major mode, the entry in
+@code{major-mode-remap-alist} takes precedence.
+@end defvar
+
+@defun major-mode-remap mode
+This function returns the major mode to use instead of @var{mode}
+according to @code{major-mode-remap-alist} and
+@code{major-mode-remap-defaults}. It returns @var{mode} if the mode
+is not remapped by those variables.
+
+When a package wants to activate a major mode for a particular file
+format, it should use this function, passing as @code{mode} argument the
+canonical major mode for that file format, to find which specific major
+mode to activate, so as to take into account the user's preferences.
+@end defun
+
@node Mode Help
@subsection Getting Help about a Major Mode
@cindex mode help
@@ -809,6 +849,7 @@ modes, rather than those of the current buffer.
@node Derived Modes
@subsection Defining Derived Modes
@cindex derived mode
+@cindex parent mode
The recommended way to define a new major mode is to derive it from an
existing one using @code{define-derived-mode}. If there is no closely
@@ -866,6 +907,9 @@ also a special mode (@pxref{Major Mode Conventions}).
You can also specify @code{nil} for @var{parent}. This gives the new
mode no parent. Then @code{define-derived-mode} behaves as described
above, but, of course, omits all actions connected with @var{parent}.
+Conversely, you can use @code{derived-mode-set-parent} and
+@code{derived-mode-add-parents}, described below, to explicitly set
+the ancestry of the new mode.
The argument @var{docstring} specifies the documentation string for the
new mode. @code{define-derived-mode} adds some general information
@@ -932,6 +976,7 @@ Do not write an @code{interactive} spec in the definition;
@code{define-derived-mode} does that automatically.
@end defmac
+@cindex ancestry, of major modes
@defun derived-mode-p modes
This function returns non-@code{nil} if the current major mode is
derived from any of the major modes given by the list of symbols
@@ -940,10 +985,28 @@ Instead of a list, @var{modes} can also be a single mode symbol.
Furthermore, we still support a deprecated calling convention where the
@var{modes} were passed as separate arguments.
+
+When examining the parent modes of the current major mode, this
+function takes into consideration the current mode's parents set by
+@code{define-derived-mode}, and also its additional parents set by
+@code{derived-mode-add-parents}, described below.
+@end defun
+
+@defun provided-mode-derived-p mode modes
+This function returns non-@code{nil} if @var{mode} is derived from any
+of the major modes given by the list of symbols in @var{modes}. Like
+with @code{derived-mode-p}, @var{modes} can also be a single symbol,
+and this function also supports a deprecated calling convention where
+the @var{modes} were passed as separate symbol arguments.
+
+When examining the parent modes of @var{mode}, this function takes
+into consideration the parents of @var{mode} set by
+@code{define-derived-mode}, and also its additional parents set by
+@code{derived-mode-add-parents}, described below.
@end defun
-The graph of major modes is accessed with the following lower-level
-functions:
+The graph of a major mode's ancestry can be accessed and modified with
+the following lower-level functions:
@defun derived-mode-set-parent mode parent
This function declares that @var{mode} inherits from @code{parent}.
@@ -956,14 +1019,19 @@ by reusing @code{parent}.
This function makes it possible to register additional parents beside
the one that was used when defining @var{mode}. This can be used when
the similarity between @var{mode} and the modes in @var{extra-parents}
-is such that it makes sense to treat it as a child of those
-modes for purposes like applying directory-local variables.
+is such that it makes sense to treat @var{mode} as a child of those
+modes for purposes like applying directory-local variables and other
+mode-specific settings. The additional parent modes are specified as
+a list of symbols in @var{extra-parents}. Those additional parent
+modes will be considered as one of the @var{mode}s parents by
+@code{derived-mode-p} and @code{provided-mode-derived-p}.
@end defun
@defun derived-mode-all-parents mode
This function returns the list of all the modes in the ancestry of
@var{mode}, ordered from the most specific to the least specific, and
-starting with @var{mode} itself.
+starting with @var{mode} itself. This includes the additional parent
+modes, if any, added by calling @code{derived-mode-add-parents}.
@end defun
@@ -1154,7 +1222,7 @@ column is sorted in the descending order.
This buffer-local variable specifies the format of the Tabulated List
data. Its value should be a vector. Each element of the vector
represents a data column, and should be a list @code{(@var{name}
-@var{width} @var{sort})}, where
+@var{width} @var{sort} . @var{props})}, where
@itemize
@item
@@ -1171,6 +1239,13 @@ sorted by comparing string values. Otherwise, this should be a
predicate function for @code{sort} (@pxref{Rearrangement}), which
accepts two arguments with the same form as the elements of
@code{tabulated-list-entries} (see below).
+
+@item
+@var{props} is a plist (@pxref{Property Lists}) of additional column
+properties. If the value of the property @code{:right-align} is
+non-@code{nil} then the column should be right-aligned. And the
+property @code{:pad-right} specifies the number of additional padding
+spaces to the right of the column (by default 1 if omitted).
@end itemize
@end defvar
@@ -1204,6 +1279,42 @@ Otherwise, the value should be a function which returns a list of the
above form when called with no arguments.
@end defvar
+@defvar tabulated-list-groups
+This buffer-local variable specifies the groups of entries displayed in
+the Tabulated List buffer. Its value should be either a list or a
+function.
+
+If the value is a list, each list element corresponds to one group, and
+should have the form @w{@code{(@var{group-name} @var{entries})}}, where
+@var{group-name} is a string inserted before all group entries, and
+@var{entries} have the same format as @code{tabulated-list-entries}
+(see above).
+
+Otherwise, the value should be a function which returns a list of the
+above form when called with no arguments.
+
+You can use @code{seq-group-by} to create @code{tabulated-list-groups}
+from @code{tabulated-list-entries}. For example:
+
+@smallexample
+@group
+(setq tabulated-list-groups
+ (seq-group-by 'Buffer-menu-group-by-mode
+ tabulated-list-entries))
+@end group
+@end smallexample
+
+@noindent
+where you can define @code{Buffer-menu-group-by-mode} like this:
+
+@smallexample
+@group
+(defun Buffer-menu-group-by-mode (entry)
+ (concat "* " (aref (cadr entry) 5)))
+@end group
+@end smallexample
+@end defvar
+
@defvar tabulated-list-revert-hook
This normal hook is run prior to reverting a Tabulated List buffer. A
derived mode can add a function to this hook to recompute
@@ -2966,6 +3077,61 @@ instead.
automatically sets up Imenu if this variable is non-@code{nil}.
@end defvar
+@node Outline Minor Mode
+@section Outline Minor Mode
+
+@cindex Outline minor mode
+ @dfn{Outline minor mode} is a buffer-local minor mode that hides
+parts of the buffer and leaves only heading lines visible.
+This minor mode can be used in conjunction with other major modes
+(@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}).
+
+ There are two ways to define which lines are headings: with the
+variable @code{outline-regexp} or @code{outline-search-function}.
+
+@defvar outline-regexp
+This variable is a regular expression.
+Any line whose beginning has a match for this regexp is considered a
+heading line. Matches that start within a line (not at the left
+margin) do not count.
+@end defvar
+
+@defvar outline-search-function
+Alternatively, when it's impossible to create a regexp that
+matches heading lines, you can define a function that helps
+Outline minor mode to find heading lines.
+
+The variable @code{outline-search-function} specifies the function with
+four arguments: @var{bound}, @var{move}, @var{backward}, and
+@var{looking-at}. The function completes two tasks: to match the
+current heading line, and to find the next or the previous heading line.
+If the argument @var{looking-at} is non-@code{nil}, it should return
+non-@code{nil} when point is at the beginning of the outline header line.
+If the argument @var{looking-at} is @code{nil}, the first three arguments
+are used. The argument @var{bound} is a buffer position that bounds
+the search. The match found must not end after that position. A
+value of nil means search to the end of the accessible portion of
+the buffer. If the argument @var{move} is non-@code{nil}, the
+failed search should move to the limit of search and return nil.
+If the argument @var{backward} is non-@code{nil}, this function
+should search for the previous heading backward.
+@end defvar
+
+@defvar outline-level
+This variable is a function that takes no arguments
+and should return the level of the current heading.
+It's required in both cases: whether you define
+@code{outline-regexp} or @code{outline-search-function}.
+@end defvar
+
+If built with tree-sitter, Emacs can automatically use
+Outline minor mode if the major mode sets the following variable.
+
+@defvar treesit-outline-predicate
+This variable instructs Emacs how to find lines with outline headings.
+It should be a predicate that matches the node on the heading line.
+@end defvar
+
@node Font Lock Mode
@section Font Lock Mode
@cindex Font Lock mode
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 99b456043b9..2c093ccd6bd 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -476,6 +476,7 @@ This function tests whether its arguments are numerically equal, and
returns @code{t} if they are not, and @code{nil} if they are.
@end defun
+@anchor{definition of <}
@defun < number-or-marker &rest number-or-markers
This function tests whether each argument is strictly less than the
following argument. It returns @code{t} if so, @code{nil} otherwise.
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 111beb5e5b0..aa1e073042f 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -60,6 +60,7 @@ to use these types can be found in later chapters.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
* Mutability:: Some objects should not be modified.
+* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects.
@end menu
@node Printed Representation
@@ -1180,13 +1181,14 @@ character), Emacs automatically assumes that it is multibyte.
You can also use hexadecimal escape sequences (@samp{\x@var{n}}) and
octal escape sequences (@samp{\@var{n}}) in string constants.
-@strong{But beware:} If a string constant contains hexadecimal or
-octal escape sequences, and these escape sequences all specify unibyte
-characters (i.e., less than 256), and there are no other literal
-non-@acronym{ASCII} characters or Unicode-style escape sequences in
-the string, then Emacs automatically assumes that it is a unibyte
-string. That is to say, it assumes that all non-@acronym{ASCII}
-characters occurring in the string are 8-bit raw bytes.
+@strong{But beware:} If a string constant contains octal escape
+sequences or one- or two-digit hexadecimal escape sequences, and these
+escape sequences all specify unibyte characters (i.e., codepoints less
+than 256), and there are no other literal non-@acronym{ASCII}
+characters or Unicode-style escape sequences in the string, then Emacs
+automatically assumes that it is a unibyte string. That is to say, it
+assumes that all non-@acronym{ASCII} characters occurring in the
+string are 8-bit raw bytes.
In hexadecimal and octal escape sequences, the escaped character
code may contain a variable number of digits, so the first subsequent
@@ -1373,8 +1375,7 @@ and contents, like this:
@example
(make-hash-table)
- @result{} #s(hash-table size 65 test eql rehash-size 1.5
- rehash-threshold 0.8125 data ())
+ @result{} #s(hash-table)
@end example
@noindent
@@ -1484,8 +1485,8 @@ types that are not built into Emacs.
@subsection Type Descriptors
A @dfn{type descriptor} is a @code{record} which holds information
-about a type. Slot 1 in the record must be a symbol naming the type, and
-@code{type-of} relies on this to return the type of @code{record}
+about a type. The first slot in the record must be a symbol naming the type,
+and @code{type-of} relies on this to return the type of @code{record}
objects. No other type descriptor slot is used by Emacs; they are
free for use by Lisp extensions.
@@ -2121,6 +2122,9 @@ with references to further information.
@item numberp
@xref{Predicates on Numbers, numberp}.
+@item obarrayp
+@xref{Creating Symbols, obarrayp}.
+
@item overlayp
@xref{Overlays, overlayp}.
@@ -2171,7 +2175,7 @@ with references to further information.
function @code{type-of}. Recall that each object belongs to one and
only one primitive type; @code{type-of} tells you which one (@pxref{Lisp
Data Types}). But @code{type-of} knows nothing about non-primitive
-types. In most cases, it is more convenient to use type predicates than
+types. In most cases, it is preferable to use type predicates than
@code{type-of}.
@defun type-of object
@@ -2181,7 +2185,7 @@ This function returns a symbol naming the primitive type of
@code{condition-variable}, @code{cons}, @code{finalizer},
@code{float}, @code{font-entity}, @code{font-object},
@code{font-spec}, @code{frame}, @code{hash-table}, @code{integer},
-@code{marker}, @code{mutex}, @code{overlay}, @code{process},
+@code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process},
@code{string}, @code{subr}, @code{symbol}, @code{thread},
@code{vector}, @code{window}, or @code{window-configuration}.
However, if @var{object} is a record, the type specified by its first
@@ -2203,6 +2207,27 @@ slot is returned; @ref{Records}.
@end example
@end defun
+@defun cl-type-of object
+This function returns a symbol naming @emph{the} type of
+@var{object}. It usually behaves like @code{type-of}, except
+that it guarantees to return the most precise type possible, which also
+implies that the specific type it returns may change depending on the
+Emacs version. For this reason, as a rule you should never compare its
+return value against some fixed set of types.
+
+@example
+(cl-type-of 1)
+ @result{} fixnum
+@group
+(cl-type-of 'nil)
+ @result{} null
+(cl-type-of (record 'foo))
+ @result{} foo
+@end group
+@end example
+@end defun
+
+
@node Equality Predicates
@section Equality Predicates
@cindex equality
@@ -2395,10 +2420,10 @@ The @code{equal} function recursively compares the contents of objects
if they are integers, strings, markers, vectors, bool-vectors,
byte-code function objects, char-tables, records, or font objects.
-If @var{object1} or @var{object2} is a symbol with position,
-@code{equal} regards it as its bare symbol when
+If @var{object1} or @var{object2} contains symbols with position,
+@code{equal} treats them as if they were their bare symbols when
@code{symbols-with-pos-enabled} is non-@code{nil}. Otherwise
-@code{equal} compares two symbols with position by recursively
+@code{equal} compares two symbols with position by
comparing their components. @xref{Symbols with Position}.
Other objects are considered @code{equal} only if they are @code{eq}.
@@ -2493,3 +2518,26 @@ their components. For example, @code{(eq "abc" "abc")} returns
literal @code{"abc"}, and returns @code{nil} if it creates two
instances. Lisp programs should be written so that they work
regardless of whether this optimization is in use.
+
+@node Type Hierarchy
+@section Type Hierarchy of Emacs Lisp Objects
+
+Lisp object types are organized in a hierarchy, which means that types
+can derive from other types. Objects of type B (which derives from type
+A) inherit all the characteristics of type A@. This also means that
+every object of type B is at the same time an object of type A from
+which it derives.
+
+Every type derives from type @code{t}.
+
+New types can be defined by the user through @code{defclass} or
+@code{cl-defstruct}.
+
+The Lisp Type Hierarchy for primitive types can be represented as
+follows:
+
+@noindent
+@image{elisp_type_hierarchy,,,,.jpg}
+
+For example type @code{list} derives from (is a special kind of) type
+@code{sequence} which itself derives from @code{t}.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index feba7192d3c..3ba3da459bf 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2945,7 +2945,7 @@ interpreted as icon name.
@item :category @var{category}
The type of notification this is, a string. See the
-@uref{https://developer.gnome.org/notification-spec/#categories,
+@url{https://specifications.freedesktop.org/notification-spec/notification-spec-latest.html#categories,
Desktop Notifications Specification} for a list of standard
categories.
@@ -3241,11 +3241,17 @@ of parameters analogous to its namesake in
@item :title @var{title}
@item :body @var{body}
@item :replaces-id @var{replaces-id}
+@item :on-action @var{on-action}
+@item :on-cancel @var{on-close}
+@item :actions @var{actions}
+@item :timeout @var{timeout}
+@item :resident @var{resident}
These have the same meaning as they do when used in calls to
-@code{notifications-notify}.
+@code{notifications-notify}, except that no more than three non-default
+actions will be displayed.
@item :urgency @var{urgency}
-The set of values for @var{urgency} is the same as with
+The set of accepted values for @var{urgency} is the same as with
@code{notifications-notify}, but the urgency applies to all
notifications displayed with the defined @var{group}, except under
Android 7.1 and earlier.
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index 6f52a33d194..421e64dd5d1 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -28,6 +28,7 @@ these archives).
* Multi-file Packages:: How to package multiple files.
* Package Archives:: Maintaining package archives.
* Archive Web Server:: Interfacing to an archive web server.
+* Forwards-Compatibility:: Supporting older versions of Emacs.
@end menu
@node Packaging Basics
@@ -284,6 +285,15 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example:
(expand-file-name file superfrobnicator-base))
@end smallexample
+@cindex @file{.elpaignore} file
+ If your package contains files that you don't wish to distribute to
+users (e.g.@: regression tests), you can add them to an
+@file{.elpaignore} file. In this file, each line lists a file or a
+wildcard matching files; those files should be ignored when producing
+your package's tarball on ELPA (@pxref{Package Archives}). (ELPA
+will pass this file to the @command{tar} command via the @option{-X}
+command-line option, when it prepares the package for download.)
+
@node Package Archives
@section Creating and Maintaining Package Archives
@cindex package archive
@@ -390,3 +400,50 @@ Return the file. This will be the tarball for a multi-file
package, or the single file for a simple package.
@end table
+
+@node Forwards-Compatibility
+@section Supporting older versions of Emacs
+@cindex compatibility compat
+
+Packages that wish to support older releases of Emacs, without giving
+up on newer functionality from recent Emacs releases, one can make use
+of the Compat package on GNU ELPA. By depending on the package, Emacs
+can provide compatibility definitions for missing functionality.
+
+The versioning of Compat follows that of Emacs, so next to the oldest
+version that a package relies on (via the @code{emacs}-package), one
+can also indicate what the newest version of Emacs is, that a package
+wishes to use definitions from:
+
+@example
+;; Package-Requires: ((emacs "27.2") (compat "29.1"))
+@end example
+
+Note that Compat provides replacement functions with extended
+functionality for functions that are already defined (@code{sort},
+@code{assoc}, @dots{}). These functions may have changed their
+calling convention (additional optional arguments) or may have changed
+their behavior. These functions must be looked up explicitly with
+@code{compat-function} or called explicitly with @code{compat-call}.
+We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added
+Definitions} can be called as usual.
+
+@defmac compat-call fun &rest args
+This macro calls the compatibility function @var{fun} with @var{args}.
+Many functions provided by Compat can be called directly without this
+macro. However in the case where Compat provides an alternative
+version of an existing function, the function call has to go through
+@code{compat-call}.
+@end defmac
+
+@defmac compat-function fun
+This macro returns the compatibility function symbol for @var{fun}.
+See @code{compat-call} for a more convenient macro to directly call
+compatibility functions.
+@end defmac
+
+For further details on how to make use of the package, see
+@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have
+the manual installed, you can also read the
+@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online
+Compat manual}.
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index 5d79c4b27f4..3d2192ace64 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -794,7 +794,7 @@ that comes after it in the buffer position order, i.e., nodes with
start positions greater than the end position of @var{start}.
In the tree shown above, @code{treesit-search-subtree} traverses node
-@samp{S} (@var{start}) and nodes marked with @code{o}, where this
+@samp{S} (@var{start}) and nodes marked with @code{o}, whereas this
function traverses the nodes marked with numbers. This function is
useful for answering questions like ``what is the first node after
@var{start} in the buffer that satisfies some condition?''
@@ -916,32 +916,37 @@ nodes.
@defun treesit-parent-until node predicate &optional include-node
This function repeatedly finds the parents of @var{node}, and returns
-the parent that satisfies @var{pred}, a function that takes a node as
-argument and returns a boolean that indicates a match. If no parent
-satisfies @var{pred}, this function returns @code{nil}.
+the parent that satisfies @var{predicate}. @var{predicate} can be
+either a function that takes a node as argument and returns @code{t}
+or @code{nil}, or a regexp matching node type names, or other valid
+predicates described in @var{treesit-thing-settings}. If no parent
+satisfies @var{predicates}, this function returns @code{nil}.
Normally this function only looks at the parents of @var{node} but not
@var{node} itself. But if @var{include-node} is non-@code{nil}, this
-function returns @var{node} if @var{node} satisfies @var{pred}.
+function returns @var{node} if @var{node} satisfies @var{predicate}.
@end defun
-@defun treesit-parent-while node pred
+@defun treesit-parent-while node predicate
This function goes up the tree starting from @var{node}, and keeps
-doing so as long as the nodes satisfy @var{pred}, a function that
+doing so as long as the nodes satisfy @var{predicate}, a function that
takes a node as argument. That is, this function returns the highest
-parent of @var{node} that still satisfies @var{pred}. Note that if
-@var{node} satisfies @var{pred} but its immediate parent doesn't,
+parent of @var{node} that still satisfies @var{predicate}. Note that if
+@var{node} satisfies @var{predicate} but its immediate parent doesn't,
@var{node} itself is returned.
@end defun
-@defun treesit-node-top-level node &optional type
+@defun treesit-node-top-level node &optional predicate include-node
This function returns the highest parent of @var{node} that has the
same type as @var{node}. If no such parent exists, it returns
@code{nil}. Therefore this function is also useful for testing
whether @var{node} is top-level.
-If @var{type} is non-@code{nil}, this function matches each parent's
-type with @var{type} as a regexp, rather than using @var{node}'s type.
+If @var{predicate} is @code{nil}, this function uses @var{node}'s type
+to find the parent. If @var{predicate} is non-@code{nil}, this
+function searches the parent that satisfies @var{predicate}. If
+@var{include-node} is non-@code{nil}, this function returns @var{node}
+if @var{node} satisfies @var{predicate}.
@end defun
@node Accessing Node Information
@@ -1892,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}.
@item
If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is
non-@code{nil}, it sets up Imenu.
+
+@item
+If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is
+non-@code{nil}, it sets up Outline minor mode.
@end itemize
@c TODO: Add treesit-thing-settings stuff once we finalize it.
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index f1f23f007a4..c9e47624878 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -350,94 +350,165 @@ encouraged to treat strings as immutable even when they are mutable.
@end defun
-@defun sort sequence predicate
+@defun sort sequence &rest keyword-args
@cindex stable sort
@cindex sorting lists
@cindex sorting vectors
-This function sorts @var{sequence} stably. Note that this function doesn't work
-for all sequences; it may be used only for lists and vectors. If @var{sequence}
-is a list, it is modified destructively. This functions returns the sorted
-@var{sequence} and compares elements using @var{predicate}. A stable sort is
-one in which elements with equal sort keys maintain their relative order before
-and after the sort. Stability is important when successive sorts are used to
-order elements according to different criteria.
+This function sorts @var{sequence}, which must be a list or vector, and
+returns a sorted sequence of the same type.
+The sort is stable, which means that elements with equal sort keys maintain
+their relative order. It takes the following optional keyword arguments:
+
+@table @code
+@item :key @var{keyfunc}
+Use @var{keyfunc}, a function that takes a single element from
+@var{sequence} and returns its key value, to generate the keys used in
+comparison. If this argument is absent or if @var{keyfunc} is
+@code{nil} then @code{identity} is assumed; that is, the elements
+themselves are used as sorting keys.
+
+@item :lessp @var{predicate}
+Use @var{predicate} to order the keys. @var{predicate} is a function
+that takes two sort keys as arguments and returns non-@code{nil} if the
+first should come before the second. If this argument is absent or
+@var{predicate} is @code{nil}, then @code{value<} is used, which
+is applicable to many different Lisp types and generally sorts in
+ascending order (@pxref{definition of value<}, below).
+
+For consistency, any predicate must obey the following rules:
+@itemize @bullet
+@item
+It must be @dfn{antisymmetric}: it cannot both order @var{a} before
+@var{b} and @var{b} before @var{a}.
+@item
+It must be @dfn{transitive}: if it orders @var{a} before @var{b} and
+@var{b} before @var{c}, then it must also order @var{a} before @var{c}.
+@end itemize
-The argument @var{predicate} must be a function that accepts two
-arguments. It is called with two elements of @var{sequence}. To get an
-increasing order sort, the @var{predicate} should return non-@code{nil} if the
-first element is ``less'' than the second, or @code{nil} if not.
+@item :reverse @var{flag}
+If @var{flag} is non-@code{nil}, the sorting order is reversed. With
+the default @code{:lessp} predicate this means sorting in descending order.
-The comparison function @var{predicate} must give reliable results for
-any given pair of arguments, at least within a single call to
-@code{sort}. It must be @dfn{antisymmetric}; that is, if @var{a} is
-less than @var{b}, @var{b} must not be less than @var{a}. It must be
-@dfn{transitive}---that is, if @var{a} is less than @var{b}, and @var{b}
-is less than @var{c}, then @var{a} must be less than @var{c}. If you
-use a comparison function which does not meet these requirements, the
-result of @code{sort} is unpredictable.
+@item :in-place @var{flag}
+If @var{flag} is non-@code{nil}, then @var{sequence} is sorted in-place
+(destructively) and returned. If @code{nil}, or if this argument is not
+given, a sorted copy of the input is returned and @var{sequence} itself
+remains unmodified. In-place sorting is slightly faster, but the
+original sequence is lost.
+@end table
-The destructive aspect of @code{sort} for lists is that it reuses the
-cons cells forming @var{sequence} by changing their contents, possibly
-rearranging them in a different order. This means that the value of
-the input list is undefined after sorting; only the list returned by
-@code{sort} has a well-defined value. Example:
+If the default behaviour is not suitable for your needs, it is usually
+easier and faster to supply a new @code{:key} function than a different
+@code{:lessp} predicate. For example, consider sorting these strings:
@example
@group
-(setq nums (list 2 1 4 3 0))
-(sort nums #'<)
- @result{} (0 1 2 3 4)
- ; nums is unpredictable at this point
+(setq numbers '("one" "two" "three" "four" "five" "six"))
+(sort numbers)
+ @result{} ("five" "four" "one" "six" "three" "two")
@end group
@end example
-Most often we store the result back into the variable that held the
-original list:
+You can sort the strings by length instead by supplying a different key
+function:
@example
-(setq nums (sort nums #'<))
+@group
+(sort numbers :key #'length)
+ @result{} ("one" "two" "six" "four" "five" "three")
+@end group
@end example
-If you wish to make a sorted copy without destroying the original,
-copy it first and then sort:
+@noindent
+Note how strings of the same length keep their original order, thanks to
+the sorting stability. Now suppose you want to sort by length, but use
+the string contents to break ties. The easiest way is to specify a key
+function that transforms an element to a value that is sorted this way.
+Since @code{value<} orders compound objects (conses, lists,
+vectors and records) lexicographically, you could do:
@example
@group
-(setq nums (list 2 1 4 3 0))
-(sort (copy-sequence nums) #'<)
- @result{} (0 1 2 3 4)
-@end group
-@group
-nums
- @result{} (2 1 4 3 0)
+(sort numbers :key (lambda (x) (cons (length x) x)))
+ @result{} ("one" "six" "two" "five" "four" "three")
@end group
@end example
-For the better understanding of what stable sort is, consider the following
-vector example. After sorting, all items whose @code{car} is 8 are grouped
-at the beginning of @code{vector}, but their relative order is preserved.
-All items whose @code{car} is 9 are grouped at the end of @code{vector},
-but their relative order is also preserved:
+@noindent
+because @code{(3 . "six")} is ordered before @code{(3 . "two")} and so on.
+
+For compatibility with previous versions of Emacs, the @code{sort}
+function can also be called using the fixed two-argument form:
@example
-@group
-(setq
- vector
- (vector '(8 . "xxx") '(9 . "aaa") '(8 . "bbb") '(9 . "zzz")
- '(9 . "ppp") '(8 . "ttt") '(8 . "eee") '(9 . "fff")))
- @result{} [(8 . "xxx") (9 . "aaa") (8 . "bbb") (9 . "zzz")
- (9 . "ppp") (8 . "ttt") (8 . "eee") (9 . "fff")]
-@end group
-@group
-(sort vector (lambda (x y) (< (car x) (car y))))
- @result{} [(8 . "xxx") (8 . "bbb") (8 . "ttt") (8 . "eee")
- (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")]
-@end group
+(@code{sort} @var{sequence} @var{predicate})
+@end example
+
+@noindent
+where @var{predicate} is the @code{:lessp} argument. When using this
+form, sorting is always done in-place.
+@end defun
+
+@xref{Sorting}, for more functions that perform sorting. See
+@code{documentation} in @ref{Accessing Documentation}, for a useful
+example of @code{sort}.
+
+@cindex comparing values
+@cindex standard sorting order
+@anchor{definition of value<}
+@defun value< a b
+This function returns non-@code{nil} if @var{a} comes before @var{b} in
+the standard sorting order; this means that it returns @code{nil} when
+@var{b} comes before @var{a}, or if they are equal or unordered.
+
+The arguments @var{a} and @var{b} must have the same type.
+Specifically:
+
+@itemize @bullet
+@item
+Numbers are compared using @code{<} (@pxref{definition of <}).
+@item
+Strings are compared using @code{string<} (@pxref{definition of
+string<}) and symbols are compared by comparing their names as strings.
+@item
+Conses, lists, vectors and records are compared lexicographically. This
+means that the two sequences are compared element-wise from left to
+right until they differ, and the result is then that of @code{value<} on
+the first pair of differing elements. If one sequence runs out of
+elements before the other, the shorter sequence comes before the longer.
+@item
+Markers are compared first by buffer, then by position.
+@item
+Buffers and processes are compared by comparing their names as strings.
+Dead buffers (whose name is @code{nil}) will compare before any live
+buffer.
+@item
+Other types are considered unordered and the return value will be
+@code{nil}.
+@end itemize
+
+Examples:
+@example
+(value< -4 3.5) @result{} t
+(value< "dog" "cat") @result{} nil
+(value< 'yip 'yip) @result{} nil
+(value< '(3 2) '(3 2 0)) @result{} t
+(value< [3 2 "a"] [3 2 "b"]) @result{} t
+@end example
+
+@noindent
+Note that @code{nil} is treated as either a symbol or an empty list,
+depending on what it is compared against:
+
+@example
+(value< nil '(0)) @result{} t
+(value< 'nib nil) @result{} t
@end example
-@xref{Sorting}, for more functions that perform sorting.
-See @code{documentation} in @ref{Accessing Documentation}, for a
-useful example of @code{sort}.
+@noindent
+There is no limit to the length of sequences (lists, vectors and so on)
+that can be compared, but @code{value<} may fail with an error if used
+to compare circular or deeply nested data structures.
@end defun
@cindex sequence functions in seq
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index d7e9200d52c..86ec82b66a1 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -995,7 +995,7 @@ less natural and is less compact.
@cindex overrides, in output functions
@cindex output variables, overriding
-The previous section (@pxref{Output Functions}) lists the numerous
+The previous section (@pxref{Output Variables}) lists the numerous
variables that control how the Emacs Lisp printer formats data for
outputs. These are generally available for users to change, but
sometimes you want to output data in the default format, or override
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 7097de49064..7f640255a7a 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used.
Emacs.
A string is a fixed sequence of characters. It is a type of
-sequence called a @dfn{array}, meaning that its length is fixed and
+sequence called an @dfn{array}, meaning that its length is fixed and
cannot be altered once it is created (@pxref{Sequences Arrays
Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated
by a distinguished character code.
@@ -612,6 +612,7 @@ that collation implements.
@end defun
@cindex lexical comparison of strings
+@anchor{definition of string<}
@defun string< string1 string2
@c (findex string< causes problems for permuted index!!)
This function compares two strings a character at a time. It
@@ -691,7 +692,8 @@ for sorting (@pxref{Sequence Functions}):
@example
@group
-(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
+(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ :lessp #'string-collate-lessp)
@result{} ("11" "1 1" "1.1" "12" "1 2" "1.2")
@end group
@end example
@@ -708,8 +710,8 @@ systems. The @var{locale} value of @code{"POSIX"} or @code{"C"} lets
@example
@group
-(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
- (lambda (s1 s2) (string-collate-lessp s1 s2 "POSIX")))
+(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ :lessp (lambda (s1 s2) (string-collate-lessp s1 s2 "POSIX")))
@result{} ("1 1" "1 2" "1.1" "1.2" "11" "12")
@end group
@end example
@@ -1369,7 +1371,7 @@ given width and precision, if specified.
@item >
This flag causes the substitution to be truncated on the right to the
-given width, if specified.
+given width and precision, if specified.
@item ^
This flag converts the substituted text to upper case (@pxref{Case
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 6fe4189901a..c76bf3d3820 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -177,34 +177,16 @@ know how Lisp reads them. Lisp must ensure that it finds the same
symbol every time it reads the same sequence of characters in the same
context. Failure to do so would cause complete confusion.
-@cindex symbol name hashing
-@cindex hashing
@cindex obarray
-@cindex bucket (in obarray)
When the Lisp reader encounters a name that references a symbol in
-the source code, it reads all the characters of that name. Then it
-looks up that name in a table called an @dfn{obarray} to find the
-symbol that the programmer meant. The technique used in this lookup
-is called ``hashing'', an efficient method of looking something up by
-converting a sequence of characters to a number, known as a ``hash
-code''. For example, instead of searching a telephone book cover to
-cover when looking up Jan Jones, you start with the J's and go from
-there. That is a simple version of hashing. Each element of the
-obarray is a @dfn{bucket} which holds all the symbols with a given
-hash code; to look for a given name, it is sufficient to look through
-all the symbols in the bucket for that name's hash code. (The same
-idea is used for general Emacs hash tables, but they are a different
-data type; see @ref{Hash Tables}.)
-
-When looking up names, the Lisp reader also considers ``shorthands''.
+the source code, it looks up that name in a table called an @dfn{obarray}
+to find the symbol that the programmer meant. An obarray is an unordered
+container of symbols, indexed by name.
+
+The Lisp reader also considers ``shorthands''.
If the programmer supplied them, this allows the reader to find a
symbol even if its name isn't present in its full form in the source
-code. Of course, the reader needs to be aware of some pre-established
-context about such shorthands, much as one needs context to be to able
-to refer uniquely to Jan Jones by just the name ``Jan'': it's probably
-fine when amongst the Joneses, or when Jan has been mentioned
-recently, but very ambiguous in any other situation.
-@xref{Shorthands}.
+code. @xref{Shorthands}.
@cindex interning
If a symbol with the desired name is found, the reader uses that
@@ -236,23 +218,6 @@ to gain access to it is by finding it in some other object or as the
value of a variable. Uninterned symbols are sometimes useful in
generating Lisp code, see below.
- In Emacs Lisp, an obarray is actually a vector. Each element of the
-vector is a bucket; its value is either an interned symbol whose name
-hashes to that bucket, or 0 if the bucket is empty. Each interned
-symbol has an internal link (invisible to the user) to the next symbol
-in the bucket. Because these links are invisible, there is no way to
-find all the symbols in an obarray except using @code{mapatoms} (below).
-The order of symbols in a bucket is not significant.
-
- In an empty obarray, every element is 0, so you can create an obarray
-with @code{(make-vector @var{length} 0)}. @strong{This is the only
-valid way to create an obarray.} Prime numbers as lengths tend
-to result in good hashing; lengths one less than a power of two are also
-good.
-
- @strong{Do not try to put symbols in an obarray yourself.} This does
-not work---only @code{intern} can enter a symbol in an obarray properly.
-
@cindex CL note---symbol in obarrays
@quotation
@b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide
@@ -262,9 +227,21 @@ Emacs Lisp provides a different namespacing system called
``shorthands'' (@pxref{Shorthands}).
@end quotation
+@defun obarray-make &optional size
+This function creates and returns a new obarray.
+The optional @var{size} may be used to specify the number of symbols
+that it is expected to hold, but since obarrays grow automatically
+as needed, this rarely provides any benefit.
+@end defun
+
+@defun obarrayp object
+This function returns @code{t} if @var{object} is an obarray,
+@code{nil} otherwise.
+@end defun
+
Most of the functions below take a name and sometimes an obarray as
arguments. A @code{wrong-type-argument} error is signaled if the name
-is not a string, or if the obarray is not a vector.
+is not a string, or if the obarray is not an obarray object.
@defun symbol-name symbol
This function returns the string that is @var{symbol}'s name. For example:
@@ -416,6 +393,10 @@ If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise
it returns @code{nil}.
@end defun
+@defun obarray-clear obarray
+This function removes all symbols from @var{obarray}.
+@end defun
+
@node Symbol Properties
@section Symbol Properties
@cindex symbol property
@@ -675,7 +656,7 @@ name} (@pxref{Symbol Components}).
It is useful to think of shorthands as @emph{abbreviating} the full
names of intended symbols. Despite this, do not confuse shorthands with the
-Abbrev system @pxref{Abbrevs}.
+Abbrev system (@pxref{Abbrevs}).
@cindex namespace etiquette
Shorthands make Emacs Lisp's @dfn{namespacing etiquette} easier to work
@@ -761,6 +742,23 @@ instead of @code{snu-}.
;; End:
@end example
+Note that if you have two shorthands in the same file where one is the
+prefix of the other, the longer shorthand will be attempted first.
+This happens regardless of the order you specify shorthands in the
+local variables section of your file.
+
+@example
+'(
+ t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo'
+ t/foo ; reads to 'my-tricks-foo'
+ )
+
+;; Local Variables:
+;; read-symbol-shorthands: (("t/" . "my-tricks-")
+;; ("t//" . "my-tricks--")
+;; End:
+@end example
+
@subsection Exceptions
There are two exceptions to rules governing Shorthand transformations:
@@ -782,13 +780,16 @@ Symbol forms whose names start with @samp{#_} are not transformed.
@cindex symbol with position
@cindex bare symbol
-A @dfn{symbol with position} is a symbol, the @dfn{bare symbol},
-together with an unsigned integer called the @dfn{position}. Symbols
-with position don't themselves have entries in the obarray (though
-their bare symbols do; @pxref{Creating Symbols}).
-
-Symbols with position are for the use of the byte compiler, which
-records in them the position of each symbol occurrence and uses those
+A @dfn{symbol with position} is a symbol, called the @dfn{bare symbol},
+together with a nonnegative fixnum called the @dfn{position}.
+Even though a symbol with position often acts like its bare symbol,
+it is not a symbol: instead, it is an object that has both a bare symbol
+and a position. Because symbols with position are not symbols,
+they don't have entries in the obarray, though their bare symbols
+typically do (@pxref{Creating Symbols}).
+
+The byte compiler uses symbols with position,
+records in them the position of each symbol occurrence, and uses those
positions in warning and error messages. They shouldn't normally be
used otherwise. Doing so can cause unexpected results with basic
Emacs functions such as @code{eq} and @code{equal}.
@@ -801,22 +802,19 @@ just the bare symbol to be printed by binding the variable
operation. The byte compiler does this before writing its output to
the compiled Lisp file.
-For most purposes, when the flag variable
-@code{symbols-with-pos-enabled} is non-@code{nil}, symbols with
-positions behave just as their bare symbols would. For example,
-@samp{(eq #<symbol foo at 12345> foo)} has a value @code{t} when the
-variable is set; likewise, @code{equal} will treat a symbol with
-position argument as its bare symbol.
+When the flag variable @code{symbols-with-pos-enabled} is non-@code{nil},
+a symbol with position ordinarily behaves like its bare symbol.
+For example, @samp{(eq (position-symbol 'foo 12345) 'foo)} yields @code{t},
+and @code{equal} likewise treats a symbol with position as its bare symbol.
-When @code{symbols-with-pos-enabled} is @code{nil}, any symbols with
-position continue to exist, but do not behave as symbols, or have the
-other useful properties outlined in the previous paragraph. @code{eq}
-returns @code{t} when given identical arguments, and @code{equal}
-returns @code{t} when given arguments with @code{equal} components.
+When @code{symbols-with-pos-enabled} is @code{nil}, symbols with
+position behave as themselves, not as symbols. For example, @samp{(eq
+(position-symbol 'foo 12345) 'foo)} yields @code{nil}, and @code{equal}
+likewise treats a symbol with position as not equal to its bare symbol.
Most of the time in Emacs @code{symbols-with-pos-enabled} is
@code{nil}, but the byte compiler and the native compiler bind it to
-@code{t} when they run.
+@code{t} when they run and Emacs runs a little more slowly in this case.
Typically, symbols with position are created by the byte compiler
calling the reader function @code{read-positioning-symbols}
@@ -824,36 +822,44 @@ calling the reader function @code{read-positioning-symbols}
@code{position-symbol}.
@defvar symbols-with-pos-enabled
-When this variable is non-@code{nil}, a symbol with position behaves
-like the contained bare symbol. Emacs runs a little more slowly in
-this case.
+This variable affects the behavior of symbols with position when they
+are not being printed and are not arguments to one of the functions
+defined later in this section. When this variable is non-@code{nil},
+such a symbol with position behaves like its bare symbol; otherwise it
+behaves as itself, not as a symbol.
@end defvar
@defvar print-symbols-bare
When bound to non-@code{nil}, the Lisp printer prints only the bare
symbol of a symbol with position, ignoring the position.
+Otherwise a symbol with position prints as itself, not as a symbol.
@end defvar
-@defun symbol-with-pos-p symbol
-This function returns @code{t} if @var{symbol} is a symbol with
+@defun symbol-with-pos-p object
+This function returns @code{t} if @var{object} is a symbol with
position, @code{nil} otherwise.
+Unlike @code{symbolp}, this function ignores @code{symbols-with-pos-enabled}.
@end defun
-@defun bare-symbol symbol
-This function returns the bare symbol contained in @var{symbol}, or
-@var{symbol} itself if it is already a bare symbol. For any other
-type of object, it signals an error.
+@defun bare-symbol sym
+This function returns the bare symbol of the symbol with
+position @var{sym}, or @var{sym} itself if it is already a symbol.
+For any other type of object, it signals an error.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
-@defun symbol-with-pos-pos symbol
-This function returns the position, a number, from a symbol with
-position. For any other type of object, it signals an error.
+@defun symbol-with-pos-pos sympos
+This function returns the position, a nonnegative fixnum, from the symbol with
+position @var{sympos}. For any other type of object, it signals an error.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
@defun position-symbol sym pos
-Make a new symbol with position. @var{sym} is either a bare symbol or
-a symbol with position, and supplies the symbol part of the new
-object. @var{pos} is either an integer which becomes the number part
-of the new object, or a symbol with position whose position is used.
+Make a new symbol with position. The new object's bare symbol is taken
+from @var{sym}, which is either a symbol, or a symbol with position
+whose bare symbol is used. The new object's position is taken from
+@var{pos}, which is either a nonnegative fixnum, or a symbol with
+position whose position is used.
Emacs signals an error if either argument is invalid.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 705d3260063..4d61d461deb 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--2024 Free Software Foundation, Inc.
+@c Copyright (C) 1990--2024 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Variables
@chapter Variables
@@ -978,6 +978,7 @@ program is executing, the binding exists.
@cindex lexical binding
@cindex lexical scope
+@cindex static scope
@cindex indefinite extent
For historical reasons, there are two dialects of Emacs Lisp,
selected via the @code{lexical-binding} buffer-local variable.
@@ -989,6 +990,7 @@ binding can also be accessed from the Lisp debugger.}. It also has
@dfn{indefinite extent}, meaning that under some circumstances the
binding can live on even after the binding construct has finished
executing, by means of objects called @dfn{closures}.
+Lexical scoping is also commonly called @dfn{static scoping}.
@cindex dynamic binding
@cindex dynamic scope
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 1e2fbc5f052..eef05d94fdb 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2629,11 +2629,15 @@ default value is an empty display action, i.e., @w{@code{(nil . nil)}}.
@defopt display-buffer-alist
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-@code{nil} value, then
-@code{display-buffer} uses the corresponding display action to display
-the buffer.
+actions. Each condition is passed to @code{buffer-match-p}
+(@pxref{Buffer List}), along with the buffer name and the @var{action}
+argument passed to @code{display-buffer}. If it returns a
+non-@code{nil} value, then @code{display-buffer} uses the
+corresponding display action to display the buffer. Caveat: if you
+use @code{derived-mode} or @code{major-mode} as condition,
+@code{buffer-match-p} could fail to report a match if
+@code{display-buffer} is called before the major mode of the buffer is
+set.
@end defopt
@defopt display-buffer-base-action
@@ -3340,6 +3344,16 @@ It is called @emph{after} the buffer is displayed, and @emph{before}
the entries @code{window-height}, @code{window-width} and
@code{preserve-size} are applied that could resize the window to fit
it to the inserted contents.
+
+@vindex post-command-select-window@r{, a buffer display action alist entry}
+@item post-command-select-window
+If the value is non-@code{nil}, the buffer displayed by @code{display-buffer}
+is selected after the current command is executed by running the hook
+@code{post-command-hook} (@pxref{Command Overview}).
+If the value is @code{nil}, the buffer selected by such functions as
+@code{pop-to-buffer} is deselected, and the window that was selected
+before calling this function will remain selected regardless of which
+windows were selected afterwards within this command.
@end table
By convention, the entries @code{window-height}, @code{window-width}
@@ -6250,11 +6264,10 @@ this function does is to restore the value of the variable
@code{minibuffer-selected-window}. In this case, the function returns
@code{nil}. Otherwise, it returns @code{t}.
-If the buffer of a window of @var{configuration} has been killed since
-@var{configuration} was made, that window is, as a rule, removed from
-the restored configuration. However, if that window is the last
-window remaining in the restored configuration, another live buffer is
-shown in it.
+This function consults the variable
+@code{window-restore-killed-buffer-windows} (see below) when it tries to
+restore a window whose buffer was killed after @var{configuration} was
+recorded.
Here is a way of using this function to get the same effect as
@code{save-window-excursion}:
@@ -6343,12 +6356,88 @@ a live window, it is replaced by a new live window created on the same
frame before putting @var{state} into it. If @var{window} is @code{nil},
it puts the window state into a new window.
+This function consults the variable
+@code{window-restore-killed-buffer-windows} (see below) when it tries to
+restore a window whose buffer was killed after @var{state} was recorded.
+
If the optional argument @var{ignore} is non-@code{nil}, it means to ignore
minimum window sizes and fixed-size restrictions. If @var{ignore}
is @code{safe}, this means windows can get as small as one line
and/or two columns.
@end defun
+By default, @code{set-window-configuration} and @code{window-state-put}
+may delete a window from the restored configuration when they find out
+that its buffer was killed since the corresponding configuration or
+state has been recorded. The variable described next can be used to
+fine-tune that behavior.
+
+@cindex restoring windows whose buffers have been killed
+@defvar window-restore-killed-buffer-windows
+This variable specifies how @code{set-window-configuration} and
+@code{window-state-put} shall handle a window whose buffer has been
+killed since the corresponding configuration or state was recorded. Any
+such window may be live---in which case it shows some other buffer---or
+dead at the time one of these functions is called. Usually,
+@code{set-window-configuration} leaves the window alone if it is live
+while @code{window-state-put} deletes it.
+
+The following values can be used to override the default behavior for
+dead windows in the case of @code{set-window-configuration} and for dead
+and live windows in the case of @code{window-state-put}.
+
+@table @asis
+@item @code{t}
+This value means to unconditionally restore the window and show some
+other buffer in it.
+
+@item @code{delete}
+This means to unconditionally try to delete the window.
+
+@item @code{dedicated}
+This means to try to delete the window if and only if it is dedicated to
+its buffer.
+
+@item @code{nil}
+This is the default, and it means that @code{set-window-configuration}
+will try to delete the window if and only if it is dedicated to its
+buffer, and @code{window-state-put} will unconditionally try to delete
+it.
+
+@item a function
+This means to restore the window and show some other buffer in it, like
+if the value is @code{t}, and also add an entry for that window to a
+list that will be later passed as the second argument to that function.
+@end table
+
+If a window cannot be deleted (typically, because it is the last window
+on its frame), @code{set-window-configuration} and
+@code{window-state-put} will show another buffer in it.
+
+If the value of this variable is a function, that function should take
+three arguments. The first argument specifies the frame whose windows
+have been restored. The third argument is either the symbol
+@code{configuration} if the windows are restored by
+@code{set-window-configuration}, or the symbol @code{state} if the
+windows are restored by @code{window-state-put}.
+
+The second argument specifies a list of entries for @emph{all} windows
+whose previous buffers have been found dead at the time
+@code{set-window-configuration} or @code{window-state-put} tried to
+restore them (minibuffer windows are excluded). This means that the
+function may also delete windows which were found live by
+@code{set-window-configuration}.
+
+Each entry in the list that is passed as the second argument to the
+function is itself a list of six values: the window whose buffer was
+found dead, the dead buffer or its name, the positions of window-start
+(@pxref{Window Start and End}) and window-point (@pxref{Window Point})
+of the buffer in that window, the dedicated state of the window as
+previously reported by @code{window-dedicated-p} and a flag that is
+@code{t} if the window has been found to be alive by
+@code{set-window-configuration} and @code{nil} otherwise.
+@end defvar
+
The functions @code{window-state-get} and @code{window-state-put} also
allow exchanging the contents of two live windows. The following
function does precisely that:
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 7ae338307a5..ac2ac5a0f91 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -6,6 +6,7 @@
@settitle GNU Emacs Calc Manual
@include docstyle.texi
@setchapternewpage odd
+@documentencoding UTF-8
@comment %**end of header (This is for running Texinfo on a region.)
@include emacsver.texi
@@ -10571,6 +10572,21 @@ Non-decimal fractions are entered and displayed as
@samp{@var{radix}#@var{num}:@var{denom}} (or in the analogous three-part
form). The numerator and denominator always use the same radix.
+@ifnottex
+Fractions may also be entered with @kbd{ā„} (U+2044 FRACTION SLASH) in
+place of any @kbd{:}. Precomposed fraction characters from @kbd{Ā½}
+(U+00BD VULGAR FRACTION ONE HALF) through @kbd{ā…ž} (U+215E VULGAR
+FRACTION SEVEN EIGHTHS) are supported as well. Thus, @samp{2:3},
+@samp{2ā„3}, and @samp{ā…ž} are all equivalent.
+@end ifnottex
+@iftex
+Fractions may also be entered with U+2044 FRACTION SLASH in place of
+any @kbd{:}. Precomposed fraction characters from U+00BD VULGAR
+FRACTION ONE HALF through U+215E VULGAR FRACTION SEVEN EIGHTHS are
+supported as well.
+@end iftex
+
+
@node Floats
@section Floats
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index 4cad016a0f6..e23ce3792e0 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -346,6 +346,16 @@ only match against the non-directory part of the file name. Set it to
match the file name relative to the buffer's top-level directory.
@end defvar
+@defvar dired-omit-size-limit
+If non-@code{nil}, @code{dired-omit-mode} will be effectively disabled
+in directories whose listing has size (in bytes) larger than the value
+of this option. Since omitting can be slow for very large directories,
+this avoids having to wait before seeing the directory. This variable
+is ignored when @code{dired-omit-mode} is called interactively, such as
+by @kbd{C-x M-o}, so you can still enable omitting in the directory
+after the initial display.
+@end defvar
+
@cindex omitting additional files
@defvar dired-omit-marker-char
Temporary marker used by Dired to implement omitting. Should never be used
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 25e6551f34b..5b722f9fd77 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -3119,8 +3119,8 @@ escape sequences. It is enabled by default.
@cindex Fullscreen mode
Run Emacs with the @samp{--maximized} command-line option or put the
-following form in your early init file (@pxref{Early Init File,,,
-emacs, The GNU Emacs Manual}).
+following form at the top of your early init file (@pxref{Early Init
+File,,, emacs, The GNU Emacs Manual}).
@lisp
(push '(fullscreen . maximized) default-frame-alist)
@@ -3128,9 +3128,9 @@ emacs, The GNU Emacs Manual}).
Note that while some customizations of @code{default-frame-alist}
could have undesirable effects when modified in the early init file,
-it is okay to do it in this particular case. Adding it to the normal
-init file will also work, but leads to a visible resizing of the
-window that some find distracting.
+it is okay to do it in this particular case. Adding it to the top of
+your normal init file will also work, but leads to a visible resizing
+of the window that some find distracting.
@node Emacs in a Linux console
@section How can I alleviate the limitations of the Linux console?
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index a5c3a967af1..85fef6be553 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -1405,8 +1405,6 @@ The remainder of the implementation consists of standard Elisp
techniques to loop over arrays, manage buffers and overlays.
@lisp
-(defvar-local eglot-clangd-inactive-region-overlays '())
-
(cl-defmethod eglot-handle-notification
(_server (_method (eql textDocument/inactiveRegions))
&key regions textDocument &allow-other-keys)
@@ -1414,14 +1412,14 @@ techniques to loop over arrays, manage buffers and overlays.
(cl-getf textDocument :uri))))
(buffer (find-buffer-visiting path)))
(with-current-buffer buffer
- (mapc #'delete-overlay eglot-clangd-inactive-region-overlays)
+ (remove-overlays nil nil 'inactive-code t)
(cl-loop
for r across regions
for (beg . end) = (eglot-range-region r)
for ov = (make-overlay beg end)
do
(overlay-put ov 'face 'shadow)
- (push ov eglot-clangd-inactive-region-overlays)))))
+ (overlay-put ov 'inactive-code t)))))
@end lisp
@end itemize
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index 27a9e2b0ebb..f450b9cbdd9 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -289,6 +289,15 @@ also ask you whether or not to sign the text before encryption and if
you answered yes, it will let you select the signing keys.
@end deffn
+@defvar epa-keys-select-method
+This variable controls the method used for key selection in
+@code{epa-select-keys}. The default value @code{buffer} pops up a
+special buffer where you can select the keys. If the value is
+@code{minibuffer}, @code{epa-select-keys} will instead prompt for the
+keys in the minibuffer, where you should type the keys separated by
+commas.
+@end defvar
+
@node Cryptographic operations on files
@section Cryptographic Operations on Files
@cindex cryptographic operations on files
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 7fbe6f9766e..c7ab7e7bf21 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -678,6 +678,14 @@ signals an error. Users defining personal modules in an init file
should @code{(provide 'erc-my-module)} somewhere to placate ERC.
Dynamically generating modules on the fly is not supported.
+Some older built-in modules have a second name along with a second
+minor-mode toggle, which is just a function alias for its primary
+counterpart. For practical reasons, ERC does not define a
+corresponding variable alias because contending with indirect
+variables complicates bookkeeping tasks, such as persisting module
+state across IRC sessions. New modules should definitely avoid
+defining aliases without a good reason.
+
Some packages have been known to autoload a module's definition
instead of its minor-mode command, which severs the link between the
library and the module. This means that enabling the mode by invoking
@@ -1048,13 +1056,19 @@ acceptable.
@section Authenticating via SASL
@cindex SASL
-Regardless of the mechanism or the network, you'll likely have to be
-registered before first use. Please refer to the network's own
+If you've used @acronym{SASL} elsewhere, you can probably skip to the
+examples below. Otherwise, if you haven't already registered with
+your network, please do so now, referring to the network's own
instructions for details. If you're new to IRC and using a bouncer,
-know that you probably won't be needing SASL for the client-to-bouncer
-connection. To get started, just add @code{sasl} to
-@code{erc-modules} like any other module. But before that, please
-explore all custom options pertaining to your chosen mechanism.
+know that you probably won't be needing this for the client-to-bouncer
+connection.
+
+When you're ready to get started, add @code{sasl} to
+@code{erc-modules}, like you would any other module. If unsure which
+@dfn{mechanism} to choose, stick with the default of @samp{PLAIN}.
+Then try @kbd{C-u M-x erc-tls @key{RET}}, and give your account name
+for the @samp{user} parameter and your account password for the
+@samp{server password}.
@defopt erc-sasl-mechanism
The name of an SASL subprotocol type as a @emph{lowercase} symbol.
@@ -1216,25 +1230,30 @@ machine Example.Net login aph-bot password sesame
(defun my-erc-up (network)
(interactive "Snetwork: ")
-
- (pcase network
- ('libera
- (let ((erc-sasl-mechanism 'external))
- (erc-tls :server "irc.libera.chat" :port 6697
- :client-certificate t)))
- ('example
- (let ((erc-sasl-auth-source-function
- #'erc-sasl-auth-source-password-as-host))
- (erc-tls :server "irc.example.net" :port 6697
- :user "alyssa"
- :password "Example.Net")))))
+ (require 'erc-sasl)
+ (or (let ((erc-modules (cons 'sasl erc-modules)))
+ (pcase network
+ ('libera
+ (let ((erc-sasl-mechanism 'external))
+ (erc-tls :server "irc.libera.chat"
+ :client-certificate t)))
+ ('example
+ (let ((erc-sasl-auth-source-function
+ #'erc-sasl-auth-source-password-as-host))
+ (erc-tls :server "irc.example.net"
+ :user "alyssa"
+ :password "Example.Net")))))
+ ;; Non-SASL
+ (call-interactively #'erc-tls)))
@end lisp
You've started storing your credentials with auth-source and have
decided to try SASL on another network as well. But there's a catch:
this network doesn't support @samp{EXTERNAL}. You use
-@code{let}-binding to get around this and successfully authenticate to
-both networks.
+@code{let}-binding to work around this and successfully authenticate
+to both networks. (Note that this example assumes you've removed
+@code{sasl} from @code{erc-modules} globally and have instead opted to
+add it locally when connecting to preconfigured networks.)
@end itemize
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index bd2ad495142..8767de71496 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -951,11 +951,13 @@ that assigns face properties to parts of the buffer. The
@code{ert-font-lock} package makes it possible to introduce unit tests
checking face assignment. Test assertions are included in code-level
comments directly and can be read either from inline strings or files.
+The parser expects the input string to contain at least one assertion.
Test assertion parser extracts tests from comment-only lines. Every
-comment assertion line starts either with a caret (@samp{^}) or an
-arrow (@samp{<-}). A caret/arrow should be followed immediately by the
-name of a face to be checked.
+comment assertion line starts either with a caret (@samp{^}) or an arrow
+(@samp{<-}). A single caret/arrow or carets should be followed
+immediately by the name of a face or a list of faces to be checked
+against the @code{:face} property at point.
The test then checks if the first non-assertion column above the caret
contains a face expected by the assertion:
@@ -967,10 +969,43 @@ var variable = 11;
// ^ font-lock-punctuation-face
// this is not an assertion, it's just a comment
// ^ font-lock-comment-face
+
+// multiple carets per line
+// ^^^^ ^ ^ font-lock-comment-face
+@end example
+
+Both symbol-only @code{:face} property values and assertion face values
+are normalized to single element lists so assertions below are
+equivalent:
+
+@example
+// single
+// ^ font-lock-comment-face
+// single
+// ^ (font-lock-comment-face)
+@end example
+
+Assertions can be negated:
+
+@example
+var variable = 11;
+// ^ !font-lock-comment-face
+@end example
+
+It is possible to specify face lists in assertions:
+
+@example
+// TODO
+// ^^^^ (font-lock-comment-face hl-todo)
+ var test = 1;
+// ^ ()
+// ^ nil
+// negation works as expected
+// ^ !nil
@end example
-The arrow means that the first non-empty column of the assertion line
-will be used for the check:
+The arrow (@samp{<-}) means that the first non-empty column of the
+assertion line will be used for the check:
@example
var variable = 1;
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index fb9a563b696..30c85da795b 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -3,7 +3,7 @@
@setfilename ../../info/eshell.info
@settitle Eshell: The Emacs Shell
@include docstyle.texi
-@defindex cm
+@defcodeindex cm
@syncodeindex vr fn
@c %**end of header
@@ -416,7 +416,7 @@ elisp, The Emacs Lisp Reference Manual}).
@end table
@node Built-ins
-@section Built-in commands
+@section Built-in Commands
Eshell provides a number of built-in commands, many of them
implementing common command-line utilities, but enhanced for Eshell.
(These built-in commands are just ordinary Lisp functions whose names
@@ -477,98 +477,133 @@ default target for the commands @command{cp}, @command{mv}, and
@command{ln} is the current directory.
A few commands are wrappers for more niche Emacs features, and can be
-loaded as part of the eshell-xtra module. @xref{Extension modules}.
+loaded as part of the @code{eshell-xtra} module. @xref{Extra built-in
+commands}.
+
+@menu
+* List of Built-ins::
+* Defining New Built-ins::
+@end menu
+
+@node List of Built-ins
+@subsection List of Built-in Commands
@table @code
-@item .
@cmindex .
-Source an Eshell file in the current environment. This is not to be
-confused with the command @command{source}, which sources a file in a
-subshell environment.
+@item . @var{file} [@var{argument}]@dots{}
+Source an Eshell script named @var{file} in the current environment,
+passing any @var{arguments} to the script (@pxref{Scripts}). This is
+not to be confused with the command @command{source}, which sources a
+file in a subshell environment.
-@item addpath
@cmindex addpath
-Adds a given path or set of paths to the PATH environment variable, or,
-with no arguments, prints the current paths in this variable.
+@item addpath
+@itemx addpath [-b] @var{directory}@dots{}
+Adds each specified @var{directory} to the @code{$PATH} environment
+variable. By default, this adds the directories to the end of
+@code{$PATH}, in the order they were passed on the command line; by
+passing @code{-b} or @code{--begin}, Eshell will instead add the
+directories to the beginning.
+
+With no directories, print the list of directories currently stored in
+@code{$PATH}.
-@item alias
@cmindex alias
-Define an alias (@pxref{Aliases}). This adds it to the aliases file.
+@item alias
+@itemx alias @var{name} [@var{command}]
+Define an alias named @var{name} and expanding to @var{command},
+adding it to the aliases file (@pxref{Aliases}). If @var{command} is
+omitted, delete the alias named @var{name}. With no arguments at all,
+list all the currently-defined aliases.
-@item basename
@cmindex basename
-Return a file name without its directory.
+@item basename @var{filename}
+Return @var{filename} without its directory.
-@item cat
@cmindex cat
-Concatenate file contents into standard output. If in a pipeline, or
-if the file is not a regular file, directory, or symlink, then this
-command reverts to the system's definition of @command{cat}.
+@item cat @var{file}@dots{}
+Concatenate the contents of @var{file}s to standard output. If in a
+pipeline, or if any of the files is not a regular file, directory, or
+symlink, then this command reverts to the system's definition of
+@command{cat}.
-@item cd
@cmindex cd
-This command changes the current working directory. Usually, it is
-invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new
-working directory. But @command{cd} knows about a few special
-arguments:
+@cindex directories, changing
+@item cd
+@itemx cd @var{directory}
+@itemx cd -[@var{n}]
+@itemx cd =[@var{regexp}]
+Change the current working directory. This command can take several
+forms:
-@itemize @minus{}
-@item
-When it receives no argument at all, it changes to the home directory.
+@table @code
-@item
-Giving the command @kbd{cd -} changes back to the previous working
-directory (this is the same as @kbd{cd $-}).
+@item cd
+Change to the user's home directory.
-@item
-The command @kbd{cd =} shows the directory ring. Each line is
-numbered.
+@item cd @var{directory}
+Change to the specified @var{directory}.
-@item
-With @kbd{cd =foo}, Eshell searches the directory ring for a directory
-matching the regular expression @samp{foo}, and changes to that
-directory.
+@item cd -
+Change back to the previous working directory (this is the same as
+@kbd{cd $-}).
-@item
-With @kbd{cd -42}, you can access the directory stack slots by number.
+@item cd -@var{n}
+Change to the directory in the @var{nth} slot of the directory stack.
+
+@item cd =
+Show the directory ring. Each line is numbered.
+
+@item cd =@var{regexp}
+Search the directory ring for a directory matching the regular
+expression @var{regexp} and change to that directory.
+
+@end table
-@item
@vindex eshell-cd-shows-directory
@vindex eshell-list-files-after-cd
If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd}
will report the directory it changes to. If
@code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls}
is called with any remaining arguments after changing directories.
-@end itemize
-@item clear
@cmindex clear
+@item clear [@var{scrollback}]
Scrolls the contents of the Eshell window out of sight, leaving a
-blank window. If provided with an optional non-@code{nil} argument,
-the scrollback contents are cleared instead.
+blank window. If @var{scrollback} is non-@code{nil}, the scrollback
+contents are cleared instead, as with @command{clear-scrollback}.
-@item clear-scrollback
@cmindex clear-scrollback
+@item clear-scrollback
Clear the scrollback contents of the Eshell window. Unlike the
command @command{clear}, this command deletes content in the Eshell
buffer.
-@item compile
@cmindex compile
+@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{}
Run an external command, sending its output to a compilation buffer if
the command would output to the screen and is not part of a pipeline
-or subcommand. This is particularly useful when defining aliases, so
+or subcommand.
+
+With the @code{-p} or @code{--plain} options, always send the output
+to the Eshell buffer; similarly, with @code{-i} or
+@code{--interactive}, always send the output to a compilation buffer.
+You can also set the mode of the compilation buffer with @code{-m
+@var{mode-name}} or @code{--mode @var{mode-name}}.
+
+@command{compile} is particularly useful when defining aliases, so
that interactively, the output shows up in a compilation buffer, but
you can still pipe the output elsewhere if desired. For example, if
you have a grep-like command on your system, you might define an alias
for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep
$*'}.
-@item cp
@cmindex cp
-Copy a file to a new location or copy multiple files to the same
-directory.
+@item cp [@var{option}@dots{}] @var{source} @var{dest}
+@item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory}
+Copy the file @var{source} to @var{dest} or @var{source} into
+@var{directory}.
@vindex eshell-cp-overwrite-files
@vindex eshell-cp-interactive-query
@@ -577,59 +612,145 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil}, then
@code{eshell-cp-interactive-query} is non-@code{nil}, then
@command{cp} will ask before overwriting anything.
-@item date
+@command{cp} accepts the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--archive}
+Equivalent to @code{--no-dereference --preserve --recursive}.
+
+@item @code{-d}, @code{--no-dereference}
+Don't dereference symbolic links when copying; instead, copy the link
+itself.
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before copying a file.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before copying a file if the target already
+exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't copy anything. This is useful if you
+want to preview what would be removed when calling @command{cp}.
+
+@item @code{-p}, @code{--preserve}
+Attempt to preserve file attributes when copying.
+
+@item @code{-r}, @code{-R}, @code{--recursive}
+Copy any specified directories and their contents recursively.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each file before copying it.
+
+@end table
+
@cmindex date
+@item date [@var{specified-time} [@var{zone}]]
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.
+is an alias to the Emacs Lisp function @code{current-time-string}
+(@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}).
-@item diff
@cmindex diff
-Compare files using Emacs's internal @code{diff} (not to be confused
-with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs
-Manual}.
+@item diff [@var{option}]@dots{} @var{old} @var{new}
+Compare the files @var{old} and @var{new} using Emacs's internal
+@code{diff} (not to be confused with @code{ediff}). @xref{Comparing
+Files, , , emacs, The GNU Emacs Manual}.
@vindex eshell-plain-diff-behavior
If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this
command does not use Emacs's internal @code{diff}. This is the same
as using @samp{alias diff '*diff $@@*'}.
-@item dirname
@cmindex dirname
-Return the directory component of a file name.
+@item dirname @var{filename}
+Return the directory component of @var{filename}.
-@item dirs
@cmindex dirs
+@cindex directory stack, listing
+@item dirs
Prints the directory stack. Directories can be added or removed from
the stack using the commands @command{pushd} and @command{popd},
respectively.
-@item du
@cmindex du
-Summarize disk usage for each file.
+@item du [@var{option}]@dots{} @var{file}@dots{}
+Summarize disk usage for each file, recursing into directories.
+
+@command{du} accepts the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--all}
+Print sizes for files, not just directories.
+
+@item @code{--block-size=@var{size}}
+Print sizes as number of blocks of size @var{size}.
+
+@item @code{-b}, @code{--bytes}
+Print file sizes in bytes.
+
+@item @code{-c}, @code{--total}
+Print a grand total of the sizes at the end.
+
+@item @code{-d}, @code{--max-depth=@var{depth}}
+Only print sizes for directories (or files with @code{--all}) that are
+@var{depth} or fewer levels below the command line arguments.
+
+@item @code{-h}, @code{--human-readable}
+Print sizes in human-readable format, with binary prefixes (so 1 KB is
+1024 bytes).
+
+@item @code{-H}, @code{--si}
+Print sizes in human-readable format, with decimal prefixes (so 1 KB
+is 1000 bytes).
+
+@item @code{-k}, @code{--kilobytes}
+Print file sizes in kilobytes (like @code{--block-size=1024}).
+
+@item @code{-L}, @code{--dereference}
+Follow symbolic links when traversing files.
+
+@item @code{-m}, @code{--megabytes}
+Print file sizes in megabytes (like @code{--block-size=1048576}).
+
+@item @code{-s}, @code{--summarize}
+Don't recurse into subdirectories (like @code{--max-depth=0}).
+
+@item @code{-x}, @code{--one-file-system}
+Skip any directories that reside on different filesystems.
+
+@end table
-@item echo
@cmindex echo
-Echoes its input. By default, this prints in a Lisp-friendly fashion
-(so that the value is useful to a Lisp command using the result of
-@command{echo} as an argument). If a single argument is passed,
-@command{echo} prints that; if multiple arguments are passed, it
-prints a list of all the arguments; otherwise, it prints the empty
-string.
+@item echo [-n | -N] [@var{arg}]@dots{}
+Prints the value of each @var{arg}. By default, this prints in a
+Lisp-friendly fashion (so that the value is useful to a Lisp command
+using the result of @command{echo} as an argument). If a single
+argument is passed, @command{echo} prints that; if multiple arguments
+are passed, it prints a list of all the arguments; otherwise, it
+prints the empty string.
@vindex eshell-plain-echo-behavior
If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo}
will try to behave more like a plain shell's @command{echo}, printing
each argument as a string, separated by a space.
-@item env
+You can control whether @command{echo} outputs a trailing newline
+using @code{-n} to disable the trailing newline (the default behavior)
+or @code{-N} to enable it (the default when
+@code{eshell-plain-echo-behavior} is non-@code{nil}).
+
@cmindex env
-Prints the current environment variables. Unlike in Bash, this
-command does not yet support running commands with a modified
-environment.
+@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{}
+With no arguments, print the current environment variables. If you
+pass arguments to this command, then @command{env} will execute the
+arguments as a command. If you pass any initial arguments of the form
+@samp{@var{var}=@var{value}}, @command{env} will first set @var{var}
+to @var{value} before running the command.
-@item eshell-debug
@cmindex eshell-debug
+@item eshell-debug [error | form | process]@dots{}
Toggle debugging information for Eshell itself. You can pass this
command one or more of the following arguments:
@@ -649,72 +770,95 @@ buffer @code{*eshell last cmd*}; or
@end itemize
-@item exit
@cmindex exit
+@item exit
@vindex eshell-kill-on-exit
Exit Eshell and save the history. By default, this command kills the
Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then
the buffer is merely buried instead.
-@item export
@cmindex export
+@item export [@var{name}=@var{value}]@dots{}
Set environment variables using input like Bash's @command{export}, as
in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}.
-@item grep
@cmindex grep
-@itemx agrep
+@item grep [@var{arg}]@dots{}
@cmindex agrep
-@itemx egrep
+@itemx agrep [@var{arg}]@dots{}
@cmindex egrep
-@itemx fgrep
+@itemx egrep [@var{arg}]@dots{}
@cmindex fgrep
-@itemx rgrep
+@itemx fgrep [@var{arg}]@dots{}
@cmindex rgrep
-@itemx glimpse
+@itemx rgrep [@var{arg}]@dots{}
@cmindex glimpse
+@itemx glimpse [@var{arg}]@dots{}
The @command{grep} commands are compatible with GNU @command{grep},
-but use Emacs's internal @code{grep} instead.
+but open a compilation buffer in @code{grep-mode} instead.
@xref{Grep Searching, , , emacs, The GNU Emacs Manual}.
@vindex eshell-plain-grep-behavior
If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these
-commands do not use Emacs's internal @code{grep}. This is the same as
-using @samp{alias grep '*grep $@@*'}, though this setting applies to
-all of the built-in commands for which you would need to create a
-separate alias.
+commands do not use open a compilation buffer, instead printing output
+to Eshell's buffer. This is the same as using @samp{alias grep '*grep
+$@@*'}, though this setting applies to all of the built-in commands
+for which you would need to create a separate alias.
-@item history
@cmindex history
-Prints Eshell's input history. With a numeric argument @var{N}, this
-command prints the @var{N} most recent items in the history.
+@item history [@var{n}]
+@itemx history [-arw] [@var{filename}]
+Prints Eshell's input history. With a numeric argument @var{n}, this
+command prints the @var{n} most recent items in the history.
+Alternately, you can specify the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--append}
+Append new history items to the history file.
+
+@item @code{-r}, @code{--read}
+Read history items from the history file and append them to the
+current shell's history.
+
+@item @code{-w}, @code{--write}
+Write the current history list to the history file.
+
+@end table
-@item info
@cmindex info
-Browse the available Info documentation. This command is the same as
-the external @command{info} command, but uses Emacs's internal Info
-reader.
-@xref{Misc Help, , , emacs, The GNU Emacs Manual}.
+@item info [@var{manual} [@var{item}]@dots{}]
+Browse the available Info documentation. With no arguments, browse
+the top-level menu. Otherwise, show the manual for @var{manual},
+selecting the menu entry for @var{item}.
+
+This command is the same as the external @command{info} command, but
+uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The
+GNU Emacs Manual}.
-@item jobs
@cmindex jobs
+@cindex processes, listing
+@item jobs
List subprocesses of the Emacs process, if any, using the function
@code{list-processes}.
-@item kill
@cmindex kill
+@cindex processes, signaling
+@item kill [-@var{signal}] [@var{pid} | @var{process}]
Kill processes. Takes a PID or a process object and an optional
-signal specifier which can either be a number or a signal name.
+@var{signal} specifier which can either be a number or a signal name.
-@item listify
@cmindex listify
-Eshell version of @code{list}. Allows you to create a list using Eshell
-syntax, rather than Elisp syntax. For example, @samp{listify foo bar}
-and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}.
+@item listify [@var{arg}]@dots{}
+Return the arguments as a single list. With a single argument, return
+it as-is if it's already a list, or otherwise wrap it in a list. With
+multiple arguments, return a list of all of them.
-@item ln
@cmindex ln
-Create links to files.
+@item ln [@var{option}]@dots{} @var{target} [@var{link-name}]
+@itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory}
+Create a link to the specified @var{target} named @var{link-name} or
+create links to multiple @var{targets} in @var{directory}.
@vindex eshell-ln-overwrite-files
@vindex eshell-ln-interactive-query
@@ -723,8 +867,31 @@ will overwrite files without warning. If
@code{eshell-ln-interactive-query} is non-@code{nil}, then
@command{ln} will ask before overwriting files.
-@item locate
+@command{ln} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before linking a target.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before linking to an item if the source
+already exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't move anything. This is useful if you
+want to preview what would be linked when calling @command{ln}.
+
+@item @code{-s}, @code{--symbolic}
+Make symbolic links instead of hard links.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each file before linking it.
+
+@end table
+
@cmindex locate
+@item locate @var{arg}@dots{}
Alias to Emacs's @code{locate} function, which simply runs the external
@command{locate} command and parses the results.
@xref{Dired and Find, , , emacs, The GNU Emacs Manual}.
@@ -734,51 +901,129 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's
internal @code{locate} is not used. This is the same as using
@samp{alias locate '*locate $@@*'}.
-@item ls
@cmindex ls
-Lists the contents of directories.
+@item ls [@var{option}]@dots{} [@var{file}]@dots{}
+List information about each @var{file}, including the contents of any
+specified directories. If @var{file} is unspecified, list the
+contents of the current directory.
+
+@vindex eshell-ls-initial-args
+The user option @code{eshell-ls-initial-args} contains a list of
+arguments to include with any call to @command{ls}. For example, you
+can include the option @option{-h} to always use a more human-readable
+format.
@vindex eshell-ls-use-colors
If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a
directory is color-coded according to file type and status. These
colors and the regexps used to identify their corresponding files can
-be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}.
+be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls
+@key{RET}}}.
+
+@command{ls} supports the following options:
+
+@table @asis
+
+@item @code{-a}, @code{--all}
+List all files, including ones starting with @samp{.}.
+
+@item @code{-A}, @code{--almost-all}
+Like @code{--all}, but don't list the current directory (@file{.}) or
+the parent directory (@file{..}).
+
+@item @code{-c}, @code{--by-ctime}
+Sort files by last status change time, with newest files first.
+
+@item @code{-C}
+List entries by columns.
+
+@item @code{-d}, @code{--directory}
+List directory entries instead of their contents.
+
+@item @code{-h}, @code{--human-readable}
+Print sizes in human-readable format, with binary prefixes (so 1 KB is
+1024 bytes).
+
+@item @code{-H}, @code{--si}
+Print sizes in human-readable format, with decimal prefixes (so 1 KB
+is 1000 bytes).
+
+@item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}}
+Don't list directory entries matching @var{pattern}.
+
+@item @code{-k}, @code{--kilobytes}
+Print sizes as 1024-byte kilobytes.
@vindex eshell-ls-date-format
-The user option @code{eshell-ls-date-format} determines how the date
-is displayed when using the @option{-l} option. The date is produced
-using the function @code{format-time-string} (@pxref{Time Parsing,,,
-elisp, GNU Emacs Lisp Reference Manual}).
+@item @code{-l}
+Use a long listing format showing details for each file. The user
+option @code{eshell-ls-date-format} determines how the date is
+displayed when using this option. The date is produced using the
+function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU
+Emacs Lisp Reference Manual}).
-@vindex eshell-ls-initial-args
-The user option @code{eshell-ls-initial-args} contains a list of
-arguments to include with any call to @command{ls}. For example, you
-can include the option @option{-h} to always use a more human-readable
-format.
+@item @code{-L}, @code{--dereference}
+Follow symbolic links when listing entries.
+
+@item @code{-n}, @code{--numeric-uid-gid}
+Show UIDs and GIDs numerically, instead of using their names.
+
+@item @code{-r}, @code{--reverse}
+Reverse order when sorting.
+
+@item @code{-R}, @code{--recursive}
+List subdirectories recursively.
+
+@item @code{-s}, @code{--size}
+Show the size of each file in blocks.
@vindex eshell-ls-default-blocksize
-The user option @code{eshell-ls-default-blocksize} determines the
-default blocksize used when displaying file sizes with the option
-@option{-s}.
+@item @code{-S}
+Sort by file size, with largest files first. The user option
+@code{eshell-ls-default-blocksize} determines the default blocksize
+used when displaying file sizes with this option.
+
+@item @code{-t}
+Sort by modification time, with newest files first.
+
+@item @code{-u}
+Sort by last access time, with newest files first.
+
+@item @code{-U}
+Do not sort results. Instead, list entries in their directory order.
+
+@item @code{-x}
+List entries by lines instead of by columns.
+
+@item @code{-X}
+Sort alphabetically by file extension.
+
+@item @code{-1}
+List one file per line.
+
+@end table
-@item make
@cmindex make
+@item make [@var{arg}]@dots{}
Run @command{make} through @code{compile} when run asynchronously
(e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs
Manual}. Otherwise call the external @command{make} command.
-@item man
@cmindex man
+@item man [@var{arg}]@dots{}
Display Man pages using the Emacs @code{man} command.
@xref{Man Page, , , emacs, The GNU Emacs Manual}.
-@item mkdir
@cmindex mkdir
-Make new directories.
+@item mkdir [-p] @var{directory}@dots{}
+Make new directories. With @code{-p} or @code{--parents},
+automatically make any necessary parent directories as well.
-@item mv
@cmindex mv
-Move or rename files.
+@item mv [@var{option}]@dots{} @var{source} @var{dest}
+@itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory}
+Rename the file @var{source} to @var{dest} or move @var{source} into
+@var{directory}.
@vindex eshell-mv-overwrite-files
@vindex eshell-mv-interactive-query
@@ -787,40 +1032,95 @@ will overwrite files without warning. If
@code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv}
will prompt before overwriting anything.
-@item occur
+@command{mv} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before moving an item.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before moving an item if the target already
+exists.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't move anything. This is useful if you
+want to preview what would be moved when calling @command{mv}.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each item before moving it.
+
+@end table
+
@cmindex occur
+@item occur @var{regexp} [@var{nlines}]
Alias to Emacs's @code{occur}.
@xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}.
-@item popd
@cmindex popd
+@cindex directory stack, removing from
+@item popd
+@item popd +@var{n}
Pop a directory from the directory stack and switch to a another place
-in the stack.
+in the stack. This command can take the following forms:
+
+@table @code
+
+@item popd
+Remove the current directory from the directory stack and change to
+the directory beneath it.
+
+@item popd +@var{n}
+Remove the current directory from the directory stack and change to
+the @var{nth} directory in the stack (counting from zero).
+
+@end table
-@item printnl
@cmindex printnl
-Print the arguments separated by newlines.
+@item printnl [@var{arg}]@dots{}
+Print all the @var{arg}s separated by newlines.
-@item pushd
@cmindex pushd
+@cindex directory stack, adding to
+@item pushd
+@itemx pushd @var{directory}
+@itemx pushd +@var{n}
Push the current directory onto the directory stack, then change to
-another directory.
+another directory. This command can take the following forms:
+
+@table @code
+
+@vindex eshell-pushd-tohome
+@item pushd
+Swap the current directory with the directory on the top of the stack.
+If @code{eshell-pushd-tohome} is non-@code{nil}, push the current
+directory onto the stack and change to the user's home directory (like
+@samp{pushd ~}).
@vindex eshell-pushd-dunique
+@item pushd @var{directory}
+Push the current directory onto the stack and change to
+@var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil},
+then only unique directories will be added to the stack.
+
@vindex eshell-pushd-dextract
-If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique
-directories will be added to the stack. If
-@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd
-+@var{n}} will pop the @var{n}th directory to the top of the stack.
+@item pushd +@var{n}
+Change to the @var{nth} directory in the directory stack (counting
+from zero), and ``rotate'' the stack by moving any elements before the
+@var{nth} to the bottom. If @code{eshell-pushd-dextract} is
+non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the
+@var{n}th directory to the top of the stack.
+
+@end table
-@item pwd
@cmindex pwd
+@item pwd
Prints the current working directory.
-@item rm
@cmindex rm
+@item rm [@var{option}]@dots{} @var{item}@dots{}
Removes files, buffers, processes, or Emacs Lisp symbols, depending on
-the argument.
+the type of each @var{item}.
@vindex eshell-rm-interactive-query
@vindex eshell-rm-removes-directories
@@ -830,59 +1130,89 @@ will prompt before removing anything. If
@command{rm} can also remove directories. Otherwise, @command{rmdir}
is required.
-@item rmdir
+@command{rm} accepts the following options:
+
+@table @asis
+
+@item @code{-f}, @code{--force}
+Never prompt for confirmation before removing an item.
+
+@item @code{-i}, @code{--interactive}
+Prompt for confirmation before removing each item.
+
+@item @code{-n}, @code{--preview}
+Run the command, but don't remove anything. This is useful if you
+want to preview what would be removed when calling @command{rm}.
+
+@item @code{-r}, @code{-R}, @code{--recursive}
+Remove any specified directories and their contents recursively.
+
+@item @code{-v}, @code{--verbose}
+Print the name of each item before removing it.
+
+@end table
+
@cmindex rmdir
+@item rmdir @var{directory}@dots{}
Removes directories if they are empty.
-@item set
@cmindex set
+@item set [@var{var} @var{value}]@dots{}
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
+The value of @var{var} 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
+@item setq [@var{symbol} @var{value}]@dots{}
Set variable values, using the function @code{setq} like a command
(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
-@item source
@cmindex source
-Source an Eshell file in a subshell environment. This is not to be
-confused with the command @command{.}, which sources a file in the
-current environment.
+@item source @var{file} [@var{argument}]@dots{}
+Source an Eshell script named @var{file} in a subshell environment,
+passing any @var{argument}s to the script (@pxref{Scripts}). This is
+not to be confused with the command @command{.}, which sources a file
+in the current environment.
-@item time
@cmindex time
-Show the time elapsed during a command's execution.
+@item time @var{command}@dots{}
+Show the time elapsed during the execution of @var{command}.
-@item umask
@cmindex umask
-Set or view the default file permissions for newly created files and
-directories.
+@item umask [-S]
+@itemx umask @var{mode}
+View the default file permissions for newly created files and
+directories. If you pass @code{-S} or @code{--symbolic}, view the
+mode symbolically. With @var{mode}, set the default permissions to
+this value.
-@item unset
@cmindex unset
-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 unset [@var{var}]@dots{}
+Unset one or more variables. As with @command{set}, the value of
+@var{var} 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
-Wait until a process has successfully completed.
+@cindex processes, waiting for
+@item wait [@var{process}]@dots{}
+Wait until each specified @var{process} has exited.
-@item which
@cmindex which
-Identify a command and its location.
+@item which @var{command}@dots{}
+For each @var{command}, identify what kind of command it is and its
+location.
-@item whoami
@cmindex whoami
-Print the current user. This Eshell version of @command{whoami}
-supports Tramp.
+@item whoami
+Print the current user. This Eshell version of @command{whoami} is
+connection-aware, so for remote directories, it will print the user
+associated with that connection.
@end table
-@subsection Defining new built-in commands
+@node Defining New Built-ins
+@subsection Defining New Built-in Commands
While Eshell can run Lisp functions directly as commands, it may be
more convenient to provide a special built-in command for
Eshell. Built-in commands are just ordinary Lisp functions designed
@@ -1178,7 +1508,7 @@ create and switch to a directory called @samp{foo}.
@node Remote Access
@section Remote Access
-@cmindex remote access
+@cindex remote access
Since Eshell uses Emacs facilities for most of its functionality, you
can access remote hosts transparently. To connect to a remote host,
@@ -1351,6 +1681,11 @@ sequence of commands, as with almost any other shell script. Scripts
are invoked from Eshell with @command{source}, or from anywhere in Emacs
with @code{eshell-source-file}.
+Like with aliases (@pxref{Aliases}), Eshell scripts can accept any
+number of arguments. Within the script, you can refer to these with
+the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and
+@code{$*}.
+
@cmindex .
If you wish to load a script into your @emph{current} environment,
rather than in a subshell, use the @code{.} command.
@@ -1450,7 +1785,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation
@command{@var{command}}, but writes the output to a temporary file and
returns the file name.
-@item $@var{expr}[@var{i...}]
+@item $@var{expr}[@var{i@dots{}}]
Expands to the @var{i}th element of the result of @var{expr}, an
expression in one of the above forms listed here. If multiple indices
are supplied, this will return a list containing the elements for each
@@ -1499,7 +1834,7 @@ Multiple sets of indices can also be specified. For example, if
expand to @code{2}, i.e.@: the second element of the first list member
(all indices are zero-based).
-@item $@var{expr}[@var{regexp} @var{i...}]
+@item $@var{expr}[@var{regexp} @var{i@dots{}}]
As above (when @var{expr} expands to a string), but use @var{regexp}
to split the string. @var{regexp} can be any form other than a
number. For example, @samp{$@var{var}[: 0]} will return the first
@@ -2273,15 +2608,23 @@ external commands. To enable it, add @code{eshell-tramp} to
@table @code
-@item su
@cmindex su
-@itemx sudo
+@item su [- | -l] [@var{user}]
+Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp,
+The Tramp Manual}) to change the current user to @var{user} (or root
+if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide
+a login environment.
+
@cmindex sudo
-@itemx doas
+@item sudo [-u @var{user}] [-s | @var{command}@dots{}]
@cmindex doas
-Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method
-(@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command
-via @command{su}, @command{sudo}, or @command{doas}.
+@itemx doas [-u @var{user}] [-s | @var{command}@dots{}]
+Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline
+methods, , , tramp, The Tramp Manual}) to run @var{command} as root
+via @command{sudo} or @command{doas}. When specifying @code{-u
+@var{user}} or @code{--user @var{user}}, run the command as @var{user}
+instead. With @code{-s} or @code{--shell}, start a shell instead of
+running @var{command}.
@end table
@@ -2294,59 +2637,59 @@ add @code{eshell-xtra} to @code{eshell-modules-list}.
@table @code
-@item count
@cmindex count
+@item count @var{item} @var{seq} [@var{option}]@dots{}
A wrapper around the function @code{cl-count} (@pxref{Searching
Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item expr
@cmindex expr
+@item expr @var{str} [@var{separator}] [@var{arg}]@dots{}
An implementation of @command{expr} using the Calc package.
@xref{Top,,, calc, The GNU Emacs Calculator}.
-@item ff
@cmindex ff
+@item ff @var{directory} @var{pattern}
Shorthand for the the function @code{find-name-dired} (@pxref{Dired
and Find, , , emacs, The Emacs Editor}).
-@item gf
@cmindex gf
+@item gf @var{directory} @var{regexp}
Shorthand for the the function @code{find-grep-dired} (@pxref{Dired
and Find, , , emacs, The Emacs Editor}).
-@item intersection
@cmindex intersection
+@item intersection @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-intersection} (@pxref{Lists as
Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command
can be used for comparing lists of strings.
-@item mismatch
@cmindex mismatch
+@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{}
A wrapper around the function @code{cl-mismatch} (@pxref{Searching
Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item set-difference
@cmindex set-difference
+@item set-difference @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-set-difference} (@pxref{Lists
as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be
used for comparing lists of strings.
-@item set-exclusive-or
@cmindex set-exclusive-or
+@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists
as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be
used for comparing lists of strings.
-@item substitute
@cmindex substitute
+@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{}
A wrapper around the function @code{cl-substitute} (@pxref{Sequence
Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can
be used for comparing lists of strings.
-@item union
@cmindex union
+@item union @var{list1} @var{list2} [@var{option}]@dots{}
A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,,
cl, GNU Emacs Common Lisp Emulation}). This command can be used for
comparing lists of strings.
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 5e69b11d347..eec6b3c3299 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -146,6 +146,27 @@ a new tab is created on the frame tab bar.
which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
+ When called interactively, this command toggles the display of the
+readable parts. With a positive prefix argument, this command always
+displays the readable parts, and with a zero or negative prefix, it
+always displays the full page.
+
+@vindex eww-readable-urls
+ If you want EWW to render a certain page in ``readable'' mode by
+default, you can add a regular expression matching its URL to
+@code{eww-readable-urls}. Each entry can either be a regular expression
+in string form or a cons cell of the form
+@w{@code{(@var{regexp} . @var{readability})}}. If @var{readability} is
+non-@code{nil}, this behaves the same as the string form; otherwise,
+URLs matching @var{regexp} will never be displayed in readable mode by
+default. For example, you can use this to make all pages default to
+readable mode, except for a few outliers:
+
+@example
+(setq eww-readable-urls '(("https://example\\.com/" . nil)
+ ".*"))
+@end example
+
@findex eww-toggle-fonts
@vindex shr-use-fonts
@kindex F
@@ -192,6 +213,15 @@ history press @kbd{H} (@code{eww-list-histories}) to open the history
buffer @file{*eww history*}. The history is lost when EWW is quit.
If you want to remember websites you can use bookmarks.
+@vindex eww-before-browse-history-function
+ By default, when browsing to a new page from a ``historical'' one
+(i.e.@: a page loaded by navigating back via @code{eww-back-url}), EWW
+will first delete any history entries newer than the current page. This
+is the same behavior as most other web browsers. You can change this by
+customizing @code{eww-before-browse-history-function} to another value.
+For example, setting it to @code{ignore} will preserve the existing
+history entries and simply prepend the new page to the history list.
+
@vindex eww-history-limit
Along with the URLs visited, EWW also remembers both the rendered
page (as it appears in the buffer) and its source. This can take a
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 1d1c15f6494..419a5390374 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -5832,10 +5832,11 @@ message to the mailing list, and include the original message
@kindex S v @r{(Summary)}
@findex gnus-summary-very-wide-reply
Mail a very wide reply to the author of the current article
-(@code{gnus-summary-wide-reply}). A @dfn{very wide reply} is a reply
-that goes out to all people listed in the @code{To}, @code{From} (or
-@code{Reply-To}) and @code{Cc} headers in all the process/prefixed
-articles. This command uses the process/prefix convention.
+(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a
+reply that goes out to all people listed in the @code{To}, @code{From}
+(or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed
+articles. This command uses the process/prefix convention. If given a
+prefix argument, the body of the current article will also be yanked.
@item S V
@kindex S V @r{(Summary)}
@@ -19806,7 +19807,7 @@ locally stored articles.
@chapter Scoring
@cindex scoring
-Other people use @dfn{kill files} (@pxref{Kill Files}, but we here at
+Other people use @dfn{kill files} (@pxref{Kill Files}), but we here at
Gnus Towers like scoring better than killing, so we'd rather switch
than fight. Scoring and score files processing are more powerful and
faster than processing of kill files. Scoring also does something
@@ -26694,9 +26695,12 @@ buffers. It is enabled with
@table @kbd
@item C-c C-m C-a
@findex gnus-dired-attach
+@vindex gnus-dired-attach-at-end
@cindex attachments, selection via dired
Send dired's marked files as an attachment (@code{gnus-dired-attach}).
-You will be prompted for a message buffer.
+The function prompts for a message buffer, and by default attaches files
+to the end of that buffer; customize @code{gnus-dired-attach-at-end} to
+place the attachments at point instead.
@item C-c C-m C-l
@findex gnus-dired-find-file-mailcap
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index 31b314cb9a0..01c7f614e7d 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -1148,6 +1148,7 @@ move between menu items.
@section @kbd{M-n} creates a new independent Info buffer in Emacs
@kindex M-n @r{(Info mode)}
+@kindex C-x x n
@findex clone-buffer
@cindex multiple Info buffers
If you are reading Info in Emacs, you can select a new independent
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 45f96778203..c3de15c35ad 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 4.3.0
-#+macro: release-date 2023-09-19
-#+macro: development-version 4.4.0-dev
+#+macro: stable-version 4.4.0
+#+macro: release-date 2024-03-17
+#+macro: development-version 4.5.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -37,12 +37,10 @@ Current development target is {{{development-version}}}.
+ Change log: <https://protesilaos.com/emacs/modus-themes-changelog>
+ Color palette: <https://protesilaos.com/emacs/modus-themes-colors>
+ Sample pictures: <https://protesilaos.com/emacs/modus-themes-pictures>
-+ Git repo on SourceHut: <https://git.sr.ht/~protesilaos/modus-themes>
- - Mirrors:
- + GitHub: <https://github.com/protesilaos/modus-themes>
- + GitLab: <https://gitlab.com/protesilaos/modus-themes>
-+ Mailing list: <https://lists.sr.ht/~protesilaos/modus-themes>
-+ Backronym: My Old Display Unexpectedly Sharpened ... themes
++ Git repositories:
+ + GitHub: <https://github.com/protesilaos/modus-themes>
+ + GitLab: <https://gitlab.com/protesilaos/modus-themes>
++ Backronym: My Old Display Unexpectedly Sharpened ... themes.
#+toc: headlines 8 insert TOC here, with eight headline levels
@@ -90,7 +88,7 @@ The Modus themes consist of eight themes, divided into four subgroups.
are variants of the two main themes. They slightly tone down the
intensity of the background and provide a bit more color variety.
~modus-operandi-tinted~ has a set of base tones that are shades of
- light ocher (earthly colors), while ~modus-vivendi-tinted~ gives a
+ light ochre (earthly colors), while ~modus-vivendi-tinted~ gives a
night sky impression.
- Deuteranopia themes :: ~modus-operandi-deuteranopia~ and its
@@ -265,9 +263,6 @@ wrong.
:properties:
:custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9
:end:
-#+findex: modus-themes-toggle
-#+findex: modus-themes-load-theme
-#+vindex: modus-themes-after-load-theme-hook
#+cindex: Essential configuration
NOTE that Emacs can load multiple themes, which typically produces
@@ -285,7 +280,7 @@ theme of their preference by adding either form to their init file:
(load-theme 'modus-vivendi) ; Dark theme
#+end_src
-Remember that the Modus themes are six themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the
+Remember that there are multiple Modus themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the
above snippet accordingly.
Users of packaged variants of the themes must add a few more lines to
@@ -342,6 +337,38 @@ This is how a basic setup could look like ([[#h:b66b128d-54a4-4265-b59f-4d1ea2fe
[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]].
+To disable other themes before loading a Modus theme, use something
+like this:
+
+#+begin_src emacs-lisp
+(mapc #'disable-theme custom-enabled-themes)
+(load-theme 'modus-operandi :no-confirm)
+#+end_src
+
+#+findex: modus-themes-load-theme
+Instead of using the basic ~load-theme~ function, users can rely on
+the ~modus-themes-load-theme~. It accepts a single argument, which is
+a symbol representing the Modus theme of choice, such as:
+
+#+begin_src emacs-lisp
+(modus-themes-load-theme 'modus-operandi)
+#+end_src
+
+#+vindex: modus-themes-after-load-theme-hook
+#+vindex: modus-themes-post-load-hook
+The ~modus-themes-load-theme~ takes care to disable other themes, if
+the user opts in ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]).
+After loading the theme of choice, this function calls the
+hook ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~).
+Users can add their own functions to this hook to make further
+customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
+
+#+findex: modus-themes-toggle
+#+findex: modus-themes-select
+The commands ~modus-themes-toggle~ and ~modus-themes-select~ use
+~modus-themes-load-theme~ internally ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]).
+The aforementioned hold true for them as well.
+
** The ~require-theme~ for built-in Emacs themes
:PROPERTIES:
:CUSTOM_ID: h:b66b128d-54a4-4265-b59f-4d1ea2feb073
@@ -449,8 +476,6 @@ will lead to failures in loading the files. If either or both of those
variables need to be changed, their values should be defined before the
package declaration of the themes.
-[[#h:aabcada6-810d-4eee-b34a-d2a9c301824d][Make the themes look like what the maintainer uses]]
-
** Differences between loading and enabling
:properties:
:custom_id: h:e68560b3-7fb0-42bc-a151-e015948f8a35
@@ -608,9 +633,9 @@ Possible values:
When the value is non-~nil~, the commands ~modus-themes-toggle~ and
~modus-themes-select~, as well as the ~modus-themes-load-theme~
function, will disable all other themes while loading the specified
-Modus theme. This is done to ensure that Emacs does not blend two or
-more themes: such blends lead to awkward results that undermine the
-work of the designer.
+Modus theme ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). This is done to
+ensure that Emacs does not blend two or more themes: such blends lead
+to awkward results that undermine the work of the designer.
When the value is ~nil~, the aforementioned commands and function will
only disable other themes within the Modus collection.
@@ -678,6 +703,32 @@ Advanced users may also want to configure the exact attributes of the
[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+** Option for which themes to toggle
+:PROPERTIES:
+:CUSTOM_ID: h:4fbfed66-5a89-447a-a07d-a03f6819c5bd
+:END:
+#+vindex: modus-themes-to-toggle
+
+Brief: Choose to Modus themes to toggle between
+
+Symbol: ~modus-themes-to-toggle~ (=list= type)
+
+Default value: ='(modus-operandi modus-vivendi)=
+
+Possible values:
+
+- ~modus-operandi~
+- ~modus-vivendi~
+- ~modus-operandi-tinted~
+- ~modus-vivendi-tinted~
+- ~modus-operandi-deuteranopia~
+- ~modus-vivendi-deuteranopia~
+- ~modus-operandi-tritanopia~
+- ~modus-vivendi-tritanopia~
+
+Specify two themes to toggle between using the command
+~modus-themes-toggle~.
+
** Option for font mixing
:properties:
:alt_title: Mixed fonts
@@ -851,43 +902,13 @@ Is the same as:
:end:
#+vindex: modus-themes-org-blocks
-Brief: Set the overall style of Org code blocks, quotes, and the like.
+As part of version =4.4.0=, the ~modus-themes-org-blocks~ is no more.
+Users can apply palette overrides to set a style that fits their
+preference (purple, blue, yellow, green, etc.). It is more flexible
+and more powerful ([[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]])
-Symbol: ~modus-themes-org-blocks~ (=choice= type)
-
-Possible values:
-
-1. ~nil~ (default)
-2. ~gray-background~
-3. ~tinted-background~
-
-Option ~nil~ (the default) means that the block has no background of
-its own: it uses the one that applies to the rest of the buffer.
-In this case, the delimiter lines have a gray color for their text,
-making them look exactly like all other Org properties.
-
-Option ~gray-background~ applies a subtle gray background to the
-block's contents. It also affects the begin and end lines of the
-block as they get another shade of gray as their background, which
-differentiates them from the contents of the block. All background
-colors extend to the edge of the window, giving the area a
-rectangular, "blocky" presentation. If the begin/end lines do not
-extend in this way, check the value of the Org user option
-~org-fontify-whole-block-delimiter-line~.
-
-Option ~tinted-background~ uses a colored background for the contents
-of the block. The exact color value will depend on the programming
-language and is controlled by the variable ~org-src-block-faces~
-(refer to the theme's source code for the current association list).
-For this to take effect, the Org buffer needs to be restarted with
-~org-mode-restart~.
-
-Code blocks use their major mode's fontification (syntax highlighting)
-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.
-
-[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]].
+For the option to change the background of Org source blocks, we
+provide the relevant setup ([[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]]).
** Option for the headings' overall style
:properties:
@@ -1169,22 +1190,175 @@ Named colors can be previewed, such as with the command
For a video tutorial that users of all skill levels can approach,
watch: https://protesilaos.com/codelog/2022-12-17-modus-themes-v4-demo/.
+* Preview theme colors
+:properties:
+:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d
+:end:
+#+cindex: Preview named colors or semantic color mappings
+
+#+findex: modus-themes-list-colors
+The command ~modus-themes-list-colors~ uses minibuffer completion to
+select an item from the Modus themes and then produces a buffer with
+previews of its color palette entries. The buffer has a naming scheme
+that reflects the given choice, like =modus-operandi-list-colors= for
+the ~modus-operandi~ theme.
+
+#+findex: modus-themes-list-colors-current
+The command ~modus-themes-list-colors-current~ skips the minibuffer
+selection process and just produces a preview for the current Modus
+theme.
+
+When called with a prefix argument (=C-u= with the default key
+bindings), these commands will show a preview of the palette's
+semantic color mappings instead of the named colors. In this context,
+"named colors" are entries that associate a symbol to a string color
+value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color
+mappings" associate a named color to a symbol, like =(string
+blue-warmer)=, thus making the theme render all string constructs in
+the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
+
+#+findex: modus-themes-preview-colors
+#+findex: modus-themes-preview-colors-current
+Aliases for those commands are ~modus-themes-preview-colors~ and
+~modus-themes-preview-colors-current~.
+
+Each row shows a foreground and background coloration using the
+underlying value it references. For example a line with =#a60000= (a
+shade of red) will show red text followed by a stripe with that same
+color as a backdrop.
+
+The name of the buffer describes the given Modus theme and what the
+contents are, such as =*modus-operandi-list-colors*= for named colors
+and ==*modus-operandi-list-mappings*= for the semantic color mappings.
+
+* Use colors from the Modus themes palette
+:PROPERTIES:
+:CUSTOM_ID: h:33460ae8-984b-40fd-8baa-383cc5fc2698
+:END:
+
+The Modus themes provide the means to access the palette of (i) the
+active theme or (ii) any theme in the Modus collection. These are
+useful for Do-It-Yourself customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]),
+though it can also be helpful in other cases, such as to reuse a color
+value in some other application.
+
+- Function :: [[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette with ~modus-themes-get-color-value~]]
+- Macro :: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with ~modus-themes-with-colors~]].
+
+** Get a single color from the palette with ~modus-themes-get-color-value~
+:PROPERTIES:
+:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e
+:END:
+
+#+findex: modus-themes-get-color-value
+The fuction ~modus-themes-get-color-value~ can be called from Lisp to
+return the value of a color from the active Modus theme palette. It
+takea a =COLOR= argument and an optional =OVERRIDES=. It also accepts
+a third =THEME= argument, to get the color from the given theme.
+
+=COLOR= is a symbol that represents a named color entry in the
+palette ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
+
+If the value is the name of another color entry in the palette (so a
+mapping), this function recurs until it finds the underlying color
+value.
+
+With an optional =OVERRIDES= argument as a non-~nil~ value, it
+accounts for palette overrides. Else it reads only the default palette
+([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]])
+
+With an optional =THEME= as a symbol among the ~modus-themes-items~
+(alias ~modus-themes-collection~), it uses the palette of that theme.
+Else it uses the current Modus theme.
+
+If =COLOR= is not present in the palette, this function returns the
+~unspecified~ symbol, which is safe when used as a face attribute's
+value.
+
+An example with ~modus-operandi~ to show how this function behaves
+with/without overrides and when recursive mappings are introduced.
+
+#+begin_src emacs-lisp
+;; Here we show the recursion of palette mappings. In general, it is
+;; better for the user to specify named colors to avoid possible
+;; confusion with their configuration, though those still work as
+;; expected.
+(setq modus-themes-common-palette-overrides
+ '((cursor red)
+ (fg-mode-line-active cursor)
+ (border-mode-line-active fg-mode-line-active)))
+
+;; Ignore the overrides and get the original value.
+(modus-themes-get-color-value 'border-mode-line-active)
+;; => "#5a5a5a"
+
+;; Read from the overrides and deal with any recursion to find the
+;; underlying value.
+(modus-themes-get-color-value 'border-mode-line-active :overrides)
+;; => "#a60000"
+#+end_src
+
+** Use theme colors in code with ~modus-themes-with-colors~
+:properties:
+:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
+:end:
+#+cindex: Use colors from the palette anywhere
+
+[ Note that for common cases the following is not not needed. Just rely on
+ the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). ]
+
+#+findex: modus-themes-with-colors
+Advanced users may want to apply many colors from the palette of the
+active Modus theme in their custom code. In such a case, retrieving
+each value with the function ~modus-themes-get-color-value~ is
+inefficient ([[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]). The Lisp macro
+~modus-themes-with-colors~ provides the requisite functionality. It
+supplies the current theme's palette to the code called from inside of
+it. For example:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
+;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045")
+#+end_src
+
+The above return value is for ~modus-operandi~ when that is the active
+theme. Switching to another theme and evaluating this code anew will
+return the relevant results for that theme (remember that since
+version 4, the Modus themes consist of many items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The
+same with ~modus-vivendi~ as the active theme:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
+;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0")
+#+end_src
+
+The ~modus-themes-with-colors~ has access to the whole palette of the
+active theme, meaning that it can instantiate both (i) named colors
+like =blue-warmer= and (ii) semantic color mappings like =warning=.
+We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
+
+Others sections in this manual show how to use the aforementioned
+macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). In practice, the use of a hook will
+also be needed ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]).
+
* Advanced customization
:properties:
:custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb
:end:
-Unlike the predefined customization options which follow a clear pattern
-of allowing the user to quickly specify their preference, the themes
-also provide a more flexible, albeit difficult, mechanism to control
-things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
+Unlike the predefined customization options which follow a clear
+pattern of allowing the user to quickly specify their preference, the
+themes also provide a more flexible, albeit a bit more difficult,
+mechanism to control things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
This section is of interest only to users who are prepared to maintain
their own local tweaks and who are willing to deal with any possible
-incompatibilities between versioned releases of the themes. As such,
+incompatibilities between versioned releases of the themes. As such,
they are labeled as "do-it-yourself" or "DIY".
-** Palette override presets
+** DIY Palette override presets
:PROPERTIES:
:CUSTOM_ID: h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc
:END:
@@ -1257,7 +1431,7 @@ the general idea (extra space for didactic purposes):
,@modus-themes-preset-overrides-intense))
#+end_src
-** Stylistic variants using palette overrides
+** DIY Stylistic variants using palette overrides
:PROPERTIES:
:CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3
:END:
@@ -1269,7 +1443,7 @@ to take effect. To apply overrides at startup simply define them
before the call that loads the theme. Remember that we also provide
presets that are easier to apply ([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]).
-*** Make the mode line borderless
+*** DIY Make the mode line borderless
:PROPERTIES:
:CUSTOM_ID: h:80ddba52-e188-411f-8cc0-480ebd75befe
:END:
@@ -1284,14 +1458,6 @@ set their color to that of the underlying background.
[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Remove the border
(setq modus-themes-common-palette-overrides
'((border-mode-line-active unspecified)
@@ -1306,7 +1472,9 @@ set their color to that of the underlying background.
(border-mode-line-inactive bg-mode-line-inactive)))
#+end_src
-*** Make the active mode line colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make the active mode line colorful
:PROPERTIES:
:CUSTOM_ID: h:e8d781be-eefc-4a81-ac4e-5ed156190df7
:END:
@@ -1323,14 +1491,6 @@ have a blue mode line for ~modus-operandi~ and a red one for
[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Blue background, neutral foreground, intense blue border
(setq modus-themes-common-palette-overrides
'((bg-mode-line-active bg-blue-intense)
@@ -1343,14 +1503,28 @@ have a blue mode line for ~modus-operandi~ and a red one for
(fg-mode-line-active fg-main)
(border-mode-line-active blue-intense)))
-;; Subtle red background, red foreground, invisible border
+;; Sage (green/cyan) background, neutral foreground, slightly distinct green border
(setq modus-themes-common-palette-overrides
- '((bg-mode-line-active bg-red-subtle)
- (fg-mode-line-active red-warmer)
- (border-mode-line-active bg-red-subtle)))
+ '((bg-mode-line-active bg-sage)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-green-intense)))
+
+;; As above, but with a purple style
+(setq modus-themes-common-palette-overrides
+ '((bg-mode-line-active bg-lavender)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-magenta-intense)))
+
+;; As above, but with an earthly style
+(setq modus-themes-common-palette-overrides
+ '((bg-mode-line-active bg-ochre)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-yellow-intense)))
#+end_src
-*** Make the tab bar more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make the tab bar more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37
:END:
@@ -1365,15 +1539,6 @@ fringes, and line numbers. These are shown in other sections of this
manual.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the `tab-bar-mode' mode subtle while keepings its original
;; gray aesthetic.
(setq modus-themes-common-palette-overrides
@@ -1402,7 +1567,9 @@ manual.
(bg-tab-other bg-cyan-subtle)))
#+end_src
-*** Make the fringe invisible or another color
+Reload the theme for changes to take effect.
+
+*** DIY Make the fringe invisible or another color
:PROPERTIES:
:CUSTOM_ID: h:c312dcac-36b6-4a1f-b1f5-ab1c9abe27b0
:END:
@@ -1415,14 +1582,6 @@ side of the Emacs window which shows indicators such as for truncation
or continuation lines.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Make the fringe invisible
(setq modus-themes-common-palette-overrides
'((fringe unspecified)))
@@ -1436,7 +1595,9 @@ or continuation lines.
'((fringe bg-blue-nuanced)))
#+end_src
-*** Make links use subtle or no underlines
+Reload the theme for changes to take effect.
+
+*** DIY Make links use subtle or no underlines
:PROPERTIES:
:CUSTOM_ID: h:6c1d1dea-5cbf-4d92-b7bb-570a7a23ffe9
:END:
@@ -1460,7 +1621,9 @@ that underline mappings can read correctly.
(underline-link-symbolic unspecified)))
#+end_src
-*** Make prompts more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make prompts more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8
:END:
@@ -1472,14 +1635,6 @@ block we show how to add or remove color from prompts.
[[#h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1][Option for command prompt styles]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Keep the background unspecified (like the default), but use a faint
;; foreground color.
(setq modus-themes-common-palette-overrides
@@ -1497,7 +1652,9 @@ block we show how to add or remove color from prompts.
(bg-prompt bg-yellow-subtle))) ; try to replace "subtle" with "intense"
#+end_src
-*** Make completion matches more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make completion matches more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:d959f789-0517-4636-8780-18123f936f91
:END:
@@ -1510,14 +1667,6 @@ three different degrees of intensity.
[[#h:f1c20c02-7b34-4c35-9c65-99170efb2882][Option for completion framework aesthetics]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Add a nuanced background color to completion matches, while keeping
;; their foreground intact (foregrounds do not need to be specified in
;; this case, but we do it for didactic purposes).
@@ -1584,7 +1733,9 @@ colors to two:
The user can mix and match to their liking.
-*** Make comments yellow and strings green
+Reload the theme for changes to take effect.
+
+*** DIY Make comments yellow and strings green
:PROPERTIES:
:CUSTOM_ID: h:26f53daa-0065-48dc-88ab-6a718d16cd95
:END:
@@ -1601,14 +1752,6 @@ reproduce the effect, but also how to tweak it to one's liking.
[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Yellow comments and green strings like older versions of the Modus
;; themes
(setq modus-themes-common-palette-overrides
@@ -1627,7 +1770,9 @@ reproduce the effect, but also how to tweak it to one's liking.
(string yellow-cooler)))
#+end_src
-*** Make code syntax use the old alt-syntax style
+Reload the theme for changes to take effect.
+
+*** DIY Make code syntax use the old alt-syntax style
:PROPERTIES:
:CUSTOM_ID: h:c8767172-bf11-4c96-81dc-e736c464fc9c
:END:
@@ -1640,16 +1785,7 @@ upside of using overrides for this purpose is that we can tweak the
style to our liking, but first let's start with its recreation:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
-;; The old "alt-syntax"
+;; The old "alt-syntax" (before version 4.0.0 of the Modus themes)
(setq modus-themes-common-palette-overrides
'((builtin magenta)
(comment fg-dim)
@@ -1712,7 +1848,9 @@ The user can always mix and match styles to their liking.
[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]].
-*** Make use of alternative styles for code syntax
+Reload the theme for changes to take effect.
+
+*** DIY Make use of alternative styles for code syntax
:PROPERTIES:
:CUSTOM_ID: h:943063da-7b27-4ba4-9afe-f8fe77652fd1
:END:
@@ -1730,18 +1868,9 @@ theme palette.
[[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings green]].
-[[*Make code syntax use the old alt-syntax style][Make code syntax use the old alt-syntax style]].
+[[#h:c8767172-bf11-4c96-81dc-e736c464fc9c][Make code syntax use the old alt-syntax style]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Mimic `ef-night' theme (from my `ef-themes') for code syntax
;; highlighting, while still using the Modus colors (and other
;; mappings).
@@ -1803,7 +1932,9 @@ theme palette.
(variable cyan-warmer)))
#+end_src
-*** Make matching parenthesis more or less intense
+Reload the theme for changes to take effect.
+
+*** DIY Make matching parenthesis more or less intense
:PROPERTIES:
:CUSTOM_ID: h:259cf8f5-48ec-4b13-8a69-5d6387094468
:END:
@@ -1815,14 +1946,6 @@ delimiters when ~show-paren-mode~ is enabled. We also demonstrate how
to enable underlines for those highlights.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Change the background to a shade of magenta
(setq modus-themes-common-palette-overrides
'((bg-paren-match bg-magenta-intense)))
@@ -1831,9 +1954,17 @@ to enable underlines for those highlights.
(setq modus-themes-common-palette-overrides
'((bg-paren-match bg-magenta-intense)
(underline-paren-match fg-main)))
+
+;; Do not use any background color and instead apply an intense red
+;; foreground.
+(setq modus-themes-common-palette-overrides
+ '((bg-paren-match unspecified)
+ (fg-paren-match red-intense)))
#+end_src
-*** Make box buttons more or less gray
+Reload the theme for changes to take effect.
+
+*** DIY Make box buttons more or less gray
:PROPERTIES:
:CUSTOM_ID: h:4f6b6ca3-f5bb-4830-8312-baa232305360
:END:
@@ -1846,14 +1977,6 @@ removes the gray from the active buttons and amplifies it for the
inactive ones.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
(setq modus-themes-common-palette-overrides
'((bg-button-active bg-main)
(fg-button-active fg-main)
@@ -1861,7 +1984,9 @@ inactive ones.
(fg-button-inactive "gray50")))
#+end_src
-*** Make TODO and DONE more or less intense
+Reload the theme for changes to take effect.
+
+*** DIY Make TODO and DONE more or less intense
:PROPERTIES:
:CUSTOM_ID: h:b57bb50b-a863-4ea8-bb38-6de2275fa868
:END:
@@ -1877,14 +2002,6 @@ to subdue them.
[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Increase intensity
(setq modus-themes-common-palette-overrides
'((prose-done green-intense)
@@ -1901,7 +2018,9 @@ to subdue them.
'((prose-done fg-dim)))
#+end_src
-*** Make headings more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make headings more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:11297984-85ea-4678-abe9-a73aeab4676a
:END:
@@ -1916,15 +2035,6 @@ match styles at will.
[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more intense]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Apply more colorful foreground to some headings (headings 0-8).
;; Level 0 is for Org #+title and related.
(setq modus-themes-common-palette-overrides
@@ -1958,7 +2068,107 @@ match styles at will.
(overline-heading-1 border)))
#+end_src
-*** Make Org agenda more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make Org block colors more or less colorful
+:properties:
+:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
+:end:
+
+This is one of our practical examples to override the semantic colors
+of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic variants using palette overrides]]). Here
+we show how to change the presentation of Org blocks (and other such
+blocks like Markdown fenced code sections, though the exact
+presentation depends on each major mode).
+
+The default style of Org blocks is a subtle gray background for the
+contents and for the delimiter lines (the =#+begin_= and =#+end_=
+parts). The text of the delimiter lines is a subtle gray foreground
+color.
+
+[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]].
+
+#+begin_src emacs-lisp
+;; Make code blocks (in Org, for example) use a more colorful style
+;; for their delimiter lines as well as their contents. Give this a
+;; purple feel. Make the delimiter lines distinct from the contents.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-magenta-nuanced)
+ (bg-prose-block-delimiter bg-lavender)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a more blue feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-blue-nuanced)
+ (bg-prose-block-delimiter bg-lavender)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a green feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-green-nuanced)
+ (bg-prose-block-delimiter bg-sage)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a yellow/gold feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-yellow-nuanced)
+ (bg-prose-block-delimiter bg-ochre)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a slightly more red feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-red-nuanced)
+ (bg-prose-block-delimiter bg-ochre)
+ (fg-prose-block-delimiter fg-main)))
+#+end_src
+
+The previous examples differentiate the delimiter lines from the
+block's contents. Though we can mimic the default aesthetic of a
+uniform background, while changing the applicable colors. Here are
+some nice combinations:
+
+#+begin_src emacs-lisp
+;; Solid green style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-green-nuanced)
+ (bg-prose-block-delimiter bg-green-nuanced)
+ (fg-prose-block-delimiter green-warmer)))
+
+;; Solid yellow style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-yellow-nuanced)
+ (bg-prose-block-delimiter bg-yellow-nuanced)
+ (fg-prose-block-delimiter yellow-cooler)))
+
+;; Solid cyan style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-cyan-nuanced)
+ (bg-prose-block-delimiter bg-cyan-nuanced)
+ (fg-prose-block-delimiter cyan-cooler)))
+#+end_src
+
+[ Combine the above with a suitable mode line style for maximum effect
+ ([[#h:e8d781be-eefc-4a81-ac4e-5ed156190df7][DIY Make the active mode line colorful]]). ]
+
+Finally, the following makes code blocks have no distinct background.
+The minimal styles are applied to the delimiter lines, which only use
+a subtle gray foreground. This was the default for the Modus themes up
+until version 4.3.0.
+
+#+begin_src emacs-lisp
+;; Make code blocks more minimal, so that (i) the delimiter lines have
+;; no background, (ii) the delimiter foreground is a subtle gray, and
+;; (iii) the block contents have no distinct background either. This
+;; was the default in versions of the Modus themes before 4.4.0
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents unspecified)
+ (bg-prose-block-delimiter unspeficied)
+ (fg-prose-block-delimiter fg-dim)))
+#+end_src
+
+[[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]].
+
+*** DIY Make Org agenda more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:a5af0452-a50f-481d-bf60-d8143f98105f
:END:
@@ -1973,14 +2183,6 @@ these styles with what we show in the other chapters with practical
stylistic variants.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Make the Org agenda use alternative and varied colors.
(setq modus-themes-common-palette-overrides
'((date-common cyan) ; default value (for timestamps and more)
@@ -2004,7 +2206,7 @@ An example with faint coloration:
(date-holiday magenta) ; default (for M-x calendar)
(date-now fg-main) ; default
(date-scheduled yellow-faint)
- (date-weekday fg-dim)
+ (date-weekday fg-alt)
(date-weekend fg-dim)))
#+end_src
@@ -2041,7 +2243,9 @@ Yet another example that also affects =DONE= and =TODO= keywords:
(prose-todo yellow)))
#+end_src
-*** Make inline code in prose use alternative styles
+Reload the theme for changes to take effect.
+
+*** DIY Make inline code in prose use alternative styles
:PROPERTIES:
:CUSTOM_ID: h:bb5b396f-5532-4d52-ab13-149ca24854f1
:END:
@@ -2053,54 +2257,47 @@ Org's verbatim, code, and macro entries. We also provide mappings for
tables, property drawers, tags, and code block delimiters, though we
do not show every possible permutation.
-[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]].
+- [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]].
+- [[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
+;; A nuanced accented background, combined with a suitable foreground.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-code bg-green-nuanced)
+ (fg-prose-code green-cooler)
+ (bg-prose-verbatim bg-magenta-nuanced)
+ (fg-prose-verbatim magenta-warmer)
-;; These are all the mappings at their default values for didactic
-;; purposes
-(setq modus-themes-common-palette-overrides
- '((prose-block fg-dim)
- (prose-code green-cooler)
- (prose-done green)
- (prose-macro magenta-cooler)
- (prose-metadata fg-dim)
- (prose-metadata-value fg-alt)
- (prose-table fg-alt)
- (prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)))
-
-;; Make code block delimiters use a shade of red, tone down verbatim,
-;; code, and macro, and amplify the style of property drawers
+ (bg-prose-macro bg-blue-nuanced)
+ (fg-prose-macro magenta-cooler)))
+
+;; A more noticeable accented background, combined with a suitable foreground.
(setq modus-themes-common-palette-overrides
- '((prose-block red-faint)
- (prose-code fg-dim)
- (prose-macro magenta-faint)
- (prose-metadata cyan)
- (prose-metadata-value green-warmer)
- (prose-verbatim fg-dim)))
-
-;; Like the above but with more color variety for the inline code
-;; elements
+ '((bg-prose-code bg-sage)
+ (fg-prose-code green-faint)
+
+ (bg-prose-verbatim bg-ochre)
+ (fg-prose-verbatim red-faint)
+
+ (bg-prose-macro bg-lavender)
+ (fg-prose-macro blue-faint)))
+
+;; Leave the backgrounds without a color and simply make the foregrounds more intense.
(setq modus-themes-common-palette-overrides
- '((prose-block red-faint)
- (prose-code blue-cooler)
- (prose-macro yellow-warmer)
- (prose-metadata cyan)
- (prose-metadata-value green-warmer)
- (prose-verbatim red-warmer)))
+ '((bg-prose-code unspecified)
+ (fg-prose-code green-intense)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-intense)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro cyan-intense)))
#+end_src
-*** Make mail citations and headers more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make mail citations and headers more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:7da7a4ad-5d3a-4f11-9796-5a1abed0f0c4
:END:
@@ -2125,15 +2322,6 @@ This is some sample text
We thus have the following:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Reduce the intensity of mail citations and headers
(setq modus-themes-common-palette-overrides
'((mail-cite-0 cyan-faint)
@@ -2169,7 +2357,9 @@ We thus have the following:
(mail-other green)))
#+end_src
-*** Make the region preserve text colors, plus other styles
+Reload the theme for changes to take effect.
+
+*** DIY Make the region preserve text colors, plus other styles
:PROPERTIES:
:CUSTOM_ID: h:c8605d37-66e1-42aa-986e-d7514c3af6fe
:END:
@@ -2183,15 +2373,6 @@ with an appropriate foreground value.
[[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region background]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; A background with no specific foreground (use foreground of
;; underlying text)
(setq modus-themes-common-palette-overrides
@@ -2209,7 +2390,9 @@ with an appropriate foreground value.
(fg-region fg-main)))
#+end_src
-*** Make mouse highlights more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make mouse highlights more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:b5cab69d-d7cb-451c-8ff9-1f545ceb6caf
:END:
@@ -2220,15 +2403,6 @@ the following code block we show how to affect the semantic color
mapping that covers mouse hover effects and related highlights:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the background an intense yellow
(setq modus-themes-common-palette-overrides
'((bg-hover bg-yellow-intense)))
@@ -2238,7 +2412,9 @@ mapping that covers mouse hover effects and related highlights:
'((bg-hover bg-green-subtle)))
#+end_src
-*** Make language underlines less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make language underlines less colorful
:PROPERTIES:
:CUSTOM_ID: h:03dbd5af-6bae-475e-85a2-cec189f69598
:END:
@@ -2249,15 +2425,6 @@ Here we show how to affect the color of the underlines that are used
by code linters and prose spell checkers.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the underlines less intense
(setq modus-themes-common-palette-overrides
'((underline-err red-faint)
@@ -2271,7 +2438,9 @@ by code linters and prose spell checkers.
(underline-note green-intense)))
#+end_src
-*** Make line numbers use alternative styles
+Reload the theme for changes to take effect.
+
+*** DIY Make line numbers use alternative styles
:PROPERTIES:
:CUSTOM_ID: h:b6466f51-cb58-4007-9ebe-53a27af655c7
:END:
@@ -2281,15 +2450,6 @@ of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic varian
this section we show how to affect the ~display-line-numbers-mode~.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make line numbers less intense
(setq modus-themes-common-palette-overrides
'((fg-line-number-inactive "gray50")
@@ -2313,7 +2473,9 @@ this section we show how to affect the ~display-line-numbers-mode~.
(bg-line-number-active bg-cyan-intense)))
#+end_src
-*** Make diffs use only a foreground
+Reload the theme for changes to take effect.
+
+*** DIY Make diffs use only a foreground
:PROPERTIES:
:CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15
:END:
@@ -2377,7 +2539,9 @@ just using the "common" overrides.
(fg-removed-intense yellow-intense)))
#+end_src
-*** Make deuteranopia diffs red and blue instead of yellow and blue
+Reload the theme for changes to take effect.
+
+*** DIY Make deuteranopia diffs red and blue instead of yellow and blue
:PROPERTIES:
:CUSTOM_ID: h:16389ea1-4cb6-4b18-9409-384324113541
:END:
@@ -2428,112 +2592,9 @@ respectively. This is achieved by overriding the "changed" and
(fg-removed-intense "#ff9095")))
#+end_src
-*** Make the themes look like what the maintainer uses
-:PROPERTIES:
-:CUSTOM_ID: h:aabcada6-810d-4eee-b34a-d2a9c301824d
-:END:
-
-Based on what we have learnt from the previous sections of this
-manual, here is what Protesilaos uses:
-
-#+begin_src emacs-lisp
-;; Always reload the theme for changes to take effect!
-
-(setq modus-themes-custom-auto-reload nil
- modus-themes-to-toggle '(modus-operandi modus-vivendi)
- modus-themes-mixed-fonts t
- modus-themes-variable-pitch-ui nil
- modus-themes-italic-constructs t
- modus-themes-bold-constructs nil
- modus-themes-org-blocks nil
- modus-themes-completions '((t . (extrabold)))
- modus-themes-prompts nil
- modus-themes-headings
- '((agenda-structure . (variable-pitch light 2.2))
- (agenda-date . (variable-pitch regular 1.3))
- (t . (regular 1.15))))
-
-(setq modus-themes-common-palette-overrides
- '((cursor magenta-cooler)
- ;; Make the fringe invisible.
- (fringe unspecified)
- ;; Make line numbers less intense and add a shade of cyan
- ;; for the current line number.
- (fg-line-number-inactive "gray50")
- (fg-line-number-active cyan-cooler)
- (bg-line-number-inactive unspecified)
- (bg-line-number-active unspecified)
- ;; Make the current line of `hl-line-mode' a fine shade of
- ;; gray (though also see my `lin' package).
- (bg-hl-line bg-dim)
- ;; Make the region have a cyan-green background with no
- ;; specific foreground (use foreground of underlying text).
- ;; "bg-sage" refers to Salvia officinalis, else the common
- ;; sage.
- (bg-region bg-sage)
- (fg-region unspecified)
- ;; Make matching parentheses a shade of magenta. It
- ;; complements the region nicely.
- (bg-paren-match bg-magenta-intense)
- ;; Make email citations faint and neutral, reducing the
- ;; default four colors to two; make mail headers cyan-blue.
- (mail-cite-0 fg-dim)
- (mail-cite-1 blue-faint)
- (mail-cite-2 fg-dim)
- (mail-cite-3 blue-faint)
- (mail-part cyan-warmer)
- (mail-recipient blue-warmer)
- (mail-subject magenta-cooler)
- (mail-other cyan-warmer)
- ;; Change dates to a set of more subtle combinations.
- (date-deadline magenta-cooler)
- (date-scheduled magenta)
- (date-weekday fg-main)
- (date-event fg-dim)
- (date-now blue-faint)
- ;; Make tags (Org) less colorful and tables look the same as
- ;; the default foreground.
- (prose-done cyan-cooler)
- (prose-tag fg-dim)
- (prose-table fg-main)
- ;; Make headings less colorful (though I never use deeply
- ;; nested headings).
- (fg-heading-2 blue-faint)
- (fg-heading-3 magenta-faint)
- (fg-heading-4 blue-faint)
- (fg-heading-5 magenta-faint)
- (fg-heading-6 blue-faint)
- (fg-heading-7 magenta-faint)
- (fg-heading-8 blue-faint)
- ;; Make the active mode line a fine shade of lavender
- ;; (purple) and tone down the gray of the inactive mode
- ;; lines.
- (bg-mode-line-active bg-lavender)
- (border-mode-line-active bg-lavender)
-
- (bg-mode-line-inactive bg-dim)
- (border-mode-line-inactive bg-inactive)
- ;; Make the prompts a shade of magenta, to fit in nicely with
- ;; the overall blue-cyan-purple style of the other overrides.
- ;; Add a nuanced background as well.
- (bg-prompt bg-magenta-nuanced)
- (fg-prompt magenta-cooler)
- ;; Tweak some more constructs for stylistic consistency.
- (name blue-warmer)
- (identifier magenta-faint)
- (keybind magenta-cooler)
- (accent-0 magenta-cooler)
- (accent-1 cyan-cooler)
- (accent-2 blue-warmer)
- (accent-3 red-cooler)))
-
-;; Make the active mode line have a pseudo 3D effect (this assumes
-;; you are using the default mode line and not an extra package).
-(custom-set-faces
- '(mode-line ((t :box (:style released-button)))))
-#+end_src
+Reload the theme for changes to take effect.
-** More accurate colors in terminal emulators
+** DIY More accurate colors in terminal emulators
:PROPERTIES:
:CUSTOM_ID: h:fbb5e254-afd6-4313-bb05-93b3b4f67358
:END:
@@ -2562,7 +2623,7 @@ Another example that can be bound to a key:
: TERM=xterm-direct uxterm -e emacsclient -nw
-** Range of color with terminal emulators
+** DIY Range of color with terminal emulators
:PROPERTIES:
:CUSTOM_ID: h:6b8211b0-d11b-4c00-9543-4685ec3b742f
:END:
@@ -2633,48 +2694,7 @@ xterm*color14: #6ae4b9
xterm*color15: #ffffff
#+end_src
-** Preview theme colors
-:properties:
-:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d
-:end:
-#+cindex: Preview named colors or semantic color mappings
-
-#+findex: modus-themes-list-colors
-The command ~modus-themes-list-colors~ uses minibuffer completion to
-select an item from the Modus themes and then produces a buffer with
-previews of its color palette entries. The buffer has a naming scheme
-that reflects the given choice, like =modus-operandi-list-colors= for
-the ~modus-operandi~ theme.
-
-#+findex: modus-themes-list-colors-current
-The command ~modus-themes-list-colors-current~ skips the minibuffer
-selection process and just produces a preview for the current Modus
-theme.
-
-When called with a prefix argument (=C-u= with the default key
-bindings), these commands will show a preview of the palette's
-semantic color mappings instead of the named colors. In this context,
-"named colors" are entries that associate a symbol to a string color
-value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color
-mappings" associate a named color to a symbol, like =(string
-blue-warmer)=, thus making the theme render all string constructs in
-the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
-
-#+findex: modus-themes-preview-colors
-#+findex: modus-themes-preview-colors-current
-Aliases for those commands are ~modus-themes-preview-colors~ and
-~modus-themes-preview-colors-current~.
-
-Each row shows a foreground and background coloration using the
-underlying value it references. For example a line with =#a60000= (a
-shade of red) will show red text followed by a stripe with that same
-color as a backdrop.
-
-The name of the buffer describes the given Modus theme and what the
-contents are, such as =*modus-operandi-list-colors*= for named colors
-and ==*modus-operandi-list-mappings*= for the semantic color mappings.
-
-** Per-theme customization settings
+** DIY Per-theme customization settings
:properties:
:custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193
:end:
@@ -2709,114 +2729,9 @@ equivalent the themes provide.
For a more elaborate design, it is better to inspect the source code of
~modus-themes-toggle~ and relevant functions.
-** Get a single color from the palette
-:PROPERTIES:
-:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e
-:END:
-
-[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]].
-
-#+findex: modus-themes-get-color-value
-The function ~modus-themes-get-color-value~ can be called from Lisp to
-return the value of a color from the active Modus theme palette. It
-takea a =COLOR= argument and an optional =OVERRIDES=.
-
-=COLOR= is a symbol that represents a named color entry in the
-palette.
-
-[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]].
-
-If the value is the name of another color entry in the palette (so a
-mapping), this function recurs until it finds the underlying color
-value.
-
-With an optional =OVERRIDES= argument as a non-~nil~ value, it accounts
-for palette overrides. Else it reads only the default palette.
-
-[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]].
-
-With optional =THEME= as a symbol among ~modus-themes-items~ (alias
-~modus-themes-collection~), use the palette of that item. Else use
-the current Modus theme.
-
-If =COLOR= is not present in the palette, this function returns the
-~unspecified~ symbol, which is safe when used as a face attribute's
-value.
-
-An example with ~modus-operandi~ to show how this function behaves
-with/without overrides and when recursive mappings are introduced.
-
-#+begin_src emacs-lisp
-;; Here we show the recursion of palette mappings. In general, it is
-;; better for the user to specify named colors to avoid possible
-;; confusion with their configuration, though those still work as
-;; expected.
-(setq modus-themes-common-palette-overrides
- '((cursor red)
- (fg-mode-line-active cursor)
- (border-mode-line-active fg-mode-line-active)))
-
-;; Ignore the overrides and get the original value.
-(modus-themes-get-color-value 'border-mode-line-active)
-;; => "#5a5a5a"
-
-;; Read from the overrides and deal with any recursion to find the
-;; underlying value.
-(modus-themes-get-color-value 'border-mode-line-active :overrides)
-;; => "#a60000"
-#+end_src
-
-** Use theme colors in code with modus-themes-with-colors
-:properties:
-:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
-:end:
-#+cindex: Use colors from the palette anywhere
-
-[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]].
-
-Note that users most probably do not need the following. Just rely on
-the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
-
-#+findex: modus-themes-with-colors
-Advanced users may want to apply colors from the palette of the active
-Modus theme in their custom code. The ~modus-themes-with-colors~
-macro supplies those to any form called inside of it. For example:
-
-#+begin_src emacs-lisp
-(modus-themes-with-colors
- (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
-;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045")
-#+end_src
-
-The above return value is for ~modus-operandi~ when that is the active
-theme. Switching to another theme and evaluating this code anew will
-give us the relevant results for that theme (remember that since
-version 4, the Modus themes consist of six items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The
-same with ~modus-vivendi~ as the active theme:
-
-#+begin_src emacs-lisp
-(modus-themes-with-colors
- (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
-;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0")
-#+end_src
-
-The ~modus-themes-with-colors~ has access to the whole palette of the
-active theme, meaning that it can instantiate both (i) named colors
-like =blue-warmer= and (ii) semantic color mappings like =warning=.
-We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
-
-Others sections in this manual show how to use the aforementioned
-macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
+Reload the theme for changes to take effect.
-Because the ~modus-themes-with-colors~ will most likely be used to
-customize faces, note that any function that calls it must be run at
-startup after the theme loads. The same function must also be
-assigned to the ~modus-themes-after-load-theme-hook~ for its effects
-to persist and be updated when switching between Modus themes (e.g. to
-update the exact value of =blue-warmer= when toggling between
-~modus-operandi~ to ~modus-vivendi~.
-
-** Do not extend the region background
+** DIY Do not extend the region background
:PROPERTIES:
:CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116
:END:
@@ -2834,11 +2749,14 @@ this to the Emacs configuration file will suffice:
[[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text colors, plus other styles]].
-** Add padding to mode line
+** DIY Add padding to the mode line
:PROPERTIES:
:CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c
:END:
+[ Consider using the ~spacious-padding~ package from GNU ELPA (by
+ Protesilaos) for more than just the mode line. ]
+
Emacs faces do not have a concept of "padding" for the space between
the text and its box boundaries. We can approximate the effect by
adding a =:box= attribute, making its border several pixels thick, and
@@ -2849,7 +2767,7 @@ mode line.
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Add "padding" to the mode lines
@@ -2859,6 +2777,8 @@ mode line.
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
The above has the effect of removing the border around the mode lines.
In older versions of the themes, we provided the option for a padded
mode line which could also have borders around it. Those were not
@@ -2866,7 +2786,7 @@ real border, however, but an underline and an overline. Adjusting the
above:
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Add "padding" to the mode lines
@@ -2886,13 +2806,15 @@ above:
The reason we no longer provide this option is because it depends on a
non-~nil~ value for ~x-underline-at-descent-line~. That variable
affects ALL underlines, including those of links. The effect is
-intrusive and looks awkward in prose.
+intrusive and looks awkard in prose.
As such, the Modus themes no longer provide that option but instead
offer this piece of documentation to make the user fully aware of the
state of affairs.
-** Remap face with local value
+Reload the theme for changes to take effect.
+
+** DIY Remap face with local value
:properties:
:custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f
:end:
@@ -2954,12 +2876,17 @@ Perhaps you may wish to generalize those findings in to a set of
functions that also accept an arbitrary face. We shall leave the
experimentation up to you.
-** Font configurations for Org and others
+Reload the theme for changes to take effect.
+
+** DIY Font configurations for Org and others
:properties:
:custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929
:end:
#+cindex: Font configurations
+[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos)
+ for all font-related configurations. ]
+
The themes are designed to optionally cope well with mixed font
configurations. This mostly concerns ~org-mode~ and ~markdown-mode~, though
expect to find it elsewhere like in ~Info-mode~.
@@ -2979,9 +2906,6 @@ the ~variable-pitch~ (proportional spacing) and ~fixed-pitch~ (monospaced)
faces respectively. It may also be convenient to set your main typeface
by configuring the ~default~ face the same way.
-[ The ~fontaine~ package on GNU ELPA (by Protesilaos) is designed to
- handle this case. ]
-
Put something like this in your initialization file (also consider
reading the doc string of ~set-face-attribute~):
@@ -3023,12 +2947,15 @@ absolute height).
[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts]].
-** Configure bold and italic faces
+** DIY Configure bold and italic faces
:properties:
:custom_id: h:2793a224-2109-4f61-a106-721c57c01375
:end:
#+cindex: Bold and italic fonts
+[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos)
+ for all font-related configurations. ]
+
The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the
thousands of faces they cover. Instead, they configure the generic
faces called ~bold~ and ~italic~ to use the appropriate styles and then
@@ -3082,12 +3009,12 @@ To reset the font family, one can use this:
#+end_src
To ensure that the effects persist after switching between the Modus
-themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to
-write their configurations to a function and pass it to the
-~modus-themes-after-load-theme-hook~. This is necessary because themes
-set the styles of faces upon activation, overriding prior values where
-conflicts occur between the previous and the current states (otherwise
-changing themes would not be possible).
+themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user
+needs to write their configurations to a function and pass it to the
+~modus-themes-after-load-theme-hook~ ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). This is
+necessary because themes set the styles of faces upon activation,
+overriding prior values where conflicts occur between the previous and
+the current states (otherwise changing themes would not be possible).
[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]].
@@ -3100,14 +3027,14 @@ of the themes, which can make it easier to redefine faces in bulk).
#+begin_src emacs-lisp
;; our generic function
-(defun my-modes-themes-bold-italic-faces ()
+(defun my-modes-themes-bold-italic-faces (&rest _)
(set-face-attribute 'default nil :family "Source Code Pro" :height 110)
(set-face-attribute 'bold nil :weight 'semibold))
;; or use this if you configure a lot of face and attributes and
;; especially if you plan to use `modus-themes-with-colors', as shown
;; elsewhere in the manual
-(defun my-modes-themes-bold-italic-faces ()
+(defun my-modes-themes-bold-italic-faces (&rest _)
(custom-set-faces
'(default ((t :family "Source Code Pro" :height 110)))
'(bold ((t :weight semibold)))))
@@ -3118,7 +3045,11 @@ of the themes, which can make it easier to redefine faces in bulk).
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]].
-** Custom Org todo keyword and priority faces
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
+Reload the theme for changes to take effect.
+
+** DIY Custom Org todo keyword and priority faces
:properties:
:custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad
:end:
@@ -3207,7 +3138,7 @@ it if you plan to control face attributes.
[[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]].
-** Custom Org emphasis faces
+** DIY Custom Org emphasis faces
:properties:
:custom_id: h:26026302-47f4-4471-9004-9665470e7029
:end:
@@ -3229,7 +3160,7 @@ specification of that variable looks like this:
With the exception of ~org-verbatim~ and ~org-code~ faces, everything else
uses the corresponding type of emphasis: a bold typographic weight, or
-italicized, underlined, and struck through text.
+italicised, underlined, and struck through text.
The best way for users to add some extra attributes, such as a
foreground color, is to define their own faces and assign them to the
@@ -3340,49 +3271,97 @@ styled by the themes, it probably is best not to edit them:
That's it! For changes to take effect in already visited Org files,
invoke {{{kbd(M-x org-mode-restart)}}}.
-** Update Org block delimiter fontification
-:properties:
-:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
-:end:
+** DIY Use colored Org source blocks per language
+:PROPERTIES:
+:CUSTOM_ID: h:8c842804-43b7-4287-b4e9-8c07d04d1f89
+:END:
-As noted in the section about ~modus-themes-org-blocks~, Org contains a
-variable that determines whether the block's begin and end lines are
-extended to the edge of the window ([[#h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2][Option for org-mode block styles]]).
-The variable is ~org-fontify-whole-block-delimiter-line~.
+[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]].
-Users who change the style of Org blocks from time to time may prefer to
-automatically update delimiter line fontification, such as with the
-following setup:
+In versions of the Modus themes before =4.4.0= there was an option to
+change the coloration of Org source blocks so that certain languages
+would have a distinctly colored background. This was not flexible
+enough, because (i) we cannot cover all languages effectively and (ii)
+the user had no choice over the =language --> color= mapping.
-#+begin_src emacs-lisp
-(defun my-modus-themes-org-fontify-block-delimiter-lines ()
- "Match `org-fontify-whole-block-delimiter-line' to theme style.
-Run this function at the post theme load phase, such as with the
-`modus-themes-after-load-theme-hook'."
- (if (eq modus-themes-org-blocks 'gray-background)
- (setq org-fontify-whole-block-delimiter-line t)
- (setq org-fontify-whole-block-delimiter-line nil)))
+As such, the old user option is no more. Users can use the following
+to achieve what they want:
+
+[ All this is done by setting the Org user option ~org-src-block-faces~,
+ so it is not related to the palette overrides mechanism provided by
+ the Modus themes. ]
-(add-hook 'modus-themes-after-load-theme-hook
- #'my-modus-themes-org-fontify-block-delimiter-lines)
+#+begin_src emacs-lisp
+(defun my-modus-themes-org-block-faces (&rest _)
+ (modus-themes-with-colors
+ ;; The `org-src-block-faces' does not get re-applied in existing
+ ;; Org buffers. Do M-x org-mode-restart for changes to take
+ ;; effect.
+ (setq org-src-block-faces
+ `(("emacs-lisp" modus-themes-nuanced-magenta)
+ ("elisp" modus-themes-nuanced-magenta)
+ ("clojure" modus-themes-nuanced-magenta)
+ ("clojurescript" modus-themes-nuanced-magenta)
+ ("c" modus-themes-nuanced-blue)
+ ("c++" modus-themes-nuanced-blue)
+ ("sh" modus-themes-nuanced-yellow)
+ ("shell" modus-themes-nuanced-yellow)
+ ("python" modus-themes-nuanced-yellow)
+ ("ipython" modus-themes-nuanced-yellow)
+ ("r" modus-themes-nuanced-yellow)
+ ("html" modus-themes-nuanced-green)
+ ("xml" modus-themes-nuanced-green)
+ ("css" modus-themes-nuanced-red)
+ ("scss" modus-themes-nuanced-red)
+ ("yaml" modus-themes-nuanced-cyan)
+ ("conf" modus-themes-nuanced-cyan)
+ ("docker" modus-themes-nuanced-cyan)))))
+
+(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces)
#+end_src
-Then {{{kbd(M-x org-mode-restart)}}} for changes to take effect, though manual
-intervention can be circumvented by tweaking the function thus:
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]].
+
+Note that the ~org-src-block-faces~ accepts a named face, as shown
+above, as well as a list of face attributes. The latter approach is
+not good enough because it hardcodes values in such a way that an
+~org-mode-restart~ is necessary. Whereas the indirection of the named
+face lets the theme change the values while Org buffers continue to
+show the right colors.
+
+Still, if a user prefers to hardcode face attributes, here is the
+idea:
#+begin_src emacs-lisp
-(defun my-modus-themes-org-fontify-block-delimiter-lines ()
- "Match `org-fontify-whole-block-delimiter-line' to theme style.
-Run this function at the post theme load phase, such as with the
-`modus-themes-after-load-theme-hook'."
- (if (eq modus-themes-org-blocks 'gray-background)
- (setq org-fontify-whole-block-delimiter-line t)
- (setq org-fontify-whole-block-delimiter-line nil))
- (when (derived-mode-p 'org-mode)
- (font-lock-flush)))
+;; This is for the sake of completeness. I DO NOT RECOMMEND THIS
+;; method because it hardcodes values and thus requires
+;; `org-mode-restart' every time you change a theme.
+(defun my-modus-themes-org-block-faces (&rest _)
+ (modus-themes-with-colors
+ (setq org-src-block-faces
+ `(("emacs-lisp" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("elisp" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("clojure" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("clojurescript" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("c" (:inherit org-block :background ,bg-blue-nuanced))
+ ("c++" (:inherit org-block :background ,bg-blue-nuanced))
+ ("sh" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("shell" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("python" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("ipython" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("r" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("html" (:inherit org-block :background ,bg-green-nuanced))
+ ("xml" (:inherit org-block :background ,bg-green-nuanced))
+ ("css" (:inherit org-block :background ,bg-red-nuanced))
+ ("scss" (:inherit org-block :background ,bg-red-nuanced))
+ ("yaml" (:inherit org-block :background ,bg-cyan-nuanced))
+ ("conf" (:inherit org-block :background ,bg-cyan-nuanced))
+ ("docker" (:inherit org-block :background ,bg-cyan-nuanced))))))
+
+(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces)
#+end_src
-** Measure color contrast
+** DIY Measure color contrast
:properties:
:custom_id: h:02e25930-e71a-493d-828a-8907fc80f874
:end:
@@ -3455,7 +3434,7 @@ minutia and relevant commentary.
Such knowledge may prove valuable while attempting to customize the
theme's color palette.
-** Load theme depending on time of day
+** DIY Load theme depending on time of day
:properties:
:custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26
:end:
@@ -3483,7 +3462,7 @@ the ~circadian~ package:
(circadian-setup))
#+end_src
-** Backdrop for pdf-tools
+** DIY Backdrop for pdf-tools
:properties:
:custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd
:end:
@@ -3504,7 +3483,7 @@ buffer-local value of the ~default~ face.
To remap the buffer's backdrop, we start with a function like this one:
#+begin_src emacs-lisp
-(defun my-pdf-tools-backdrop ()
+(defun my-pdf-tools-backdrop (&rest _)
(modus-themes-with-colors
(face-remap-add-relative
'default
@@ -3518,7 +3497,8 @@ The idea is to assign that function to a hook that gets called when
when you only use one theme. However it has the downside of setting the
background color value only at render time. In other words, the face
remapping function does not get evaluated anew whenever the theme
-changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}.
+changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}
+([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]).
To have our face remapping adapt gracefully while switching between the
Modus themes, we need to also account for the current theme and control
@@ -3526,20 +3506,20 @@ the activation of ~pdf-view-midnight-minor-mode~. To which end we arrive
at something like the following, which builds on the above example:
#+begin_src emacs-lisp
-(defun my-pdf-tools-backdrop ()
+(defun my-pdf-tools-backdrop (&rest _)
(modus-themes-with-colors
(face-remap-add-relative
'default
`(:background ,bg-dim))))
-(defun my-pdf-tools-midnight-mode-toggle ()
+(defun my-pdf-tools-midnight-mode-toggle (&rest _)
(when (derived-mode-p 'pdf-view-mode)
(if (eq (car custom-enabled-themes) 'modus-vivendi)
(pdf-view-midnight-minor-mode 1)
(pdf-view-midnight-minor-mode -1))
(my-pdf-tools-backdrop)))
-(defun my-pdf-tools-themes-toggle ()
+(defun my-pdf-tools-themes-toggle (&rest _)
(mapc
(lambda (buf)
(with-current-buffer buf
@@ -3550,11 +3530,15 @@ at something like the following, which builds on the above example:
(add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-themes-toggle)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
With those in place, PDFs have a distinct backdrop for their page, while
buffers with major-mode as ~pdf-view-mode~ automatically switches to dark
mode when ~modus-themes-toggle~ is called.
-** Toggle themes without reloading them
+Reload the theme for changes to take effect.
+
+** DIY Toggle themes without reloading them
:properties:
:custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237
:end:
@@ -3583,58 +3567,7 @@ manual."
Recall that ~modus-themes-toggle~ uses ~load-theme~.
-** A theme-agnostic hook for theme loading
-:properties:
-:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
-:end:
-
-The themes are designed with the intent to be useful to Emacs users of
-varying skill levels, from beginners to experts. This means that we try
-to make things easier by not expecting anyone reading this document to
-be proficient in Emacs Lisp or programming in general.
-
-Such a case is with the use of ~modus-themes-after-load-theme-hook~,
-which runs after the ~modus-themes-load-theme~ function (used by the
-command ~modus-themes-toggle~). We recommend using that hook for
-advanced customizations, because (1) we know for sure that it is
-available once the themes are loaded, and (2) anyone consulting this
-manual, especially the sections on enabling and loading the themes,
-will be in a good position to benefit from that hook.
-
-Advanced users who have a need to switch between the Modus themes and
-other items will find that such a hook does not meet their requirements:
-it only works with the Modus themes and only with the aforementioned
-functions.
-
-A theme-agnostic setup can be configured thus:
-
-#+begin_src emacs-lisp
-(defvar after-enable-theme-hook nil
- "Normal hook run after enabling a theme.")
-
-(defun run-after-enable-theme-hook (&rest _args)
- "Run `after-enable-theme-hook'."
- (run-hooks 'after-enable-theme-hook))
-
-(advice-add 'enable-theme :after #'run-after-enable-theme-hook)
-#+end_src
-
-This creates the ~after-enable-theme-hook~ and makes it run after each
-call to ~enable-theme~, which means that it will work for all themes and
-also has the benefit that it does not depend on functions such as
-~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is
-called internally by ~load-theme~, so the hook works everywhere.
-
-The downside of the theme-agnostic hook is that any functions added to
-it will likely not be able to benefit from macro calls that read the
-active theme, such as ~modus-themes-with-colors~. Not all Emacs
-themes have the same capabilities.
-
-In this document, we cover ~modus-themes-after-load-theme-hook~ though
-the user can replace it with ~after-enable-theme-hook~ should they
-need to (provided they understand the implications).
-
-** Use more spacious margins or padding in Emacs frames
+** DIY Use more spacious margins or padding in Emacs frames
:PROPERTIES:
:CUSTOM_ID: h:43bcb5d0-e25f-470f-828c-662cee9e21f1
:END:
@@ -3687,7 +3620,7 @@ The reason we do this with a function is so we can hook it to the
faces will no longer be invisible).
#+begin_src emacs-lisp
-(defun my-modus-themes-invisible-dividers ()
+(defun my-modus-themes-invisible-dividers (&rest _)
"Make window dividers invisible.
Add this to the `modus-themes-post-load-hook'."
(let ((bg (face-background 'default)))
@@ -3700,6 +3633,8 @@ Add this to the `modus-themes-post-load-hook'."
(add-hook 'modus-themes-post-load-hook #'my-modus-themes-invisible-dividers)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
The above will work only for themes that belong to the Modus family.
For users of Emacs version 29 or higher, there exists a theme-agnostic
hook that takes a function with one argument---that of the theme---and
@@ -3707,7 +3642,7 @@ calls in the the "post enable" phase of theme loading. Here is the
above snippet, with the necessary tweaks:
#+begin_src emacs-lisp
-(defun my-modus-themes-invisible-dividers (_theme)
+(defun my-modus-themes-invisible-dividers (&rest _)
"Make window dividers for THEME invisible."
(let ((bg (face-background 'default)))
(custom-set-faces
@@ -3722,7 +3657,7 @@ above snippet, with the necessary tweaks:
Users of older versions of Emacs can read the entry herein about
defining their own theme-agnostic hook ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]).
-** Custom hl-todo colors
+** DIY Custom hl-todo colors
:PROPERTIES:
:CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743
:END:
@@ -3735,7 +3670,7 @@ may still prefer to apply their custom values, in which case the
following approach is necessary:
#+begin_src emacs-lisp
-(defun my-modus-themes-hl-todo-faces ()
+(defun my-modus-themes-hl-todo-faces (&rest _)
(setq hl-todo-keyword-faces '(("TODO" . "#ff0000")
("HACK" . "#ffff00")
("XXX" . "#00ffff")
@@ -3744,10 +3679,12 @@ following approach is necessary:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
Or include a ~let~ form, if needed:
#+begin_src emacs-lisp
-(defun my-modus-themes-hl-todo-faces ()
+(defun my-modus-themes-hl-todo-faces (&rest _)
(let ((red "#ff0000")
(blue "#0000ff"))
(setq hl-todo-keyword-faces `(("TODO" . ,blue)
@@ -3758,10 +3695,14 @@ Or include a ~let~ form, if needed:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
Normally, we do not touch user options, though this is an exception:
otherwise the defaults are not always legible.
-** Add support for solaire-mode
+Reload the theme for changes to take effect.
+
+** DIY Add support for solaire-mode
:PROPERTIES:
:CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671
:END:
@@ -3806,7 +3747,7 @@ on what we cover at length elsewhere in this manual:
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
`(solaire-default-face ((,c :inherit default :background ,bg-dim :foreground ,fg-dim)))
@@ -3817,7 +3758,106 @@ on what we cover at length elsewhere in this manual:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
-As always, re-load the theme for changes to take effect.
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
+Reload the theme for changes to take effect.
+
+** DIY Use a hook at the post-load-theme phase
+:PROPERTIES:
+:CUSTOM_ID: h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24
+:END:
+
+Many of the Do-It-Yourself (DIY) snippets provided herein make use of
+a hook to apply the desired changes. In most examples, this hook is
+the ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~).
+This hook is provided by the Modus themes and is called at the end of
+one the following:
+
+- Command ~modus-themes-toggle~ :: [[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]].
+
+- Command ~modus-themes-select~ :: Select a Modus theme using minibuffer
+ completion and then load it.
+
+- Function ~modus-themes-load-theme~ :: Called only from Lisp, such as
+ in the user's init file, with the quoted symbol of a Modus theme as
+ an argument ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]).
+ This function is used internally by ~modus-themes-toggle~ and
+ ~modus-themes-select~.
+
+Users who switch between themes that are not limited to the Modus
+collection cannot benefit from the aforementioned hook: it only works
+with the Modus themes. A theme-agnostic hook is needed in such a case.
+Before Emacs 29, this had to be set up manually ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][DIY A theme-agnostic hook for theme loading]]).
+Starting with Emacs 29, the special hook ~enable-theme-functions~
+works with anything that uses the basic ~enable-theme~ function.
+
+To use the ~enable-theme-functions~ just add the given function to it
+the way it is done with every hook:
+
+#+begin_src emacs-lisp
+(add-hook 'enable-theme-functions 'MY-FUNCTION-HERE)
+#+end_src
+
+Functions added to ~enable-theme-functions~ accept a single =THEME=
+argument. The examples shown in this manual use the pattern =(&rest
+_)=, which is how a function accepts one or more arguments but
+declares it will not use them (in plain terms, the code works with or
+without ~enable-theme-functions~).
+
+*** DIY A theme-agnostic hook for theme loading
+:properties:
+:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
+:end:
+
+[ NOTE: The following is for versions of Emacs before 29. For Emacs 29
+ or higher, users can rely on the built-in ~enable-theme-functions~
+ ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]). ]
+
+The themes are designed with the intent to be useful to Emacs users of
+varying skill levels, from beginners to experts. This means that we try
+to make things easier by not expecting anyone reading this document to
+be proficient in Emacs Lisp or programming in general.
+
+Such a case is with the use of ~modus-themes-after-load-theme-hook~,
+which runs after the ~modus-themes-load-theme~ function (used by the
+command ~modus-themes-toggle~). We recommend using that hook for
+advanced customizations, because (1) we know for sure that it is
+available once the themes are loaded, and (2) anyone consulting this
+manual, especially the sections on enabling and loading the themes,
+will be in a good position to benefit from that hook.
+
+Advanced users who have a need to switch between the Modus themes and
+other items will find that such a hook does not meet their requirements:
+it only works with the Modus themes and only with the aforementioned
+functions.
+
+A theme-agnostic setup can be configured thus:
+
+#+begin_src emacs-lisp
+(defvar after-enable-theme-hook nil
+ "Normal hook run after enabling a theme.")
+
+(defun run-after-enable-theme-hook (&rest _args)
+ "Run `after-enable-theme-hook'."
+ (run-hooks 'after-enable-theme-hook))
+
+(advice-add 'enable-theme :after #'run-after-enable-theme-hook)
+#+end_src
+
+This creates the ~after-enable-theme-hook~ and makes it run after each
+call to ~enable-theme~, which means that it will work for all themes and
+also has the benefit that it does not depend on functions such as
+~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is
+called internally by ~load-theme~, so the hook works everywhere.
+
+The downside of the theme-agnostic hook is that any functions added to
+it will likely not be able to benefit from macro calls that read the
+active theme, such as ~modus-themes-with-colors~. Not all Emacs
+themes have the same capabilities.
+
+In this document, we cover ~modus-themes-after-load-theme-hook~ though
+the user can replace it with ~after-enable-theme-hook~ should they
+need to (provided they understand the implications).
* Face coverage
:properties:
@@ -3882,7 +3922,9 @@ have lots of extensions, so the "full support" may not be 100% trueā€¦
+ custom (what you get with {{{kbd(M-x customize)}}})
+ dashboard
+ deadgrep
++ debbugs
+ deft
++ denote
+ devdocs
+ dictionary
+ diff-hl
@@ -3978,6 +4020,7 @@ have lots of extensions, so the "full support" may not be 100% trueā€¦
+ marginalia
+ markdown-mode
+ markup-faces (~adoc-mode~)
++ mct
+ messages
+ minimap
+ mode-line
@@ -4089,6 +4132,7 @@ have lots of extensions, so the "full support" may not be 100% trueā€¦
+ xterm-color (and ansi-colors)
+ yaml-mode
+ yasnippet
++ ztree
Plus many other miscellaneous faces that are provided by Emacs.
@@ -4213,7 +4257,7 @@ length elsewhere in this manual:
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Make foreground the same as background for a uniform bar on
@@ -4229,6 +4273,8 @@ length elsewhere in this manual:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
As always, re-load the theme for changes to take effect.
If the above does not work, try this instead:
@@ -4260,7 +4306,7 @@ multiline comments in PHP with the ~php-mode~ package use the
This seems to make all comments use the appropriate face:
#+begin_src emacs-lisp
-(defun my-multine-comments ()
+(defun my-multine-comments (&rest _)
(setq-local c-doc-face-name 'font-lock-comment-face))
(add-hook 'php-mode-hook #'my-multine-comments)
@@ -4396,7 +4442,7 @@ advanced customization options of the themes.
[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]].
In the following example, we are assuming that the user wants to (i)
-reuse color variables provided by the themes, (ii) be able to retain
+re-use color variables provided by the themes, (ii) be able to retain
their tweaks while switching between ~modus-operandi~ and ~modus-vivendi~,
and (iii) have the option to highlight either the foreground of the
parentheses or the background as well.
@@ -4416,7 +4462,7 @@ Then we can update our preference with this:
(setq my-highlight-parentheses-use-background nil)
#+end_src
-To reuse colors from the themes, we must wrap our code in the
+To re-use colors from the themes, we must wrap our code in the
~modus-themes-with-colors~ macro. Our implementation must interface with
the variables ~highlight-parentheses-background-colors~ and/or
~highlight-parentheses-colors~.
@@ -4472,7 +4518,7 @@ implementation:
(setq my-highlight-parentheses-use-background nil) ; Set to nil to disable backgrounds
-(defun my-modus-themes-highlight-parentheses ()
+(defun my-modus-themes-highlight-parentheses (&rest _)
(modus-themes-with-colors
;; Our preference for setting either background or foreground
;; styles, depending on `my-highlight-parentheses-use-background'.
@@ -4507,6 +4553,8 @@ implementation:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-highlight-parentheses)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]].
+
As always, re-load the theme for changes to take effect.
** Note on mmm-mode.el background colors
@@ -5026,7 +5074,7 @@ more effective than trying to do the same with either red or blue (the
latter is the least effective in that regard).
When we need to work with several colors, it is always better to have
-sufficient maneuvering space, especially since we cannot pick arbitrary
+sufficient manoeuvring space, especially since we cannot pick arbitrary
colors but only those that satisfy the accessibility objectives of the
themes.
@@ -5080,7 +5128,7 @@ each of the three channels of light (red, green, blue). For example:
: xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68
Typography is another variable. Some font families are blurry at small
-point sizes. Others may have a regular weight that is lighter (thinner)
+point sizes. Others may have a regular weight that is lighter (thiner)
than that of their peers which may, under certain circumstances, cause a
halo effect around each glyph.
@@ -5132,7 +5180,7 @@ it is already understood that one must follow the indicator or headline
to view its contents and (ii) underlining everything would make the
interface virtually unusable.
-Again, one must exercise judgment in order to avoid discrimination,
+Again, one must exercise judgement in order to avoid discrimination,
where "discrimination" refers to:
+ The treatment of substantially different magnitudes as if they were of
@@ -5206,7 +5254,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.
@@ -5356,12 +5404,12 @@ The Modus themes are a collective effort. Every bit of work matters.
Daniel Mendler, David Edmondson, Eli Zaretskii, Fritz Grabo, Gautier
Ponsinet, Illia Ostapyshyn, KĆ©vin Le Gouguec, Koen van Greevenbroek,
Kostadin Ninev, Madhavan Krishnan, Manuel Giraud, Markus Beppler,
- Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Nicolas De
- Jaeghere, Paul David, Philip Kaludercic, Pierre TĆ©choueyres, Rudolf
- Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, Stefan Kangas,
- Stephen Berman, Stephen Gildea, Steve Downey, Tomasz Hołubowicz,
- Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie, fluentpwn,
- okamsn.
+ Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Niall Dooley,
+ Nicolas De Jaeghere, Paul David, Philip Kaludercic, Pierre
+ TĆ©choueyres, Rudolf Adamkovič, Sergey Nichiporchik, Shreyas Ragavan,
+ Stefan Kangas, Stephen Berman, Stephen Gildea, Steve Downey, Tomasz
+ Hołubowicz, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen
+ Xie, fluentpwn, okamsn.
+ Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers,
Adrian Manea, Aleksei Pirogov, Alex Griffin, Alex Koen, Alex
@@ -5376,13 +5424,13 @@ The Modus themes are a collective effort. Every bit of work matters.
GonƧalo Marrafa, Guilherme Semente, Gustavo Barros, Hƶrmetjan
Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan Popovych, James
Ferguson, 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, Laith Bahodi, Lasse Lindner, Len Trigg, Lennart
- C. Karssen, Luis Miguel CastaƱeda, Magne Hov, Manuel Giraud, Manuel
- Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus
- Beppler, Matt Armstrong, Matthias Fuchs, Mattias EngdegƄrd, Mauro
- Aranda, Maxime TrƩca, Michael Goldenberg, Morgan Smith, Morgan
+ John Wick, Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C.
+ Villasante, Kenta Usami, Kevin Fleming, KĆ©vin Le Gouguec, Kevin
+ Kainan Li, Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg,
+ Lennart C.{{{space()}}} Karssen, Luis Miguel CastaƱeda, Magne Hov, Manuel Giraud,
+ Manuel Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic,
+ Markus Beppler, Matt Armstrong, Matthias Fuchs, Mattias EngdegƄrd,
+ Mauro Aranda, Maxime TrƩca, Michael Goldenberg, Morgan Smith, Morgan
Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere,
Nicolas Semrau, Olaf Meeuwissen, Oliver Epper, Pablo Stafforini,
Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip
@@ -5392,11 +5440,12 @@ The Modus themes are a collective effort. Every bit of work matters.
Ragavan, Simon Pugnet, Steve Downey, Tassilo Horn, Thanos Apollo,
Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey
Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh,
- Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1,
+ Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1,
Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer
Emacs, TheBlob42, TitusMu, Trey, bepolymathe, bit9tream,
bangedorrunt, derek-upham, doolio, fleimgruber, gitrj95, iSeeU,
- jixiuf, okamsn, pRot0ta1p, soaringbird, tumashu, wakamenod.
+ jixiuf, ltmsyvag, okamsn, pRot0ta1p, soaringbird, tumashu,
+ wakamenod.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index b48ed0c1949..8500a0f08c4 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -507,7 +507,7 @@ To list the local printers in a help buffer.
Except for @code{ses-prin1}, the other standard printers are suitable
only for cells, not columns or default, because they format the value
using the column-printer (or default-printer if @code{nil}) and then
-post-proces the result, eg.@: center it:
+post-process the result, eg.@: center it:
@ftable @code
@item ses-center
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 7fd371c1d9d..93d592193a0 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,9 +3,9 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2024-01-02.10}
+\def\texinfoversion{2024-02-10.22}
%
-% Copyright 1985--1986, 1988, 1990--2024 Free Software Foundation, Inc.
+% Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc.
%
% This texinfo.tex file is free software: you can redistribute it and/or
% modify it under the terms of the GNU General Public License as
@@ -5238,14 +5238,14 @@ $$%
% the current value of \escapechar.
\def\escapeisbackslash{\escapechar=`\\}
-% Use \ in index files by default. texi2dvi didn't support @ as the escape
-% character (as it checked for "\entry" in the files, and not "@entry"). When
-% the new version of texi2dvi has had a chance to become more prevalent, then
-% the escape character can change back to @ again. This should be an easy
-% change to make now because both @ and \ are only used as escape characters in
-% index files, never standing for themselves.
+% Uncomment to use \ in index files by default. Old texi2dvi (before 2019)
+% didn't support @ as the escape character (as it checked for "\entry" in
+% the files, and not "@entry").
+% In the future we can remove this flag and simplify the code for
+% index files and backslashes, once the support is no longer likely to be
+% useful.
%
-\set txiindexescapeisbackslash
+% \set txiindexescapeisbackslash
% Write the entry in \indextext to the index file.
%
@@ -5652,42 +5652,13 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\parfillskip=0pt plus -1fill
%
\advance\rightskip by \entryrightmargin
- % Determine how far we can stretch into the margin.
- % This allows, e.g., "Appendix H GNU Free Documentation License" to
- % fit on one line in @letterpaper format.
- \ifdim\entryrightmargin>2.1em
- \dimen@i=2.1em
- \else
- \dimen@i=0em
- \fi
- \advance \parfillskip by 0pt minus 1\dimen@i
%
\dimen@ii = \hsize
\advance\dimen@ii by -1\leftskip
\advance\dimen@ii by -1\entryrightmargin
- \advance\dimen@ii by 1\dimen@i
\ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line
\ifdim\dimen@ > 0.8\dimen@ii % due to long index text
- % Undo changes above
- \advance \parfillskip by 0pt minus -1\dimen@i
- \advance\dimen@ii by -1\dimen@i
- %
- % Try to split the text roughly evenly. \dimen@ will be the length of
- % the first line.
- \dimen@ = 0.7\dimen@
- \dimen@ii = \hsize
- \ifnum\dimen@>\dimen@ii
- % If the entry is too long (for example, if it needs more than
- % two lines), use the same line length for all lines.
- \dimen@ = \dimen@ii
- \else
- \advance \dimen@ by 1\rightskip
- \fi
\advance\leftskip by 0pt plus 1fill % ragged right
- \parshape = 2 0pt \dimen@ 0em \dimen@ii
- % Ideally we'd add a finite glue at the end of the first line only,
- % instead of using \parshape with explicit line lengths, but TeX
- % doesn't seem to provide a way to do such a thing.
%
% Indent all lines but the first one.
\advance\leftskip by \entrycontskip
@@ -5714,12 +5685,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\newskip\thinshrinkable
\skip\thinshrinkable=.15em minus .15em
-% Like plain.tex's \dotfill, except uses up at least 1 em.
+% Like plain.tex's \dotfill, except uses up at least 0.5 em.
% The filll stretch here overpowers both the fil and fill stretch to push
% the page number to the right.
\def\indexdotfill{\cleaders
- \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1filll}
-
+ \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 0.5em plus 1filll}
\def\primary #1{\line{#1\hfil}}
@@ -6167,8 +6137,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally unnmhead0 calls unnumberedzzz:
\outer\parseargdef\unnumbered{\unnmhead0{#1}}
\def\unnumberedzzz#1{%
- \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
- \global\advance\unnumberedno by 1
+ \global\advance\unnumberedno by 1
%
% Since an unnumbered has no number, no prefix for figures.
\global\let\chaplevelprefix = \empty
@@ -6224,8 +6193,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally calls unnumberedseczzz:
\outer\parseargdef\unnumberedsec{\unnmhead1{#1}}
\def\unnumberedseczzz#1{%
- \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
- \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno}%
}
% Subsections.
@@ -6248,9 +6217,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally calls unnumberedsubseczzz:
\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}}
\def\unnumberedsubseczzz#1{%
- \global\subsubsecno=0 \global\advance\subsecno by 1
- \sectionheading{#1}{subsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{subsec}{Ynothing}{\the\unnumberedno}%
}
% Subsubsections.
@@ -6274,9 +6242,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% normally unnumberedsubsubseczzz:
\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}}
\def\unnumberedsubsubseczzz#1{%
- \global\advance\subsubsecno by 1
- \sectionheading{#1}{subsubsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}%
+ \global\advance\unnumberedno by 1
+ \sectionheading{#1}{subsubsec}{Ynothing}{\the\unnumberedno}%
}
% These macros control what the section commands do, according
@@ -7709,9 +7676,13 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\deflineheader#1 #2 #3\endheader{%
\printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}%
}
+
\def\deftypeline{%
\doingtypefntrue
- \parseargusing\activeparens{\printdefunline\deflineheader}%
+ \parseargusing\activeparens{\printdefunline\deftypelineheader}%
+}
+\def\deftypelineheader#1 #2 #3 #4\endheader{%
+ \printdefname{#1}{#2}{#3}\magicamp\defunargs{#4\unskip}%
}
% \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) }
@@ -8231,8 +8202,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\commondummyword\unmacrodo
\xdef\macrolist{\macrolist}%
\endgroup
- \else
- \errmessage{Macro #1 not defined}%
\fi
}
@@ -8846,6 +8815,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi
}
+% @nodedescription, @nodedescriptionblock - do nothing for TeX
+\parseargdef\nodedescription{}
+\def\nodedescriptionblock{\doignore{nodedescriptionblock}}
+
+
% @anchor{NAME} -- define xref target at arbitrary point.
%
\newcount\savesfregister
@@ -11859,9 +11833,13 @@ directory should work if nowhere else does.}
\def\c{\loadconf\c}%
% Definition for the first newline read in the file
\def ^^M{\loadconf}%
- % In case the first line has a whole-line command on it
+ % In case the first line has a whole-line or environment command on it
\let\originalparsearg\parsearg%
\def\parsearg{\loadconf\originalparsearg}%
+ %
+ % \startenvironment is in the expansion of commands defined with \envdef
+ \let\originalstartenvironment\startenvironment%
+ \def\startenvironment{\loadconf\startenvironment}%
}}
@@ -11889,6 +11867,7 @@ directory should work if nowhere else does.}
\enableemergencynewline
\let\c=\comment
\let\parsearg\originalparsearg
+ \let\startenvironment\originalstartenvironment
%
% Also turn back on active characters that might appear in the input
% file name, in case not using a pre-dumped format.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 7e938d0f97f..131a23b7423 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -321,7 +321,7 @@ behind the scenes when you open a file with @value{tramp}.
@cindex GNU ELPA
@vindex tramp-version
-@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}).
+@value{tramp} is included as part of Emacs.
@value{tramp} is also freely packaged for download on the Internet at
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@@ -343,10 +343,12 @@ versions packaged with Emacs can be retrieved by
@end lisp
@value{tramp} is also available as @uref{https://elpa.gnu.org, GNU
-ELPA} package. Besides the standalone releases, further minor versions
-of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
-release appears. These minor versions have a four-number string, like
-``2.4.5.1''.
+ELPA} package. Besides the standalone releases, further minor
+versions of @value{tramp} will appear on GNU ELPA, until the next
+@value{tramp} release appears. These minor versions have a
+four-number string, like ``2.4.5.1''. The manual of the latest
+@value{tramp} ELPA package is located at
+@uref{https://elpa.gnu.org/packages/doc/tramp.html}.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
@@ -486,24 +488,28 @@ an @command{ssh} server:
@file{@trampfn{plink,user@@host,/path/to/file}}.
-@anchor{Quick Start Guide su, sudo, doas and sg methods}
-@section Using @option{su}, @option{sudo}, @option{doas} and @option{sg}
+@anchor{Quick Start Guide su, sudo, doas, androidsu and sg methods}
+@section Using @option{su}, @option{sudo}, @option{doas}, @option{androidsu} and @option{sg}
@cindex method @option{su}
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
@cindex method @option{doas}
@cindex @option{doas} method
+@cindex method @option{androidsu}
+@cindex @option{androidsu} method
@cindex method @option{sg}
@cindex @option{sg} method
Sometimes, it is necessary to work on your local host under different
permissions. For this, you can use the @option{su} or @option{sudo}
connection method. On OpenBSD systems, the @option{doas} connection
-method offers the same functionality. These methods use @samp{root}
-as default user name and the return value of @code{(system-name)} as
-default host name. Therefore, it is convenient to open a file as
-@file{@trampfn{sudo,,/path/to/file}}.
+method offers the same functionality. If your local system is
+Android, use the method @option{androidsu} instead of @option{su}.
+
+These methods use @samp{root} as default user name and the return
+value of @code{(system-name)} as default host name. Therefore, it is
+convenient to open a file as @file{@trampfn{sudo,,/path/to/file}}.
The method @option{sg} stands for ``switch group''; here the user name
is used as the group to change to. The default host name is the same.
@@ -523,7 +529,7 @@ is used as the group to change to. The default host name is the same.
@cindex @option{doas} method
If the @option{su}, @option{sudo} or @option{doas} option should be
-performed on another host, it can be comnbined with a leading
+performed on another host, it can be combined with a leading
@option{ssh} or @option{plink} option. That means that @value{tramp}
connects first to the other host with non-administrative credentials,
and changes to administrative credentials on that host afterwards. In
@@ -817,6 +823,17 @@ editing as another user. The host can be either @samp{localhost} or
the host returned by the function @command{(system-name)}. See
@ref{Multi-hops} for an exception to this behavior.
+@item @option{androidsu}
+@cindex method @option{androidsu}
+@cindex @option{androidsu} method
+Because the default implementation of the @option{su} method and other
+shell-based methods conflict with non-standard @command{su}
+implementations popular among Android users and the restricted
+command-line utilities distributed with that system, a largely
+equivalent @option{androidsu} method is provided for that system with
+workarounds for its many idiosyncrasies, with the exception that
+multi-hops are unsupported.
+
@item @option{sudo}
@cindex method @option{sudo}
@cindex @option{sudo} method
@@ -1057,6 +1074,20 @@ session.
These methods support the @samp{-P} argument.
+@item @option{dockercp}
+@item @option{podmancp}
+@cindex method @option{dockercp}
+@cindex @option{dockercp} method
+@cindex method @option{podmancp}
+@cindex @option{podmancp} method
+
+These methods are similar to @option{docker} or @option{podman}, but
+they use the command @command{docker cp} or @command{podman cp} for
+transferring large files.
+
+These copy commands do not support file globs, and they ignore a user
+name.
+
@item @option{fcp}
@cindex method @option{fcp}
@cindex @option{fcp} method
@@ -2034,7 +2065,7 @@ machine @var{host} port sudo login @var{user} password secret
@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
+methods is connected via a multi-hop (@pxref{Multi-hops}), the
credentials of the previous hop are used.
@vindex auth-source-save-behavior
@@ -5236,9 +5267,14 @@ Does @value{tramp} support @acronym{SSH} security keys?
Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
devices via special key types @option{*-sk}. @value{tramp} supports
the additional handshaking messages for them. This requires at least
-@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
-security key, like yubikey, solokey, nitrokey, or titankey.
-
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or
+@acronym{FIDO2} compatible security key, like yubikey, solokey,
+nitrokey, or titankey.
+@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/}
+
+@strong{Note} that there are reports on problems of handling FIDO2
+(residential) keys by @command{ssh-agent}. As workaround, you might
+disable @command{ssh-agent} for such keys.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index a239c091889..bf5c90ee8a9 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -7,7 +7,7 @@
@c In the Tramp GIT, the version number and the bug report address
@c are auto-frobbed from configure.ac.
-@set trampver 2.7.0-pre
+@set trampver 2.7.1-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 27.1
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index f76edc6b1e4..3a6486903bf 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -31,7 +31,7 @@ General Public License for more details.
@finalout
@titlepage
@title Transient User and Developer Manual
-@subtitle for version 0.5.2
+@subtitle for version 0.6.0
@author Jonas Bernoulli
@page
@vskip 0pt plus 1filll
@@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial,
available at @uref{https://github.com/positron-solutions/transient-showcase}.
@noindent
-This manual is for Transient version 0.5.2.
+This manual is for Transient version 0.6.0.
@insertcopying
@end ifnottex
@@ -554,7 +554,7 @@ state, you have to make sure that that state is currently active.
@item @kbd{C-x a} (@code{transient-toggle-level-limit})
@kindex C-x a
@findex transient-toggle-level-limit
-This command toggle whether suffixes that are on levels lower than
+This command toggle whether suffixes that are on levels higher than
the level specified by @code{transient-default-level} are temporarily
available anyway.
@end table
@@ -1206,9 +1206,19 @@ The returned children must have the same form as stored in the
prefix's @code{transient--layout} property, but it is often more convenient
to use the same form as understood by @code{transient-define-prefix},
described below. If you use the latter approach, you can use the
-@code{transient-parse-child} and @code{transient-parse-children} functions to
+@code{transient-parse-suffixes} and @code{transient-parse-suffix} functions to
transform them from the convenient to the expected form.
+If you explicitly specify children and then transform them using
+@code{:setup-chilren}, then the class of the group is determined as usual,
+based on explicitly specified children.
+
+If you do not explicitly specify children and thus rely solely on
+@code{:setup-children}, then you must specify the class using @code{:class}.
+For backward compatibility, if you fail to do so, @code{transient-column}
+is used and a warning is displayed. This warning will eventually
+be replaced with an error.
+
@item
The boolean @code{:pad-keys} argument controls whether keys of all suffixes
contained in a group are right padded, effectively aligning the
@@ -1220,11 +1230,11 @@ The @var{ELEMENT}s are either all subgroups, or all suffixes and strings.
subgroups with commands at the same level, though in principle there
is nothing that prevents that.)
-If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists
-that specify commands and strings. Strings are inserted verbatim into
-the buffer. The empty string can be used to insert gaps between
-suffixes, which is particularly useful if the suffixes are outlined as
-a table.
+If the @var{ELEMENT}s are not subgroups, then they can be a mixture of
+lists, which specify commands, and strings. Strings are inserted
+verbatim into the buffer. The empty string can be used to insert gaps
+between suffixes, which is particularly useful if the suffixes are
+outlined as a table.
Inside group specifications, including inside contained suffix
specifications, nothing has to be quoted and quoting anyway is
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index a4f2ed29d93..dd5b70cf32f 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -554,12 +554,19 @@ the object after this object; otherwise append to @var{table}. This
also updates the displayed table.
@end defun
-@defun vtable-update-object table object old-object
-Change @var{old-object} into @var{object} in @var{table}. This also
-updates the displayed table.
+@defun vtable-update-object table object &optional old-object
+Update @var{object}'s representation in @var{table}. Optional argument
+@var{old-object}, if non-@code{nil}, means to replace @var{old-object}
+with @var{object} and redisplay the associated row in the table. In
+either case, if the existing object is not found in the table (being
+compared with @code{equal}), signal an error.
This has the same effect as calling @code{vtable-remove-object} and
then @code{vtable-insert-object}, but is more efficient.
+
+Note a limitation: if the table's buffer is not in a visible window, or
+if its window has changed width since it was updated, updating the table
+is not possible, and an error is signaled.
@end defun
@defun vtable-column table index
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index 93b7606b01e..cfb9d2211cf 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -1384,6 +1384,15 @@ a specific way. If present, @var{value} is used to initialize the
@code{:value} property. When created, it inserts the value as a
string in the buffer.
+@noindent
+Example:
+
+@lisp
+(widget-create 'item :tag "Today is" :format "%t: %v\n"
+ (format-time-string "%d-%m-%Y"))
+@end lisp
+
+
By default, it has the following properties:
@table @code
@@ -1428,6 +1437,20 @@ The @var{value}, if present, is used to initialize the @code{:value}
property. The value should be a string, which will be inserted in the
buffer.
+@noindent
+Example:
+
+@lisp
+(widget-create 'link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Mail yourself"
+ :action #'(lambda (widget &optional _event)
+ (compose-mail-other-window (widget-value widget)))
+ user-mail-address)
+@end lisp
+
+
By default, it has the following properties:
@table @code
@@ -1471,6 +1494,31 @@ A widget to represent a link to a web page. Its super is the
It overrides the @code{:action} property to open up the @var{url}
specified.
+@noindent
+Example:
+
+@lisp
+@group
+(widget-create 'url-link
+ :button-prefix ""
+ :button-suffix ""
+ ;; Return appropriate face.
+ :button-face-get (lambda (widget)
+ (if (widget-get widget :visited)
+ 'link-visited
+ 'link))
+ :format "%[%t%]"
+ :tag "Browse this manual"
+ :action (lambda (widget &optional _event)
+ (widget-put widget :visited t)
+ ;; Takes care of redrawing the widget.
+ (widget-value-set widget (widget-value widget))
+ ;; And then call the original function.
+ (widget-url-link-action widget))
+ "https://www.gnu.org/software/emacs/manual/html_mono/widget.html")
+@end group
+@end lisp
+
@node info-link
@subsection The @code{info-link} Widget
@findex info-link@r{ widget}
@@ -1487,6 +1535,17 @@ A widget to represent a link to an info file. Its super is the
It overrides the @code{:action} property, to a function to start the
built-in Info reader on @var{address}, when invoked.
+@noindent
+Example:
+
+@lisp
+(widget-create 'info-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Browse this manual"
+ "(widget) info-link")))
+@end lisp
+
@node function-link
@subsection The @code{function-link} Widget
@findex function-link@r{ widget}
@@ -1502,6 +1561,17 @@ A widget to represent a link to an Emacs function. Its super is the
It overrides the @code{:action} property, to a function to describe
@var{function}.
+@noindent
+Example:
+
+@lisp
+(widget-create 'function-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Describe the function that gets called"
+ #'widget-function-link-action)
+@end lisp
+
@node variable-link
@subsection The @code{variable-link} Widget
@findex variable-link@r{ widget}
@@ -1517,6 +1587,17 @@ A widget to represent a link to an Emacs variable. Its super is the
It overrides the @code{:action} property, to a function to describe
@var{var}.
+@noindent
+Example:
+
+@lisp
+(widget-create 'variable-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "What setting controls button-prefix?"
+ 'widget-button-prefix)
+@end lisp
+
@node face-link
@subsection The @code{face-link} Widget
@findex face-link@r{ widget}
@@ -1532,6 +1613,17 @@ A widget to represent a link to an Emacs face. Its super is the
It overrides the @code{:action} property, to a function to describe
@var{face}.
+@noindent
+Example:
+
+@lisp
+(widget-create 'face-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Which face is this one?"
+ 'widget-button)
+@end lisp
+
@node file-link
@subsection The @code{file-link} Widget
@findex file-link@r{ widget}
@@ -1547,6 +1639,19 @@ A widget to represent a link to a file. Its super is the
It overrides the @code{:action} property, to a function to find the file
@var{file}.
+@noindent
+Example:
+
+@lisp
+(let ((elisp-files (directory-files user-emacs-directory t ".el$")))
+ (dolist (file elisp-files)
+ (widget-create 'file-link
+ :button-prefix ""
+ :button-suffix ""
+ file)
+ (widget-insert "\n")))
+@end lisp
+
@node emacs-library-link
@subsection The @code{emacs-library-link} Widget
@findex emacs-library-link@r{ widget}
@@ -1562,6 +1667,17 @@ A widget to represent a link to an Emacs Lisp file. Its super is the
It overrides the @code{:action} property, to a function to find the file
@var{file}.
+@noindent
+Example:
+
+@lisp
+(widget-create 'emacs-library-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Show yourself, Widget Library!"
+ "wid-edit.el")
+@end lisp
+
@node emacs-commentary-link
@subsection The @code{emacs-commentary-link} Widget
@findex emacs-commentary-link@r{ widget}
@@ -1577,6 +1693,17 @@ file. Its super is the @code{link} widget.
It overrides the @code{:action} property, to a function to find the file
@var{file} and put point in the Comment section.
+@noindent
+Example:
+
+@lisp
+(widget-create 'emacs-commentary-link
+ :button-prefix ""
+ :button-suffix ""
+ :tag "Check our good friend Customize"
+ "cus-edit.el")
+@end lisp
+
@node push-button
@subsection The @code{push-button} Widget
@findex push-button@r{ widget}
@@ -2009,6 +2136,33 @@ A widget that can toggle between two states. Its super is the
The widget has two possible states, @samp{on} and @samp{off}, which
correspond to a @code{t} or @code{nil} value, respectively.
+@noindent
+Example:
+
+@lisp
+@group
+(widget-insert "Press the button to activate/deactivate the field: ")
+(widget-create 'toggle
+ :notify (lambda (widget &rest _ignored)
+ (widget-apply widget-example-field
+ (if (widget-value widget)
+ :activate
+ :deactivate))))
+(widget-insert "\n")
+@end group
+@group
+(setq widget-example-field
+ (widget-create 'editable-field
+ :deactivate (lambda (widget)
+ (widget-specify-inactive
+ widget
+ (widget-field-start widget)
+ (widget-get widget :to)))))
+(widget-apply widget-example-field :deactivate)))
+@end group
+@end lisp
+
+
It either overrides or adds the following properties:
@table @code
@@ -2148,6 +2302,21 @@ The @var{type} arguments represent each checklist item. The widget's
value will be a list containing the values of all checked @var{type}
arguments.
+@noindent
+Example:
+
+@lisp
+(widget-create 'checklist
+ :notify (lambda (widget child &optional _event)
+ (funcall
+ (widget-value (widget-get-sibling child))
+ 'toggle))
+ :value (list 'tool-bar-mode 'menu-bar-mode)
+ '(item :tag "Tool-bar" tool-bar-mode)
+ '(item :tag "Menu-bar" menu-bar-mode))))
+@end lisp
+
+
It either overrides or adds the following properties:
@table @code
@@ -2899,6 +3068,59 @@ The predefined functions @code{widget-types-convert-widget} and
@code{widget-value-convert-widget} can be used here.
@end table
+@noindent
+Example:
+
+@lisp
+@group
+(defvar widget-ranged-integer-map
+ (let ((map (copy-keymap widget-keymap)))
+ (define-key map [up] #'widget-ranged-integer-increase)
+ (define-key map [down] #'widget-ranged-integer-decrease)
+ map))
+@end group
+
+@group
+(define-widget 'ranged-integer 'integer
+ "A ranged integer widget."
+ :min-value most-negative-fixnum
+ :max-value most-positive-fixnum
+ :keymap widget-ranged-integer-map)
+@end group
+
+@group
+(defun widget-ranged-integer-change (widget how)
+ "Change the value of the ranged-integer WIDGET, according to HOW."
+ (let* ((value (widget-value widget))
+ (newval (cond
+ ((eq how 'up)
+ (if (< (1+ value) (widget-get widget :max-value))
+ (1+ value)
+ (widget-get widget :max-value)))
+ ((eq how 'down)
+ (if (> (1- value) (widget-get widget :min-value))
+ (1- value)
+ (widget-get widget :min-value)))
+ (t (error "HOW has a bad value"))))
+ (inhibit-read-only t))
+ (widget-value-set widget newval)))
+@end group
+
+@group
+(defun widget-ranged-integer-increase (widget)
+ "Increase the value of the ranged-integer WIDGET."
+ (interactive (list (widget-at)))
+ (widget-ranged-integer-change widget 'up))
+@end group
+
+@group
+(defun widget-ranged-integer-decrease (widget)
+ "Decrease the value of the ranged-integer WIDGET."
+ (interactive (list (widget-at)))
+ (widget-ranged-integer-change widget 'down))
+@end group
+@end lisp
+
@node Inspecting Widgets
@chapter Inspecting Widgets
@cindex widget browser
diff --git a/doc/translations/README b/doc/translations/README
new file mode 100644
index 00000000000..02edb829dcf
--- /dev/null
+++ b/doc/translations/README
@@ -0,0 +1,211 @@
+* Translating the Emacs manuals
+
+** Copyright assignment
+
+People who contribute translated documents should provide a copyright
+assignment to the Free Software Foundation. See the "Copyright
+Assignment" section in the Emacs manual.
+
+
+** Translated documents license
+
+The translated documents are distributed under the same license as the
+original documents: the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation.
+
+See https://www.gnu.org/licenses/fdl-1.3.html for more information.
+
+If you have any questions regarding the use of the FDL license in your
+translation work that do not appear in the FAQ, feel free to contact the
+GNU project.
+
+See https://www.gnu.org/contact/ for more information.
+
+** Location of the translated files
+
+*** Texinfo source files
+
+The source files of the translated manuals are located in the
+doc/translations directory, under the sub-directory corresponding to the
+translated language.
+
+ E.g., French manual sources are found under doc/translations/fr.
+
+The structure of each language's folder should match that of the English
+manuals (i.e. include misc, man, lispref, lispintro, emacs).
+
+*** Built files
+
+Translated deliverables in Info format are built at release time and are
+made available for local installation.
+
+
+** Source files format
+
+The manuals and their translations are written in the Texinfo format
+(with the exception of the org-mode manual, which is written in Org, and
+illustrations for the Introduction to Emacs Lisp Programming, which are
+EPS files).
+
+See https://www.gnu.org/software/Texinfo/ for more information.
+
+You must install the Texinfo package in order to verify the translated
+files, and refer to the Texinfo manual for information on the various
+Texinfo features.
+
+Emacs has a Texinfo mode that highlights the parts of the Texinfo code
+to be translated for easy reference.
+
+
+*** Texinfo specific issues
+
+Until the Emacs/Texinfo projects provide better solutions, here are a
+few rules to follow:
+
+- Under each @node, add an @anchor that has the same content as the
+ original English @node.
+
+- Translate the @node content but leave the @anchor in English.
+
+- Most Emacs manuals are set to include the docstyle.Texi file. This
+ file adds the "@documentencoding UTF-8" directive to the targeted
+ manual. There is no need to add this directive in a manual that
+ includes docstyle.texi.
+
+- Add a @documentlanguage directive that includes your language.
+
+ E.g., @documentlanguage zh
+
+This directive currently has little effect but will be useful in the
+future.
+
+- The @author directive can be used for the translator's name.
+
+ E.g., @author traduit en franƧais par Achile Talon
+
+
+** Fixing the original document
+
+During the course of the translation, you might encounter passages in
+the original document that need to be updated or otherwise corrected, or
+even run into a bug in Emacs. If you cannot immediately correct the
+problem, please file a bug report promptly.
+
+See the 'Bugs' section in the Emacs manual.
+
+** Sending your contributions
+
+Send your contributions (files or revisions) for review to the Emacs
+development list at emacs-devel@gnu.org. Subscribing to the list is not
+obligatory.
+
+Always send contributions in the format of the original document. Most
+of the content in the Emacs manuals is in Texinfo format, so please do
+not send contributions in derivative formats (e.g. info, html, docbook,
+plain text, etc.)
+
+Before sending files for review, please ensure that they have been
+thoroughly checked for spelling/grammar/typography by at least using the
+tools provided by Emacs.
+
+Please also make sure that the Texinfo files build properly on your
+system.
+
+Send your contributions as patches (git diff -p --stat), and prefer the
+git format-patch form, since that format allows for easier review and
+easier installation of the changes by the persons with write access to
+the repository.
+
+The Emacs project has a lot of coding, documentation and commenting
+conventions. Sending such patches allows the project managers to make
+sure that the contributions comply with the various conventions.
+
+
+** Discussing translation issues
+
+Translation-related discussions are welcome on the emacs development
+list. Discussions specific to your language do not have to be in
+English.
+
+
+** Translation teams
+
+The number of words in the Emacs manuals is over 2,000,000 words and
+growing. While one individual could theoretically translate all the
+files, it is more practical to work in language teams.
+
+If you have a small group of translators willing to help, please make
+sure that the files are properly reviewed before sending them to the
+Emacs development list (see above).
+
+Please refer to the translation-related documents maintained by the GNU
+Project, and contact your language translation team to learn the
+practices they have developed over the years.
+
+See https://www.gnu.org/server/standards/README.translations.html for
+more information.
+
+
+** Translation processes
+
+Emacs does not yet provide tools that significantly help the translation
+process. A few useful functions would be:
+
+- automatic lookup of a list of glossary items when starting to work on
+ a translation "unit" (paragraph or otherwise); such glossary terms
+ should be easily insertable at point,
+
+- automatic lookup of past translations to check for similarity and
+ improve homogeneity over the whole document set; such past translation
+ matches should be easily insertable at point, etc.
+
+
+*** Using the PO format as an intermediate translation format
+
+Although the PO format has not been developed with documentation in
+mind, it is well-known among free software translation teams, and you
+can easily use the po4a utility to convert Texinfo to PO for work in
+translation tools that support the PO format.
+
+See https://po4a.org for more information.
+
+However, regardless of the intermediate file format that you might use,
+you should only send files in the original format (Texinfo, org-mode,
+eps) for review and installation.
+
+
+*** Free tools that you can use in your processes
+
+A number of free software tools are available outside the Emacs project,
+to help translators (both amateur and professional) in the translation
+process.
+
+If they have any features that you think Emacs should implement, you are
+welcome to provide patches to the Emacs project.
+
+Such tools include:
+
+- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/
+- KDE's Lokalize, https://apps.kde.org/lokalize/
+- OmegaT, https://omegat.org
+- the Okapi Framework, https://www.okapiframework.org
+- pootle, https://pootle.translatehouse.org
+
+etc.
+
+
+* Licence of this document
+
+Copyright (C) 2024 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice
+and this notice are preserved. This file is offered as-is, without any
+warranty.
+
+
+Local Variables:
+mode: outline
+paragraph-separate: "[ ]*$"
+coding: utf-8
+End:
diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi
index e1b9cac5fc3..e1b9cac5fc3 100644
--- a/doc/lang/fr/misc/ses-fr.texi
+++ b/doc/translations/fr/misc/ses-fr.texi
diff --git a/etc/AUTHORS b/etc/AUTHORS
index 5fc54f1909f..8a541e8a7e2 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -45,7 +45,7 @@ Adam Hupp: changed emacs.py emacs2.py emacs3.py gud.el
progmodes/python.el
Adam Porter: changed tab-line.el cl-macs.el map.el control.texi
- map-tests.el pcase-tests.el tab-bar.el
+ map-tests.el pcase-tests.el tab-bar.el variables.texi
Adam SjĆøgren: changed mml2015.el shr.el spam.el xterm.c blink.xpm
braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm frown.xpm
@@ -537,7 +537,7 @@ Aubrey Jaffer: changed info.el unexelf.c
August Feng: changed bookmark.el
-Augustin ChƩneau: changed treesit.el
+Augustin ChƩneau: changed c-ts-mode.el treesit.el
Augusto Stoffel: co-wrote ansi-osc.el
and changed progmodes/python.el isearch.el eglot.el comint.el eldoc.el
@@ -555,6 +555,8 @@ Axel Boldt: changed ehelp.el electric.el
Axel Svensson: changed characters.el display.texi x-win.el
+Aymeric Agon-Rambosson: changed indent.el
+
Bahodir Mansurov: changed quail/cyrillic.el
Bake Timmons: changed gnus.texi mail-source.el
@@ -583,7 +585,7 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el
Basil L. Contovounesios: changed simple.el subr.el message.el eww.el
modes.texi custom.el text.texi bibtex.el gnus-sum.el internals.texi
js.el customize.texi display.texi files.texi gnus-group.el gnus-win.el
- gnus.texi gravatar.el json.el map.el shr.el and 345 other files
+ gnus.texi gravatar.el json.el map.el shr.el and 346 other files
Bastian Beischer: changed semantic/complete.el calc-yank.el include.el
mru-bookmark.el refs.el senator.el
@@ -984,7 +986,7 @@ Christoph Dittmann: changed ox-beamer.el
Christophe de Dinechin: co-wrote ns-win.el
-Christophe Deleuze: changed icalendar.el image-dired.el
+Christophe Deleuze: changed ange-ftp.el icalendar.el image-dired.el
Christoph Egger: changed configure.ac
@@ -1016,7 +1018,8 @@ Christopher Thorne: changed dired.el progmodes/grep.el
Christopher Wellons: changed emacs-lisp/cl-lib.el hashcash.el
viper-cmd.el viper-ex.el viper-init.el viper.el
-Christophe Troestler: changed gnus-icalendar.el epg.el newcomment.el
+Christophe Troestler: changed rust-ts-mode.el gnus-icalendar.el epg.el
+ newcomment.el
Christoph Gƶttschkes: changed make-mode.el
@@ -1186,6 +1189,9 @@ Daniel LaLiberte: wrote edebug.el isearch.el
and co-wrote hideif.el
and changed cust-print.el mlconvert.el eval-region.el
+Daniel Laurens Nicolai: changed doc-view.el facemenu.el files.el
+ misc.texi re-builder.el searching.texi
+
Daniel Lenski: changed speedbar.el
Daniel Lopez: changed progmodes/compile.el
@@ -1196,7 +1202,7 @@ Daniel MartĆ­n: changed c-ts-mode.el nsterm.m shortdoc.el ns-win.el
simple.el diff-mode-tests.el erc.texi files.el files.texi indent.erts
msdos-xtra.texi progmodes/python.el search.texi .lldbinit basic.texi
c-ts-mode-tests.el cmacexp.el compilation.txt compile-tests.el
- compile.texi configure.ac and 46 other files
+ compile.texi configure.ac and 47 other files
Daniel McClanahan: changed lisp-mode.el
@@ -1240,6 +1246,8 @@ Dani Moncayo: changed msys-to-w32 Makefile.in configure.ac buffers.texi
dired.texi display.texi emacs-lisp-intro.texi files.texi killing.texi
make-dist mark.texi msysconfig.sh simple.el text.texi version.el
+Dan Jacobson: changed vnvni.el
+
Dan Nicolaescu: wrote iris-ansi.el romanian.el vc-dir.el
and co-wrote hideshow.el
and changed vc.el configure.ac vc-hg.el vc-git.el src/Makefile.in
@@ -1475,6 +1483,9 @@ and changed complete.el
Denis StĆ¼nkel: changed ibuf-ext.el
+Denis Zubarev: changed treesit-tests.el progmodes/python.el
+ python-tests.el treesit.c
+
Deniz Dogan: changed rcirc.el simple.el css-mode.el TUTORIAL.sv
commands.texi erc-backend.el erc-log.el erc.el image.el iswitchb.el
lisp-mode.el process.c progmodes/python.el quickurl.el rcirc.texi
@@ -1564,10 +1575,10 @@ Dmitry Gorbik: changed org.el
Dmitry Gutov: wrote elisp-mode-tests.el jit-lock-tests.el json-tests.el
vc-hg-tests.el xref-tests.el
and changed xref.el ruby-mode.el project.el vc-git.el ruby-ts-mode.el
- elisp-mode.el etags.el ruby-mode-tests.el js.el vc.el package.el
- vc-hg.el symref/grep.el dired-aux.el ruby-ts-mode-tests.el simple.el
- progmodes/python.el treesit.el log-edit.el ruby-ts.rb rust-ts-mode.el
- and 157 other files
+ elisp-mode.el js.el etags.el ruby-mode-tests.el vc.el package.el
+ vc-hg.el symref/grep.el treesit.el dired-aux.el progmodes/python.el
+ ruby-ts-mode-tests.el simple.el typescript-ts-mode.el log-edit.el
+ ruby-ts.rb and 159 other files
Dmitry Kurochkin: changed isearch.el
@@ -1666,9 +1677,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c]
chartab-tests.el coding-tests.el etags-tests.el rxvt.el tty-colors.el
and co-wrote help-tests.el
and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c
- files.el fileio.c keyboard.c emacs.c text.texi configure.ac w32term.c
+ files.el fileio.c keyboard.c emacs.c configure.ac text.texi w32term.c
dispnew.c frames.texi w32proc.c files.texi xfaces.c window.c
- dispextern.h lisp.h and 1334 other files
+ dispextern.h lisp.h and 1341 other files
Eliza Velasquez: changed server.el
@@ -1814,7 +1825,7 @@ Ernesto Alfonso: changed simple.el
E Sabof: changed hi-lock.el image-dired.el
-Eshel Yaron: changed eglot.el emacs.texi eww.el indent.texi
+Eshel Yaron: changed eglot.el emacs.texi emoji.el eww.el indent.texi
Espen Skoglund: wrote pascal.el
@@ -1926,7 +1937,7 @@ F. Jason Park: changed erc.el erc-backend.el erc-tests.el foonet.eld
barnet.eld erc-scenarios-misc.el erc-services.el erc-common.el
erc-networks-tests.el erc-scenarios-base-reconnect.el
erc-scenarios-common.el socks-tests.el auth-source-pass-tests.el
- auth-source-pass.el erc-join.el erc-sasl-tests.el and 104 other files
+ auth-source-pass.el erc-join.el erc-sasl-tests.el and 106 other files
Flemming Hoejstrup Hansen: changed forms.el
@@ -2087,6 +2098,8 @@ George D. Plymale Ii: changed esh-cmd.el
George Kettleborough: changed org-clock.el org-timer.el
+George Kuzler: changed calc.el
+
George McNinch: changed nnir.el
Georges Brun-Cottan: wrote easy-mmode.el
@@ -2172,7 +2185,7 @@ Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c
Gregory Chernov: changed nnslashdot.el
-Gregory Heytings: changed xdisp.c editfns.c keyboard.c subr.el buffer.c
+Gregory Heytings: changed xdisp.c editfns.c subr.el keyboard.c buffer.c
dispextern.h lisp.h buffer.h display.texi efaq.texi files.el isearch.el
minibuffer.el Makefile.in bytecode.c composite.c positions.texi
bytecomp.el emake help-fns.el lread.c and 78 other files
@@ -2345,7 +2358,7 @@ Igor Saprykin: changed ftfont.c
Ihor Radchenko: wrote org-fold-core.el org-fold.el org-persist.el
and changed ox.el fns.c emacsclient.desktop help-mode.el oc.el
- org-element.el
+ org-element.el org.el
Iku Iwasa: changed auth-source-pass-tests.el auth-source-pass.el
@@ -2556,11 +2569,10 @@ and changed gnus-score.el gnus-logic.el
Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el
-Jared Finder: changed menu-bar.el term.c commands.texi frame.c isearch.el
- mouse.el tmm.el wid-edit.el xt-mouse.el artist.el dispnew.c
- ediff-wind.el ediff.el faces.el foldout.el frames.texi keyboard.c
- lread.c mouse-drag.el progmodes/compile.el ruler-mode.el
- and 7 other files
+Jared Finder: changed menu-bar.el term.c commands.texi xt-mouse.el
+ frame.c isearch.el mouse.el tmm.el wid-edit.el artist.el dired.el
+ dispnew.c ediff-wind.el ediff.el faces.el foldout.el frames.texi
+ keyboard.c lread.c mouse-drag.el progmodes/compile.el and 9 other files
Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c
misc.texi server.el shell.el w32fns.c xgselect.c
@@ -2626,7 +2638,7 @@ and changed idlw-rinfo.el idlw-toolbar.el comint.el idlwave.texi vc.el
Jean Abou Samra: changed scheme.el
-Jean-Christophe Helary: changed emacs-lisp-intro.texi ns-win.el
+Jean-Christophe Helary: changed back.texi emacs-lisp-intro.texi ns-win.el
package-tests.el package.el strings.texi subr-x.el ucs-normalize.el
Jean Forget: changed cal-french.el
@@ -2704,6 +2716,9 @@ JĆ©rĆ©mie CourrĆØges-Anglas: changed kqueue.c org.texi ox-latex.el
Jeremy Bertram Maitin-Shepard: changed erc.el erc-backend.el
erc-button.el erc-track.el mml.el
+Jeremy Bryant: changed abbrev.el cl-extra.el emacs-lisp/cl-lib.el
+ files.texi functions.texi simple.el
+
JƩrƩmy Compostella: changed tramp-sh.el mml.el battery.el keyboard.c
windmove.el window.el xdisp.c
@@ -2767,7 +2782,7 @@ Jim Porter: changed eshell.texi esh-cmd.el esh-var-tests.el
esh-util.el eshell-tests-helpers.el em-pred.el esh-arg.el
esh-cmd-tests.el tramp.el em-pred-tests.el em-dirs-tests.el server.el
em-basic.el em-extpipe-tests.el esh-opt-tests.el esh-opt.el
- and 92 other files
+ and 94 other files
Jim Radford: changed gnus-start.el
@@ -3046,7 +3061,7 @@ and changed xterm.c xfns.c keyboard.c screen.c dispnew.c xdisp.c window.c
Joseph M. Kelsey: changed fileio.c skeleton.el
-Joseph Turner: changed package-vc.el subr.el
+Joseph Turner: changed package-vc.el minibuffer.el subr.el
Josh Elsasser: changed eglot.el README.md configure.ac
@@ -3129,7 +3144,7 @@ Juri Linkov: wrote compose.el emoji.el files-x.el misearch.el
and changed isearch.el simple.el info.el replace.el dired.el dired-aux.el
progmodes/grep.el minibuffer.el window.el subr.el vc.el outline.el
mouse.el diff-mode.el repeat.el image-mode.el files.el menu-bar.el
- search.texi startup.el progmodes/compile.el and 473 other files
+ search.texi startup.el display.texi and 473 other files
Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h
w32console.c w32heap.c w32inevt.c w32term.h
@@ -3422,7 +3437,7 @@ Konstantin Kharlamov: changed smerge-mode.el diff-mode.el files.el
ada-mode.el autorevert.el calc-aent.el calc-ext.el calc-lang.el
cc-mode.el cperl-mode.el css-mode.el cua-rect.el dnd.el ebnf-abn.el
ebnf-dtd.el ebnf-ebx.el emacs-module-tests.el epg.el faces.el
- gnus-art.el gtkutil.c and 27 other files
+ gnus-art.el gtkutil.c and 28 other files
Konstantin Kliakhandler: changed org-agenda.el
@@ -3598,6 +3613,8 @@ LluĆ­s Vilanova: changed ede/linux.el
Logan Perkins: changed keyboard.c
+LoĆÆc LemaĆ®tre: changed typescript-ts-mode.el
+
Luca Capello: changed mm-encode.el
Lucas Werkmeister: changed emacs.c emacs.service nxml-mode.el
@@ -3645,6 +3662,8 @@ Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el
Lynn Slater: wrote help-macro.el
+Maciej Kalandyk: changed progmodes/python.el
+
Maciek Pasternacki: changed nnrss.el
Madan Ramakrishnan: changed org-agenda.el
@@ -3935,11 +3954,15 @@ Matthew Mundell: changed calendar.texi diary-lib.el files.texi
Matthew Newton: changed imenu.el
+Matthew Smith: changed typescript-ts-mode-tests.el
+
Matthew Tromp: changed ielm.el
Matthew White: changed buffer.c bookmark-tests.el bookmark.el
test-list.bmk
+Matthew Woodcraft: changed eglot.texi
+
Matthias Dahl: changed faces.el process.c process.h
Matthias Fƶrste: changed files.el
@@ -3986,11 +4009,11 @@ Matt Simmons: changed message.el
Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el
outline.el progmodes/compile.el rx.el simple.el startup.el
-Mauro Aranda: changed wid-edit.el cus-edit.el custom.el wid-edit-tests.el
- widget.texi perl-mode.el custom-tests.el checkdoc-tests.el checkdoc.el
- cperl-mode-tests.el cus-edit-tests.el cus-theme.el customize.texi
- files.texi gnus.texi octave.el pong.el align.el auth-source.el
- autorevert.el base.el and 56 other files
+Mauro Aranda: changed wid-edit.el cus-edit.el widget.texi custom.el
+ wid-edit-tests.el perl-mode.el custom-tests.el checkdoc-tests.el
+ checkdoc.el cperl-mode-tests.el cus-edit-tests.el cus-theme.el
+ customize.texi files.texi gnus.texi octave.el pong.el align.el
+ auth-source.el autorevert.el base.el and 62 other files
Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el
@@ -4013,7 +4036,7 @@ and co-wrote tramp-cache.el tramp-sh.el tramp.el
and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c
files.el ange-ftp.el files.texi file-notify-tests.el dbus.texi
gitlab-ci.yml autorevert.el tramp-fish.el kqueue.c Dockerfile.emba
- os.texi tramp-gw.el test/Makefile.in README shell.el files-tests.el
+ os.texi tramp-gw.el test/Makefile.in README files-x.el shell.el
and 309 other files
Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h
@@ -4197,8 +4220,8 @@ Mike Kazantsev: changed erc-dcc.el
Mike Kupfer: changed mh-comp.el mh-e.el mh-mime.el mh-utils.el files.el
ftcrfont.c mh-compat.el mh-utils-tests.el emacs-mime.texi files.texi
- gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-identity.el mh-scan.el
- xftfont.c
+ gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-funcs.el mh-identity.el
+ mh-scan.el xftfont.c
Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el
@@ -4258,10 +4281,8 @@ Mohsin Kaleem: changed eglot.el
Mon Key: changed animate.el imap.el syntax.el
-Morgan J. Smith: changed gnus-group-tests.el
-
-Morgan Smith: changed image-dired.el minibuffer-tests.el minibuffer.el
- vc-git.el window.el
+Morgan Smith: changed image-dired.el doc-view.el gnus-group-tests.el
+ minibuffer-tests.el minibuffer.el url-vars.el vc-git.el window.el
Morten Welinder: wrote [many MS-DOS files] arc-mode.el desktop.el
dosfns.c internal.el msdos.h pc-win.el
@@ -4274,6 +4295,8 @@ Mosur Mohan: changed etags.c
Motorola: changed buff-menu.el
+Mou Tong: changed eglot.el
+
Muchenxuan Tong: changed org-agenda.el org-mobile.el org-timer.el
Murata Shuuichirou: changed coding.c
@@ -4341,6 +4364,8 @@ Nevin Kapur: changed nnmail.el gnus-sum.el nnimap.el gnus-group.el
Nguyen Thai Ngoc Duy: co-wrote vnvni.el
+Niall Dooley: changed eglot.el
+
Niall Mansfield: changed etags.c
Nic Ferrier: changed ert.el tramp.el
@@ -4455,7 +4480,8 @@ and changed rsz-mini.el emacs-buffer.gdb comint.el files.el Makefile
Noah Lavine: changed tramp.el
-Noah Peart: changed treesit.el
+Noah Peart: changed typescript-ts-mode.el indent.erts js.el treesit.el
+ c-ts-mode.el js-tests.el js-ts-indents.erts
Noah Swainland: changed calc.el goto-addr.el misc.texi
@@ -4720,7 +4746,8 @@ Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h
Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop
Makefile.in emacs-mail.desktop server.el configure.ac emacs.desktop
- emacs.metainfo.xml misc.texi perl-mode.el ruby-mode-tests.el vc-sccs.el
+ emacs.metainfo.xml emacsclient.1 misc.texi perl-mode.el
+ ruby-mode-tests.el vc-sccs.el
Peter Povinec: changed term.el
@@ -4760,7 +4787,7 @@ Petri Kaurinkoski: changed configure.ac iris4d.h irix6-0.h irix6-5.h
Petr Salinger: changed configure.ac gnu-kfreebsd.h
Petteri Hintsanen: changed sequences.texi Makefile.in emacs/Makefile.in
- lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in
+ lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in tab-bar.el
Phil Hagelberg: wrote ert-x-tests.el
and changed package.el pcmpl-unix.el subr.el
@@ -4802,7 +4829,7 @@ 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
pdumper.c alloc.c emacs-module.h.in emacs.c lread.c nsterm.m
bytecomp.el lisp.h seccomp-filter.c callproc.c cl-macs.el gtkutil.c
- and 188 other files
+ and 189 other files
Phillip Dixon: changed eglot.el
@@ -4851,6 +4878,8 @@ Piet van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el
Pinku Surana: changed sql.el
+Piotr Kwiecinski: changed eglot.el
+
Piotr Trojanek: changed gnutls.c process.c
Piotr Zieliński: wrote org-mouse.el
@@ -4946,8 +4975,8 @@ Randall Smith: changed dired.el
Randal Schwartz: wrote pp.el
-Randy Taylor: changed build.sh eglot.el batch.sh dockerfile-ts-mode.el
- rust-ts-mode.el go-ts-mode.el c-ts-mode.el cmake-ts-mode.el
+Randy Taylor: changed build.sh dockerfile-ts-mode.el eglot.el batch.sh
+ rust-ts-mode.el cmake-ts-mode.el go-ts-mode.el c-ts-mode.el
cus-theme.el font-lock.el java-ts-mode.el js.el json-ts-mode.el
modes.texi progmodes/python.el project.el sh-script.el
typescript-ts-mode.el yaml-ts-mode.el
@@ -5495,6 +5524,8 @@ Simon Thum: changed ob-maxima.el
Skip Collins: changed w32fns.c w32term.c w32term.h
+Skykanin-: changed eglot.el
+
Sławomir Nowaczyk: changed emacs.py progmodes/python.el TUTORIAL.pl
flyspell.el ls-lisp.el w32proc.c
@@ -5527,7 +5558,7 @@ and co-wrote help-tests.el keymap-tests.el
and changed image-dired.el efaq.texi package.el cperl-mode.el help.el
subr.el checkdoc.el bookmark.el simple.el dired.el files.el gnus.texi
dired-x.el keymap.c image-mode.el erc.el ediff-util.el speedbar.el
- woman.el browse-url.el bytecomp-tests.el and 1678 other files
+ woman.el browse-url.el bytecomp-tests.el and 1690 other files
Stefan Merten: co-wrote rst.el
@@ -5581,7 +5612,7 @@ and changed wdired.el todo-mode.texi wdired-tests.el diary-lib.el
dired.el dired-tests.el doc-view.el files.el info.el minibuffer.el
outline.el todo-test-1.todo allout.el eww.el find-dired.el frames.texi
hl-line.el menu-bar.el mouse.el otodo-mode.el simple.el
- and 63 other files
+ and 64 other files
Stephen C. Gilardi: changed configure.ac
@@ -5791,10 +5822,10 @@ Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c
Theodor Thornhill: changed typescript-ts-mode.el java-ts-mode.el
c-ts-mode.el eglot.el csharp-mode.el js.el css-mode.el project.el
- json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el EGLOT-NEWS
- README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el
- indent-bsd.erts indent.erts maintaining.texi mwheel.el
- and 5 other files
+ indent.erts json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el
+ EGLOT-NEWS README.md c-ts-mode-tests.el compile-tests.el
+ csharp-mode-tests.el go-ts-mode.el indent-bsd.erts
+ java-ts-mode-tests.el and 9 other files
Theresa O'Connor: wrote json.el
and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el
@@ -6162,7 +6193,7 @@ Vincent Bernat: changed gnus-int.el nnimap.el xsettings.c
Vincent Del Vecchio: changed info.el mh-utils.el
-Vincenzo Pupillo: changed cmake-ts-mode.el js.el typescript-ts-mode.el
+Vincenzo Pupillo: changed js.el cmake-ts-mode.el typescript-ts-mode.el
java-ts-mode.el
Vince Salvino: changed msdos.texi w32.c w32fns.c
@@ -6317,10 +6348,15 @@ W. Trevor King: changed xterm.el
Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el
+Xiaoyue Chen: changed esh-proc.el
+
Xi Lu: changed etags.c htmlfontify.el ruby-mode.el CTAGS.good_crlf
CTAGS.good_update Makefile TUTORIAL.cn crlf eww.el shortdoc.el
tramp-sh.el
+Xiyue Deng: changed emacs-lisp-intro.texi functions.texi strings.texi
+ symbols.texi
+
Xu Chunyang: changed eglot.el eww.el dom.el gud.el netrc.el
Xue Fuqiao: changed display.texi emacs-lisp-intro.texi files.texi
@@ -6383,11 +6419,11 @@ Yoshinari Nomura: changed ox-html.el ox.el
Yoshinori Koseki: wrote iimage.el
and changed fontset.el message.el nnheader.el nnmail.el
-Yuan Fu: changed treesit.el treesit.c c-ts-mode.el parsing.texi
+Yuan Fu: changed treesit.el c-ts-mode.el treesit.c parsing.texi
progmodes/python.el modes.texi js.el treesit-tests.el indent.erts
- typescript-ts-mode.el css-mode.el treesit.h configure.ac
+ typescript-ts-mode.el treesit.h css-mode.el configure.ac
java-ts-mode.el print.c sh-script.el c-ts-common.el gdb-mi.el
- rust-ts-mode.el go-ts-mode.el starter-guide and 54 other files
+ rust-ts-mode.el go-ts-mode.el starter-guide and 55 other files
Yuanle Song: changed rng-xsd.el
diff --git a/etc/DEBUG b/etc/DEBUG
index 181e24e0057..4eae090621f 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -864,11 +864,6 @@ in your ~/.emacs file. When the problem happens, exit the Emacs that
you were running, kill it, and rename the two files. Then you can start
another Emacs without clobbering those files, and use it to examine them.
-An easy way to see if too much text is being redrawn on a terminal is to
-evaluate '(setq inverse-video t)' before you try the operation you think
-will cause too much redrawing. This doesn't refresh the screen, so only
-newly drawn text is in inverse video.
-
** Debugging LessTif
If you encounter bugs whereby Emacs built with LessTif grabs all mouse
@@ -933,7 +928,10 @@ data that is modified only very rarely.)
It is also useful to look at the corrupted object or data structure in
a fresh Emacs session and compare its contents with a session that you
-are debugging.
+are debugging. This might be somewhat harder on modern systems which
+randomize addresses of running executables (the so-called Address
+Space Layout Randomization, or ASLR, feature). If you have this
+problem, see below under "How to disable ASLR".
** Debugging the TTY (non-windowed) version
@@ -1085,6 +1083,37 @@ suppresses some Valgrind false alarms during Emacs garbage collection:
Unfortunately Valgrind suppression files tend to be system-dependent,
so you will need to keep one around that matches your system.
+** How to disable ASLR
+
+Modern systems use the so-called Address Space Layout Randomization,
+(ASLR) feature, which randomizes the base address of running programs,
+making it harder for malicious software or hackers to find the address
+of some function or variable in a running program by looking at its
+executable file. This causes the address of the same symbol to be
+different across rerunning of the same program. Sometimes, it can be
+useful to disable ASLR, for example, if you want to compare objects in
+two different Emacs sessions.
+
+On GNU/Linux, you can disable ASLR temporarily with the following
+shell command:
+
+ echo 0 > /proc/sys/kernel/randomize_va_space
+
+or by running Emacs in an environment where ASLR is temporarily
+disabled:
+
+ setarch -R emacs [args...]
+
+To disable ASLR in Emacs on MS-Windows, you will have to rebuild Emacs
+while adding '-Wl,-disable-dynamicbase' to LD_SWITCH_SYSTEM_TEMACS
+variable defined in src/Makefile. Alternatively, use some tool to
+edit the PE header of the Emacs executable file and reset the
+DYNAMIC_BASE (0x40) flag in the DllCharacteristics flags recorded by
+the PE header.
+
+On macOS, there's no official way for disabling ASLR, but there are
+various hacks that can be found by searching the Internet.
+
** How to recover buffer contents from an Emacs core dump file
The file etc/emacs-buffer.gdb defines a set of GDB commands for
diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index 1f913f81236..12e7d3f6b9b 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -21,6 +21,19 @@ https://github.com/joaotavora/eglot/issues/1234.
* Changes in upcoming Eglot
+* Changes in Eglot 1.17 (25/1/2024)
+
+** Fixes to completion (github#847, github#1349)
+
+** Fix code-action gathering for some servers (github#847)
+
+** Experimental support for Eglot-only subprojects
+
+Until project.el's support for subprojects improves, github#1337
+describes a reasonably sane way to configure nested sub-projects
+within a larger one just for Eglot purposes.
+
+
* Changes in Eglot 1.16 (27/12/2023)
** Code actions can be previewed in diff format
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index c51b6f05458..d7f513addfb 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -325,6 +325,20 @@ to enable the displaying of status prefixes on the speaker nicks of
incoming chat messages. Prefixes on your speaker nick for outgoing
chat messages continue to always be present.
+** Updating user options requires cycling associated minor modes.
+During a live ERC session, you may need to disable and re-enable a
+module's minor mode via 'M-x erc-foo-mode RET' or similar before an
+option's updated value takes effect. This primarily impacts new
+options introduced by this release and existing ones whose behavior
+has changed in some way. At present, ERC does not perform this step
+automatically on your behalf, even if a change was made in a
+'Custom-mode' buffer or via 'setopt'.
+
+** New broadcast-oriented slash commands /AME, /GME, and /GMSG.
+Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME',
+and 'erc-cmd-GMSG', these new slash commands can prove handy in test
+environments.
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, fool visibility has become togglable with the new
@@ -387,8 +401,10 @@ when present, at depths beginning at 20 and ending below 80. Of most
interest to module authors is the new relative positioning of the
first three, which have been rotated leftward with respect to their
previous places in recent ERC versions (fill, button, match ,stamp).
+A similar designated range from -80 to -20 also exists and is home to
+the function 'erc-controls-highlight'.
-ERC also provisionally reserves the same depth interval for
+ERC also provisionally reserves the same depth intervals for
'erc-insert-pre-hook' and possibly other, similar hooks, but will
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
@@ -424,9 +440,12 @@ contains unique closures and thus no longer proves effective for
traversing inserted messages. For now, ERC only provides an internal
means of visiting messages, but a public interface is forthcoming.
Also affecting the 'stamp' module is the deprecation of the function
-'erc-insert-aligned' and its removal from client code. Additionally,
-the module now merges its 'invisible' property with existing ones and
-includes all white space around stamps when doing so.
+'erc-insert-aligned' and its removal from the default client's code.
+In the same library, the function 'erc-munge-invisibility-spec' has
+been renamed to 'erc-stamp--manage-local-options-state' to better
+reflect its purpose. Additionally, the module now merges its
+'invisible' property with existing ones and includes all white space
+around stamps when doing so.
This "propertizing" of surrounding white space extends to all
'stamp'-applied properties, like 'field', in all intervening space
@@ -488,6 +507,16 @@ encouraged to keep a module's name aligned with its group's as well as
the provided feature of its containing library, if only for the usual
reasons of namespace hygiene and discoverability.
+*** The function 'erc-open' no longer uses the 'TGT-LIST' parameter.
+ERC has always used the parameter to initialize the local variable
+'erc-default-recipients', which stores a list of routing targets with
+the topmost considered "active." However, since at least ERC 5.1, a
+buffer and its active target effectively mate for life, making
+'TGT-LIST', in practice, a read-only list of a single target. And
+because that target must also appear as the 'CHANNEL' parameter,
+'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being
+unruly.
+
*** ERC supports arbitrary CHANTYPES.
Specifically, channels can be prefixed with any predesignated
character, mainly to afford more flexibility to specialty services,
@@ -560,14 +589,27 @@ third-party code, the key takeaway is that more 'font-lock-face'
properties encountered in the wild may be combinations of faces rather
than lone ones.
+*** 'erc-flood-protect' no longer influences input splitting.
+This variable's role has been narrowed to rate limiting only. ERC
+used to suppress protocol line-splitting when its value was nil, but
+that's now handled by setting 'erc-split-line-length' to zero.
+
*** 'erc-pre-send-functions' visits prompt input post-split.
ERC now adjusts input lines to fall within allowed length limits
before showing hook members the result. For compatibility,
third-party code can request that the final input be adjusted again
prior to being sent. To facilitate this, the 'erc-input' object
-shared among hook members has gained a "phony" 'refoldp' slot that's
-only accessible from 'erc-pre-send-functions'. See doc string for
-details.
+shared among hook members has gained a 'refoldp' slot. See doc string
+for details.
+
+*** More flexibility in sending and displaying prompt input.
+The abnormal hook 'erc-pre-send-functions' previously married outgoing
+message text to its inserted representation in an ERC target buffer.
+Going forward, users can populate the new slot 'substxt' with
+alternate text to insert in place of the 'string' slot's contents,
+which ERC still sends to the server. This dichotomy lets users
+completely avoid the often fiddly 'erc-send-modify-hook' and friends
+for use cases like language translation and subprotocol encoding.
*** ERC's prompt survives the insertion of user input and messages.
Previously, ERC's prompt and its input marker disappeared while
@@ -657,8 +699,6 @@ by toggling a provided compatibility switch. See source code around
the function 'erc-send-action' for details.
*** Miscellaneous changes
-Two helper macros from GNU ELPA's Compat library are now available to
-third-party modules as 'erc-compat-call' and 'erc-compat-function'.
In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain
old 'info', and the "<URL:...>" entry has been removed because it was
more or less redundant. In all ERC buffers, the "<TAB>" key is now
@@ -1340,7 +1380,7 @@ reconnection attempts that ERC will make per server.
in seconds, that ERC will wait between successive reconnect attempts.
*** erc-server-send-ping-timeout: Determines when to consider a connection
-stalled and restart it. The default is after 120 seconds.
+stalled and restart it. The default is after 120 seconds.
*** erc-system-name: Determines the system name to use when logging in.
The default is to figure this out by calling `system-name'.
@@ -2301,7 +2341,7 @@ in XEmacs.
Please use M-x customize-variable RET erc-modules RET to change the
default if it does not suite your needs.
-** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers
+** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers
(formerly called OpenProjects, now FreeNode) has changed from
openprojects to freenode. You may need to update your configuration
for a successful automatic nickserv identification.
diff --git a/etc/HISTORY b/etc/HISTORY
index f6df3e6fe60..cfd4f1f6873 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -233,6 +233,10 @@ Was not actually released.
GNU Emacs 29.1 (2023-07-30) emacs-29.1
+GNU Emacs 29.2 (2024-01-18) emacs-29.2
+
+GNU Emacs 29.3 (2024-03-24) emacs-29.3
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index a6b0beb6ee5..6cefe11a2cc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -15,12 +15,6 @@ in older Emacs versions.
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'.
-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.
-
* Installation Changes in Emacs 30.1
@@ -68,6 +62,16 @@ more details.
* Incompatible Changes in Emacs 30.1
+** Tree-Sitter modes are now declared as submodes of the non-TS modes.
+In order to help the use of those Tree-Sitter modes, they are now
+declared to have the corresponding non-Tree-Sitter mode as an
+additional parent.
+This way, things like `.dir-locals.el` settings, and YASnippet
+collections of snippets automatically apply to the new Tree-Sitter modes.
+
+Note that those modes still do not inherit from the non-TS mode, so
+configuration settings installed via mode hooks are not affected.
+
+++
** URL now never sends user email addresses in HTTP requests.
Emacs never sent email addresses by default, but it used to be
@@ -82,7 +86,7 @@ see the variable 'url-request-extra-headers'.
+++
** 'completion-auto-help' now affects 'icomplete-in-buffer'.
-Previously, completion-auto-help mostly affected only minibuffer
+Previously, 'completion-auto-help' mostly affected only minibuffer
completion. Now, if 'completion-auto-help' has the value 'lazy', then
Icomplete's in-buffer display of possible completions will only appear
after the 'completion-at-point' command has been invoked twice, and if
@@ -91,12 +95,12 @@ completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure
'completion-auto-help' is not customized to 'lazy' or nil.
+++
-** The *Completions* buffer now always accompanies 'icomplete-in-buffer'.
-Previously, it was not consistent when the *Completions* buffer would
-appear when using 'icomplete-in-buffer'. Now the *Completions* buffer
+** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'.
+Previously, it was not consistent whether the "*Completions*" buffer would
+appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer
and Icomplete's in-buffer display of possible completions always
appear together. If you would prefer to see only Icomplete's
-in-buffer display, and not the *Completions* buffer, you can add this
+in-buffer display, and not the "*Completions*" buffer, you can add this
to your init:
(advice-add 'completion-at-point :after #'minibuffer-hide-completions)
@@ -104,6 +108,16 @@ to your init:
* Changes in Emacs 30.1
+** 'describe-function' now shows the type of the function object.
+The text used to say things like "car is is a built-in function"
+whereas it now says "car is a primitive-function" where "primitive-function"
+is the symbol returned by `cl-type-of` and you can click on it to get
+information about that type.
+
+** 'advice-remove' is now an interactive command.
+When called interactively, 'advice-remove' now prompts for an advised
+function to the advice to remove.
+
** Emacs now supports Unicode Standard version 15.1.
** Network Security Manager
@@ -132,6 +146,17 @@ the signature) the automatically inferred function type as well.
This user option controls outline visibility in the output buffer of
'describe-bindings' when 'describe-bindings-outline' is non-nil.
+---
+*** 'C-h m' ('describe-mode') uses outlining by default.
+Set 'describe-mode-outline' to nil to get back the old behavior.
+
+** Outline Mode
+
++++
+*** 'outline-minor-mode' is supported in tree-sitter major modes.
+It can be used in all tree-sitter major modes that set either the
+variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'.
+
** X selection requests are now handled much faster and asynchronously.
This means it should be less necessary to disable the likes of
'select-active-regions' when Emacs is running over a slow network
@@ -258,12 +283,35 @@ Anything following the symbol 'mode-line-format-right-align' in
right-aligned to is controlled by the new user option
'mode-line-right-align-edge'.
+** Windows
+
+*** New action alist entry 'post-command-select-window' for 'display-buffer'.
+It specifies whether the window of the displayed buffer should be
+selected or deselected at the end of executing the current command.
+
++++
+*** New variable 'window-restore-killed-buffer-windows'.
+It specifies how 'set-window-configuration' and 'window-state-put'
+should proceed with windows whose buffer was killed after the
+corresponding configuration or state was recorded.
+
** Tab Bars and Tab Lines
+---
+*** New user option 'tab-bar-select-restore-windows'.
+It defines what to do with windows whose buffer was killed
+since the tab was last selected. By default it displays
+a placeholder buffer that provides information about the name
+of the killed buffer that was displayed in that window.
+
+---
*** New user option 'tab-bar-tab-name-format-functions'.
It can be used to add, remove and reorder functions that change
the appearance of every tab on the tab bar.
+---
+*** New hook 'tab-bar-tab-post-select-functions'.
+
+++
** New optional argument for modifying directory-local variables.
The commands 'add-dir-local-variable', 'delete-dir-local-variable' and
@@ -301,13 +349,36 @@ between the auto save file and the current file.
---
** 'ffap-lax-url' now defaults to nil.
-Previously, it was set to 'ffap-lax-url' to t but this broke remote file
-name detection.
+Previously, it was set to t but this broke remote file name detection.
+
++++
+** Multi-character key echo now ends with a suggestion to use Help.
+Customize 'echo-keystrokes-help' to nil to prevent that.
+
++++
+** 'read-passwd' can toggle the visibility of passwords.
+Use 'TAB' in the minibuffer to show or hide the password. Likewise,
+there is an icon on the mode-line, which toggles the visibility of the
+password when clicking with 'mouse-1'.
* Editing Changes in Emacs 30.1
+++
+** New minor mode 'visual-wrap-prefix-mode'.
+When enabled, continuation lines displayed for a wrapped long line
+will receive a 'wrap-prefix' automatically computed from the line's
+surrounding context, such that continuation lines are indented on
+display as if they were filled with 'M-q' or similar. Unlike 'M-q',
+the indentation only happens on display, and doesn't change the buffer
+text in any way. The global minor mode
+'global-visual-wrap-prefix-mode' enables this minor mode in all
+buffers.
+
+(This minor mode is the 'adaptive-wrap' ELPA package renamed and
+lightly edited for inclusion in Emacs.)
+
++++
** New user option 'gud-highlight-current-line'.
When enabled, Gud will visually emphasize the line being executed upon
pauses in the debugee's execution, such as those occasioned by
@@ -392,7 +463,11 @@ functions in CJK locales.
---
*** New input methods for the Urdu, Pashto, and Sindhi languages.
-These languages are spoken in Pakistan and Afganistan.
+These languages are spoken in Pakistan and Afghanistan.
+
+---
+*** New input method "english-colemak".
+This input method supports the Colemak keyboard layout.
*** Additional 'C-x 8' key translations for "Ʀ" and "Ɔ".
These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E',
@@ -402,6 +477,41 @@ respectively, in addition to the existing translations 'C-x 8 / e' and
* Changes in Specialized Modes and Packages in Emacs 30.1
+---
+** Titdic-cnv
+Most of the variables and functions in the file have been renamed to
+make sure they all use a 'tit-' namespace prefix.
+
+---
+** Trace
+In batch mode, tracing now sends the trace to stdout.
+
++++
+** Mwheel
+The 'wheel-up/down/left/right' events are now bound unconditionally,
+and the 'mouse-wheel-up/down/left/right-event' variables are thus used
+only to specify the 'mouse-4/5/6/7' events generated by older
+configurations such as X11 when the X server does not support at least
+version 2.1 of the X Input Extension, and 'xterm-mouse-mode'.
+
+** 'xterm-mouse-mode'
+This mode now emits 'wheel-up/down/right/left' events instead of
+'mouse-4/5/6/7' events for the mouse wheel.
+It uses the 'mouse-wheel-up/down/left/right-event'
+variables to decide which button maps to which wheel event (if any).
+
+** Info
+
+---
+*** New user option 'Info-url-alist'.
+This user option associates manual names with URLs. It affects the
+'Info-goto-node-web' command. By default, associations for all
+Emacs-included manuals are set. Further associations can be added for
+arbitrary Info manuals.
+
+*** Emacs can now display Info manuals compressed with 'lzip'.
+This requires the 'lzip' program to be installed on your system.
+
+++
** New command 'lldb'.
Run the LLDB debugger, analogous to the 'gud-gdb' command.
@@ -448,6 +558,11 @@ This is because it partly acts by modifying other rules which may
occasionally be surprising. It can be re-enabled by adding 'omake' to
'compilation-error-regexp-alist'.
+*** Lua errors and stack traces are now recognized.
+Compilation mode now recognizes Lua language errors and stack traces.
+Every Lua error is recognized as a compilation error, and every Lua
+stack frame is recognized as a compilation info.
+
** Project
+++
@@ -524,6 +639,14 @@ It allows tweaking the thresholds for rename and copy detection.
** Diff mode
+---
+*** New user option 'diff-refine-nonmodified'.
+When this is non-nil, 'diff-refine' will highlight lines that were added
+or removed in their entirety (as opposed to modified lines, where some
+parts of the line were modified), using the same faces as for
+highlighting the words added and removed within modified lines. The
+default value is nil.
+
+++
*** 'diff-ignore-whitespace-hunk' can now be applied to all hunks.
When called with a non-nil prefix argument,
@@ -582,6 +705,12 @@ marked or clicked on files according to the OS conventions. For
example, on systems supporting XDG, this runs 'xdg-open' on the
files.
+*** The default value of 'dired-omit-size-limit' was increased.
+After performance improvements to omitting in large directories, the new
+default value is 300k, up from 100k. This means 'dired-omit-mode' will
+omit files in directories whose directory listing is up to 300 kilobytes
+in size.
+
+++
*** 'dired-listing-switches' handles connection-local values if exist.
This allows to customize different switches for different remote machines.
@@ -591,7 +720,7 @@ This allows to customize different switches for different remote machines.
+++
*** New mode of prompting for register names and showing preview.
The new user option 'register-use-preview' can be customized to the
-value t to request a different user interface of prompting for
+value t or insist to request a different user interface of prompting for
register names and previewing the registers: Emacs will require
confirmation for overwriting the value of a register, and will show
the preview of registers without delay. You can also customize this
@@ -630,12 +759,28 @@ For more information, see the "(eshell) Built-ins" node in the Eshell
manual.
+++
+*** Eshell's 'env' command now supports running commands.
+Like in many other shells, Eshell's 'env' command now lets you run a
+command passed as arguments to 'env'. If you pass any initial
+arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to
+'VALUE' before running the command.
+
+---
+*** Eshell's 'umask' command now supports setting the mask symbolically.
+Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask'
+command, which will give write permission for owners of newly-created
+files and deny read permission for users who are not members of the
+file's group. See the Info node "(coreutils) File permissions" for
+more information on this notation.
+
++++
*** New special reference type '#<marker POSITION BUFFER>'.
This special reference type returns a marker at 'POSITION' in
'BUFFER'. You can insert it by typing or using the new interactive
-command 'eshell-insert-marker'. You can also insert markers of any
-type with the new command 'eshell-insert-special-reference'. See the
-"(eshell) Arguments" node in the Eshell manual for more details.
+command 'eshell-insert-marker'. You can also insert special
+references of any type using the new interactive command
+'eshell-insert-special-reference'. See the "(eshell) Arguments" node
+in the Eshell manual for more details.
+++
*** New splice operator for Eshell dollar expansions.
@@ -740,6 +885,19 @@ When 'completions-sort' is set to 'historical', completion candidates
will be first sorted alphabetically, and then re-sorted by their order
in the minibuffer history, with more recent candidates appearing first.
++++
+*** 'completion-category-overrides' supports more metadata.
+The new supported completion properties are 'cycle-sort-function',
+'display-sort-function', 'annotation-function', 'affixation-function',
+and 'group-function'. You can now customize them for any category in
+'completion-category-overrides' that will override the properties
+defined in completion metadata.
+
++++
+*** 'completion-extra-properties' supports more metadata.
+The new supported completion properties are 'category',
+'group-function', 'display-sort-function', and 'cycle-sort-function'.
+
** Pcomplete
---
@@ -788,6 +946,16 @@ mode line. 'header' will display in the header line;
** Tramp
+++
+*** New connection method "androidsu".
+This provides access to system files with elevated privileges granted by
+the idiosyncratic 'su' implementations and system utilities customary on
+Android.
+
++++
+*** New connection methods "dockercp" and "podmancp".
+These are the external methods counterparts of "docker" and "podman".
+
++++
*** New connection methods "toolbox" and "flatpak".
They allow accessing system containers provided by Toolbox or
sandboxes provided by Flatpak.
@@ -885,6 +1053,37 @@ When invoked with the prefix argument ('C-u'),
This is useful for continuing reading the URL in the current buffer
when the new URL is fetched.
+---
+*** History navigation in EWW now works like other browsers.
+Previously, when navigating back and forward through page history, EWW
+would add a duplicate entry to the end of the history list each time.
+This made it impossible to navigate to the "end" of the history list.
+Now, navigating through history in EWW simply changes your position in
+the history list, allowing you to reach the end as expected. In
+addition, when browsing to a new page from a "historical" one (i.e. a
+page loaded by navigating back through history), EWW deletes the history
+entries newer than the current page. To change the behavior when
+browsing from "historical" pages, you can customize
+'eww-before-browse-history-function'.
+
++++
+*** 'eww-readable' now toggles display of the readable parts of a web page.
+When called interactively, 'eww-readable' toggles whether to display
+only the readable parts of a page or the full page. With a positive
+prefix argument, it always displays the readable parts, and with a zero
+or negative prefix, it always displays the full page.
+
++++
+*** New option 'eww-readable-urls'.
+This is a list of regular expressions matching the URLs where EWW should
+display only the readable parts by default. For more details, see
+"(eww) Basics" in the EWW manual.
+
+---
+*** New option 'eww-readable-adds-to-history'.
+When non-nil (the default), calling 'eww-readable' adds a new entry to
+the EWW page history.
+
** go-ts-mode
+++
@@ -973,6 +1172,12 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Flyspell
+
+*** New user option 'flyspell-check-changes'.
+When non-nil, Flyspell mode spell-checks only words that you edited; it
+does not check unedited words just because you move point across them.
+
** JS mode.
The binding 'M-.' has been removed from the major mode keymaps in
'js-mode' and 'js-ts-mode', having it default to the global binding
@@ -980,6 +1185,11 @@ which calls 'xref-find-definitions'. If the previous one worked
better for you, use 'define-key' in your init script to bind
'js-find-symbol' to that combination again.
+** Json mode.
+'js-json-mode' does not derive from 'js-mode' any more so as not
+to confuse tools like Eglot or YASnippet into thinking that those
+buffers contain Javascript code.
+
** Python mode
---
@@ -1015,6 +1225,12 @@ The gmane.org website is, sadly, down since a number of years with no
prospect of it coming back. Therefore, it is no longer valid to set
the user option 'nnweb-type' to 'gmane'.
+---
+*** New user option 'gnus-mode-line-logo'.
+This allows the user to either disable the display of any logo or
+specify which logo will be displayed as part of the
+buffer-identification in the mode-line of Gnus buffers.
+
** Rmail
---
@@ -1086,6 +1302,11 @@ Previously, the '@' character, which normally has 'symbol' syntax,
would combine with a following Lisp symbol and interfere with symbol
searching.
+---
+*** 'emacs-lisp-docstring-fill-column' now defaults to 72.
+It was previously 65. The new default formats documentation strings to
+fit on fewer lines without negatively impacting readability.
+
** CPerl mode
---
@@ -1104,6 +1325,11 @@ value of 'perl-code' is useful for trailing POD and for AutoSplit
modules, the value 'comment' makes CPerl mode treat trailers as
comment, like Perl mode does.
+*** New command 'cperl-file-style'.
+This command sets the indentation style for the current buffer. To
+change the default style, either use the user option with the same name
+or use the command 'cperl-set-style'.
+
*** Commands using the Perl info page are obsolete.
The Perl documentation in info format is no longer distributed with
Perl or on CPAN since more than 10 years. Perl documentation can be
@@ -1142,6 +1368,18 @@ without specifying a file, like this:
(notifications-notify
:title "I am playing music" :app-icon 'multimedia-player)
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
** Image Dired
*** New user option 'image-dired-thumb-naming'.
@@ -1192,6 +1430,14 @@ When this is non-nil, the lines of key sequences are displayed with
the most recent line first. This is can be useful when working with
macros with many lines, such as from 'kmacro-edit-lossage'.
+** Proced
+
+---
+*** More control on automatic update of Proced buffers.
+The user option 'proced-auto-update-flag' can now be set to 2 additional
+values, which control automatic updates of Proced buffers that are not
+displayed in some window.
+
** Miscellaneous
---
@@ -1210,12 +1456,62 @@ will return the URL for that bug.
This allows for rcirc logs to use a custom timestamp format, than the
chat buffers use by default.
+---
+*** New user option 'Buffer-menu-group-by'.
+It controls how buffers are divided into groups that are displayed with
+headings using Outline minor mode.
+
++++
+*** New command 'Buffer-menu-toggle-internal'.
+This command toggles the display of internal buffers in Buffer Menu mode;
+that is, buffers not visiting a file and whose names start with a space.
+Previously, such buffers were never shown. This command is bound to 'I'
+in Buffer Menu mode.
+
** Customize
+++
*** New command 'customize-dirlocals'.
This command pops up a buffer to edit the settings in ".dir-locals.el".
+---
+** New command 'customize-toggle-option'.
+This command can toggle boolean options for the duration of a session.
+
+** Calc
+
++++
+*** Calc parses fractions written using U+2044 FRACTION SLASH.
+Fractions of the form "123ā„456" are handled as if written "123:456".
+Note in particular the difference in behavior from U+2215 DIVISION SLASH
+and U+002F SOLIDUS, which result in division rather than a rational
+fraction. You may also be interested to know that precomposed fraction
+characters, such as Ā½ (U+00BD VULGAR FRACTION ONE HALF), are also
+recognized as rational fractions. They have been since 2004, but it
+looks like it was never mentioned in the NEWS, or even the manual.
+
+** IELM
+
+---
+*** IELM now remembers input history between sessions.
+The new user option 'ielm-history-file-name' is the name of the file
+where IELM input history will be saved. Customize it to nil to revert
+to the old behavior of not remembering input history between sessions.
+
+** EasyPG
+
++++
+*** New user option 'epa-keys-select-method'.
+This allows the user to customize the key selection method, which can be
+either by using a pop-up buffer or from the minibuffer. The pop-up
+buffer method is the default, which preserves previous behavior.
+
+** Xwidget Webkit
+
++++
+*** New user option 'xwidget-webkit-disable-javascript'.
+This allows disabling JavaScript in xwidget Webkit sessions.
+
* New Modes and Packages in Emacs 30.1
@@ -1265,17 +1561,41 @@ the needs of users with red-green or blue-yellow color deficiency.
The Info manual "(modus-themes) Top" describes the details and
showcases all their customization options.
++++
+** New global minor mode 'etags-regen-mode'.
+This minor mode generates the tags table automatically based on the
+current project configuration, and later updates it as you edit the
+files and save the changes.
+
++++
+** New package Compat.
+Emacs now comes with a stub implementation of the
+forwards-compatibility Compat package from GNU ELPA. This allows
+built-in packages to use the library more effectively, and helps
+preventing the installation of Compat if unnecessary.
+
* Incompatible Lisp Changes in Emacs 30.1
+---
+** Old derived.el functions removed.
+The following functions have been deleted because they were only used
+by code compiled with Emacs<21:
+'derived-mode-init-mode-variables', 'derived-mode-merge-abbrev-tables',
+'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables',
+'derived-mode-run-hooks', 'derived-mode-set-abbrev-table',
+'derived-mode-set-keymap', 'derived-mode-set-syntax-table',
+'derived-mode-setup-function-name'.
+
+++
** 'M-TAB' now invokes 'completion-at-point' also in Text mode.
-Text mode no longer binds 'M-TAB' to 'ispell-complete-word', and
-instead this mode arranges for 'completion-at-point', globally bound
-to 'M-TAB', to perform word completion as well. If you want 'M-TAB'
-to invoke 'ispell-complete-word', as it did in previous Emacs
-versions, customize the new user option
-'text-mode-meta-tab-ispell-complete-word' to non-nil.
+By default, Text mode no longer binds 'M-TAB' to
+'ispell-complete-word'. Instead, this mode arranges for
+'completion-at-point', globally bound to 'M-TAB', to perform word
+completion as well. You can have Text mode bind 'M-TAB' to
+'ispell-complete-word' as it did in previous Emacs versions, or
+disable Ispell word completion in Text mode altogether, by customizing
+the new user option 'text-mode-ispell-word-completion'.
** 'pp' and 'pp-to-string' now always include a terminating newline.
In the past they included a terminating newline in most cases but not all.
@@ -1377,6 +1697,42 @@ values.
* Lisp Changes in Emacs 30.1
+** New function 'help-fns-function-name'.
+For named functions, it just returns the name and otherwise
+it returns a short "unique" string that identifies the function.
+In either case, the string is propertized so clicking on it gives
+further details.
+
+** New function 'cl-type-of'.
+This function is like 'type-of' except that it sometimes returns
+a more precise type. For example, for nil and t it returns 'null'
+and 'boolean' respectively, instead of just 'symbol'.
+
+** New functions `primitive-function-p` and `cl-functionp`.
+`primitive-function-p` is like `subr-primitive-p` except that it returns
+t only if the argument is a function rather than a special-form,
+and `cl-functionp` is like `functionp` except it return nil
+for lists and symbols.
+
+** Built-in types have now corresponding classes.
+At the Lisp level, this means that things like (cl-find-class 'integer)
+will now return a class object, and at the UI level it means that
+things like 'C-h o integer RET' will show some information about that type.
+
+** New var 'major-mode-remap-defaults' and function 'major-mode-remap'.
+The first is like Emacs-29's 'major-mode-remap-alist' but to be set by
+packages (instead of users). The second looks up those two variables.
+
++++
+** Pcase's functions (in 'pred' and 'app') can specify the argument position.
+For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'.
+
++++
+** 'define-advice' now sets the new advice's 'name' property to NAME.
+Named advices defined with 'define-advice' can now be removed with
+'(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL
+SYMBOL@NAME)'.
+
+++
** New function 'require-with-check' to detect new versions shadowing.
This is like 'require', but it checks whether the argument 'feature'
@@ -1384,6 +1740,18 @@ is already loaded, in which case it either signals an error or
forcibly reloads the file that defines the feature.
+++
+** New variable 'lisp-eval-depth-reserve'.
+It puts a limit to the amount by which Emacs can temporarily increase
+'max-lisp-eval-depth' when handling signals.
+
++++
+** New special form 'handler-bind'.
+It provides a functionality similar to 'condition-case' except it runs
+the handler code without unwinding the stack, such that we can record
+the backtrace and other dynamic state at the point of the error. See
+the Info node "(elisp) Handling Errors".
+
++++
** New 'pop-up-frames' action alist entry for 'display-buffer'.
This has the same effect as the variable of the same name and takes
precedence over the variable when present.
@@ -1392,6 +1760,41 @@ precedence over the variable when present.
Mostly used internally to do a kind of topological sort of
inheritance hierarchies.
++++
+** New polymorphic comparison function 'value<'.
+This function returns non-nil if the first argument is less than the
+second. It works for any two values of the same type with reasonable
+ordering for numbers, strings, symbols, bool-vectors, markers, buffers
+and processes. Conses, lists, vectors and records are ordered
+lexicographically.
+It is intended as a convenient ordering predicate for sorting, and is
+likely to be faster than hand-written Lisp functions.
+
++++
+** New 'sort' arguments and features.
+The 'sort' function can now be called using the signature
+
+ (sort SEQ &rest KEYWORD-ARGUMENTS)
+
+where arguments after the first are keyword/value pairs, all optional:
+':key' specifies a function that produces the sorting key from an element,
+':lessp' specifies the ordering predicate, defaulting to 'value<',
+':reverse' is used to reverse the sorting order,
+':in-place is used for in-place sorting, as the default is now to
+sort a copy of the input.
+
+The new signature is less error-prone and reduces the need to write
+ordering predicates by hand. We recommend that you use the ':key'
+argument instead of ':lessp' unless a suitable ordering predicate is
+already available. This can also be used for multi-key sorting:
+
+ (sort seq :key (lambda (x) (list (age x) (size x) (cost x))))
+
+sorts by the return value of 'age', then by 'size', then by 'cost'.
+
+The old signature, '(sort SEQ PREDICATE)', can still be used and sorts
+its input in-place as before.
+
** New API for 'derived-mode-p' and control of the graph of major modes.
*** 'derived-mode-p' now takes the list of modes as a single argument.
@@ -1513,6 +1916,16 @@ styles to skip eager fontification of completion candidates, which
improves performance. Such a Lisp program can then use the
'completion-lazy-hilit' function to fontify candidates just in time.
+** New primitive 'buffer-last-name'.
+It returns the name of a buffer before the last time it was renamed or
+killed.
+
+** New primitive 'marker-last-position'.
+It returns the last position of a marker in its buffer even if that
+buffer has been killed. ('marker-position' would return nil in that
+case.)
+
+
** Functions and variables to transpose sexps
+++
@@ -1552,6 +1965,22 @@ Tree-sitter conditionally sets 'forward-sexp-function' for major modes
that have defined 'sexp' in 'treesit-thing-settings' to enable
sexp-related motion commands.
++++
+** Returned strings are never docstrings.
+Functions and macros whose bodies consist of a single string literal now
+only return that string; it is not used as a docstring. Example:
+
+ (defun sing-a-song ()
+ "Sing a song.")
+
+The above function returns the string '"Sing a song."' but has no
+docstring. Previously, that string was used as both a docstring and
+return value, which was never what the programmer wanted. If you want
+the string to be a docstring, add an explicit return value.
+
+This change applies to 'defun', 'defsubst', 'defmacro' and 'lambda'
+forms; other defining forms such as 'cl-defun' already worked this way.
+
** New or changed byte-compilation warnings
---
@@ -1706,15 +2135,46 @@ The warning will only be issued for calls to functions declared
'important-return-value' or 'side-effect-free' (but not 'error-free').
---
+*** Warn about docstrings that contain control characters.
+The compiler now warns about docstrings with control characters other
+than newline and tab. This is often a result of improper escaping.
+Example:
+
+ (defun my-fun ()
+ "Uses c:\remote\dir\files and the key \C-x."
+ ...)
+
+where the docstring contains the four control characters 'CR', 'DEL',
+'FF' and 'C-x'.
+
+The warning name is 'docstrings-control-chars'.
+
+---
*** The warning about wide docstrings can now be disabled separately.
Its warning name is 'docstrings-wide'.
+---
+** New user option 'native-comp-async-warnings-errors-kind'.
+It allows control of what kinds of warnings and errors from asynchronous
+native compilation are reported to the parent Emacs process. The
+default is to report all errors and only important warnings. If you
+were used to customizing 'native-comp-async-report-warnings-errors' to
+nil or 'silent', we suggest that you now leave it at its default value,
+and see if you get only warnings that matter.
+
+++
** New function declaration and property 'important-return-value'.
The declaration '(important-return-value t)' sets the
'important-return-value' property which indicates that the function
return value should probably not be thrown away implicitly.
+** Bytecode is now always loaded eagerly.
+Bytecode compiled with older Emacs versions for lazy loading using
+'byte-compile-dynamic' is now loaded all at once.
+As a consequence, 'fetch-bytecode' has no use, does nothing, and is
+now obsolete. The variable 'byte-compile-dynamic' has no effect any
+more; compilation will always yield bytecode for eager loading.
+
+++
** New functions 'file-user-uid' and 'file-group-gid'.
These functions are like 'user-uid' and 'group-gid', respectively, but
@@ -1755,9 +2215,98 @@ The former macro returns non-nil if a variable has a connection-local
binding. The latter macro returns the connection-local value of a
variable if any, or its current value.
+** Hash tables
+
++++
+*** ':rehash-size' and ':rehash-threshold' args no longer have any effect.
+These keyword arguments are now ignored by 'make-hash-table'. Emacs
+manages the memory for all hash table objects in the same way.
+The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold'
+remain for compatibility but now always return the old default values.
+
++++
+*** The printed representation has been shrunk and simplified.
+The 'test' parameter is omitted if it is 'eql' (the default), as is
+'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are
+always omitted, and ignored if present when the object is read back in.
+
+** Obarrays
+
++++
+*** New obarray type.
+Obarrays are now represented by an opaque type instead of using vectors.
+They are created by 'obarray-make' and manage their internal storage
+automatically, which means that the size parameter to 'obarray-make' can
+safely be omitted. That is, they do not become slower as they fill up.
+
+The old vector representation is still accepted by functions operating
+on obarrays, but 'obarrayp' only returns t for obarray objects.
+'type-of' now returns 'obarray' for obarray objects.
+
+Old code which (incorrectly) created "obarrays" as Lisp vectors filled
+with something other than 0, as in '(make-vector N nil)', will no longer
+work, and should be rewritten to use 'obarray-make'. Alternatively, you
+can fill the vector with 0.
+
++++
+*** New function 'obarray-clear' removes all symbols from an obarray.
+
+---
+*** 'obarray-size' and 'obarray-default-size' are now obsolete.
+They pertained to the internal storage size which is now irrelevant.
+
++++
+** 'treesit-install-language-grammar' can handle local directory instead of URL.
+It is now possible to pass a directory of a local repository as URL
+inside 'treesit-language-source-alist', so that calling
+'treesit-install-language-grammar' would avoid cloning the repository.
+It may be useful, for example, for the purposes of bisecting a
+treesitter grammar.
+
++++
+** New buffer-local variable 'tabulated-list-groups'.
+It controls display and separate sorting of groups of entries.
+
+---
+** New text property 'context-menu-functions'.
+Like the variable with the same name, it adds menus from the list that
+is the value of the property to context menus shown when clicking on the
+text which as this property.
+
+---
+** Detecting the end of an iteration of a keyboard macro
+'read-event', 'read-char', and 'read-char-exclusive' no longer return -1
+when called at the end of an iteration of a the execution of a keyboard
+macro. Instead, they will transparently continue reading available input
+(e.g., from the keyboard). If you need to detect the end of a macro
+iteration, check the following condition before calling one of the
+aforementioned functions:
+
+ (and (arrayp executing-kbd-macro)
+ (>= executing-kbd-macro-index (length executing-kbd-macro))))
+
++++
+** 'vtable-update-object' updates an existing object with just two arguments.
+It is now possible to update the representation of an object in a vtable
+by calling 'vtable-update-object' with just the vtable and the object as
+arguments. (Previously the 'old-object' argument was required which, in
+this case, would mean repeating the object in the argument list.) When
+replacing an object with a different one, passing both the new and old
+objects is still necessary.
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
+** MS-Windows
+
++++
+*** You can now opt out of following the system's Dark mode.
+By default, Emacs on MS-Windows follows the system's Dark mode for its
+title bars' and scroll bars' appearance. If the new user option
+'w32-follow-system-dark-mode' is customized to the nil value, Emacs
+will disregard the system's Dark mode and will always use the default
+Light mode.
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index 3c5e9569b49..f647809074b 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -1158,6 +1158,11 @@ few or no entries have changed.
* New Modes and Packages in Emacs 25.1
+** New preloaded package 'obarray'
+
+Provides obarray operations under the 'obarray-' prefix, such as
+'obarray-make', 'obarrayp', and 'obarray-map'.
+
** pinentry.el allows GnuPG passphrase to be prompted through the
minibuffer instead of a graphical dialog, depending on whether the gpg
command is called from Emacs (i.e., INSIDE_EMACS environment variable
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 2617e1a48f4..080568433c2 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -28,7 +28,6 @@ If set to a non-nil value which isn't a function, resize the mini
frame using the new function 'fit-mini-frame-to-buffer' which won't
skip leading or trailing empty lines of the buffer.
-+++
** Update IRC-related references to point to Libera.Chat.
In June 2021, the Free Software Foundation and the GNU Project moved
their official IRC channels from the Freenode network to Libera.Chat
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index 069661866ce..3f94b0d4634 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -15,11 +15,28 @@ in older Emacs versions.
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'.
-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.
+
+* Changes in Emacs 29.3
+Emacs 29.3 is an emergency bugfix release intended to fix several
+security vulnerabilities described below.
+
+** Arbitrary Lisp code is no longer evaluated as part of turning on Org mode.
+This is for security reasons, to avoid evaluating malicious Lisp code.
+
+** New buffer-local variable 'untrusted-content'.
+When this is non-nil, Lisp programs should treat buffer contents with
+extra caution.
+
+** Gnus now treats inline MIME contents as untrusted.
+To get back previous insecure behavior, 'untrusted-content' should be
+reset to nil in the buffer.
+
+** LaTeX preview is now by default disabled for email attachments.
+To get back previous insecure behavior, set the variable
+'org--latex-preview-when-risky' to a non-nil value.
+
+** Org mode now considers contents of remote files to be untrusted.
+Remote files are recognized by calling 'file-remote-p'.
* Installation Changes in Emacs 29.2
@@ -43,37 +60,25 @@ more details.
* Changes in Emacs 29.2
-
-* Editing Changes in Emacs 29.2
+This is a bug-fix release with no new features.
* Changes in Specialized Modes and Packages in Emacs 29.2
** Tramp
-+++
*** New user option 'tramp-show-ad-hoc-proxies'.
When non-nil, ad-hoc definitions are kept in remote file names instead
of showing the shortcuts.
-* New Modes and Packages in Emacs 29.2
-
-
* Incompatible Lisp Changes in Emacs 29.2
-+++
** 'with-sqlite-transaction' rolls back changes if its BODY fails.
If the BODY of the macro signals an error, or committing the results
of the transaction fails, the changes will now be rolled back.
-* Lisp Changes in Emacs 29.2
-
-
-* Changes in Emacs 29.2 on Non-Free Operating Systems
-
-
* Installation Changes in Emacs 29.1
** Ahead-of-time native compilation can now be requested via configure.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 4d3b236ab03..19456640299 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -432,7 +432,7 @@ than the corresponding .el file.
Alternatively, if you set the option 'load-prefer-newer' non-nil,
Emacs will load whichever version of a file is the newest.
-*** Watch out for the EMACSLOADPATH environment variable
+*** Watch out for the EMACSLOADPATH environment variable.
EMACSLOADPATH overrides which directories the function "load" will search.
@@ -441,7 +441,7 @@ environment.
** Keyboard problems
-*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier
+*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier.
If you arrange for the Wayland compositor to send the Hyper key
modifier (e.g., via XKB customizations), the Hyper modifier will still
@@ -452,6 +452,17 @@ Since GDK 3.x is no longer developed, this bug in GDK will probably
never be solved. And the Emacs PGTK build cannot yet support GTK4,
where this problem is reportedly solved.
+*** Emacs built with GTK lags in its response to keyboard input.
+This can happen when input methods are used. It happens because Emacs
+behaves in an unconventional way with respect to GTK input methods: it
+registers to receive keyboard input as unprocessed key events with
+metadata (as opposed to receiving them as text strings). Most GTK
+programs use the latter approach, so some modern input methods have
+bugs and misbehave when faced with the way Emacs does it.
+
+A workaround is to set GTK_IM_MODULE=none in the environment, or maybe
+find a different input method without these problems.
+
*** Unable to enter the M-| key on some German keyboards.
Some users have reported that M-| suffers from "keyboard ghosting".
This can't be fixed by Emacs, as the keypress never gets passed to it
@@ -476,6 +487,29 @@ You are probably using a shell that doesn't support job control, even
though the system itself is capable of it. Either use a different shell,
or set the variable 'cannot-suspend' to a non-nil value.
+*** Emacs running on WSL receives stray characters as input.
+
+For example, you could see Emacs inserting 'z' characters even though
+nothing is typed on the keyboard, and even if you unplug the keyboard.
+
+The reason is a bug in the WSL X server's handling of key-press and
+key-repeat events. A workaround is to use the Cygwin or native
+MS-Windows build of Emacs instead.
+
+*** On MS-Windows, the Windows key gets "stuck".
+When this problem happens, Windows behaves as if the Windows key were
+permanently pressed down. This could be a side effect of Emacs on
+MS-Windows hooking keyboard input on a low level, in order to support
+registering the Windows keys as hot keys. If that hook takes too much
+time for some reason, Windows can decide to remove the hook, which
+then has this effect.
+
+This is arguably a bug in Emacs, for which we don't yet have a
+solution. To work around, set the 'LowLevelHooksTimeout' value in the
+registry key "HKEY_CURRENT_USER\Control Panel\Desktop" to a number
+higher than 200 msec; the maximum allowed value is 1000 msec (create
+the value if it doesn't exist under that key).
+
** Mailers and other helper programs
*** movemail compiled with POP support can't connect to the POP server.
@@ -530,11 +564,10 @@ The solution is to use gawk (GNU awk).
*** Saving a file encrypted with GnuPG via EasyPG hangs.
This is known to happen with GnuPG v2.4.1. The only known workaround
-is to downgrade to a version of GnuPG older than 2.4.1 (or, in the
-future, upgrade to a newer version which solves the problem, when such
-a fixed version becomes available). Note that GnuPG v2.2.42 and later
-also has this problem, so you should also avoid those later 2.2.4x
-versions; v2.2.41 is reported to work fine.
+is to downgrade to a version of GnuPG older than 2.4.1, or upgrade to
+version 2.4.4 and newer, which reportedly solves the problem. Note
+that GnuPG v2.2.42 and later also has this problem, so you should also
+avoid those later 2.2.4x versions; v2.2.41 is reported to work fine.
*** EasyPG loopback pinentry does not work with gpgsm.
@@ -546,15 +579,6 @@ As a workaround, input the passphrase with a GUI-capable pinentry
program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you
can use the 'pinentry' package from Emacs 25.
-*** Emacs running on WSL receives stray characters as input.
-
-For example, you could see Emacs inserting 'z' characters even though
-nothing is typed on the keyboard, and even if you unplug the keyboard.
-
-The reason is a bug in the WSL X server's handling of key-press and
-key-repeat events. A workaround is to use the Cygwin or native
-MS-Windows build of Emacs instead.
-
** Problems with hostname resolution
*** Emacs does not know your host's fully-qualified domain name.
@@ -3406,26 +3430,22 @@ this and many other problems do not exist on the regular X builds.
** Text displayed in the default monospace font looks horrible.
-Droid Sans Mono (the default Monospace font which comes with Android)
-incorporates instruction code designed for Microsoft's proprietary
-TrueType font scaler. When this code is executed by Emacs to instruct
-a glyph containing more than one component, it tries to address
-"reference points" which are set to the values of two extra "phantom
-points" in the glyph, that are a proprietary extension of the MS font
-scaler.
-
-Emacs does not support these extensions, and as a result characters
-such as
-
- Ä„
-
-display incorrectly, with the right most edge of the `h' component
-stretched very far out to the right, on some low density displays.
-
-The solution is to replace the MS-specific hinting code in Droid Sans
-Mono with automatically generated code from the FreeType project's
-"ttfautohint" program. First, extract
-'/system/fonts/DroidSansMono.ttf' from your device:
+TrueType fonts incorporate instruction code executed by the font
+scaler (the component responsible for transforming outlines into
+bitmap images capable of being displayed onscreen) to align features
+of each glyph to pixel boundaries while maintaining their shape, in
+order to alleviate visual imperfections produced by scaling. The
+substandard instruction code provided by the Android "Droid Sans Mono"
+font misplaces features of glyphs containing, as components, "E" and
+"F", between PPEM sizes of 16 and 24, resulting in noticeable
+whitespace inconsistencies with other glyphs. Furthermore, the
+vertical stem in the glyph "T" is positioned too far to the left at
+PPEM sizes of 12.
+
+The remedy for this is to replace the instruction code with
+automatically generated code from the FreeType project's "ttfautohint"
+program. First, extract '/system/fonts/DroidSansMono.ttf' from your
+device:
$ adb pull /system/fonts/DroidSansMono.ttf
/system/fonts/DroidSansMono.ttf: 1 file pulled, 0 skipped.
@@ -3448,85 +3468,18 @@ allowed by free versions of Android, such as Replicant):
or to the user fonts directory described in the "Android Fonts" node
of the Emacs manual. You may want to perform this procedure even if
-you are not seeing problems with character display, as the
-automatically generated instructions result in superior display
-results that are easier to read.
-
-We have been told that the default Sans font under Android 2.3.7,
-named "Droid Sans", also exhibits this problem. The procedure for
-repairing the font is identical to the procedure outlined above,
-albeit with "DroidSansMono" replaced by simply "DroidSans".
-
-** The "Anonymous Pro" font displays incorrectly.
-
-Glyph instruction code within the Anonymous Pro font relies on
-undocumented features of the Microsoft TrueType font scaler, namely
-that the scaler always resets the "projection" and "freedom" vector
-interpreter control registers after the execution of the font
-pre-program, which sets them to a value that is perpendicular to the
-horizontal plane of movement.
-
-Since Emacs does not provide this "feature", various points inside
-glyphs are moved vertically rather than horizontally when a glyph
-program later executes an instruction such as "MIRP" (Move Indirect
-Relative Point) that moves and measures points along the axis
-specified by those registers.
-
-This can be remedied in two ways; the first (and the easiest) is to
-replace its instruction code with that supplied by "ttfautohint", as
-depicted above. The second is to patch the instruction code inside
-the font itself, using the "ttx" utility:
-
- https://fonttools.readthedocs.io/en/latest/ttx.html
-
-First, convert the font to its XML representation:
-
- $ ttx Anonymous_Pro.ttf
-
-then, find the end of the section labeled 'prep':
-
- <prep>
- <assembly>
- [...]
- ROUND[01] /* Round */
- RTG[ ] /* RoundToGrid */
- WCVTP[ ] /* WriteCVTInPixels */
- </assembly>
- </prep>
-
-and insert the following instruction immediately before the closing
-'/assembly' tag, so as to reset the interpreter control registers back
-to their default values prior to the completion of the pre-program:
-
- SVTCA[1] /* Set Vector registers to Control Axis X */
-
-Then, reassemble the font from the modified XML:
-
- $ ttx Anonymous_Pro.ttx
-
-which should produce a modified font by the name of
-Anonymous_Pro#1.ttf.
-
-** The "IBM Plex Mono" font displays incorrectly.
-
-This problem is precipitated by an attempt to exploit the undocumented
-feature of the MS font scaler explicated within the previous heading.
-
-Its remedy is also unsurprisingly alike the fix described there: both
-patching the preprogram to reset the point movement vectors and
-replacing the instruction code with code generated by "ttfautohint"
-will adequately resolve the problem.
+you are not experiencing problems with character display, as the
+automatically generated instructions result in more legible text.
** Glyphs are missing within the "Arial" font or it does not load.
-On account of its origins at Microsoft, instruction code included
-within this font is awash with references to behavior specific to the
-MS scaler. It is incorrigibly broken, to a degree that even
-"ttfautohint" cannot repair; your only recourse is to select some
-other font.
-
-This issue may extend beyond Arial to encompass a larger selection of
-fonts designed by Microsoft.
+Old versions of this font included instruction code that assumed a
+degree of latitude from the Microsoft font scaler, which grants fonts
+leave to address nonexistent points without aborting the scaling
+process, among other invalid TrueType operations. This issue may
+extend beyond Arial to encompass a larger selection of old fonts
+designed by Microsoft or Monotype; most of the time, installing newer
+versions of such fonts will suffice.
** Some TrueType test fonts don't work.
@@ -3554,9 +3507,9 @@ Executing instruction code is not a strict requirement for producing
correct display results from most current fonts. If a font's
instruction code produces results that are merely unpleasing, but not
incorrect, then the font was presumably not designed for Emacs's
-scaler. If its uninstructed glyphs are satisfactory (such as if your
-screen resolution is high to the extent that scaling artifacts prove
-invisible), disable instruction code execution by appending its family
+scaler. If its uninstructed glyphs are satisfactory (such as when
+your screen resolution is high enough to ameliorate scaling
+artifacts), disable instruction code execution by appending its family
name to the variable 'sfnt-uninstructable-font-regexp', then
restarting Emacs.
diff --git a/etc/TODO b/etc/TODO
index a3674c452a3..52c77ccc28d 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -156,6 +156,8 @@ from.
** Make back_comment use syntax-ppss or equivalent
+** Make play-sound asynchronous and non-blocking
+
** Consider improving src/sysdep.c's search for a fqdn
https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html
@@ -908,22 +910,6 @@ restore the redirection through funcall.
*** Features to be improved or missing
-**** Diagnostic
-
-***** Filtering async warnings
-
-Add a new 'native-comp-async-report-warnings-errors' value such that
-we filter out all the uninteresting warnings (that the programmer
-already got during byte compilation) but we still report the important
-ones ('the function ā€˜xxxā€™ is not known to be defined.').
-
-This way even if the package developer doesn't use native compilation
-it can get the bug report for the issue and
-'*Async-native-compile-log*' is not too crowded.
-
-This new value for 'native-comp-async-report-warnings-errors' should
-be default.
-
**** Fix portable dumping so that you can redump without using -batch
***** Redumps and native compiler "preloaded" sub-folder.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index c03d30afa79..05f0829864c 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -344,6 +344,19 @@ In /home/janneke/vc/guile/examples/gud-break.scm:
1033: 0 [stderr "~a:hello world\n" (# # #)]
+* Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1
+
+/usr/bin/lua: database.lua:31: assertion failed!
+stack traceback:
+ [C]: in function 'assert'
+ database.lua:31: in field 'statement'
+ database.lua:42: in field 'table'
+ database.lua:55: in field 'row'
+ database.lua:63: in field 'value'
+ io.lua: in main chunk
+ [C]: in ?
+
+
* Lucid Compiler, lcc 3.x
symbol: lcc
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py
index fdf4314e2d0..9865fe391a2 100644
--- a/etc/emacs_lldb.py
+++ b/etc/emacs_lldb.py
@@ -56,6 +56,7 @@ class Lisp_Object:
"PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector",
"PVEC_BUFFER": "struct buffer",
"PVEC_HASH_TABLE": "struct Lisp_Hash_Table",
+ "PVEC_OBARRAY": "struct Lisp_Obarray",
"PVEC_TERMINAL": "struct terminal",
"PVEC_WINDOW_CONFIGURATION": "struct save_window_data",
"PVEC_SUBR": "struct Lisp_Subr",
diff --git a/etc/images/README b/etc/images/README
index a778d9ce6c3..8e112448373 100644
--- a/etc/images/README
+++ b/etc/images/README
@@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository at:
https://gitlab.gnome.org/GNOME/adwaita-icon-theme
-Emacs images and their source in the Adwaita/scalable directory:
+Emacs images and their source in the Adwaita/symbolic directory:
checked.svg ui/checkbox-checked-symbolic.svg
unchecked.svg ui/checkbox-symbolic.svg
@@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable directory:
left.svg ui/pan-start-symbolic.svg
right.svg ui/pan-end-symbolic.svg
up.svg ui/pan-up-symbolic.svg
+ conceal.svg actions/view-conceal-symbolic.svg
+ reveal.svg actions/view-reveal-symbolic.svg
+
+conceal.pbm and reveal.pbm are generated from the respective *.svg
+files, using the ImageMagick converter tool.
diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm
new file mode 100644
index 00000000000..3df787d6fd6
--- /dev/null
+++ b/etc/images/conceal.pbm
Binary files differ
diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg
new file mode 100644
index 00000000000..172b73ed3d3
--- /dev/null
+++ b/etc/images/conceal.svg
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<svg height="16px" viewBox="0 0 16 16" width="16px" xmlns="http://www.w3.org/2000/svg">
+ <path d="m 1.53125 0.46875 l -1.0625 1.0625 l 14 14 l 1.0625 -1.0625 l -2.382812 -2.382812 c 1.265624 -1.0625 2.171874 -2.496094 2.589843 -4.097657 c -0.914062 -3.523437 -4.097656 -5.984375 -7.738281 -5.988281 c -1.367188 0.011719 -2.707031 0.371094 -3.894531 1.042969 z m 6.46875 3.53125 c 2.210938 0 4 1.789062 4 4 c -0.003906 0.800781 -0.246094 1.578125 -0.699219 2.238281 l -1.46875 -1.46875 c 0.105469 -0.242187 0.164063 -0.503906 0.167969 -0.769531 c 0 -1.105469 -0.894531 -2 -2 -2 c -0.265625 0.003906 -0.527344 0.0625 -0.769531 0.167969 l -1.46875 -1.46875 c 0.660156 -0.453125 1.4375 -0.695313 2.238281 -0.699219 z m -6.144531 0.917969 c -0.753907 0.898437 -1.296875 1.957031 -1.59375 3.09375 c 0.914062 3.523437 4.097656 5.984375 7.738281 5.988281 c 0.855469 -0.007812 1.703125 -0.152344 2.511719 -0.425781 l -1.667969 -1.667969 c -0.277344 0.058594 -0.5625 0.089844 -0.84375 0.09375 c -2.210938 0 -4 -1.789062 -4 -4 c 0.003906 -0.28125 0.035156 -0.566406 0.09375 -0.84375 z m 0 0" fill="#2e3436"/>
+</svg>
diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm
new file mode 100644
index 00000000000..79d2f1f3307
--- /dev/null
+++ b/etc/images/reveal.pbm
Binary files differ
diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg
new file mode 100644
index 00000000000..41ae3733a53
--- /dev/null
+++ b/etc/images/reveal.svg
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<svg height="16px" viewBox="0 0 16 16" width="16px" xmlns="http://www.w3.org/2000/svg">
+ <path d="m 8 2 c -3.648438 0.003906 -6.832031 2.476562 -7.738281 6.007812 c 0.914062 3.527344 4.097656 5.988282 7.738281 5.992188 c 3.648438 -0.003906 6.832031 -2.476562 7.738281 -6.011719 c -0.914062 -3.523437 -4.097656 -5.984375 -7.738281 -5.988281 z m 0 2 c 2.210938 0 4 1.789062 4 4 s -1.789062 4 -4 4 s -4 -1.789062 -4 -4 s 1.789062 -4 4 -4 z m 0 2 c -1.105469 0 -2 0.894531 -2 2 s 0.894531 2 2 2 s 2 -0.894531 2 -2 s -0.894531 -2 -2 -2 z m 0 0" fill="#2e3436"/>
+</svg>
diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el b/etc/themes/modus-operandi-deuteranopia-theme.el
index 4d210b977eb..42479965300 100644
--- a/etc/themes/modus-operandi-deuteranopia-theme.el
+++ b/etc/themes/modus-operandi-deuteranopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a white background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-blue-nuanced)
+ (fg-active-value blue-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -289,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
- (date-now blue-faint)
+ (date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done blue)
- (prose-macro magenta-cooler)
+ (prose-todo yellow-warmer)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula yellow-warmer)
+
(prose-tag magenta-faint)
- (prose-todo yellow-warmer)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 yellow-faint)
(rainbow-8 cyan)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-blue-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-cyan-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-blue-subtle)
+ (bg-search-rx-group-3 bg-yellow-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el
index b41d5491c2e..fb2ff99a74b 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-theme.el --- Elegant, highly legible theme with a white background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -126,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -210,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -239,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -341,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code green-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -364,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -372,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -407,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el
index 7e0ad3d7ea8..f112456034b 100644
--- a/etc/themes/modus-operandi-tinted-theme.el
+++ b/etc/themes/modus-operandi-tinted-theme.el
@@ -1,11 +1,11 @@
-;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ocher background -*- lexical-binding:t -*-
+;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ochre background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -44,7 +44,7 @@
;;;###theme-autoload
(deftheme modus-operandi-tinted
- "Elegant, highly legible theme with a light ocher background.
+ "Elegant, highly legible theme with a light ochre background.
Conforms with the highest legibility standard for color contrast
between background and foreground in any given piece of text,
which corresponds to a minimum contrast in relative luminance of
@@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#ffe8f0")
- (bg-green-nuanced "#e0f5e0")
- (bg-yellow-nuanced "#f9ead0")
- (bg-blue-nuanced "#ebebff")
- (bg-magenta-nuanced "#f6e7ff")
- (bg-cyan-nuanced "#e1f3fc")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#7fdfcf")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of
;;;; General mappings
(fringe bg-dim)
- (cursor red)
+ (cursor red-intense)
- (keybind blue-cooler)
+ (keybind red)
(name magenta)
(identifier yellow-cooler)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code green-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-tritanopia-theme.el b/etc/themes/modus-operandi-tritanopia-theme.el
index 968a6526ca3..56be8329784 100644
--- a/etc/themes/modus-operandi-tritanopia-theme.el
+++ b/etc/themes/modus-operandi-tritanopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-tritanopia-theme.el --- Tritanopia-optimized theme with a white background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-red-nuanced)
+ (fg-active-argument red-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan)
+
;;;; Code mappings
(builtin magenta)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro red-warmer)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done cyan)
- (prose-macro red-warmer)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
- (prose-tag fg-alt)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
+ (prose-table-formula red-cooler)
+
+ (prose-tag magenta-faint)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-red-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-cyan-subtle)
+ (bg-search-rx-group-3 bg-red-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index 44f25182a30..b776f12671e 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -1,12 +1,11 @@
;;; modus-themes.el --- Elegant, highly legible and customizable themes -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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: 4.3.0
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Version: 4.4.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -37,9 +36,7 @@
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
+(eval-when-compile (require 'subr-x))
(defgroup modus-themes ()
"User options for the Modus themes.
@@ -66,11 +63,6 @@ deficiency (deuteranopia or tritanopia, respectively)."
:prefix "modus-themes-"
:tag "Modus Themes Faces")
-(make-obsolete-variable 'modus-themes-operandi-colors nil "4.0.0")
-(make-obsolete-variable 'modus-themes-vivendi-colors nil "4.0.0")
-(make-obsolete-variable 'modus-themes-version nil "4.0.0")
-(make-obsolete 'modus-themes-report-bug nil "4.0.0")
-
;;;; Custom faces
@@ -139,7 +131,7 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(dolist (scope '(current lazy))
+(dolist (scope '(current lazy replace))
(custom-declare-face
(intern (format "modus-themes-search-%s" scope))
nil (format "Search of type %s." scope)
@@ -147,15 +139,13 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(define-obsolete-variable-alias
- 'modus-themes-search-success
- 'modus-themes-search-current
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-search-success-lazy
- 'modus-themes-search-lazy
- "4.0.0")
+(dotimes (n 4)
+ (custom-declare-face
+ (intern (format "modus-themes-search-rx-group-%s" n))
+ nil (format "Search regexp group number %s." n)
+ :package-version '(modus-themes . "4.4.0")
+ :version "30.1"
+ :group 'modus-themes-faces))
(dolist (scope '(code macro verbatim))
(custom-declare-face
@@ -165,21 +155,6 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(define-obsolete-variable-alias
- 'modus-themes-markup-code
- 'modus-themes-prose-code
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-markup-macro
- 'modus-themes-prose-macro
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-markup-verbatim
- 'modus-themes-prose-verbatim
- "4.0.0")
-
(dotimes (n 9)
(custom-declare-face
(intern (format "modus-themes-heading-%d" n))
@@ -248,67 +223,6 @@ text should not be underlined as well) yet still blend in."
:version "30.1"
:group 'modus-themes-faces))
-(make-obsolete-variable 'modus-themes-reset-hard nil "4.0.0")
-(make-obsolete-variable 'modus-themes-subtle-neutral nil "4.0.0")
-(make-obsolete-variable 'modus-themes-intense-neutral nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-red-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-green-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-yellow-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-blue-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-magenta-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-cyan-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-calm nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-cold nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-mild nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-warm nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-heading nil "4.0.0")
-(make-obsolete-variable 'modus-themes-pseudo-header nil "4.0.0")
-(make-obsolete-variable 'modus-themes-mark-symbol nil "4.0.0")
-(make-obsolete-variable 'modus-themes-hl-line nil "4.0.0")
-(make-obsolete-variable 'modus-themes-search-success-modeline nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-intense nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-subtle nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-refine nil "4.0.0")
-(make-obsolete-variable 'modus-themes-link-broken nil "4.0.0")
-(make-obsolete-variable 'modus-themes-link-symlink nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-backdrop nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-inactive nil "4.0.0")
-(make-obsolete-variable 'modus-themes-completion-selected-popup nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-button nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-button-pressed nil "4.0.0")
-
;;;; Customization variables
@@ -331,8 +245,6 @@ consequences. The user must manually reload the theme."
:type 'boolean
:link '(info-link "(modus-themes) Custom reload theme"))
-(make-obsolete-variable 'modus-themes-inhibit-reload 'modus-themes-custom-auto-reload "4.0.0")
-
(defun modus-themes--set-option (sym val)
"Custom setter for theme related user options.
Will set SYM to VAL, and reload the current theme, unless
@@ -422,9 +334,6 @@ This is used by the command `modus-themes-toggle'."
:initialize #'custom-initialize-default
:group 'modus-themes)
-(make-obsolete-variable 'modus-themes-operandi-color-overrides nil "4.0.0")
-(make-obsolete-variable 'modus-themes-vivendi-color-overrides nil "4.0.0")
-
(defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs)
(defcustom modus-themes-italic-constructs nil
@@ -477,8 +386,6 @@ Protesilaos))."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Mixed fonts"))
-(make-obsolete-variable 'modus-themes-intense-mouseovers nil "4.0.0")
-
(defconst modus-themes--weight-widget
'(choice :tag "Font weight (must be supported by the typeface)"
(const :tag "Unspecified (use whatever the default is)" nil)
@@ -611,51 +518,7 @@ and related user options."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Heading styles"))
-(make-obsolete-variable 'modus-themes-org-agenda nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringes nil "4.0.0")
-(make-obsolete-variable 'modus-themes-lang-checkers nil "4.0.0")
-
-(defcustom modus-themes-org-blocks nil
- "Set the overall style of Org code blocks, quotes, and the like.
-
-Nil (the default) means that the block has no background of its
-own: it uses the one that applies to the rest of the buffer. In
-this case, the delimiter lines have a gray color for their text,
-making them look exactly like all other Org properties.
-
-Option `gray-background' applies a subtle gray background to the
-block's contents. It also affects the begin and end lines of the
-block as they get another shade of gray as their background,
-which differentiates them from the contents of the block. All
-background colors extend to the edge of the window, giving the
-area a rectangular, \"blocky\" presentation. If the begin/end
-lines do not extend in this way, check the value of the Org user
-option `org-fontify-whole-block-delimiter-line'.
-
-Option `tinted-background' uses a colored background for the
-contents of the block. The exact color value will depend on the
-programming language and is controlled by the variable
-`org-src-block-faces' (refer to the theme's source code for the
-current association list). For this to take effect, the Org
-buffer needs to be restarted with `org-mode-restart'.
-
-Code blocks use their major mode's fontification (syntax
-highlighting) 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."
- :group 'modus-themes
- :package-version '(modus-themes . "4.0.0")
- :version "30.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "No Org block background (default)" nil)
- (const :format "[%v] %t\n" :tag "Subtle gray block background" gray-background)
- (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background))
- :set #'modus-themes--set-option
- :initialize #'custom-initialize-default
- :link '(info-link "(modus-themes) Org mode blocks"))
-
-(make-obsolete-variable 'modus-themes-mode-line nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diffs nil "4.0.0")
+(make-obsolete-variable 'modus-themes-org-blocks nil "4.4.0: Use palette overrides")
(defcustom modus-themes-completions nil
"Control the style of completion user interfaces.
@@ -778,17 +641,6 @@ In user configuration files the form may look like this:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Command prompts"))
-(make-obsolete-variable 'modus-themes-subtle-line-numbers nil "4.0.0")
-(make-obsolete-variable 'modus-themes-markup nil "4.0.0")
-(make-obsolete-variable 'modus-themes-paren-match nil "4.0.0")
-(make-obsolete-variable 'modus-themes-syntax nil "4.0.0")
-(make-obsolete-variable 'modus-themes-links nil "4.0.0")
-(make-obsolete-variable 'modus-themes-region nil "4.0.0")
-(make-obsolete-variable 'modus-themes-deuteranopia nil "4.0.0")
-(make-obsolete-variable 'modus-themes-mail-citations nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tabs-accented nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-buttons nil "4.0.0")
-
(defcustom modus-themes-common-palette-overrides nil
"Set palette overrides for all the Modus themes.
@@ -918,12 +770,13 @@ represents."
(fg-prompt cyan-faint)
- (prose-code olive)
+ (fg-prose-code olive)
+ (fg-prose-macro indigo)
+ (fg-prose-verbatim maroon)
+
(prose-done green-faint)
- (prose-macro indigo)
(prose-tag rust)
(prose-todo red-faint)
- (prose-verbatim maroon)
(rainbow-0 fg-main)
(rainbow-1 magenta)
@@ -983,17 +836,18 @@ Info node `(modus-themes) Option for palette overrides'.")
(keybind blue-intense)
(mail-cite-0 blue)
- (mail-cite-1 yellow)
- (mail-cite-2 green)
+ (mail-cite-1 yellow-cooler)
+ (mail-cite-2 green-warmer)
(mail-cite-3 magenta)
- (mail-part magenta-cooler)
- (mail-recipient cyan)
+ (mail-part cyan)
+ (mail-recipient magenta-cooler)
(mail-subject red-warmer)
(mail-other cyan-cooler)
(fg-prompt blue-intense)
- (prose-block red-faint)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter red-faint)
(prose-done green-intense)
(prose-metadata magenta-faint)
(prose-metadata-value blue-cooler)
@@ -1081,7 +935,7 @@ Info node `(modus-themes) Option for palette overrides'.")
(mail-other blue)
(prose-tag fg-dim)
- (prose-verbatim blue-cooler))
+ (fg-prose-verbatim blue-cooler))
"Preset of palette overrides with cooler colors.
This changes parts of the palette to use more blue and
@@ -1136,7 +990,7 @@ Info node `(modus-themes) Option for palette overrides'.")
(mail-subject blue-warmer)
(mail-other magenta-warmer)
- (prose-macro red-cooler)
+ (fg-prose-macro red-cooler)
(prose-tag fg-dim))
"Preset of palette overrides with warmer colors.
@@ -1162,14 +1016,22 @@ Info node `(modus-themes) Option for palette overrides'.")
;;;; Helper functions for theme setup
;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html
+(defun modus-themes--wcag-contribution (channel weight)
+ "Return the CHANNEL contribution to overall luminance given WEIGHT."
+ (* weight
+ (if (<= channel 0.03928)
+ (/ channel 12.92)
+ (expt (/ (+ channel 0.055) 1.055) 2.4))))
+
(defun modus-themes-wcag-formula (hex)
"Get WCAG value of color value HEX.
The value is defined in hexadecimal RGB notation, such #123456."
- (cl-loop for k in '(0.2126 0.7152 0.0722)
- for x in (color-name-to-rgb hex)
- sum (* k (if (<= x 0.03928)
- (/ x 12.92)
- (expt (/ (+ x 0.055) 1.055) 2.4)))))
+ (let ((channels (color-name-to-rgb hex))
+ (weights '(0.2126 0.7152 0.0722))
+ contribution)
+ (while channels
+ (push (modus-themes--wcag-contribution (pop channels) (pop weights)) contribution))
+ (apply #'+ contribution)))
;;;###autoload
(defun modus-themes-contrast (c1 c2)
@@ -1179,32 +1041,27 @@ C1 and C2 are color values written in hexadecimal RGB."
(+ (modus-themes-wcag-formula c2) 0.05))))
(max ct (/ ct))))
-(make-obsolete 'modus-themes-color nil "4.0.0")
-(make-obsolete 'modus-themes-color-alts nil "4.0.0")
-
-(declare-function cl-remove-if-not "cl-seq" (cl-pred cl-list &rest cl-keys))
+(defun modus-themes--modus-p (theme)
+ "Return non-nil if THEME name has a modus- prefix."
+ (string-prefix-p "modus-" (symbol-name theme)))
(defun modus-themes--list-enabled-themes ()
"Return list of `custom-enabled-themes' with modus- prefix."
- (cl-remove-if-not
- (lambda (theme)
- (string-prefix-p "modus-" (symbol-name theme)))
- custom-enabled-themes))
+ (seq-filter #'modus-themes--modus-p custom-enabled-themes))
+
+(defun modus-themes--load-no-enable (theme)
+ "Load but do not enable THEME if it belongs to `custom-known-themes'."
+ (unless (memq theme custom-known-themes)
+ (load-theme theme :no-confirm :no-enable)))
(defun modus-themes--enable-themes ()
"Enable the Modus themes."
- (mapc (lambda (theme)
- (unless (memq theme custom-known-themes)
- (load-theme theme :no-confirm :no-enable)))
- modus-themes-items))
+ (mapc #'modus-themes--load-no-enable modus-themes-items))
(defun modus-themes--list-known-themes ()
"Return list of `custom-known-themes' with modus- prefix."
(modus-themes--enable-themes)
- (cl-remove-if-not
- (lambda (theme)
- (string-prefix-p "modus-" (symbol-name theme)))
- custom-known-themes))
+ (seq-filter #'modus-themes--modus-p custom-known-themes))
(defun modus-themes--current-theme ()
"Return first enabled Modus theme."
@@ -1311,10 +1168,6 @@ symbol, which is safe when used as a face attribute's value."
;;;; Commands
-(make-obsolete 'modus-themes-load-themes nil "4.0.0")
-(make-obsolete 'modus-themes-load-operandi nil "4.0.0; Check `modus-themes-load-theme'")
-(make-obsolete 'modus-themes-load-vivendi nil "4.0.0; Check `modus-themes-load-theme'")
-
(defvar modus-themes--select-theme-history nil
"Minibuffer history of `modus-themes--select-prompt'.")
@@ -1322,7 +1175,9 @@ symbol, which is safe when used as a face attribute's value."
"Return completion annotation for THEME."
(when-let ((symbol (intern-soft theme))
(doc-string (get symbol 'theme-documentation)))
- (format " -- %s" (car (split-string doc-string "\\.")))))
+ (format " -- %s"
+ (propertize (car (split-string doc-string "\\."))
+ 'face 'completions-annotations))))
(defun modus-themes--completion-table (category candidates)
"Pass appropriate metadata CATEGORY to completion CANDIDATES."
@@ -1486,8 +1341,7 @@ Check PROPERTIES for an alist value that corresponds to
ALIST-KEY. If no alist is present, search the PROPERTIES
list given LIST-PRED, using DEFAULT as a fallback."
(if-let* ((val (or (alist-get alist-key properties)
- (cl-loop for x in properties
- if (funcall list-pred x) return x)
+ (seq-filter (lambda (x) (funcall list-pred x)) properties)
default))
((listp val)))
(car val)
@@ -1535,7 +1389,7 @@ color that is combined with FG-FOR-BG."
:foreground fg
:weight
;; If we have `bold' specifically, we inherit the face of
- ;; the same name. This allows the user to customize that
+ ;; the same name. This allows the user to customise that
;; face, such as to change its font family.
(if (and weight (not (eq weight 'bold)))
weight
@@ -1581,16 +1435,6 @@ Optional OL is the color of an overline."
'unspecified)
:weight (or weight 'unspecified))))
-(defun modus-themes--org-block (fg bg)
- "Conditionally set the FG and BG of Org blocks."
- (let ((gray (or (eq modus-themes-org-blocks 'gray-background)
- (eq modus-themes-org-blocks 'grayscale) ; for backward compatibility
- (eq modus-themes-org-blocks 'greyscale))))
- (list :inherit 'modus-themes-fixed-pitch
- :background (if gray bg 'unspecified)
- :foreground (if gray 'unspecified fg)
- :extend (if gray t 'unspecified))))
-
(defun modus-themes--completion-line (bg)
"Styles for `modus-themes-completions' with BG as the background."
(let* ((var (modus-themes--list-or-warn 'modus-themes-completions))
@@ -1723,12 +1567,18 @@ FG and BG are the main colors."
`(modus-themes-prominent-note ((,c :background ,bg-prominent-note :foreground ,fg-prominent-note)))
`(modus-themes-prominent-warning ((,c :background ,bg-prominent-warning :foreground ,fg-prominent-warning)))
;;;;; markup
- `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-code)))
- `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-macro)))
- `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim)))
+ `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-code :foreground ,fg-prose-code)))
+ `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-macro :foreground ,fg-prose-macro)))
+ `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-verbatim :foreground ,fg-prose-verbatim)))
;;;;; search
- `(modus-themes-search-current ((,c :background ,bg-yellow-intense :foreground ,fg-main)))
- `(modus-themes-search-lazy ((,c :background ,bg-cyan-intense :foreground ,fg-main)))
+ `(modus-themes-search-current ((,c :background ,bg-search-current :foreground ,fg-main)))
+ `(modus-themes-search-lazy ((,c :background ,bg-search-lazy :foreground ,fg-main)))
+ `(modus-themes-search-replace ((,c :background ,bg-search-replace :foreground ,fg-main)))
+;;;;; search regexp groups
+ `(modus-themes-search-rx-group-0 ((,c :background ,bg-search-rx-group-0 :foreground ,fg-main)))
+ `(modus-themes-search-rx-group-1 ((,c :background ,bg-search-rx-group-1 :foreground ,fg-main)))
+ `(modus-themes-search-rx-group-2 ((,c :background ,bg-search-rx-group-2 :foreground ,fg-main)))
+ `(modus-themes-search-rx-group-3 ((,c :background ,bg-search-rx-group-3 :foreground ,fg-main)))
;;;;; completion frameworks
`(modus-themes-completion-match-0 ((,c ,@(modus-themes--completion-match fg-completion-match-0 bg-completion-match-0))))
`(modus-themes-completion-match-1 ((,c ,@(modus-themes--completion-match fg-completion-match-1 bg-completion-match-1))))
@@ -1756,12 +1606,12 @@ FG and BG are the main colors."
`(cursor ((,c :background ,cursor)))
`(fringe ((,c :background ,fringe :foreground ,fg-main)))
`(menu ((,c :background ,bg-dim :foreground ,fg-main)))
- `(scroll-bar ((,c :background ,bg-dim :foreground ,fg-dim)))
+ `(scroll-bar ((,c :background ,fringe :foreground ,border)))
`(tool-bar ((,c :background ,bg-dim :foreground ,fg-main)))
`(vertical-border ((,c :foreground ,border)))
;;;;; basic and/or ungrouped styles
- `(appt-notification ((,c :inherit error)))
- `(blink-matching-paren-highlight-offscreen ((,c :background ,bg-paren-match)))
+ `(appt-notification ((,c :inherit bold :foreground ,modeline-err)))
+ `(blink-matching-paren-offscreen ((,c :background ,bg-paren-match)))
`(bold ((,c :weight bold)))
`(bold-italic ((,c :inherit (bold italic))))
`(underline ((,c :underline ,fg-dim)))
@@ -1776,7 +1626,7 @@ FG and BG are the main colors."
`(escape-glyph ((,c :foreground ,err)))
`(file-name-shadow ((,c :inherit shadow)))
`(header-line ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-dim)))
- `(header-line-highlight ((,c :inherit highlight)))
+ `(header-line-highlight ((,c :background ,bg-hover :foreground ,fg-main :box ,fg-main)))
`(help-argument-name ((,c :inherit modus-themes-slant :foreground ,variable)))
`(help-key-binding ((,c :inherit modus-themes-key-binding)))
`(highlight ((,c :background ,bg-hover :foreground ,fg-main)))
@@ -1792,7 +1642,7 @@ FG and BG are the main colors."
`(mm-uu-extract ((,c :foreground ,mail-part)))
`(next-error ((,c :inherit modus-themes-prominent-error :extend t)))
`(pgtk-im-0 ((,c :inherit modus-themes-prominent-note)))
- `(read-multiple-choice-face ((,c :inherit (bold modus-themes-mark-alt))))
+ `(read-multiple-choice-face ((,c :inherit modus-themes-mark-sel)))
`(rectangle-preview ((,c :inherit secondary-selection)))
`(region ((,c :background ,bg-region :foreground ,fg-region)))
`(secondary-selection ((,c :background ,bg-hover-secondary :foreground ,fg-main)))
@@ -1909,7 +1759,7 @@ FG and BG are the main colors."
`(anzu-match-3 ((,c :inherit modus-themes-subtle-yellow)))
`(anzu-mode-line ((,c :inherit bold)))
`(anzu-mode-line-no-match ((,c :inherit error)))
- `(anzu-replace-highlight ((,c :inherit modus-themes-prominent-error :underline t)))
+ `(anzu-replace-highlight ((,c :inherit modus-themes-search-replace)))
`(anzu-replace-to ((,c :inherit modus-themes-search-current)))
;;;;; auctex and Tex
`(font-latex-bold-face ((,c :inherit bold)))
@@ -2097,6 +1947,7 @@ FG and BG are the main colors."
`(completions-annotations ((,c :inherit modus-themes-slant :foreground ,docstring)))
`(completions-common-part ((,c :inherit modus-themes-completion-match-0)))
`(completions-first-difference ((,c :inherit modus-themes-completion-match-1)))
+ `(completions-highlight ((,c :inherit modus-themes-completion-selected)))
;;;;; consult
`(consult-async-split ((,c :inherit error)))
`(consult-file ((,c :inherit modus-themes-bold :foreground ,info)))
@@ -2104,6 +1955,7 @@ FG and BG are the main colors."
`(consult-imenu-prefix ((,c :inherit shadow)))
`(consult-line-number ((,c :inherit shadow)))
`(consult-line-number-prefix ((,c :inherit shadow)))
+ `(consult-preview-insertion ((,c :background ,bg-dim)))
;;;;; corfu
`(corfu-current ((,c :inherit modus-themes-completion-selected)))
`(corfu-bar ((,c :background ,fg-dim)))
@@ -2164,6 +2016,22 @@ FG and BG are the main colors."
`(deadgrep-meta-face ((,c :inherit shadow)))
`(deadgrep-regexp-metachar-face ((,c :inherit font-lock-regexp-grouping-construct)))
`(deadgrep-search-term-face ((,c :inherit success)))
+;;;;; debbugs
+ `(debbugs-gnu-archived ((,c :background ,bg-inactive :foreground ,fg-dim)))
+ `(debbugs-gnu-done ((,c :inherit success)))
+ `(debbugs-gnu-forwarded ((,c :inherit modus-themes-slant :foreground ,info)))
+ `(debbugs-gnu-handled (( )))
+ `(debbugs-gnu-marked ((,c :inherit modus-themes-mark-sel)))
+ `(debbugs-gnu-marked-stale ((,c :inherit modus-themes-mark-alt)))
+ `(debbugs-gnu-new ((,c :inherit error)))
+ `(debbugs-gnu-pending ((,c :inherit modus-themes-slant :foreground ,fg-alt)))
+ `(debbugs-gnu-stale-1 ((,c :foreground ,red-cooler)))
+ `(debbugs-gnu-stale-2 ((,c :foreground ,yellow-warmer)))
+ `(debbugs-gnu-stale-3 ((,c :foreground ,magenta-warmer)))
+ `(debbugs-gnu-stale-4 ((,c :foreground ,magenta-cooler)))
+ `(debbugs-gnu-stale-5 ((,c :foreground ,cyan-faint)))
+ `(debbugs-gnu-tagged ((,c :inherit modus-themes-mark-alt)))
+ `(debbugs-gnu-title ((,c :inherit bold)))
;;;;; deft
`(deft-filter-string-face ((,c :inherit success)))
`(deft-header-face ((,c :inherit shadow)))
@@ -2171,6 +2039,20 @@ FG and BG are the main colors."
`(deft-summary-face ((,c :inherit (shadow modus-themes-slant))))
`(deft-time-face ((,c :foreground ,date-common)))
`(deft-title-face ((,c :inherit bold)))
+;;;;; denote
+ `(denote-faces-date ((,c :foreground ,date-common)))
+ `(denote-faces-delimiter ((,c :inherit shadow)))
+ `(denote-faces-extension ((,c :inherit shadow)))
+ `(denote-faces-keywords ((,c :inherit modus-themes-bold :foreground ,keyword)))
+ `(denote-faces-link ((,c :inherit link)))
+ `(denote-faces-prompt-current-name ((,c :inherit modus-themes-slant :foreground ,fg-changed-intense)))
+ `(denote-faces-prompt-new-name ((,c :inherit modus-themes-slant :foreground ,fg-added-intense)))
+ `(denote-faces-prompt-old-name ((,c :inherit modus-themes-slant :foreground ,fg-removed-intense)))
+ `(denote-faces-signature ((,c :inherit modus-themes-bold :foreground ,string)))
+ `(denote-faces-subdirectory ((,c :inherit modus-themes-bold :foreground ,fg-alt)))
+ `(denote-faces-time ((,c :inherit denote-faces-date)))
+ `(denote-faces-time-delimiter ((,c :inherit shadow)))
+ `(denote-faces-title (( )))
;;;;; devdocs
`(devdocs-code-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t)))
;;;;; dictionary
@@ -2340,7 +2222,7 @@ FG and BG are the main colors."
`(el-search-occur-match ((,c :inherit match)))
;;;;; eldoc
;; NOTE: see https://github.com/purcell/package-lint/issues/187
- (list 'eldoc-highlight-function-argument `((,c :inherit modus-themes-mark-alt)))
+ (list 'eldoc-highlight-function-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument)))
;;;;; eldoc-box
`(eldoc-box-body ((,c :background ,bg-dim :foreground ,fg-main)))
`(eldoc-box-border ((,c :background ,border)))
@@ -2420,9 +2302,11 @@ FG and BG are the main colors."
`(erc-dangerous-host-face ((,c :inherit error)))
`(erc-direct-msg-face ((,c :inherit shadow)))
`(erc-error-face ((,c :inherit error)))
+ `(erc-fill-wrap-merge-indicator-face ((,c :foreground ,fg-dim)))
`(erc-fool-face ((,c :inherit shadow)))
`(erc-input-face ((,c :foreground ,fnname)))
`(erc-inverse-face ((,c :inherit erc-default-face :inverse-video t)))
+ `(erc-keep-place-indicator-arrow ((,c :foreground ,info)))
`(erc-keyword-face ((,c :inherit bold :foreground ,keyword)))
`(erc-my-nick-face ((,c :inherit bold :foreground ,name)))
`(erc-my-nick-prefix-face ((,c :inherit erc-my-nick-face)))
@@ -2463,7 +2347,7 @@ FG and BG are the main colors."
`(evil-ex-info ((,c :inherit font-lock-type-face)))
`(evil-ex-lazy-highlight ((,c :inherit modus-themes-search-lazy)))
`(evil-ex-search ((,c :inherit modus-themes-search-current)))
- `(evil-ex-substitute-matches ((,c :inherit modus-themes-prominent-error :underline t)))
+ `(evil-ex-substitute-matches ((,c :inherit modus-themes-search-replace)))
`(evil-ex-substitute-replacement ((,c :inherit modus-themes-search-current)))
;;;;; eww
`(eww-invalid-certificate ((,c :foreground ,err)))
@@ -2533,7 +2417,7 @@ FG and BG are the main colors."
`(font-lock-variable-name-face ((,c :foreground ,variable)))
`(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground ,warning)))
;;;;; geiser
- `(geiser-font-lock-autodoc-current-arg ((,c :inherit modus-themes-mark-alt)))
+ `(geiser-font-lock-autodoc-current-arg ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument)))
`(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring)))
`(geiser-font-lock-doc-button ((,c :inherit button)))
`(geiser-font-lock-doc-link ((,c :inherit button)))
@@ -2574,7 +2458,7 @@ FG and BG are the main colors."
`(git-timemachine-minibuffer-author-face ((,c :foreground ,name)))
`(git-timemachine-minibuffer-detail-face ((,c :foreground ,fg-main)))
;;;;; gnus
- `(gnus-button ((,c :inherit button)))
+ `(gnus-button ((,c :inherit button :underline nil)))
`(gnus-cite-1 ((,c :inherit message-cited-text-1)))
`(gnus-cite-2 ((,c :inherit message-cited-text-2)))
`(gnus-cite-3 ((,c :inherit message-cited-text-3)))
@@ -2665,37 +2549,37 @@ FG and BG are the main colors."
;; 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)
+ :background "#ffffff" :foreground "#227f9f" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#66cbdc" :inverse-video t)))
+ :background "#000000" :foreground "#66cbdc" :inverse-video t)))
`(hi-black-b ((,c :inverse-video t)))
`(hi-black-hb ((,c :background ,bg-main :foreground ,fg-dim :inverse-video t)))
`(hi-blue ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#3366dd" :inverse-video t)
+ :background "#ffffff" :foreground "#3366dd" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#aaccff" :inverse-video t)))
+ :background "#000000" :foreground "#aaccff" :inverse-video t)))
`(hi-blue-b ((,c :inherit (bold hi-blue))))
`(hi-green ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#008a00" :inverse-video t)
+ :background "#ffffff" :foreground "#008a00" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#66dd66" :inverse-video t)))
+ :background "#000000" :foreground "#66dd66" :inverse-video t)))
`(hi-green-b ((,c :inherit (bold hi-green))))
`(hi-pink ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#bd30aa" :inverse-video t)
+ :background "#ffffff" :foreground "#bd30aa" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#ff88ee" :inverse-video t)))
+ :background "#000000" :foreground "#ff88ee" :inverse-video t)))
`(hi-red-b ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#dd0000" :inverse-video t)
+ :background "#ffffff" :foreground "#dd0000" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#f06666" :inverse-video t)))
+ :background "#000000" :foreground "#f06666" :inverse-video t)))
`(hi-salmon ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#bf555a" :inverse-video t)
+ :background "#ffffff" :foreground "#bf555a" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#e08a50" :inverse-video t)))
+ :background "#000000" :foreground "#e08a50" :inverse-video t)))
`(hi-yellow ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#af6400" :inverse-video t)
+ :background "#ffffff" :foreground "#af6400" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#faea00" :inverse-video t)))
+ :background "#000000" :foreground "#faea00" :inverse-video t)))
`(highlight-changes ((,c :foreground ,warning :underline nil)))
`(highlight-changes-delete ((,c :foreground ,err :underline t)))
`(hl-line ((,c :background ,bg-hl-line :extend t)))
@@ -2735,14 +2619,14 @@ FG and BG are the main colors."
`(image-dired-thumb-header-file-size ((,c :foreground ,constant)))
`(image-dired-thumb-mark ((,c :inherit modus-themes-mark-sel :box (:line-width -3))))
;;;;; imenu-list
- `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-0)))
- `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-1)))
- `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-2)))
- `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-3)))
- `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-4 :underline t)))
- `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-5 :underline t)))
- `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-6 :underline t)))
- `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-7 :underline t)))
+ `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-1)))
+ `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-2)))
+ `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-3)))
+ `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-4)))
+ `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-1 :underline t)))
+ `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-2 :underline t)))
+ `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-3 :underline t)))
+ `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-4 :underline t)))
;;;;; indium
`(indium-breakpoint-face ((,c :foreground ,err)))
`(indium-frame-url-face ((,c :inherit (shadow button))))
@@ -2807,11 +2691,11 @@ FG and BG are the main colors."
;;;;; isearch, occur, and the like
`(isearch ((,c :inherit modus-themes-search-current)))
`(isearch-fail ((,c :inherit modus-themes-prominent-error)))
- `(isearch-group-1 ((,c :inherit modus-themes-intense-blue)))
- `(isearch-group-2 ((,c :inherit modus-themes-intense-magenta)))
+ `(isearch-group-1 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(isearch-group-2 ((,c :inherit modus-themes-search-rx-group-1)))
`(lazy-highlight ((,c :inherit modus-themes-search-lazy)))
`(match ((,c :background ,bg-magenta-subtle :foreground ,fg-main)))
- `(query-replace ((,c :inherit modus-themes-prominent-error)))
+ `(query-replace ((,c :inherit modus-themes-search-replace)))
;;;;; ivy
`(ivy-action ((,c :inherit modus-themes-key-binding)))
`(ivy-confirm-face ((,c :inherit success)))
@@ -2876,7 +2760,7 @@ FG and BG are the main colors."
`(kaocha-runner-warning-face ((,c :inherit warning)))
;;;;; keycast
`(keycast-command ((,c :inherit bold)))
- `(keycast-key ((,c :background ,keybind :foreground ,bg-main)))
+ `(keycast-key ((,c :inherit modus-themes-bold :background ,keybind :foreground ,bg-main)))
;;;;; ledger-mode
`(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face)))
`(ledger-font-account-name-face ((,c :foreground ,name)))
@@ -3033,7 +2917,7 @@ FG and BG are the main colors."
`(markdown-highlighting-face ((,c :inherit secondary-selection)))
`(markdown-inline-code-face ((,c :inherit modus-themes-prose-code)))
`(markdown-italic-face ((,c :inherit italic)))
- `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-block)))
+ `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter)))
`(markdown-line-break-face ((,c :inherit nobreak-space)))
`(markdown-link-face ((,c :inherit link)))
`(markdown-markup-face ((,c :inherit shadow)))
@@ -3046,12 +2930,12 @@ FG and BG are the main colors."
;;;;; markup-faces (`adoc-mode')
`(markup-attribute-face ((,c :inherit (modus-themes-slant markup-meta-face))))
`(markup-bold-face ((,c :inherit bold)))
- `(markup-code-face ((,c :foreground ,prose-code)))
+ `(markup-code-face ((,c :inherit modus-themes-prose-code)))
`(markup-comment-face ((,c :inherit font-lock-comment-face)))
- `(markup-complex-replacement-face ((,c :foreground ,prose-macro)))
+ `(markup-complex-replacement-face ((,c :inherit modus-themes-prose-macro)))
`(markup-emphasis-face ((,c :inherit markup-italic-face)))
`(markup-error-face ((,c :inherit error)))
- `(markup-gen-face ((,c :foreground ,prose-verbatim)))
+ `(markup-gen-face ((,c :inherit modus-themes-prose-verbatim)))
`(markup-internal-reference-face ((,c :inherit (shadow modus-themes-slant))))
`(markup-italic-face ((,c :inherit italic)))
`(markup-list-face ((,c :background ,bg-inactive)))
@@ -3073,7 +2957,9 @@ FG and BG are the main colors."
`(markup-title-3-face ((,c :inherit modus-themes-heading-4)))
`(markup-title-4-face ((,c :inherit modus-themes-heading-5)))
`(markup-title-5-face ((,c :inherit modus-themes-heading-6)))
- `(markup-verbatim-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim)))
+ `(markup-verbatim-face ((,c :inherit modus-themes-prose-verbatim)))
+;;;;; mct
+ `(mct-highlight-candidate ((,c :inherit modus-themes-completion-selected)))
;;;;; messages
`(message-cited-text-1 ((,c :foreground ,mail-cite-0)))
`(message-cited-text-2 ((,c :foreground ,mail-cite-1)))
@@ -3087,7 +2973,7 @@ FG and BG are the main colors."
`(message-header-xheader ((,c :inherit message-header-other)))
`(message-header-other ((,c :foreground ,mail-other)))
`(message-mml ((,c :foreground ,mail-part)))
- `(message-separator ((,c :background ,bg-active)))
+ `(message-separator ((,c :background ,bg-inactive :foreground ,fg-main)))
;;;;; minimap
`(minimap-active-region-background ((,c :background ,bg-active)))
`(minimap-current-line-face ((,c :background ,bg-cyan-intense :foreground ,fg-main)))
@@ -3129,7 +3015,7 @@ FG and BG are the main colors."
`(mu4e-contact-face ((,c :inherit message-header-to)))
`(mu4e-context-face ((,c :inherit bold)))
`(mu4e-draft-face ((,c :foreground ,warning)))
- `(mu4e-flagged-face ((,c :foreground ,err)))
+ `(mu4e-flagged-face ((,c :foreground ,keyword)))
`(mu4e-footer-face ((,c :inherit italic :foreground ,fg-alt)))
`(mu4e-forwarded-face ((,c :inherit italic :foreground ,info)))
`(mu4e-header-face ((,c :inherit shadow)))
@@ -3148,6 +3034,7 @@ FG and BG are the main colors."
`(mu4e-replied-face ((,c :foreground ,info)))
`(mu4e-special-header-value-face ((,c :inherit message-header-subject)))
`(mu4e-system-face ((,c :inherit italic)))
+ `(mu4e-thread-fold-face ((,c :foreground ,border)))
`(mu4e-title-face (( )))
`(mu4e-trashed-face ((,c :foreground ,err)))
`(mu4e-unread-face ((,c :inherit bold)))
@@ -3233,7 +3120,7 @@ FG and BG are the main colors."
`(notmuch-message-summary-face ((,c :inherit bold :background ,bg-inactive)))
`(notmuch-search-count ((,c :foreground ,fg-dim)))
`(notmuch-search-date ((,c :foreground ,date-common)))
- `(notmuch-search-flagged-face ((,c :foreground ,err)))
+ `(notmuch-search-flagged-face ((,c :foreground ,keyword)))
`(notmuch-search-matching-authors ((,c :foreground ,mail-recipient)))
`(notmuch-search-non-matching-authors ((,c :inherit shadow)))
`(notmuch-search-subject ((,c :foreground ,fg-main)))
@@ -3241,7 +3128,7 @@ FG and BG are the main colors."
`(notmuch-tag-added ((,c :underline ,info)))
`(notmuch-tag-deleted ((,c :strike-through ,err)))
`(notmuch-tag-face ((,c :foreground ,accent-0)))
- `(notmuch-tag-flagged ((,c :foreground ,err)))
+ `(notmuch-tag-flagged ((,c :foreground ,keyword)))
`(notmuch-tag-unread ((,c :foreground ,accent-1)))
`(notmuch-tree-match-author-face ((,c :inherit notmuch-search-matching-authors)))
`(notmuch-tree-match-date-face ((,c :inherit notmuch-search-date)))
@@ -3280,7 +3167,7 @@ FG and BG are the main colors."
`(nxml-ref ((,c :inherit (shadow modus-themes-bold))))
`(rng-error ((,c :inherit error)))
;;;;; olivetti
- `(olivetti-fringe ((,c :background ,bg-main)))
+ `(olivetti-fringe ((,c :background ,fringe)))
;;;;; orderless
`(orderless-match-face-0 ((,c :inherit modus-themes-completion-match-0)))
`(orderless-match-face-1 ((,c :inherit modus-themes-completion-match-1)))
@@ -3290,7 +3177,7 @@ FG and BG are the main colors."
`(org-agenda-calendar-daterange ((,c :foreground ,date-range)))
`(org-agenda-calendar-event ((,c :foreground ,date-event)))
`(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant org-agenda-calendar-event))))
- `(org-agenda-clocking ((,c :inherit modus-themes-mark-alt)))
+ `(org-agenda-clocking ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument)))
`(org-agenda-column-dateline ((,c :background ,bg-inactive)))
`(org-agenda-current-time ((,c :foreground ,date-now)))
`(org-agenda-date ((,c ,@(modus-themes--heading 'agenda-date date-weekday))))
@@ -3309,10 +3196,10 @@ FG and BG are the main colors."
`(org-agenda-structure-filter ((,c :inherit org-agenda-structure :foreground ,warning)))
`(org-agenda-structure-secondary ((,c :inherit font-lock-doc-face)))
`(org-archived ((,c :background ,bg-inactive :foreground ,fg-main)))
- `(org-block ((,c ,@(modus-themes--org-block fg-main bg-dim))))
- `(org-block-begin-line ((,c ,@(modus-themes--org-block prose-block bg-inactive))))
+ `(org-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-contents :extend t)))
+ `(org-block-begin-line ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter :extend t)))
`(org-block-end-line ((,c :inherit org-block-begin-line)))
- `(org-checkbox ((,c :foreground ,warning)))
+ `(org-checkbox ((,c :inherit modus-themes-fixed-pitch :foreground ,warning)))
`(org-checkbox-statistics-done ((,c :inherit org-done)))
`(org-checkbox-statistics-todo ((,c :inherit org-todo)))
`(org-clock-overlay ((,c :inherit secondary-selection)))
@@ -3321,6 +3208,11 @@ FG and BG are the main colors."
`(org-column-title ((,c :inherit (bold default) :underline t :background ,bg-dim)))
`(org-date ((,c :inherit modus-themes-fixed-pitch :foreground ,date-common)))
`(org-date-selected ((,c :foreground ,date-common :inverse-video t)))
+ ;; NOTE 2024-03-17: Normally we do not want to add this padding
+ ;; with the :box, but I do it here because the keys are otherwise
+ ;; very hard to read. The square brackets around them are not
+ ;; colored, which is what is causing the problem.
+ `(org-dispatcher-highlight ((,c :inherit modus-themes-bold :box (:line-width 2 :color ,bg-hover-secondary) :background ,bg-hover-secondary :foreground ,fg-main)))
`(org-document-info ((,c :foreground ,prose-metadata-value)))
`(org-document-info-keyword ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata)))
`(org-document-title ((,c :inherit modus-themes-heading-0)))
@@ -3328,7 +3220,7 @@ FG and BG are the main colors."
`(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata)))
`(org-ellipsis (( ))) ; inherits from the heading's color
`(org-footnote ((,c :inherit link)))
- `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,fnname)))
+ `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-table-formula)))
`(org-headline-done ((,c :inherit org-done)))
`(org-headline-todo ((,c :inherit org-todo)))
`(org-hide ((,c :foreground ,bg-main)))
@@ -3370,13 +3262,13 @@ FG and BG are the main colors."
`(org-verse ((,c :inherit org-block)))
`(org-warning ((,c :inherit warning)))
;;;;; org-habit
- `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "black"))) ; fg is special case
+ `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "#000000"))) ; fg is special case
`(org-habit-alert-future-face ((,c :background ,bg-graph-yellow-1)))
- `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "black"))) ; fg is special case
+ `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "#000000"))) ; fg is special case
`(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1)))
`(org-habit-overdue-face ((,c :background ,bg-graph-red-0)))
`(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1)))
- `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "black"))) ; fg is special case
+ `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "#000000"))) ; fg is special case
`(org-habit-ready-future-face ((,c :background ,bg-graph-green-1)))
;;;;; org-journal
`(org-journal-calendar-entry-face ((,c :inherit modus-themes-slant :foreground ,date-common)))
@@ -3551,10 +3443,10 @@ FG and BG are the main colors."
`(recursion-indicator-general ((,c :foreground ,modeline-err)))
`(recursion-indicator-minibuffer ((,c :foreground ,modeline-info)))
;;;;; regexp-builder (re-builder)
- `(reb-match-0 ((,c :inherit modus-themes-intense-cyan)))
- `(reb-match-1 ((,c :inherit modus-themes-subtle-magenta)))
- `(reb-match-2 ((,c :inherit modus-themes-subtle-green)))
- `(reb-match-3 ((,c :inherit modus-themes-intense-yellow)))
+ `(reb-match-0 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(reb-match-1 ((,c :inherit modus-themes-search-rx-group-1)))
+ `(reb-match-2 ((,c :inherit modus-themes-search-rx-group-2)))
+ `(reb-match-3 ((,c :inherit modus-themes-search-rx-group-3)))
`(reb-regexp-grouping-backslash ((,c :inherit font-lock-regexp-grouping-backslash)))
`(reb-regexp-grouping-construct ((,c :inherit font-lock-regexp-grouping-construct)))
;;;;; rg (rg.el)
@@ -3609,7 +3501,7 @@ FG and BG are the main colors."
`(shortdoc-heading ((,c :inherit bold)))
`(shortdoc-section (())) ; remove the default's variable-pitch style
;;;;; show-paren-mode
- `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-main :underline ,underline-paren-match)))
+ `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-paren-match :underline ,underline-paren-match)))
`(show-paren-match-expression ((,c :background ,bg-paren-expression)))
`(show-paren-mismatch ((,c :inherit modus-themes-prominent-error)))
;;;;; shr
@@ -3621,6 +3513,7 @@ FG and BG are the main colors."
`(shr-h4 ((,c :inherit modus-themes-heading-4)))
`(shr-h5 ((,c :inherit modus-themes-heading-5)))
`(shr-h6 ((,c :inherit modus-themes-heading-6)))
+ `(shr-mark ((,c :inherit match)))
`(shr-selected-link ((,c :inherit modus-themes-mark-sel)))
;;;;; side-notes
`(side-notes ((,c :background ,bg-dim :foreground ,fg-dim)))
@@ -3803,14 +3696,25 @@ FG and BG are the main colors."
`(transient-amaranth ((,c :inherit bold :foreground ,yellow-warmer)))
;; Placate the compiler for what is a spurious warning. We also
;; have to do this with `eldoc-highlight-function-argument'.
- (list 'transient-argument `((,c :inherit (bold modus-themes-mark-alt))))
+ (list 'transient-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument)))
`(transient-blue ((,c :inherit bold :foreground ,blue)))
`(transient-disabled-suffix ((,c :inherit modus-themes-mark-del)))
`(transient-enabled-suffix ((,c :inherit modus-themes-subtle-cyan)))
`(transient-heading ((,c :inherit bold :foreground ,fg-main)))
`(transient-inactive-argument ((,c :inherit shadow)))
`(transient-inactive-value ((,c :inherit shadow)))
+ ;; NOTE 2023-12-09 10:30:09 +0200: The new user option
+ ;; `transient-semantic-coloring' is enabled by default. This is
+ ;; not good for us, because we are making it harder for users who
+ ;; need accessible colors to use the transient interfaces. I
+ ;; could set that user option to nil, but I think it is less
+ ;; intrusive to enforce uniformity among the relevant faces.
+ ;; Those who want semantic coloring can modify these faces.
`(transient-key ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-exit ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-noop ((,c :inherit (shadow modus-themes-key-binding))))
+ `(transient-key-return ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-stay ((,c :inherit modus-themes-key-binding)))
`(transient-mismatched-key ((,c :underline t)))
`(transient-nonstandard-key ((,c :underline t)))
`(transient-pink ((,c :inherit bold :foreground ,magenta)))
@@ -3819,7 +3723,7 @@ FG and BG are the main colors."
`(transient-teal ((,c :inherit bold :foreground ,cyan-cooler)))
`(transient-unreachable ((,c :inherit shadow)))
`(transient-unreachable-key ((,c :inherit shadow)))
- `(transient-value ((,c :inherit (bold modus-themes-mark-sel))))
+ `(transient-value ((,c :inherit bold :background ,bg-active-value :foreground ,fg-active-value)))
;;;;; trashed
`(trashed-deleted ((,c :inherit modus-themes-mark-del)))
`(trashed-directory ((,c :foreground ,accent-0)))
@@ -3918,11 +3822,11 @@ FG and BG are the main colors."
`(visible-mark-forward-face1 ((,c :background ,bg-magenta-intense)))
`(visible-mark-forward-face2 ((,c :background ,bg-green-intense)))
;;;;; visual-regexp
- `(vr/group-0 ((,c :inherit modus-themes-intense-blue)))
- `(vr/group-1 ((,c :inherit modus-themes-intense-magenta)))
- `(vr/group-2 ((,c :inherit modus-themes-intense-green)))
- `(vr/match-0 ((,c :inherit modus-themes-intense-yellow)))
- `(vr/match-1 ((,c :inherit modus-themes-intense-yellow)))
+ `(vr/group-0 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(vr/group-1 ((,c :inherit modus-themes-search-rx-group-1)))
+ `(vr/group-2 ((,c :inherit modus-themes-search-rx-group-2)))
+ `(vr/match-0 ((,c :inherit modus-themes-search-current)))
+ `(vr/match-1 ((,c :inherit modus-themes-search-lazy)))
`(vr/match-separator-face ((,c :inherit bold :background ,bg-active)))
;;;;; vterm
;; NOTE 2023-08-10: `vterm-color-black' and `vterm-color-white'
@@ -4025,7 +3929,7 @@ FG and BG are the main colors."
`(which-func ((,c :inherit bold :foreground ,modeline-info))) ; same as `breadcrumb-imenu-leaf-face'
;;;;; which-key
`(which-key-command-description-face ((,c :foreground ,fg-main)))
- `(which-key-group-description-face ((,c :foreground ,keyword)))
+ `(which-key-group-description-face ((,c :foreground ,type)))
`(which-key-highlighted-command-face ((,c :foreground ,warning :underline t)))
`(which-key-key-face ((,c :inherit modus-themes-key-binding)))
`(which-key-local-map-description-face ((,c :foreground ,fg-main)))
@@ -4034,14 +3938,14 @@ FG and BG are the main colors."
`(which-key-special-key-face ((,c :inherit error)))
;;;;; whitespace-mode
`(whitespace-big-indent ((,c :background ,bg-space-err)))
- `(whitespace-empty ((,c :inherit modus-themes-intense-magenta)))
+ `(whitespace-empty ((,c :background ,bg-space)))
`(whitespace-hspace ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-indentation ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-line ((,c :background ,bg-space :foreground ,warning)))
`(whitespace-newline ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-space ((,c :background ,bg-space :foreground ,fg-space)))
- `(whitespace-space-after-tab ((,c :inherit modus-themes-subtle-magenta)))
- `(whitespace-space-before-tab ((,c :inherit modus-themes-subtle-cyan)))
+ `(whitespace-space-after-tab ((,c :inherit warning :background ,bg-space)))
+ `(whitespace-space-before-tab ((,c :inherit warning :background ,bg-space)))
`(whitespace-tab ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-trailing ((,c :background ,bg-space-err)))
;;;;; window-divider-mode
@@ -4072,14 +3976,27 @@ FG and BG are the main colors."
;;;;; yaml-mode
`(yaml-tab-face ((,c :background ,bg-space-err)))
;;;;; yasnippet
- `(yas-field-highlight-face ((,c :inherit highlight))))
+ `(yas-field-highlight-face ((,c :inherit highlight)))
+;;;;; ztree
+ `(ztreep-arrow-face ((,c :inherit shadow)))
+ `(ztreep-diff-header-face ((,c :inherit modus-themes-heading-0)))
+ `(ztreep-diff-header-small-face ((,c :inherit font-lock-doc-face)))
+ `(ztreep-diff-model-add-face ((,c :foreground ,info)))
+ `(ztreep-diff-model-diff-face ((,c :foreground ,err)))
+ `(ztreep-diff-model-ignored-face ((,c :foreground ,fg-dim :strike-through t)))
+ `(ztreep-diff-model-normal-face (( )))
+ `(ztreep-expand-sign-face ((,c :inherit shadow)))
+ `(ztreep-header-face ((,c :inherit modus-themes-heading-0)))
+ `(ztreep-leaf-face (( )))
+ `(ztreep-node-count-children-face ((,c :inherit (shadow italic))))
+ `(ztreep-node-face ((,c :foreground ,accent-0))))
"Face specs for use with `modus-themes-theme'.")
(defconst modus-themes-custom-variables
'(
;;;; ansi-colors
`(ansi-color-faces-vector [default bold shadow italic underline success warning error])
- `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"])
+ `(ansi-color-names-vector ["#595959" ,red ,green ,yellow ,blue ,magenta ,cyan "#a6a6a6"])
;;;; chart
`(chart-face-color-list
'( ,bg-graph-red-0 ,bg-graph-green-0 ,bg-graph-yellow-0 ,bg-graph-blue-0 ,bg-graph-magenta-0 ,bg-graph-cyan-0
@@ -4152,29 +4069,35 @@ FG and BG are the main colors."
modus-themes-fg-yellow-intense
modus-themes-fg-magenta-intense
modus-themes-fg-cyan-intense))
-;;;; org-src-block-faces
- (if (or (eq modus-themes-org-blocks 'tinted-background)
- (eq modus-themes-org-blocks 'rainbow))
- `(org-src-block-faces
- `(("emacs-lisp" modus-themes-nuanced-magenta)
- ("elisp" modus-themes-nuanced-magenta)
- ("clojure" modus-themes-nuanced-magenta)
- ("clojurescript" modus-themes-nuanced-magenta)
- ("c" modus-themes-nuanced-blue)
- ("c++" modus-themes-nuanced-blue)
- ("sh" modus-themes-nuanced-green)
- ("shell" modus-themes-nuanced-green)
- ("html" modus-themes-nuanced-yellow)
- ("xml" modus-themes-nuanced-yellow)
- ("css" modus-themes-nuanced-red)
- ("scss" modus-themes-nuanced-red)
- ("python" modus-themes-nuanced-green)
- ("ipython" modus-themes-nuanced-magenta)
- ("r" modus-themes-nuanced-cyan)
- ("yaml" modus-themes-nuanced-cyan)
- ("conf" modus-themes-nuanced-cyan)
- ("docker" modus-themes-nuanced-cyan)))
- `(org-src-block-faces '())))
+;;;; rustic-ansi-faces
+ `(rustic-ansi-faces
+ [,fg-term-black
+ ,fg-term-red
+ ,fg-term-green
+ ,fg-term-yellow
+ ,fg-term-blue
+ ,fg-term-magenta
+ ,fg-term-cyan
+ ,fg-term-white])
+;;;; xterm-color
+ `(xterm-color-names
+ [,fg-term-black
+ ,fg-term-red
+ ,fg-term-green
+ ,fg-term-yellow
+ ,fg-term-blue
+ ,fg-term-magenta
+ ,fg-term-cyan
+ ,fg-term-white])
+ `(xterm-color-names-bright
+ [,fg-term-black-bright
+ ,fg-term-red-bright
+ ,fg-term-green-bright
+ ,fg-term-yellow-bright
+ ,fg-term-blue-bright
+ ,fg-term-magenta-bright
+ ,fg-term-cyan-bright
+ ,fg-term-white-bright]))
"Custom variables for `modus-themes-theme'.")
;;; Theme macros
diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el
index 62715e20e51..d721dba09a9 100644
--- a/etc/themes/modus-vivendi-deuteranopia-theme.el
+++ b/etc/themes/modus-vivendi-deuteranopia-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a black background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -127,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -211,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -240,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-blue-nuanced)
+ (fg-active-value blue-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -288,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
- (date-now blue-faint)
+ (date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@@ -342,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done blue)
- (prose-macro magenta-cooler)
+ (prose-todo yellow-warmer)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula yellow-warmer)
+
(prose-tag magenta-faint)
- (prose-todo yellow-warmer)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -365,6 +384,17 @@ standard)."
(rainbow-7 blue-faint)
(rainbow-8 magenta-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-blue-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-cyan-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-blue-subtle)
+ (bg-search-rx-group-3 bg-yellow-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -373,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -408,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el
index 238484206bb..8b822974c15 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-theme.el --- Elegant, highly legible theme with a black background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-cooler)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-cooler)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
@@ -451,7 +481,6 @@ Semantic color mappings have the form (MAPPING-NAME COLOR-NAME)
with both as symbols. The latter is a named color that already
exists in the palette and is associated with a HEX-VALUE.")
-
(defcustom modus-vivendi-palette-overrides nil
"Overrides for `modus-vivendi-palette'.
diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el
index 025257ef01c..5aa44304ee9 100644
--- a/etc/themes/modus-vivendi-tinted-theme.el
+++ b/etc/themes/modus-vivendi-tinted-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible theme with a night sky background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -125,12 +125,18 @@ which corresponds to a minimum contrast in relative luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#350f14")
- (bg-green-nuanced "#002718")
- (bg-yellow-nuanced "#2c1f00")
- (bg-blue-nuanced "#131c4d")
- (bg-magenta-nuanced "#2f133f")
- (bg-cyan-nuanced "#04253f")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
+
+;;; Uncommon accent backgrounds
+
+ (bg-ochre "#442c2f")
+ (bg-lavender "#38325c")
+ (bg-sage "#0f3d30")
;;; Graphs
@@ -200,15 +206,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-diff-context "#1a1f30")
-;;; Uncommon accent backgrounds
-
- (bg-ochre "#442c2f")
- (bg-lavender "#38325c")
- (bg-sage "#0f3d30")
-
;;; Paren match
- (bg-paren-match "#2f7f9f")
+ (bg-paren-match "#5f789f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of
;;;; General mappings
(fringe bg-dim)
- (cursor magenta-warmer)
+ (cursor magenta-intense)
- (keybind blue-cooler)
+ (keybind magenta-cooler)
(name magenta)
(identifier yellow-faint)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-cooler)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-cooler)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -337,20 +343,32 @@ which corresponds to a minimum contrast in relative luminance of
(fg-prompt cyan-cooler)
(bg-prompt unspecified)
- (bg-space-err bg-red-intense)
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -364,17 +382,29 @@ which corresponds to a minimum contrast in relative luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
(fg-space border)
+ (bg-space-err bg-red-intense)
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el b/etc/themes/modus-vivendi-tritanopia-theme.el
index bfd6d63b844..2327a1e9c97 100644
--- a/etc/themes/modus-vivendi-tritanopia-theme.el
+++ b/etc/themes/modus-vivendi-tritanopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-vivendi-tritanopia-theme.el --- Tritanopia-optimized theme with a black background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; 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
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-red-nuanced)
+ (fg-active-argument red-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan)
+
;;;; Code mappings
(builtin magenta)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro red-warmer)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done cyan)
- (prose-macro red-warmer)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
- (prose-tag fg-alt)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
+ (prose-table-formula red-cooler)
+
+ (prose-tag magenta-faint)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-red-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-cyan-subtle)
+ (bg-search-rx-group-3 bg-red-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/tutorials/TUTORIAL.pl b/etc/tutorials/TUTORIAL.pl
index 6f2565f6855..462fdcd835e 100644
--- a/etc/tutorials/TUTORIAL.pl
+++ b/etc/tutorials/TUTORIAL.pl
@@ -218,17 +218,11 @@ Na przykład C-u 4 C-v przewija ekran o 4 linie.
To powinno było przewinąć ekran do gĆ³ry o 8 linii. Jeśli chciałbyś
przewinąć ekran w dĆ³Å‚, to powinieneś podać argument przed poleceniem M-v.
-Jeśli pracujesz w systemie z okienkowym trybem graficznym, jak X11
-lub MS-Windows, to prawdopodobnie po lewej stronie okna Emacsa znajduje
-się prostokątny obszar nazywany po angielsku "scrollbar", a po polsku
-suwakiem. Za jego pomocą możesz przewijać tekst, używając do tego myszy.
+W środowisku graficznym, takim jak X lub Microsoft Windows, po jednej
+stronie okna Emacs znajdzie się długi prostokątny obszar, nazywany
+prowadnicą przewijacza.Ā  Można przewijać treść, stukając myszą w prowadnicę.
->> SprĆ³buj nacisnąć środkowy klawisz myszy u gĆ³ry podświetlonego
- obszaru na suwaku. To powinno przewinąć tekst do miejsca
- określonego przez wysokość, na ktĆ³rej nacisnąłeś klawisz myszy.
-
->> Przesuń mysz do miejsca oddalonego od gĆ³rnego końca suwaka o mniej
- więcej trzy linie i naciśnij lewy klawisz myszy kilka razy.
+Można rĆ³wnież używać kĆ³Å‚eczka myszy do przewijania, jeśli jest dostępne.
* GDY EMACS JEST ZABLOKOWANY
diff --git a/exec/Makefile.in b/exec/Makefile.in
index 068f59efc75..36f0c0c74a9 100644
--- a/exec/Makefile.in
+++ b/exec/Makefile.in
@@ -131,9 +131,12 @@ maintainer-clean: distclean
### the coding standards seem to come from. It's like distclean, but
### it deletes backup and autosave files too.
+# config.* and install-sh are copied from build-aux in the root of
+# this repository by autogen.sh.
extraclean: maintainer-clean
-rm -f config-tmp-* $(srcdir)/aclocal.m4 $(srcdir)/configure \
- $(srcdir)/src/config.in
+ $(srcdir)/src/config.in $(srcdir)/config.guess \
+ $(srcdir)/config.sub $(srcdir)/install-sh
-[ "$(srcdir)" = "." ] || \
find $(srcdir) '(' -name '*~' -o -name '#*' ')' $(FIND_DELETE)
-find . '(' -name '*~' -o -name '#*' ')' $(FIND_DELETE)
diff --git a/exec/config.guess b/exec/config.guess
deleted file mode 100755
index 62974adb3dd..00000000000
--- a/exec/config.guess
+++ /dev/null
@@ -1,1774 +0,0 @@
-#!/usr/bin/sh
-# Attempt to guess a canonical system name.
-# Copyright 1992-2024 Free Software Foundation, Inc.
-
-# shellcheck disable=SC2006,SC2268 # see below for rationale
-
-timestamp='2023-06-23'
-
-# 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
-# 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/>.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that
-# program. This Exception is an additional permission under section 7
-# of the GNU General Public License, version 3 ("GPLv3").
-#
-# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
-#
-# You can get the latest version of this script from:
-# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
-#
-# Please send patches to <config-patches@gnu.org>.
-
-
-# The "shellcheck disable" line above the timestamp inhibits complaints
-# about features and limitations of the classic Bourne shell that were
-# superseded or lifted in POSIX. However, this script identifies a wide
-# variety of pre-POSIX systems that do not have POSIX shells at all, and
-# even some reasonably current systems (Solaris 10 as case-in-point) still
-# have a pre-POSIX /bin/sh.
-
-
-me=`echo "$0" | sed -e 's,.*/,,'`
-
-usage="\
-Usage: $0 [OPTION]
-
-Output the configuration name of the system '$me' is run on.
-
-Options:
- -h, --help print this help, then exit
- -t, --time-stamp print date of last modification, then exit
- -v, --version print version number, then exit
-
-Report bugs and patches to <config-patches@gnu.org>."
-
-version="\
-GNU config.guess ($timestamp)
-
-Originally written by Per Bothner.
-Copyright 1992-2023 Free Software Foundation, Inc.
-
-This is free software; see the source for copying conditions. There is NO
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
-
-help="
-Try '$me --help' for more information."
-
-# Parse command line
-while test $# -gt 0 ; do
- case $1 in
- --time-stamp | --time* | -t )
- echo "$timestamp" ; exit ;;
- --version | -v )
- echo "$version" ; exit ;;
- --help | --h* | -h )
- echo "$usage"; exit ;;
- -- ) # Stop option processing
- shift; break ;;
- - ) # Use stdin as input.
- break ;;
- -* )
- echo "$me: invalid option $1$help" >&2
- exit 1 ;;
- * )
- break ;;
- esac
-done
-
-if test $# != 0; then
- echo "$me: too many arguments$help" >&2
- exit 1
-fi
-
-# Just in case it came from the environment.
-GUESS=
-
-# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
-# compiler to aid in system detection is discouraged as it requires
-# temporary files to be created and, as you can see below, it is a
-# headache to deal with in a portable fashion.
-
-# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still
-# use 'HOST_CC' if defined, but it is deprecated.
-
-# Portable tmp directory creation inspired by the Autoconf team.
-
-tmp=
-# shellcheck disable=SC2172
-trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15
-
-set_cc_for_build() {
- # prevent multiple calls if $tmp is already set
- test "$tmp" && return 0
- : "${TMPDIR=/tmp}"
- # shellcheck disable=SC2039,SC3028
- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
- dummy=$tmp/dummy
- case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
- ,,) echo "int x;" > "$dummy.c"
- for driver in cc gcc c89 c99 ; do
- if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
- CC_FOR_BUILD=$driver
- break
- fi
- done
- if test x"$CC_FOR_BUILD" = x ; then
- CC_FOR_BUILD=no_compiler_found
- fi
- ;;
- ,,*) CC_FOR_BUILD=$CC ;;
- ,*,*) CC_FOR_BUILD=$HOST_CC ;;
- esac
-}
-
-# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
-# (ghazi@noc.rutgers.edu 1994-08-24)
-if test -f /.attbin/uname ; then
- PATH=$PATH:/.attbin ; export PATH
-fi
-
-UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
-UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
-
-case $UNAME_SYSTEM in
-Linux|GNU|GNU/*)
- LIBC=unknown
-
- set_cc_for_build
- cat <<-EOF > "$dummy.c"
- #include <features.h>
- #if defined(__UCLIBC__)
- LIBC=uclibc
- #elif defined(__dietlibc__)
- LIBC=dietlibc
- #elif defined(__GLIBC__)
- LIBC=gnu
- #else
- #include <stdarg.h>
- /* First heuristic to detect musl libc. */
- #ifdef __DEFINED_va_list
- LIBC=musl
- #endif
- #endif
- EOF
- cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`
- eval "$cc_set_libc"
-
- # Second heuristic to detect musl libc.
- if [ "$LIBC" = unknown ] &&
- command -v ldd >/dev/null &&
- ldd --version 2>&1 | grep -q ^musl; then
- LIBC=musl
- fi
-
- # If the system lacks a compiler, then just pick glibc.
- # We could probably try harder.
- if [ "$LIBC" = unknown ]; then
- LIBC=gnu
- fi
- ;;
-esac
-
-# Note: order is significant - the case branches are not exclusive.
-
-case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
- *:NetBSD:*:*)
- # NetBSD (nbsd) targets should (where applicable) match one or
- # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
- # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
- # switched to ELF, *-*-netbsd* would select the old
- # object file format. This provides both forward
- # compatibility and a consistent mechanism for selecting the
- # object file format.
- #
- # Note: NetBSD doesn't particularly care about the vendor
- # portion of the name. We always set it to "unknown".
- UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \
- /sbin/sysctl -n hw.machine_arch 2>/dev/null || \
- /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \
- echo unknown)`
- case $UNAME_MACHINE_ARCH in
- aarch64eb) machine=aarch64_be-unknown ;;
- armeb) machine=armeb-unknown ;;
- arm*) machine=arm-unknown ;;
- sh3el) machine=shl-unknown ;;
- sh3eb) machine=sh-unknown ;;
- sh5el) machine=sh5le-unknown ;;
- earmv*)
- arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`
- endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`
- machine=${arch}${endian}-unknown
- ;;
- *) machine=$UNAME_MACHINE_ARCH-unknown ;;
- esac
- # The Operating System including object format, if it has switched
- # to ELF recently (or will in the future) and ABI.
- case $UNAME_MACHINE_ARCH in
- earm*)
- os=netbsdelf
- ;;
- arm*|i386|m68k|ns32k|sh3*|sparc|vax)
- set_cc_for_build
- if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
- | grep -q __ELF__
- then
- # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
- # Return netbsd for either. FIX?
- os=netbsd
- else
- os=netbsdelf
- fi
- ;;
- *)
- os=netbsd
- ;;
- esac
- # Determine ABI tags.
- case $UNAME_MACHINE_ARCH in
- earm*)
- expr='s/^earmv[0-9]/-eabi/;s/eb$//'
- abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`
- ;;
- esac
- # The OS release
- # Debian GNU/NetBSD machines have a different userland, and
- # thus, need a distinct triplet. However, they do not need
- # kernel version information, so it can be replaced with a
- # suitable tag, in the style of linux-gnu.
- case $UNAME_VERSION in
- Debian*)
- release='-gnu'
- ;;
- *)
- release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2`
- ;;
- esac
- # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
- # contains redundant information, the shorter form:
- # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
- GUESS=$machine-${os}${release}${abi-}
- ;;
- *:Bitrig:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
- GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE
- ;;
- *:OpenBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
- GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE
- ;;
- *:SecBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'`
- GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE
- ;;
- *:LibertyBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
- GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE
- ;;
- *:MidnightBSD:*:*)
- GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE
- ;;
- *:ekkoBSD:*:*)
- GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE
- ;;
- *:SolidBSD:*:*)
- GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE
- ;;
- *:OS108:*:*)
- GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE
- ;;
- macppc:MirBSD:*:*)
- GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE
- ;;
- *:MirBSD:*:*)
- GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE
- ;;
- *:Sortix:*:*)
- GUESS=$UNAME_MACHINE-unknown-sortix
- ;;
- *:Twizzler:*:*)
- GUESS=$UNAME_MACHINE-unknown-twizzler
- ;;
- *:Redox:*:*)
- GUESS=$UNAME_MACHINE-unknown-redox
- ;;
- mips:OSF1:*.*)
- GUESS=mips-dec-osf1
- ;;
- alpha:OSF1:*:*)
- # Reset EXIT trap before exiting to avoid spurious non-zero exit code.
- trap '' 0
- case $UNAME_RELEASE in
- *4.0)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
- ;;
- *5.*)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
- ;;
- esac
- # According to Compaq, /usr/sbin/psrinfo has been available on
- # OSF/1 and Tru64 systems produced since 1995. I hope that
- # covers most systems running today. This code pipes the CPU
- # types through head -n 1, so we only detect the type of CPU 0.
- ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
- case $ALPHA_CPU_TYPE in
- "EV4 (21064)")
- UNAME_MACHINE=alpha ;;
- "EV4.5 (21064)")
- UNAME_MACHINE=alpha ;;
- "LCA4 (21066/21068)")
- UNAME_MACHINE=alpha ;;
- "EV5 (21164)")
- UNAME_MACHINE=alphaev5 ;;
- "EV5.6 (21164A)")
- UNAME_MACHINE=alphaev56 ;;
- "EV5.6 (21164PC)")
- UNAME_MACHINE=alphapca56 ;;
- "EV5.7 (21164PC)")
- UNAME_MACHINE=alphapca57 ;;
- "EV6 (21264)")
- UNAME_MACHINE=alphaev6 ;;
- "EV6.7 (21264A)")
- UNAME_MACHINE=alphaev67 ;;
- "EV6.8CB (21264C)")
- UNAME_MACHINE=alphaev68 ;;
- "EV6.8AL (21264B)")
- UNAME_MACHINE=alphaev68 ;;
- "EV6.8CX (21264D)")
- UNAME_MACHINE=alphaev68 ;;
- "EV6.9A (21264/EV69A)")
- UNAME_MACHINE=alphaev69 ;;
- "EV7 (21364)")
- UNAME_MACHINE=alphaev7 ;;
- "EV7.9 (21364A)")
- UNAME_MACHINE=alphaev79 ;;
- esac
- # A Pn.n version is a patched version.
- # A Vn.n version is a released version.
- # A Tn.n version is a released field test version.
- # A Xn.n version is an unreleased experimental baselevel.
- # 1.2 uses "1.2" for uname -r.
- OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
- GUESS=$UNAME_MACHINE-dec-osf$OSF_REL
- ;;
- Amiga*:UNIX_System_V:4.0:*)
- GUESS=m68k-unknown-sysv4
- ;;
- *:[Aa]miga[Oo][Ss]:*:*)
- GUESS=$UNAME_MACHINE-unknown-amigaos
- ;;
- *:[Mm]orph[Oo][Ss]:*:*)
- GUESS=$UNAME_MACHINE-unknown-morphos
- ;;
- *:OS/390:*:*)
- GUESS=i370-ibm-openedition
- ;;
- *:z/VM:*:*)
- GUESS=s390-ibm-zvmoe
- ;;
- *:OS400:*:*)
- GUESS=powerpc-ibm-os400
- ;;
- arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
- GUESS=arm-acorn-riscix$UNAME_RELEASE
- ;;
- arm*:riscos:*:*|arm*:RISCOS:*:*)
- GUESS=arm-unknown-riscos
- ;;
- SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
- GUESS=hppa1.1-hitachi-hiuxmpp
- ;;
- Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
- # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
- case `(/bin/universe) 2>/dev/null` in
- att) GUESS=pyramid-pyramid-sysv3 ;;
- *) GUESS=pyramid-pyramid-bsd ;;
- esac
- ;;
- NILE*:*:*:dcosx)
- GUESS=pyramid-pyramid-svr4
- ;;
- DRS?6000:unix:4.0:6*)
- GUESS=sparc-icl-nx6
- ;;
- DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
- case `/usr/bin/uname -p` in
- sparc) GUESS=sparc-icl-nx7 ;;
- esac
- ;;
- s390x:SunOS:*:*)
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL
- ;;
- sun4H:SunOS:5.*:*)
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=sparc-hal-solaris2$SUN_REL
- ;;
- sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=sparc-sun-solaris2$SUN_REL
- ;;
- i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
- GUESS=i386-pc-auroraux$UNAME_RELEASE
- ;;
- i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
- set_cc_for_build
- SUN_ARCH=i386
- # If there is a compiler, see if it is configured for 64-bit objects.
- # Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
- # This test works for both compilers.
- if test "$CC_FOR_BUILD" != no_compiler_found; then
- if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
- (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \
- grep IS_64BIT_ARCH >/dev/null
- then
- SUN_ARCH=x86_64
- fi
- fi
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=$SUN_ARCH-pc-solaris2$SUN_REL
- ;;
- sun4*:SunOS:6*:*)
- # According to config.sub, this is the proper way to canonicalize
- # SunOS6. Hard to guess exactly what SunOS6 will be like, but
- # it's likely to be more like Solaris than SunOS4.
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=sparc-sun-solaris3$SUN_REL
- ;;
- sun4*:SunOS:*:*)
- case `/usr/bin/arch -k` in
- Series*|S4*)
- UNAME_RELEASE=`uname -v`
- ;;
- esac
- # Japanese Language versions have a version number like '4.1.3-JL'.
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'`
- GUESS=sparc-sun-sunos$SUN_REL
- ;;
- sun3*:SunOS:*:*)
- GUESS=m68k-sun-sunos$UNAME_RELEASE
- ;;
- sun*:*:4.2BSD:*)
- UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
- test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
- case `/bin/arch` in
- sun3)
- GUESS=m68k-sun-sunos$UNAME_RELEASE
- ;;
- sun4)
- GUESS=sparc-sun-sunos$UNAME_RELEASE
- ;;
- esac
- ;;
- aushp:SunOS:*:*)
- GUESS=sparc-auspex-sunos$UNAME_RELEASE
- ;;
- # The situation for MiNT is a little confusing. The machine name
- # can be virtually everything (everything which is not
- # "atarist" or "atariste" at least should have a processor
- # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
- # to the lowercase version "mint" (or "freemint"). Finally
- # the system name "TOS" denotes a system which is actually not
- # MiNT. But MiNT is downward compatible to TOS, so this should
- # be no problem.
- atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
- GUESS=m68k-atari-mint$UNAME_RELEASE
- ;;
- atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
- GUESS=m68k-atari-mint$UNAME_RELEASE
- ;;
- *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
- GUESS=m68k-atari-mint$UNAME_RELEASE
- ;;
- milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
- GUESS=m68k-milan-mint$UNAME_RELEASE
- ;;
- hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
- GUESS=m68k-hades-mint$UNAME_RELEASE
- ;;
- *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
- GUESS=m68k-unknown-mint$UNAME_RELEASE
- ;;
- m68k:machten:*:*)
- GUESS=m68k-apple-machten$UNAME_RELEASE
- ;;
- powerpc:machten:*:*)
- GUESS=powerpc-apple-machten$UNAME_RELEASE
- ;;
- RISC*:Mach:*:*)
- GUESS=mips-dec-mach_bsd4.3
- ;;
- RISC*:ULTRIX:*:*)
- GUESS=mips-dec-ultrix$UNAME_RELEASE
- ;;
- VAX*:ULTRIX*:*:*)
- GUESS=vax-dec-ultrix$UNAME_RELEASE
- ;;
- 2020:CLIX:*:* | 2430:CLIX:*:*)
- GUESS=clipper-intergraph-clix$UNAME_RELEASE
- ;;
- mips:*:*:UMIPS | mips:*:*:RISCos)
- set_cc_for_build
- sed 's/^ //' << EOF > "$dummy.c"
-#ifdef __cplusplus
-#include <stdio.h> /* for printf() prototype */
- int main (int argc, char *argv[]) {
-#else
- int main (argc, argv) int argc; char *argv[]; {
-#endif
- #if defined (host_mips) && defined (MIPSEB)
- #if defined (SYSTYPE_SYSV)
- printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0);
- #endif
- #if defined (SYSTYPE_SVR4)
- printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0);
- #endif
- #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
- printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0);
- #endif
- #endif
- exit (-1);
- }
-EOF
- $CC_FOR_BUILD -o "$dummy" "$dummy.c" &&
- dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&
- SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
- { echo "$SYSTEM_NAME"; exit; }
- GUESS=mips-mips-riscos$UNAME_RELEASE
- ;;
- Motorola:PowerMAX_OS:*:*)
- GUESS=powerpc-motorola-powermax
- ;;
- Motorola:*:4.3:PL8-*)
- GUESS=powerpc-harris-powermax
- ;;
- Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
- GUESS=powerpc-harris-powermax
- ;;
- Night_Hawk:Power_UNIX:*:*)
- GUESS=powerpc-harris-powerunix
- ;;
- m88k:CX/UX:7*:*)
- GUESS=m88k-harris-cxux7
- ;;
- m88k:*:4*:R4*)
- GUESS=m88k-motorola-sysv4
- ;;
- m88k:*:3*:R3*)
- GUESS=m88k-motorola-sysv3
- ;;
- AViiON:dgux:*:*)
- # DG/UX returns AViiON for all architectures
- UNAME_PROCESSOR=`/usr/bin/uname -p`
- if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110
- then
- if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \
- test "$TARGET_BINARY_INTERFACE"x = x
- then
- GUESS=m88k-dg-dgux$UNAME_RELEASE
- else
- GUESS=m88k-dg-dguxbcs$UNAME_RELEASE
- fi
- else
- GUESS=i586-dg-dgux$UNAME_RELEASE
- fi
- ;;
- M88*:DolphinOS:*:*) # DolphinOS (SVR3)
- GUESS=m88k-dolphin-sysv3
- ;;
- M88*:*:R3*:*)
- # Delta 88k system running SVR3
- GUESS=m88k-motorola-sysv3
- ;;
- XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
- GUESS=m88k-tektronix-sysv3
- ;;
- Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
- GUESS=m68k-tektronix-bsd
- ;;
- *:IRIX*:*:*)
- IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'`
- GUESS=mips-sgi-irix$IRIX_REL
- ;;
- ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
- GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id
- ;; # Note that: echo "'`uname -s`'" gives 'AIX '
- i*86:AIX:*:*)
- GUESS=i386-ibm-aix
- ;;
- ia64:AIX:*:*)
- if test -x /usr/bin/oslevel ; then
- IBM_REV=`/usr/bin/oslevel`
- else
- IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
- fi
- GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV
- ;;
- *:AIX:2:3)
- if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
- set_cc_for_build
- sed 's/^ //' << EOF > "$dummy.c"
- #include <sys/systemcfg.h>
-
- main()
- {
- if (!__power_pc())
- exit(1);
- puts("powerpc-ibm-aix3.2.5");
- exit(0);
- }
-EOF
- if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
- then
- GUESS=$SYSTEM_NAME
- else
- GUESS=rs6000-ibm-aix3.2.5
- fi
- elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
- GUESS=rs6000-ibm-aix3.2.4
- else
- GUESS=rs6000-ibm-aix3.2
- fi
- ;;
- *:AIX:*:[4567])
- IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
- if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then
- IBM_ARCH=rs6000
- else
- IBM_ARCH=powerpc
- fi
- if test -x /usr/bin/lslpp ; then
- IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \
- awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
- else
- IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
- fi
- GUESS=$IBM_ARCH-ibm-aix$IBM_REV
- ;;
- *:AIX:*:*)
- GUESS=rs6000-ibm-aix
- ;;
- ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*)
- GUESS=romp-ibm-bsd4.4
- ;;
- ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
- GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to
- ;; # report: romp-ibm BSD 4.3
- *:BOSX:*:*)
- GUESS=rs6000-bull-bosx
- ;;
- DPX/2?00:B.O.S.:*:*)
- GUESS=m68k-bull-sysv3
- ;;
- 9000/[34]??:4.3bsd:1.*:*)
- GUESS=m68k-hp-bsd
- ;;
- hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
- GUESS=m68k-hp-bsd4.4
- ;;
- 9000/[34678]??:HP-UX:*:*)
- HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
- case $UNAME_MACHINE in
- 9000/31?) HP_ARCH=m68000 ;;
- 9000/[34]??) HP_ARCH=m68k ;;
- 9000/[678][0-9][0-9])
- if test -x /usr/bin/getconf; then
- sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
- sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
- case $sc_cpu_version in
- 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
- 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
- 532) # CPU_PA_RISC2_0
- case $sc_kernel_bits in
- 32) HP_ARCH=hppa2.0n ;;
- 64) HP_ARCH=hppa2.0w ;;
- '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20
- esac ;;
- esac
- fi
- if test "$HP_ARCH" = ""; then
- set_cc_for_build
- sed 's/^ //' << EOF > "$dummy.c"
-
- #define _HPUX_SOURCE
- #include <stdlib.h>
- #include <unistd.h>
-
- int main ()
- {
- #if defined(_SC_KERNEL_BITS)
- long bits = sysconf(_SC_KERNEL_BITS);
- #endif
- long cpu = sysconf (_SC_CPU_VERSION);
-
- switch (cpu)
- {
- case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
- case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
- case CPU_PA_RISC2_0:
- #if defined(_SC_KERNEL_BITS)
- switch (bits)
- {
- case 64: puts ("hppa2.0w"); break;
- case 32: puts ("hppa2.0n"); break;
- default: puts ("hppa2.0"); break;
- } break;
- #else /* !defined(_SC_KERNEL_BITS) */
- puts ("hppa2.0"); break;
- #endif
- default: puts ("hppa1.0"); break;
- }
- exit (0);
- }
-EOF
- (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"`
- test -z "$HP_ARCH" && HP_ARCH=hppa
- fi ;;
- esac
- if test "$HP_ARCH" = hppa2.0w
- then
- set_cc_for_build
-
- # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
- # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
- # generating 64-bit code. GNU and HP use different nomenclature:
- #
- # $ CC_FOR_BUILD=cc ./config.guess
- # => hppa2.0w-hp-hpux11.23
- # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
- # => hppa64-hp-hpux11.23
-
- if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) |
- grep -q __LP64__
- then
- HP_ARCH=hppa2.0w
- else
- HP_ARCH=hppa64
- fi
- fi
- GUESS=$HP_ARCH-hp-hpux$HPUX_REV
- ;;
- ia64:HP-UX:*:*)
- HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
- GUESS=ia64-hp-hpux$HPUX_REV
- ;;
- 3050*:HI-UX:*:*)
- set_cc_for_build
- sed 's/^ //' << EOF > "$dummy.c"
- #include <unistd.h>
- int
- main ()
- {
- long cpu = sysconf (_SC_CPU_VERSION);
- /* The order matters, because CPU_IS_HP_MC68K erroneously returns
- true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
- results, however. */
- if (CPU_IS_PA_RISC (cpu))
- {
- switch (cpu)
- {
- case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
- case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
- case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
- default: puts ("hppa-hitachi-hiuxwe2"); break;
- }
- }
- else if (CPU_IS_HP_MC68K (cpu))
- puts ("m68k-hitachi-hiuxwe2");
- else puts ("unknown-hitachi-hiuxwe2");
- exit (0);
- }
-EOF
- $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
- { echo "$SYSTEM_NAME"; exit; }
- GUESS=unknown-hitachi-hiuxwe2
- ;;
- 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*)
- GUESS=hppa1.1-hp-bsd
- ;;
- 9000/8??:4.3bsd:*:*)
- GUESS=hppa1.0-hp-bsd
- ;;
- *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
- GUESS=hppa1.0-hp-mpeix
- ;;
- hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*)
- GUESS=hppa1.1-hp-osf
- ;;
- hp8??:OSF1:*:*)
- GUESS=hppa1.0-hp-osf
- ;;
- i*86:OSF1:*:*)
- if test -x /usr/sbin/sysversion ; then
- GUESS=$UNAME_MACHINE-unknown-osf1mk
- else
- GUESS=$UNAME_MACHINE-unknown-osf1
- fi
- ;;
- parisc*:Lites*:*:*)
- GUESS=hppa1.1-hp-lites
- ;;
- C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
- GUESS=c1-convex-bsd
- ;;
- C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
- if getsysinfo -f scalar_acc
- then echo c32-convex-bsd
- else echo c2-convex-bsd
- fi
- exit ;;
- C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
- GUESS=c34-convex-bsd
- ;;
- C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
- GUESS=c38-convex-bsd
- ;;
- C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
- GUESS=c4-convex-bsd
- ;;
- CRAY*Y-MP:*:*:*)
- CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
- GUESS=ymp-cray-unicos$CRAY_REL
- ;;
- CRAY*[A-Z]90:*:*:*)
- echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \
- | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
- -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
- -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*TS:*:*:*)
- CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
- GUESS=t90-cray-unicos$CRAY_REL
- ;;
- CRAY*T3E:*:*:*)
- CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
- GUESS=alphaev5-cray-unicosmk$CRAY_REL
- ;;
- CRAY*SV1:*:*:*)
- CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
- GUESS=sv1-cray-unicos$CRAY_REL
- ;;
- *:UNICOS/mp:*:*)
- CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
- GUESS=craynv-cray-unicosmp$CRAY_REL
- ;;
- F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
- FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
- FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
- FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'`
- GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
- ;;
- 5000:UNIX_System_V:4.*:*)
- FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
- FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'`
- GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
- ;;
- i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
- GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE
- ;;
- sparc*:BSD/OS:*:*)
- GUESS=sparc-unknown-bsdi$UNAME_RELEASE
- ;;
- *:BSD/OS:*:*)
- GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE
- ;;
- arm:FreeBSD:*:*)
- UNAME_PROCESSOR=`uname -p`
- set_cc_for_build
- if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
- | grep -q __ARM_PCS_VFP
- then
- FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
- GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi
- else
- FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
- GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf
- fi
- ;;
- *:FreeBSD:*:*)
- UNAME_PROCESSOR=`/usr/bin/uname -p`
- case $UNAME_PROCESSOR in
- amd64)
- UNAME_PROCESSOR=x86_64 ;;
- i386)
- UNAME_PROCESSOR=i586 ;;
- esac
- FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
- GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL
- ;;
- i*:CYGWIN*:*)
- GUESS=$UNAME_MACHINE-pc-cygwin
- ;;
- *:MINGW64*:*)
- GUESS=$UNAME_MACHINE-pc-mingw64
- ;;
- *:MINGW*:*)
- GUESS=$UNAME_MACHINE-pc-mingw32
- ;;
- *:MSYS*:*)
- GUESS=$UNAME_MACHINE-pc-msys
- ;;
- i*:PW*:*)
- GUESS=$UNAME_MACHINE-pc-pw32
- ;;
- *:SerenityOS:*:*)
- GUESS=$UNAME_MACHINE-pc-serenity
- ;;
- *:Interix*:*)
- case $UNAME_MACHINE in
- x86)
- GUESS=i586-pc-interix$UNAME_RELEASE
- ;;
- authenticamd | genuineintel | EM64T)
- GUESS=x86_64-unknown-interix$UNAME_RELEASE
- ;;
- IA64)
- GUESS=ia64-unknown-interix$UNAME_RELEASE
- ;;
- esac ;;
- i*:UWIN*:*)
- GUESS=$UNAME_MACHINE-pc-uwin
- ;;
- amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
- GUESS=x86_64-pc-cygwin
- ;;
- prep*:SunOS:5.*:*)
- SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
- GUESS=powerpcle-unknown-solaris2$SUN_REL
- ;;
- *:GNU:*:*)
- # the GNU system
- GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'`
- GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'`
- GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL
- ;;
- *:GNU/*:*:*)
- # other systems with GNU libc and userland
- GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"`
- GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
- GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
- ;;
- x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*)
- GUESS="$UNAME_MACHINE-pc-managarm-mlibc"
- ;;
- *:[Mm]anagarm:*:*)
- GUESS="$UNAME_MACHINE-unknown-managarm-mlibc"
- ;;
- *:Minix:*:*)
- GUESS=$UNAME_MACHINE-unknown-minix
- ;;
- aarch64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- aarch64_be:Linux:*:*)
- UNAME_MACHINE=aarch64_be
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
- EV5) UNAME_MACHINE=alphaev5 ;;
- EV56) UNAME_MACHINE=alphaev56 ;;
- PCA56) UNAME_MACHINE=alphapca56 ;;
- PCA57) UNAME_MACHINE=alphapca56 ;;
- EV6) UNAME_MACHINE=alphaev6 ;;
- EV67) UNAME_MACHINE=alphaev67 ;;
- EV68*) UNAME_MACHINE=alphaev68 ;;
- esac
- objdump --private-headers /bin/sh | grep -q ld.so.1
- if test "$?" = 0 ; then LIBC=gnulibc1 ; fi
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- arm*:Linux:*:*)
- set_cc_for_build
- if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
- | grep -q __ARM_EABI__
- then
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- else
- if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
- | grep -q __ARM_PCS_VFP
- then
- GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi
- else
- GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf
- fi
- fi
- ;;
- avr32*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- cris:Linux:*:*)
- GUESS=$UNAME_MACHINE-axis-linux-$LIBC
- ;;
- crisv32:Linux:*:*)
- GUESS=$UNAME_MACHINE-axis-linux-$LIBC
- ;;
- e2k:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- frv:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- hexagon:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- i*86:Linux:*:*)
- GUESS=$UNAME_MACHINE-pc-linux-$LIBC
- ;;
- ia64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- k1om:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- loongarch32:Linux:*:* | loongarch64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- m32r*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- m68*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- mips:Linux:*:* | mips64:Linux:*:*)
- set_cc_for_build
- IS_GLIBC=0
- test x"${LIBC}" = xgnu && IS_GLIBC=1
- sed 's/^ //' << EOF > "$dummy.c"
- #undef CPU
- #undef mips
- #undef mipsel
- #undef mips64
- #undef mips64el
- #if ${IS_GLIBC} && defined(_ABI64)
- LIBCABI=gnuabi64
- #else
- #if ${IS_GLIBC} && defined(_ABIN32)
- LIBCABI=gnuabin32
- #else
- LIBCABI=${LIBC}
- #endif
- #endif
-
- #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
- CPU=mipsisa64r6
- #else
- #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
- CPU=mipsisa32r6
- #else
- #if defined(__mips64)
- CPU=mips64
- #else
- CPU=mips
- #endif
- #endif
- #endif
-
- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- MIPS_ENDIAN=el
- #else
- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- MIPS_ENDIAN=
- #else
- MIPS_ENDIAN=
- #endif
- #endif
-EOF
- cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`
- eval "$cc_set_vars"
- test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
- ;;
- mips64el:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- openrisc*:Linux:*:*)
- GUESS=or1k-unknown-linux-$LIBC
- ;;
- or32:Linux:*:* | or1k*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- padre:Linux:*:*)
- GUESS=sparc-unknown-linux-$LIBC
- ;;
- parisc64:Linux:*:* | hppa64:Linux:*:*)
- GUESS=hppa64-unknown-linux-$LIBC
- ;;
- parisc:Linux:*:* | hppa:Linux:*:*)
- # Look for CPU level
- case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
- PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;;
- PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;;
- *) GUESS=hppa-unknown-linux-$LIBC ;;
- esac
- ;;
- ppc64:Linux:*:*)
- GUESS=powerpc64-unknown-linux-$LIBC
- ;;
- ppc:Linux:*:*)
- GUESS=powerpc-unknown-linux-$LIBC
- ;;
- ppc64le:Linux:*:*)
- GUESS=powerpc64le-unknown-linux-$LIBC
- ;;
- ppcle:Linux:*:*)
- GUESS=powerpcle-unknown-linux-$LIBC
- ;;
- riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- s390:Linux:*:* | s390x:Linux:*:*)
- GUESS=$UNAME_MACHINE-ibm-linux-$LIBC
- ;;
- sh64*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- sh*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- sparc:Linux:*:* | sparc64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- tile*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- vax:Linux:*:*)
- GUESS=$UNAME_MACHINE-dec-linux-$LIBC
- ;;
- x86_64:Linux:*:*)
- set_cc_for_build
- CPU=$UNAME_MACHINE
- LIBCABI=$LIBC
- if test "$CC_FOR_BUILD" != no_compiler_found; then
- ABI=64
- sed 's/^ //' << EOF > "$dummy.c"
- #ifdef __i386__
- ABI=x86
- #else
- #ifdef __ILP32__
- ABI=x32
- #endif
- #endif
-EOF
- cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
- eval "$cc_set_abi"
- case $ABI in
- x86) CPU=i686 ;;
- x32) LIBCABI=${LIBC}x32 ;;
- esac
- fi
- GUESS=$CPU-pc-linux-$LIBCABI
- ;;
- xtensa*:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
- ;;
- i*86:DYNIX/ptx:4*:*)
- # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
- # earlier versions are messed up and put the nodename in both
- # sysname and nodename.
- GUESS=i386-sequent-sysv4
- ;;
- i*86:UNIX_SV:4.2MP:2.*)
- # Unixware is an offshoot of SVR4, but it has its own version
- # number series starting with 2...
- # I am not positive that other SVR4 systems won't match this,
- # I just have to hope. -- rms.
- # Use sysv4.2uw... so that sysv4* matches it.
- GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
- ;;
- i*86:OS/2:*:*)
- # If we were able to find 'uname', then EMX Unix compatibility
- # is probably installed.
- GUESS=$UNAME_MACHINE-pc-os2-emx
- ;;
- i*86:XTS-300:*:STOP)
- GUESS=$UNAME_MACHINE-unknown-stop
- ;;
- i*86:atheos:*:*)
- GUESS=$UNAME_MACHINE-unknown-atheos
- ;;
- i*86:syllable:*:*)
- GUESS=$UNAME_MACHINE-pc-syllable
- ;;
- i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
- GUESS=i386-unknown-lynxos$UNAME_RELEASE
- ;;
- i*86:*DOS:*:*)
- GUESS=$UNAME_MACHINE-pc-msdosdjgpp
- ;;
- i*86:*:4.*:*)
- UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'`
- if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
- GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL
- else
- GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL
- fi
- ;;
- i*86:*:5:[678]*)
- # UnixWare 7.x, OpenUNIX and OpenServer 6.
- case `/bin/uname -X | grep "^Machine"` in
- *486*) UNAME_MACHINE=i486 ;;
- *Pentium) UNAME_MACHINE=i586 ;;
- *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
- esac
- GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
- ;;
- i*86:*:3.2:*)
- if test -f /usr/options/cb.name; then
- UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
- GUESS=$UNAME_MACHINE-pc-isc$UNAME_REL
- elif /bin/uname -X 2>/dev/null >/dev/null ; then
- UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
- (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
- (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
- && UNAME_MACHINE=i586
- (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
- && UNAME_MACHINE=i686
- (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
- && UNAME_MACHINE=i686
- GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL
- else
- GUESS=$UNAME_MACHINE-pc-sysv32
- fi
- ;;
- pc:*:*:*)
- # Left here for compatibility:
- # uname -m prints for DJGPP always 'pc', but it prints nothing about
- # the processor, so we play safe by assuming i586.
- # Note: whatever this is, it MUST be the same as what config.sub
- # prints for the "djgpp" host, or else GDB configure will decide that
- # this is a cross-build.
- GUESS=i586-pc-msdosdjgpp
- ;;
- Intel:Mach:3*:*)
- GUESS=i386-pc-mach3
- ;;
- paragon:*:*:*)
- GUESS=i860-intel-osf1
- ;;
- i860:*:4.*:*) # i860-SVR4
- if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
- GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4
- else # Add other i860-SVR4 vendors below as they are discovered.
- GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4
- fi
- ;;
- mini*:CTIX:SYS*5:*)
- # "miniframe"
- GUESS=m68010-convergent-sysv
- ;;
- mc68k:UNIX:SYSTEM5:3.51m)
- GUESS=m68k-convergent-sysv
- ;;
- M680?0:D-NIX:5.3:*)
- GUESS=m68k-diab-dnix
- ;;
- M68*:*:R3V[5678]*:*)
- test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
- 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
- OS_REL=''
- test -r /etc/.relid \
- && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
- /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
- && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
- 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4; exit; } ;;
- NCR*:*:4.2:* | MPRAS*:*:4.2:*)
- OS_REL='.3'
- test -r /etc/.relid \
- && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
- /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
- && { echo i586-ncr-sysv4.3"$OS_REL"; exit; }
- /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
- && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
- m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
- GUESS=m68k-unknown-lynxos$UNAME_RELEASE
- ;;
- mc68030:UNIX_System_V:4.*:*)
- GUESS=m68k-atari-sysv4
- ;;
- TSUNAMI:LynxOS:2.*:*)
- GUESS=sparc-unknown-lynxos$UNAME_RELEASE
- ;;
- rs6000:LynxOS:2.*:*)
- GUESS=rs6000-unknown-lynxos$UNAME_RELEASE
- ;;
- PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
- GUESS=powerpc-unknown-lynxos$UNAME_RELEASE
- ;;
- SM[BE]S:UNIX_SV:*:*)
- GUESS=mips-dde-sysv$UNAME_RELEASE
- ;;
- RM*:ReliantUNIX-*:*:*)
- GUESS=mips-sni-sysv4
- ;;
- RM*:SINIX-*:*:*)
- GUESS=mips-sni-sysv4
- ;;
- *:SINIX-*:*:*)
- if uname -p 2>/dev/null >/dev/null ; then
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
- GUESS=$UNAME_MACHINE-sni-sysv4
- else
- GUESS=ns32k-sni-sysv
- fi
- ;;
- PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort
- # says <Richard.M.Bartel@ccMail.Census.GOV>
- GUESS=i586-unisys-sysv4
- ;;
- *:UNIX_System_V:4*:FTX*)
- # From Gerald Hewes <hewes@openmarket.com>.
- # How about differentiating between stratus architectures? -djm
- GUESS=hppa1.1-stratus-sysv4
- ;;
- *:*:*:FTX*)
- # From seanf@swdc.stratus.com.
- GUESS=i860-stratus-sysv4
- ;;
- i*86:VOS:*:*)
- # From Paul.Green@stratus.com.
- GUESS=$UNAME_MACHINE-stratus-vos
- ;;
- *:VOS:*:*)
- # From Paul.Green@stratus.com.
- GUESS=hppa1.1-stratus-vos
- ;;
- mc68*:A/UX:*:*)
- GUESS=m68k-apple-aux$UNAME_RELEASE
- ;;
- news*:NEWS-OS:6*:*)
- GUESS=mips-sony-newsos6
- ;;
- R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
- if test -d /usr/nec; then
- GUESS=mips-nec-sysv$UNAME_RELEASE
- else
- GUESS=mips-unknown-sysv$UNAME_RELEASE
- fi
- ;;
- BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
- GUESS=powerpc-be-beos
- ;;
- BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
- GUESS=powerpc-apple-beos
- ;;
- BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
- GUESS=i586-pc-beos
- ;;
- BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
- GUESS=i586-pc-haiku
- ;;
- ppc:Haiku:*:*) # Haiku running on Apple PowerPC
- GUESS=powerpc-apple-haiku
- ;;
- *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat)
- GUESS=$UNAME_MACHINE-unknown-haiku
- ;;
- SX-4:SUPER-UX:*:*)
- GUESS=sx4-nec-superux$UNAME_RELEASE
- ;;
- SX-5:SUPER-UX:*:*)
- GUESS=sx5-nec-superux$UNAME_RELEASE
- ;;
- SX-6:SUPER-UX:*:*)
- GUESS=sx6-nec-superux$UNAME_RELEASE
- ;;
- SX-7:SUPER-UX:*:*)
- GUESS=sx7-nec-superux$UNAME_RELEASE
- ;;
- SX-8:SUPER-UX:*:*)
- GUESS=sx8-nec-superux$UNAME_RELEASE
- ;;
- SX-8R:SUPER-UX:*:*)
- GUESS=sx8r-nec-superux$UNAME_RELEASE
- ;;
- SX-ACE:SUPER-UX:*:*)
- GUESS=sxace-nec-superux$UNAME_RELEASE
- ;;
- Power*:Rhapsody:*:*)
- GUESS=powerpc-apple-rhapsody$UNAME_RELEASE
- ;;
- *:Rhapsody:*:*)
- GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE
- ;;
- arm64:Darwin:*:*)
- GUESS=aarch64-apple-darwin$UNAME_RELEASE
- ;;
- *:Darwin:*:*)
- UNAME_PROCESSOR=`uname -p`
- case $UNAME_PROCESSOR in
- unknown) UNAME_PROCESSOR=powerpc ;;
- esac
- if command -v xcode-select > /dev/null 2> /dev/null && \
- ! xcode-select --print-path > /dev/null 2> /dev/null ; then
- # Avoid executing cc if there is no toolchain installed as
- # cc will be a stub that puts up a graphical alert
- # prompting the user to install developer tools.
- CC_FOR_BUILD=no_compiler_found
- else
- set_cc_for_build
- fi
- if test "$CC_FOR_BUILD" != no_compiler_found; then
- if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
- (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
- grep IS_64BIT_ARCH >/dev/null
- then
- case $UNAME_PROCESSOR in
- i386) UNAME_PROCESSOR=x86_64 ;;
- powerpc) UNAME_PROCESSOR=powerpc64 ;;
- esac
- fi
- # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
- if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
- (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
- grep IS_PPC >/dev/null
- then
- UNAME_PROCESSOR=powerpc
- fi
- elif test "$UNAME_PROCESSOR" = i386 ; then
- # uname -m returns i386 or x86_64
- UNAME_PROCESSOR=$UNAME_MACHINE
- fi
- GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE
- ;;
- *:procnto*:*:* | *:QNX:[0123456789]*:*)
- UNAME_PROCESSOR=`uname -p`
- if test "$UNAME_PROCESSOR" = x86; then
- UNAME_PROCESSOR=i386
- UNAME_MACHINE=pc
- fi
- GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE
- ;;
- *:QNX:*:4*)
- GUESS=i386-pc-qnx
- ;;
- NEO-*:NONSTOP_KERNEL:*:*)
- GUESS=neo-tandem-nsk$UNAME_RELEASE
- ;;
- NSE-*:NONSTOP_KERNEL:*:*)
- GUESS=nse-tandem-nsk$UNAME_RELEASE
- ;;
- NSR-*:NONSTOP_KERNEL:*:*)
- GUESS=nsr-tandem-nsk$UNAME_RELEASE
- ;;
- NSV-*:NONSTOP_KERNEL:*:*)
- GUESS=nsv-tandem-nsk$UNAME_RELEASE
- ;;
- NSX-*:NONSTOP_KERNEL:*:*)
- GUESS=nsx-tandem-nsk$UNAME_RELEASE
- ;;
- *:NonStop-UX:*:*)
- GUESS=mips-compaq-nonstopux
- ;;
- BS2000:POSIX*:*:*)
- GUESS=bs2000-siemens-sysv
- ;;
- DS/*:UNIX_System_V:*:*)
- GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE
- ;;
- *:Plan9:*:*)
- # "uname -m" is not consistent, so use $cputype instead. 386
- # is converted to i386 for consistency with other x86
- # operating systems.
- if test "${cputype-}" = 386; then
- UNAME_MACHINE=i386
- elif test "x${cputype-}" != x; then
- UNAME_MACHINE=$cputype
- fi
- GUESS=$UNAME_MACHINE-unknown-plan9
- ;;
- *:TOPS-10:*:*)
- GUESS=pdp10-unknown-tops10
- ;;
- *:TENEX:*:*)
- GUESS=pdp10-unknown-tenex
- ;;
- KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
- GUESS=pdp10-dec-tops20
- ;;
- XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
- GUESS=pdp10-xkl-tops20
- ;;
- *:TOPS-20:*:*)
- GUESS=pdp10-unknown-tops20
- ;;
- *:ITS:*:*)
- GUESS=pdp10-unknown-its
- ;;
- SEI:*:*:SEIUX)
- GUESS=mips-sei-seiux$UNAME_RELEASE
- ;;
- *:DragonFly:*:*)
- DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
- GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL
- ;;
- *:*VMS:*:*)
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
- case $UNAME_MACHINE in
- A*) GUESS=alpha-dec-vms ;;
- I*) GUESS=ia64-dec-vms ;;
- V*) GUESS=vax-dec-vms ;;
- esac ;;
- *:XENIX:*:SysV)
- GUESS=i386-pc-xenix
- ;;
- i*86:skyos:*:*)
- SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`
- GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL
- ;;
- i*86:rdos:*:*)
- GUESS=$UNAME_MACHINE-pc-rdos
- ;;
- i*86:Fiwix:*:*)
- GUESS=$UNAME_MACHINE-pc-fiwix
- ;;
- *:AROS:*:*)
- GUESS=$UNAME_MACHINE-unknown-aros
- ;;
- x86_64:VMkernel:*:*)
- GUESS=$UNAME_MACHINE-unknown-esx
- ;;
- amd64:Isilon\ OneFS:*:*)
- GUESS=x86_64-unknown-onefs
- ;;
- *:Unleashed:*:*)
- GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
- ;;
-esac
-
-# Do we have a guess based on uname results?
-if test "x$GUESS" != x; then
- echo "$GUESS"
- exit
-fi
-
-# No uname command or uname output not recognized.
-set_cc_for_build
-cat > "$dummy.c" <<EOF
-#ifdef _SEQUENT_
-#include <sys/types.h>
-#include <sys/utsname.h>
-#endif
-#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
-#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
-#include <signal.h>
-#if defined(_SIZE_T_) || defined(SIGLOST)
-#include <sys/utsname.h>
-#endif
-#endif
-#endif
-main ()
-{
-#if defined (sony)
-#if defined (MIPSEB)
- /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
- I don't know.... */
- printf ("mips-sony-bsd\n"); exit (0);
-#else
-#include <sys/param.h>
- printf ("m68k-sony-newsos%s\n",
-#ifdef NEWSOS4
- "4"
-#else
- ""
-#endif
- ); exit (0);
-#endif
-#endif
-
-#if defined (NeXT)
-#if !defined (__ARCHITECTURE__)
-#define __ARCHITECTURE__ "m68k"
-#endif
- int version;
- version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
- if (version < 4)
- printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
- else
- printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
- exit (0);
-#endif
-
-#if defined (MULTIMAX) || defined (n16)
-#if defined (UMAXV)
- printf ("ns32k-encore-sysv\n"); exit (0);
-#else
-#if defined (CMU)
- printf ("ns32k-encore-mach\n"); exit (0);
-#else
- printf ("ns32k-encore-bsd\n"); exit (0);
-#endif
-#endif
-#endif
-
-#if defined (__386BSD__)
- printf ("i386-pc-bsd\n"); exit (0);
-#endif
-
-#if defined (sequent)
-#if defined (i386)
- printf ("i386-sequent-dynix\n"); exit (0);
-#endif
-#if defined (ns32000)
- printf ("ns32k-sequent-dynix\n"); exit (0);
-#endif
-#endif
-
-#if defined (_SEQUENT_)
- struct utsname un;
-
- uname(&un);
- if (strncmp(un.version, "V2", 2) == 0) {
- printf ("i386-sequent-ptx2\n"); exit (0);
- }
- if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
- printf ("i386-sequent-ptx1\n"); exit (0);
- }
- printf ("i386-sequent-ptx\n"); exit (0);
-#endif
-
-#if defined (vax)
-#if !defined (ultrix)
-#include <sys/param.h>
-#if defined (BSD)
-#if BSD == 43
- printf ("vax-dec-bsd4.3\n"); exit (0);
-#else
-#if BSD == 199006
- printf ("vax-dec-bsd4.3reno\n"); exit (0);
-#else
- printf ("vax-dec-bsd\n"); exit (0);
-#endif
-#endif
-#else
- printf ("vax-dec-bsd\n"); exit (0);
-#endif
-#else
-#if defined(_SIZE_T_) || defined(SIGLOST)
- struct utsname un;
- uname (&un);
- printf ("vax-dec-ultrix%s\n", un.release); exit (0);
-#else
- printf ("vax-dec-ultrix\n"); exit (0);
-#endif
-#endif
-#endif
-#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
-#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
-#if defined(_SIZE_T_) || defined(SIGLOST)
- struct utsname *un;
- uname (&un);
- printf ("mips-dec-ultrix%s\n", un.release); exit (0);
-#else
- printf ("mips-dec-ultrix\n"); exit (0);
-#endif
-#endif
-#endif
-
-#if defined (alliant) && defined (i860)
- printf ("i860-alliant-bsd\n"); exit (0);
-#endif
-
- exit (1);
-}
-EOF
-
-$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` &&
- { echo "$SYSTEM_NAME"; exit; }
-
-# Apollos put the system type in the environment.
-test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; }
-
-echo "$0: unable to guess system type" >&2
-
-case $UNAME_MACHINE:$UNAME_SYSTEM in
- mips:Linux | mips64:Linux)
- # If we got here on MIPS GNU/Linux, output extra information.
- cat >&2 <<EOF
-
-NOTE: MIPS GNU/Linux systems require a C compiler to fully recognize
-the system type. Please install a C compiler and try again.
-EOF
- ;;
-esac
-
-cat >&2 <<EOF
-
-This script (version $timestamp), has failed to recognize the
-operating system you are using. If your script is old, overwrite *all*
-copies of config.guess and config.sub with the latest versions from:
-
- https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
-and
- https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
-EOF
-
-our_year=`echo $timestamp | sed 's,-.*,,'`
-thisyear=`date +%Y`
-# shellcheck disable=SC2003
-script_age=`expr "$thisyear" - "$our_year"`
-if test "$script_age" -lt 3 ; then
- cat >&2 <<EOF
-
-If $0 has already been updated, send the following data and any
-information you think might be pertinent to config-patches@gnu.org to
-provide the necessary information to handle your system.
-
-config.guess timestamp = $timestamp
-
-uname -m = `(uname -m) 2>/dev/null || echo unknown`
-uname -r = `(uname -r) 2>/dev/null || echo unknown`
-uname -s = `(uname -s) 2>/dev/null || echo unknown`
-uname -v = `(uname -v) 2>/dev/null || echo unknown`
-
-/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
-/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
-
-hostinfo = `(hostinfo) 2>/dev/null`
-/bin/universe = `(/bin/universe) 2>/dev/null`
-/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
-/bin/arch = `(/bin/arch) 2>/dev/null`
-/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
-
-UNAME_MACHINE = "$UNAME_MACHINE"
-UNAME_RELEASE = "$UNAME_RELEASE"
-UNAME_SYSTEM = "$UNAME_SYSTEM"
-UNAME_VERSION = "$UNAME_VERSION"
-EOF
-fi
-
-exit 1
-
-# Local variables:
-# eval: (add-hook 'before-save-hook 'time-stamp)
-# time-stamp-start: "timestamp='"
-# time-stamp-format: "%:y-%02m-%02d"
-# time-stamp-end: "'"
-# End:
diff --git a/exec/config.sub b/exec/config.sub
deleted file mode 100755
index 7ab92879f13..00000000000
--- a/exec/config.sub
+++ /dev/null
@@ -1,1907 +0,0 @@
-#!/usr/bin/sh
-# Configuration validation subroutine script.
-# Copyright 1992-2024 Free Software Foundation, Inc.
-
-# shellcheck disable=SC2006,SC2268 # see below for rationale
-
-timestamp='2023-06-23'
-
-# 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
-# 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/>.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that
-# program. This Exception is an additional permission under section 7
-# of the GNU General Public License, version 3 ("GPLv3").
-
-
-# Please send patches to <config-patches@gnu.org>.
-#
-# Configuration subroutine to validate and canonicalize a configuration type.
-# Supply the specified configuration type as an argument.
-# If it is invalid, we print an error message on stderr and exit with code 1.
-# Otherwise, we print the canonical config type on stdout and succeed.
-
-# You can get the latest version of this script from:
-# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
-
-# This file is supposed to be the same for all GNU packages
-# and recognize all the CPU types, system types and aliases
-# that are meaningful with *any* GNU software.
-# Each package is responsible for reporting which valid configurations
-# it does not support. The user should be able to distinguish
-# a failure to support a valid configuration from a meaningless
-# configuration.
-
-# The goal of this file is to map all the various variations of a given
-# machine specification into a single specification in the form:
-# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
-# or in some cases, the newer four-part form:
-# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
-# It is wrong to echo any other type of specification.
-
-# The "shellcheck disable" line above the timestamp inhibits complaints
-# about features and limitations of the classic Bourne shell that were
-# superseded or lifted in POSIX. However, this script identifies a wide
-# variety of pre-POSIX systems that do not have POSIX shells at all, and
-# even some reasonably current systems (Solaris 10 as case-in-point) still
-# have a pre-POSIX /bin/sh.
-
-me=`echo "$0" | sed -e 's,.*/,,'`
-
-usage="\
-Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
-
-Canonicalize a configuration name.
-
-Options:
- -h, --help print this help, then exit
- -t, --time-stamp print date of last modification, then exit
- -v, --version print version number, then exit
-
-Report bugs and patches to <config-patches@gnu.org>."
-
-version="\
-GNU config.sub ($timestamp)
-
-Copyright 1992-2023 Free Software Foundation, Inc.
-
-This is free software; see the source for copying conditions. There is NO
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
-
-help="
-Try '$me --help' for more information."
-
-# Parse command line
-while test $# -gt 0 ; do
- case $1 in
- --time-stamp | --time* | -t )
- echo "$timestamp" ; exit ;;
- --version | -v )
- echo "$version" ; exit ;;
- --help | --h* | -h )
- echo "$usage"; exit ;;
- -- ) # Stop option processing
- shift; break ;;
- - ) # Use stdin as input.
- break ;;
- -* )
- echo "$me: invalid option $1$help" >&2
- exit 1 ;;
-
- *local*)
- # First pass through any local machine types.
- echo "$1"
- exit ;;
-
- * )
- break ;;
- esac
-done
-
-case $# in
- 0) echo "$me: missing argument$help" >&2
- exit 1;;
- 1) ;;
- *) echo "$me: too many arguments$help" >&2
- exit 1;;
-esac
-
-# Split fields of configuration type
-# shellcheck disable=SC2162
-saved_IFS=$IFS
-IFS="-" read field1 field2 field3 field4 <<EOF
-$1
-EOF
-IFS=$saved_IFS
-
-# Separate into logical components for further validation
-case $1 in
- *-*-*-*-*)
- echo "Invalid configuration '$1': more than four components" >&2
- exit 1
- ;;
- *-*-*-*)
- basic_machine=$field1-$field2
- basic_os=$field3-$field4
- ;;
- *-*-*)
- # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
- # parts
- maybe_os=$field2-$field3
- case $maybe_os in
- nto-qnx* | linux-* | uclinux-uclibc* \
- | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \
- | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
- | storm-chaos* | os2-emx* | rtmk-nova* | managarm-*)
- basic_machine=$field1
- basic_os=$maybe_os
- ;;
- android-linux)
- basic_machine=$field1-unknown
- basic_os=linux-android
- ;;
- *)
- basic_machine=$field1-$field2
- basic_os=$field3
- ;;
- esac
- ;;
- *-*)
- # A lone config we happen to match not fitting any pattern
- case $field1-$field2 in
- decstation-3100)
- basic_machine=mips-dec
- basic_os=
- ;;
- *-*)
- # Second component is usually, but not always the OS
- case $field2 in
- # Prevent following clause from handling this valid os
- sun*os*)
- basic_machine=$field1
- basic_os=$field2
- ;;
- zephyr*)
- basic_machine=$field1-unknown
- basic_os=$field2
- ;;
- # Manufacturers
- dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \
- | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \
- | unicom* | ibm* | next | hp | isi* | apollo | altos* \
- | convergent* | ncr* | news | 32* | 3600* | 3100* \
- | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \
- | ultra | tti* | harris | dolphin | highlevel | gould \
- | cbm | ns | masscomp | apple | axis | knuth | cray \
- | microblaze* | sim | cisco \
- | oki | wec | wrs | winbond)
- basic_machine=$field1-$field2
- basic_os=
- ;;
- *)
- basic_machine=$field1
- basic_os=$field2
- ;;
- esac
- ;;
- esac
- ;;
- *)
- # Convert single-component short-hands not valid as part of
- # multi-component configurations.
- case $field1 in
- 386bsd)
- basic_machine=i386-pc
- basic_os=bsd
- ;;
- a29khif)
- basic_machine=a29k-amd
- basic_os=udi
- ;;
- adobe68k)
- basic_machine=m68010-adobe
- basic_os=scout
- ;;
- alliant)
- basic_machine=fx80-alliant
- basic_os=
- ;;
- altos | altos3068)
- basic_machine=m68k-altos
- basic_os=
- ;;
- am29k)
- basic_machine=a29k-none
- basic_os=bsd
- ;;
- amdahl)
- basic_machine=580-amdahl
- basic_os=sysv
- ;;
- amiga)
- basic_machine=m68k-unknown
- basic_os=
- ;;
- amigaos | amigados)
- basic_machine=m68k-unknown
- basic_os=amigaos
- ;;
- amigaunix | amix)
- basic_machine=m68k-unknown
- basic_os=sysv4
- ;;
- apollo68)
- basic_machine=m68k-apollo
- basic_os=sysv
- ;;
- apollo68bsd)
- basic_machine=m68k-apollo
- basic_os=bsd
- ;;
- aros)
- basic_machine=i386-pc
- basic_os=aros
- ;;
- aux)
- basic_machine=m68k-apple
- basic_os=aux
- ;;
- balance)
- basic_machine=ns32k-sequent
- basic_os=dynix
- ;;
- blackfin)
- basic_machine=bfin-unknown
- basic_os=linux
- ;;
- cegcc)
- basic_machine=arm-unknown
- basic_os=cegcc
- ;;
- convex-c1)
- basic_machine=c1-convex
- basic_os=bsd
- ;;
- convex-c2)
- basic_machine=c2-convex
- basic_os=bsd
- ;;
- convex-c32)
- basic_machine=c32-convex
- basic_os=bsd
- ;;
- convex-c34)
- basic_machine=c34-convex
- basic_os=bsd
- ;;
- convex-c38)
- basic_machine=c38-convex
- basic_os=bsd
- ;;
- cray)
- basic_machine=j90-cray
- basic_os=unicos
- ;;
- crds | unos)
- basic_machine=m68k-crds
- basic_os=
- ;;
- da30)
- basic_machine=m68k-da30
- basic_os=
- ;;
- decstation | pmax | pmin | dec3100 | decstatn)
- basic_machine=mips-dec
- basic_os=
- ;;
- delta88)
- basic_machine=m88k-motorola
- basic_os=sysv3
- ;;
- dicos)
- basic_machine=i686-pc
- basic_os=dicos
- ;;
- djgpp)
- basic_machine=i586-pc
- basic_os=msdosdjgpp
- ;;
- ebmon29k)
- basic_machine=a29k-amd
- basic_os=ebmon
- ;;
- es1800 | OSE68k | ose68k | ose | OSE)
- basic_machine=m68k-ericsson
- basic_os=ose
- ;;
- gmicro)
- basic_machine=tron-gmicro
- basic_os=sysv
- ;;
- go32)
- basic_machine=i386-pc
- basic_os=go32
- ;;
- h8300hms)
- basic_machine=h8300-hitachi
- basic_os=hms
- ;;
- h8300xray)
- basic_machine=h8300-hitachi
- basic_os=xray
- ;;
- h8500hms)
- basic_machine=h8500-hitachi
- basic_os=hms
- ;;
- harris)
- basic_machine=m88k-harris
- basic_os=sysv3
- ;;
- hp300 | hp300hpux)
- basic_machine=m68k-hp
- basic_os=hpux
- ;;
- hp300bsd)
- basic_machine=m68k-hp
- basic_os=bsd
- ;;
- hppaosf)
- basic_machine=hppa1.1-hp
- basic_os=osf
- ;;
- hppro)
- basic_machine=hppa1.1-hp
- basic_os=proelf
- ;;
- i386mach)
- basic_machine=i386-mach
- basic_os=mach
- ;;
- isi68 | isi)
- basic_machine=m68k-isi
- basic_os=sysv
- ;;
- m68knommu)
- basic_machine=m68k-unknown
- basic_os=linux
- ;;
- magnum | m3230)
- basic_machine=mips-mips
- basic_os=sysv
- ;;
- merlin)
- basic_machine=ns32k-utek
- basic_os=sysv
- ;;
- mingw64)
- basic_machine=x86_64-pc
- basic_os=mingw64
- ;;
- mingw32)
- basic_machine=i686-pc
- basic_os=mingw32
- ;;
- mingw32ce)
- basic_machine=arm-unknown
- basic_os=mingw32ce
- ;;
- monitor)
- basic_machine=m68k-rom68k
- basic_os=coff
- ;;
- morphos)
- basic_machine=powerpc-unknown
- basic_os=morphos
- ;;
- moxiebox)
- basic_machine=moxie-unknown
- basic_os=moxiebox
- ;;
- msdos)
- basic_machine=i386-pc
- basic_os=msdos
- ;;
- msys)
- basic_machine=i686-pc
- basic_os=msys
- ;;
- mvs)
- basic_machine=i370-ibm
- basic_os=mvs
- ;;
- nacl)
- basic_machine=le32-unknown
- basic_os=nacl
- ;;
- ncr3000)
- basic_machine=i486-ncr
- basic_os=sysv4
- ;;
- netbsd386)
- basic_machine=i386-pc
- basic_os=netbsd
- ;;
- netwinder)
- basic_machine=armv4l-rebel
- basic_os=linux
- ;;
- news | news700 | news800 | news900)
- basic_machine=m68k-sony
- basic_os=newsos
- ;;
- news1000)
- basic_machine=m68030-sony
- basic_os=newsos
- ;;
- necv70)
- basic_machine=v70-nec
- basic_os=sysv
- ;;
- nh3000)
- basic_machine=m68k-harris
- basic_os=cxux
- ;;
- nh[45]000)
- basic_machine=m88k-harris
- basic_os=cxux
- ;;
- nindy960)
- basic_machine=i960-intel
- basic_os=nindy
- ;;
- mon960)
- basic_machine=i960-intel
- basic_os=mon960
- ;;
- nonstopux)
- basic_machine=mips-compaq
- basic_os=nonstopux
- ;;
- os400)
- basic_machine=powerpc-ibm
- basic_os=os400
- ;;
- OSE68000 | ose68000)
- basic_machine=m68000-ericsson
- basic_os=ose
- ;;
- os68k)
- basic_machine=m68k-none
- basic_os=os68k
- ;;
- paragon)
- basic_machine=i860-intel
- basic_os=osf
- ;;
- parisc)
- basic_machine=hppa-unknown
- basic_os=linux
- ;;
- psp)
- basic_machine=mipsallegrexel-sony
- basic_os=psp
- ;;
- pw32)
- basic_machine=i586-unknown
- basic_os=pw32
- ;;
- rdos | rdos64)
- basic_machine=x86_64-pc
- basic_os=rdos
- ;;
- rdos32)
- basic_machine=i386-pc
- basic_os=rdos
- ;;
- rom68k)
- basic_machine=m68k-rom68k
- basic_os=coff
- ;;
- sa29200)
- basic_machine=a29k-amd
- basic_os=udi
- ;;
- sei)
- basic_machine=mips-sei
- basic_os=seiux
- ;;
- sequent)
- basic_machine=i386-sequent
- basic_os=
- ;;
- sps7)
- basic_machine=m68k-bull
- basic_os=sysv2
- ;;
- st2000)
- basic_machine=m68k-tandem
- basic_os=
- ;;
- stratus)
- basic_machine=i860-stratus
- basic_os=sysv4
- ;;
- sun2)
- basic_machine=m68000-sun
- basic_os=
- ;;
- sun2os3)
- basic_machine=m68000-sun
- basic_os=sunos3
- ;;
- sun2os4)
- basic_machine=m68000-sun
- basic_os=sunos4
- ;;
- sun3)
- basic_machine=m68k-sun
- basic_os=
- ;;
- sun3os3)
- basic_machine=m68k-sun
- basic_os=sunos3
- ;;
- sun3os4)
- basic_machine=m68k-sun
- basic_os=sunos4
- ;;
- sun4)
- basic_machine=sparc-sun
- basic_os=
- ;;
- sun4os3)
- basic_machine=sparc-sun
- basic_os=sunos3
- ;;
- sun4os4)
- basic_machine=sparc-sun
- basic_os=sunos4
- ;;
- sun4sol2)
- basic_machine=sparc-sun
- basic_os=solaris2
- ;;
- sun386 | sun386i | roadrunner)
- basic_machine=i386-sun
- basic_os=
- ;;
- sv1)
- basic_machine=sv1-cray
- basic_os=unicos
- ;;
- symmetry)
- basic_machine=i386-sequent
- basic_os=dynix
- ;;
- t3e)
- basic_machine=alphaev5-cray
- basic_os=unicos
- ;;
- t90)
- basic_machine=t90-cray
- basic_os=unicos
- ;;
- toad1)
- basic_machine=pdp10-xkl
- basic_os=tops20
- ;;
- tpf)
- basic_machine=s390x-ibm
- basic_os=tpf
- ;;
- udi29k)
- basic_machine=a29k-amd
- basic_os=udi
- ;;
- ultra3)
- basic_machine=a29k-nyu
- basic_os=sym1
- ;;
- v810 | necv810)
- basic_machine=v810-nec
- basic_os=none
- ;;
- vaxv)
- basic_machine=vax-dec
- basic_os=sysv
- ;;
- vms)
- basic_machine=vax-dec
- basic_os=vms
- ;;
- vsta)
- basic_machine=i386-pc
- basic_os=vsta
- ;;
- vxworks960)
- basic_machine=i960-wrs
- basic_os=vxworks
- ;;
- vxworks68)
- basic_machine=m68k-wrs
- basic_os=vxworks
- ;;
- vxworks29k)
- basic_machine=a29k-wrs
- basic_os=vxworks
- ;;
- xbox)
- basic_machine=i686-pc
- basic_os=mingw32
- ;;
- ymp)
- basic_machine=ymp-cray
- basic_os=unicos
- ;;
- *)
- basic_machine=$1
- basic_os=
- ;;
- esac
- ;;
-esac
-
-# Decode 1-component or ad-hoc basic machines
-case $basic_machine in
- # Here we handle the default manufacturer of certain CPU types. It is in
- # some cases the only manufacturer, in others, it is the most popular.
- w89k)
- cpu=hppa1.1
- vendor=winbond
- ;;
- op50n)
- cpu=hppa1.1
- vendor=oki
- ;;
- op60c)
- cpu=hppa1.1
- vendor=oki
- ;;
- ibm*)
- cpu=i370
- vendor=ibm
- ;;
- orion105)
- cpu=clipper
- vendor=highlevel
- ;;
- mac | mpw | mac-mpw)
- cpu=m68k
- vendor=apple
- ;;
- pmac | pmac-mpw)
- cpu=powerpc
- vendor=apple
- ;;
-
- # Recognize the various machine names and aliases which stand
- # for a CPU type and a company and sometimes even an OS.
- 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
- cpu=m68000
- vendor=att
- ;;
- 3b*)
- cpu=we32k
- vendor=att
- ;;
- bluegene*)
- cpu=powerpc
- vendor=ibm
- basic_os=cnk
- ;;
- decsystem10* | dec10*)
- cpu=pdp10
- vendor=dec
- basic_os=tops10
- ;;
- decsystem20* | dec20*)
- cpu=pdp10
- vendor=dec
- basic_os=tops20
- ;;
- delta | 3300 | motorola-3300 | motorola-delta \
- | 3300-motorola | delta-motorola)
- cpu=m68k
- vendor=motorola
- ;;
- dpx2*)
- cpu=m68k
- vendor=bull
- basic_os=sysv3
- ;;
- encore | umax | mmax)
- cpu=ns32k
- vendor=encore
- ;;
- elxsi)
- cpu=elxsi
- vendor=elxsi
- basic_os=${basic_os:-bsd}
- ;;
- fx2800)
- cpu=i860
- vendor=alliant
- ;;
- genix)
- cpu=ns32k
- vendor=ns
- ;;
- h3050r* | hiux*)
- cpu=hppa1.1
- vendor=hitachi
- basic_os=hiuxwe2
- ;;
- hp3k9[0-9][0-9] | hp9[0-9][0-9])
- cpu=hppa1.0
- vendor=hp
- ;;
- hp9k2[0-9][0-9] | hp9k31[0-9])
- cpu=m68000
- vendor=hp
- ;;
- hp9k3[2-9][0-9])
- cpu=m68k
- vendor=hp
- ;;
- hp9k6[0-9][0-9] | hp6[0-9][0-9])
- cpu=hppa1.0
- vendor=hp
- ;;
- hp9k7[0-79][0-9] | hp7[0-79][0-9])
- cpu=hppa1.1
- vendor=hp
- ;;
- hp9k78[0-9] | hp78[0-9])
- # FIXME: really hppa2.0-hp
- cpu=hppa1.1
- vendor=hp
- ;;
- hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
- # FIXME: really hppa2.0-hp
- cpu=hppa1.1
- vendor=hp
- ;;
- hp9k8[0-9][13679] | hp8[0-9][13679])
- cpu=hppa1.1
- vendor=hp
- ;;
- hp9k8[0-9][0-9] | hp8[0-9][0-9])
- cpu=hppa1.0
- vendor=hp
- ;;
- i*86v32)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
- vendor=pc
- basic_os=sysv32
- ;;
- i*86v4*)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
- vendor=pc
- basic_os=sysv4
- ;;
- i*86v)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
- vendor=pc
- basic_os=sysv
- ;;
- i*86sol2)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
- vendor=pc
- basic_os=solaris2
- ;;
- j90 | j90-cray)
- cpu=j90
- vendor=cray
- basic_os=${basic_os:-unicos}
- ;;
- iris | iris4d)
- cpu=mips
- vendor=sgi
- case $basic_os in
- irix*)
- ;;
- *)
- basic_os=irix4
- ;;
- esac
- ;;
- miniframe)
- cpu=m68000
- vendor=convergent
- ;;
- *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)
- cpu=m68k
- vendor=atari
- basic_os=mint
- ;;
- news-3600 | risc-news)
- cpu=mips
- vendor=sony
- basic_os=newsos
- ;;
- next | m*-next)
- cpu=m68k
- vendor=next
- case $basic_os in
- openstep*)
- ;;
- nextstep*)
- ;;
- ns2*)
- basic_os=nextstep2
- ;;
- *)
- basic_os=nextstep3
- ;;
- esac
- ;;
- np1)
- cpu=np1
- vendor=gould
- ;;
- op50n-* | op60c-*)
- cpu=hppa1.1
- vendor=oki
- basic_os=proelf
- ;;
- pa-hitachi)
- cpu=hppa1.1
- vendor=hitachi
- basic_os=hiuxwe2
- ;;
- pbd)
- cpu=sparc
- vendor=tti
- ;;
- pbb)
- cpu=m68k
- vendor=tti
- ;;
- pc532)
- cpu=ns32k
- vendor=pc532
- ;;
- pn)
- cpu=pn
- vendor=gould
- ;;
- power)
- cpu=power
- vendor=ibm
- ;;
- ps2)
- cpu=i386
- vendor=ibm
- ;;
- rm[46]00)
- cpu=mips
- vendor=siemens
- ;;
- rtpc | rtpc-*)
- cpu=romp
- vendor=ibm
- ;;
- sde)
- cpu=mipsisa32
- vendor=sde
- basic_os=${basic_os:-elf}
- ;;
- simso-wrs)
- cpu=sparclite
- vendor=wrs
- basic_os=vxworks
- ;;
- tower | tower-32)
- cpu=m68k
- vendor=ncr
- ;;
- vpp*|vx|vx-*)
- cpu=f301
- vendor=fujitsu
- ;;
- w65)
- cpu=w65
- vendor=wdc
- ;;
- w89k-*)
- cpu=hppa1.1
- vendor=winbond
- basic_os=proelf
- ;;
- none)
- cpu=none
- vendor=none
- ;;
- leon|leon[3-9])
- cpu=sparc
- vendor=$basic_machine
- ;;
- leon-*|leon[3-9]-*)
- cpu=sparc
- vendor=`echo "$basic_machine" | sed 's/-.*//'`
- ;;
-
- *-*)
- # shellcheck disable=SC2162
- saved_IFS=$IFS
- IFS="-" read cpu vendor <<EOF
-$basic_machine
-EOF
- IFS=$saved_IFS
- ;;
- # We use 'pc' rather than 'unknown'
- # because (1) that's what they normally are, and
- # (2) the word "unknown" tends to confuse beginning users.
- i*86 | x86_64)
- cpu=$basic_machine
- vendor=pc
- ;;
- # These rules are duplicated from below for sake of the special case above;
- # i.e. things that normalized to x86 arches should also default to "pc"
- pc98)
- cpu=i386
- vendor=pc
- ;;
- x64 | amd64)
- cpu=x86_64
- vendor=pc
- ;;
- # Recognize the basic CPU types without company name.
- *)
- cpu=$basic_machine
- vendor=unknown
- ;;
-esac
-
-unset -v basic_machine
-
-# Decode basic machines in the full and proper CPU-Company form.
-case $cpu-$vendor in
- # Here we handle the default manufacturer of certain CPU types in canonical form. It is in
- # some cases the only manufacturer, in others, it is the most popular.
- craynv-unknown)
- vendor=cray
- basic_os=${basic_os:-unicosmp}
- ;;
- c90-unknown | c90-cray)
- vendor=cray
- basic_os=${Basic_os:-unicos}
- ;;
- fx80-unknown)
- vendor=alliant
- ;;
- romp-unknown)
- vendor=ibm
- ;;
- mmix-unknown)
- vendor=knuth
- ;;
- microblaze-unknown | microblazeel-unknown)
- vendor=xilinx
- ;;
- rs6000-unknown)
- vendor=ibm
- ;;
- vax-unknown)
- vendor=dec
- ;;
- pdp11-unknown)
- vendor=dec
- ;;
- we32k-unknown)
- vendor=att
- ;;
- cydra-unknown)
- vendor=cydrome
- ;;
- i370-ibm*)
- vendor=ibm
- ;;
- orion-unknown)
- vendor=highlevel
- ;;
- xps-unknown | xps100-unknown)
- cpu=xps100
- vendor=honeywell
- ;;
-
- # Here we normalize CPU types with a missing or matching vendor
- armh-unknown | armh-alt)
- cpu=armv7l
- vendor=alt
- basic_os=${basic_os:-linux-gnueabihf}
- ;;
- dpx20-unknown | dpx20-bull)
- cpu=rs6000
- vendor=bull
- basic_os=${basic_os:-bosx}
- ;;
-
- # Here we normalize CPU types irrespective of the vendor
- amd64-*)
- cpu=x86_64
- ;;
- blackfin-*)
- cpu=bfin
- basic_os=linux
- ;;
- c54x-*)
- cpu=tic54x
- ;;
- c55x-*)
- cpu=tic55x
- ;;
- c6x-*)
- cpu=tic6x
- ;;
- e500v[12]-*)
- cpu=powerpc
- basic_os=${basic_os}"spe"
- ;;
- mips3*-*)
- cpu=mips64
- ;;
- ms1-*)
- cpu=mt
- ;;
- m68knommu-*)
- cpu=m68k
- basic_os=linux
- ;;
- m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
- cpu=s12z
- ;;
- openrisc-*)
- cpu=or32
- ;;
- parisc-*)
- cpu=hppa
- basic_os=linux
- ;;
- pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
- cpu=i586
- ;;
- pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*)
- cpu=i686
- ;;
- pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
- cpu=i686
- ;;
- pentium4-*)
- cpu=i786
- ;;
- pc98-*)
- cpu=i386
- ;;
- ppc-* | ppcbe-*)
- cpu=powerpc
- ;;
- ppcle-* | powerpclittle-*)
- cpu=powerpcle
- ;;
- ppc64-*)
- cpu=powerpc64
- ;;
- ppc64le-* | powerpc64little-*)
- cpu=powerpc64le
- ;;
- sb1-*)
- cpu=mipsisa64sb1
- ;;
- sb1el-*)
- cpu=mipsisa64sb1el
- ;;
- sh5e[lb]-*)
- cpu=`echo "$cpu" | sed 's/^\(sh.\)e\(.\)$/\1\2e/'`
- ;;
- spur-*)
- cpu=spur
- ;;
- strongarm-* | thumb-*)
- cpu=arm
- ;;
- tx39-*)
- cpu=mipstx39
- ;;
- tx39el-*)
- cpu=mipstx39el
- ;;
- x64-*)
- cpu=x86_64
- ;;
- xscale-* | xscalee[bl]-*)
- cpu=`echo "$cpu" | sed 's/^xscale/arm/'`
- ;;
- arm64-* | aarch64le-*)
- cpu=aarch64
- ;;
-
- # Recognize the canonical CPU Types that limit and/or modify the
- # company names they are paired with.
- cr16-*)
- basic_os=${basic_os:-elf}
- ;;
- crisv32-* | etraxfs*-*)
- cpu=crisv32
- vendor=axis
- ;;
- cris-* | etrax*-*)
- cpu=cris
- vendor=axis
- ;;
- crx-*)
- basic_os=${basic_os:-elf}
- ;;
- neo-tandem)
- cpu=neo
- vendor=tandem
- ;;
- nse-tandem)
- cpu=nse
- vendor=tandem
- ;;
- nsr-tandem)
- cpu=nsr
- vendor=tandem
- ;;
- nsv-tandem)
- cpu=nsv
- vendor=tandem
- ;;
- nsx-tandem)
- cpu=nsx
- vendor=tandem
- ;;
- mipsallegrexel-sony)
- cpu=mipsallegrexel
- vendor=sony
- ;;
- tile*-*)
- basic_os=${basic_os:-linux-gnu}
- ;;
-
- *)
- # Recognize the canonical CPU types that are allowed with any
- # company name.
- case $cpu in
- 1750a | 580 \
- | a29k \
- | aarch64 | aarch64_be \
- | abacus \
- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \
- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \
- | alphapca5[67] | alpha64pca5[67] \
- | am33_2.0 \
- | amdgcn \
- | arc | arceb | arc32 | arc64 \
- | arm | arm[lb]e | arme[lb] | armv* \
- | avr | avr32 \
- | asmjs \
- | ba \
- | be32 | be64 \
- | bfin | bpf | bs2000 \
- | c[123]* | c30 | [cjt]90 | c4x \
- | c8051 | clipper | craynv | csky | cydra \
- | d10v | d30v | dlx | dsp16xx \
- | e2k | elxsi | epiphany \
- | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \
- | h8300 | h8500 \
- | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
- | hexagon \
- | i370 | i*86 | i860 | i960 | ia16 | ia64 \
- | ip2k | iq2000 \
- | k1om \
- | le32 | le64 \
- | lm32 \
- | loongarch32 | loongarch64 \
- | m32c | m32r | m32rle \
- | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \
- | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
- | m88110 | m88k | maxq | mb | mcore | mep | metag \
- | microblaze | microblazeel \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64eb | mips64el \
- | mips64octeon | mips64octeonel \
- | mips64orion | mips64orionel \
- | mips64r5900 | mips64r5900el \
- | mips64vr | mips64vrel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mips64vr5900 | mips64vr5900el \
- | mipsisa32 | mipsisa32el \
- | mipsisa32r2 | mipsisa32r2el \
- | mipsisa32r3 | mipsisa32r3el \
- | mipsisa32r5 | mipsisa32r5el \
- | mipsisa32r6 | mipsisa32r6el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64r2 | mipsisa64r2el \
- | mipsisa64r3 | mipsisa64r3el \
- | mipsisa64r5 | mipsisa64r5el \
- | mipsisa64r6 | mipsisa64r6el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipsr5900 | mipsr5900el \
- | mipstx39 | mipstx39el \
- | mmix \
- | mn10200 | mn10300 \
- | moxie \
- | mt \
- | msp430 \
- | nds32 | nds32le | nds32be \
- | nfp \
- | nios | nios2 | nios2eb | nios2el \
- | none | np1 | ns16k | ns32k | nvptx \
- | open8 \
- | or1k* \
- | or32 \
- | orion \
- | picochip \
- | pdp10 | pdp11 | pj | pjl | pn | power \
- | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \
- | pru \
- | pyramid \
- | riscv | riscv32 | riscv32be | riscv64 | riscv64be \
- | rl78 | romp | rs6000 | rx \
- | s390 | s390x \
- | score \
- | sh | shl \
- | sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \
- | sh[1234]e[lb] | sh[12345][lb]e | sh[23]ele | sh64 | sh64le \
- | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet \
- | sparclite \
- | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \
- | spu \
- | tahoe \
- | thumbv7* \
- | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \
- | tron \
- | ubicom32 \
- | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \
- | vax \
- | visium \
- | w65 \
- | wasm32 | wasm64 \
- | we32k \
- | x86 | x86_64 | xc16x | xgate | xps100 \
- | xstormy16 | xtensa* \
- | ymp \
- | z8k | z80)
- ;;
-
- *)
- echo "Invalid configuration '$1': machine '$cpu-$vendor' not recognized" 1>&2
- exit 1
- ;;
- esac
- ;;
-esac
-
-# Here we canonicalize certain aliases for manufacturers.
-case $vendor in
- digital*)
- vendor=dec
- ;;
- commodore*)
- vendor=cbm
- ;;
- *)
- ;;
-esac
-
-# Decode manufacturer-specific aliases for certain operating systems.
-
-if test x$basic_os != x
-then
-
-# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just
-# set os.
-case $basic_os in
- gnu/linux*)
- kernel=linux
- os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'`
- ;;
- os2-emx)
- kernel=os2
- os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'`
- ;;
- nto-qnx*)
- kernel=nto
- os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'`
- ;;
- *-*)
- # shellcheck disable=SC2162
- saved_IFS=$IFS
- IFS="-" read kernel os <<EOF
-$basic_os
-EOF
- IFS=$saved_IFS
- ;;
- # Default OS when just kernel was specified
- nto*)
- kernel=nto
- os=`echo "$basic_os" | sed -e 's|nto|qnx|'`
- ;;
- linux*)
- kernel=linux
- os=`echo "$basic_os" | sed -e 's|linux|gnu|'`
- ;;
- managarm*)
- kernel=managarm
- os=`echo "$basic_os" | sed -e 's|managarm|mlibc|'`
- ;;
- *)
- kernel=
- os=$basic_os
- ;;
-esac
-
-# Now, normalize the OS (knowing we just have one component, it's not a kernel,
-# etc.)
-case $os in
- # First match some system type aliases that might get confused
- # with valid system types.
- # solaris* is a basic system type, with this one exception.
- auroraux)
- os=auroraux
- ;;
- bluegene*)
- os=cnk
- ;;
- solaris1 | solaris1.*)
- os=`echo "$os" | sed -e 's|solaris1|sunos4|'`
- ;;
- solaris)
- os=solaris2
- ;;
- unixware*)
- os=sysv4.2uw
- ;;
- # es1800 is here to avoid being matched by es* (a different OS)
- es1800*)
- os=ose
- ;;
- # Some version numbers need modification
- chorusos*)
- os=chorusos
- ;;
- isc)
- os=isc2.2
- ;;
- sco6)
- os=sco5v6
- ;;
- sco5)
- os=sco3.2v5
- ;;
- sco4)
- os=sco3.2v4
- ;;
- sco3.2.[4-9]*)
- os=`echo "$os" | sed -e 's/sco3.2./sco3.2v/'`
- ;;
- sco*v* | scout)
- # Don't match below
- ;;
- sco*)
- os=sco3.2v2
- ;;
- psos*)
- os=psos
- ;;
- qnx*)
- os=qnx
- ;;
- hiux*)
- os=hiuxwe2
- ;;
- lynx*178)
- os=lynxos178
- ;;
- lynx*5)
- os=lynxos5
- ;;
- lynxos*)
- # don't get caught up in next wildcard
- ;;
- lynx*)
- os=lynxos
- ;;
- mac[0-9]*)
- os=`echo "$os" | sed -e 's|mac|macos|'`
- ;;
- opened*)
- os=openedition
- ;;
- os400*)
- os=os400
- ;;
- sunos5*)
- os=`echo "$os" | sed -e 's|sunos5|solaris2|'`
- ;;
- sunos6*)
- os=`echo "$os" | sed -e 's|sunos6|solaris3|'`
- ;;
- wince*)
- os=wince
- ;;
- utek*)
- os=bsd
- ;;
- dynix*)
- os=bsd
- ;;
- acis*)
- os=aos
- ;;
- atheos*)
- os=atheos
- ;;
- syllable*)
- os=syllable
- ;;
- 386bsd)
- os=bsd
- ;;
- ctix* | uts*)
- os=sysv
- ;;
- nova*)
- os=rtmk-nova
- ;;
- ns2)
- os=nextstep2
- ;;
- # Preserve the version number of sinix5.
- sinix5.*)
- os=`echo "$os" | sed -e 's|sinix|sysv|'`
- ;;
- sinix*)
- os=sysv4
- ;;
- tpf*)
- os=tpf
- ;;
- triton*)
- os=sysv3
- ;;
- oss*)
- os=sysv3
- ;;
- svr4*)
- os=sysv4
- ;;
- svr3)
- os=sysv3
- ;;
- sysvr4)
- os=sysv4
- ;;
- ose*)
- os=ose
- ;;
- *mint | mint[0-9]* | *MiNT | MiNT[0-9]*)
- os=mint
- ;;
- dicos*)
- os=dicos
- ;;
- pikeos*)
- # Until real need of OS specific support for
- # particular features comes up, bare metal
- # configurations are quite functional.
- case $cpu in
- arm*)
- os=eabi
- ;;
- *)
- os=elf
- ;;
- esac
- ;;
- *)
- # No normalization, but not necessarily accepted, that comes below.
- ;;
-esac
-
-else
-
-# Here we handle the default operating systems that come with various machines.
-# The value should be what the vendor currently ships out the door with their
-# machine or put another way, the most popular os provided with the machine.
-
-# Note that if you're going to try to match "-MANUFACTURER" here (say,
-# "-sun"), then you have to tell the case statement up towards the top
-# that MANUFACTURER isn't an operating system. Otherwise, code above
-# will signal an error saying that MANUFACTURER isn't an operating
-# system, and we'll never get to this point.
-
-kernel=
-case $cpu-$vendor in
- score-*)
- os=elf
- ;;
- spu-*)
- os=elf
- ;;
- *-acorn)
- os=riscix1.2
- ;;
- arm*-rebel)
- kernel=linux
- os=gnu
- ;;
- arm*-semi)
- os=aout
- ;;
- c4x-* | tic4x-*)
- os=coff
- ;;
- c8051-*)
- os=elf
- ;;
- clipper-intergraph)
- os=clix
- ;;
- hexagon-*)
- os=elf
- ;;
- tic54x-*)
- os=coff
- ;;
- tic55x-*)
- os=coff
- ;;
- tic6x-*)
- os=coff
- ;;
- # This must come before the *-dec entry.
- pdp10-*)
- os=tops20
- ;;
- pdp11-*)
- os=none
- ;;
- *-dec | vax-*)
- os=ultrix4.2
- ;;
- m68*-apollo)
- os=domain
- ;;
- i386-sun)
- os=sunos4.0.2
- ;;
- m68000-sun)
- os=sunos3
- ;;
- m68*-cisco)
- os=aout
- ;;
- mep-*)
- os=elf
- ;;
- mips*-cisco)
- os=elf
- ;;
- mips*-*)
- os=elf
- ;;
- or32-*)
- os=coff
- ;;
- *-tti) # must be before sparc entry or we get the wrong os.
- os=sysv3
- ;;
- sparc-* | *-sun)
- os=sunos4.1.1
- ;;
- pru-*)
- os=elf
- ;;
- *-be)
- os=beos
- ;;
- *-ibm)
- os=aix
- ;;
- *-knuth)
- os=mmixware
- ;;
- *-wec)
- os=proelf
- ;;
- *-winbond)
- os=proelf
- ;;
- *-oki)
- os=proelf
- ;;
- *-hp)
- os=hpux
- ;;
- *-hitachi)
- os=hiux
- ;;
- i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
- os=sysv
- ;;
- *-cbm)
- os=amigaos
- ;;
- *-dg)
- os=dgux
- ;;
- *-dolphin)
- os=sysv3
- ;;
- m68k-ccur)
- os=rtu
- ;;
- m88k-omron*)
- os=luna
- ;;
- *-next)
- os=nextstep
- ;;
- *-sequent)
- os=ptx
- ;;
- *-crds)
- os=unos
- ;;
- *-ns)
- os=genix
- ;;
- i370-*)
- os=mvs
- ;;
- *-gould)
- os=sysv
- ;;
- *-highlevel)
- os=bsd
- ;;
- *-encore)
- os=bsd
- ;;
- *-sgi)
- os=irix
- ;;
- *-siemens)
- os=sysv4
- ;;
- *-masscomp)
- os=rtu
- ;;
- f30[01]-fujitsu | f700-fujitsu)
- os=uxpv
- ;;
- *-rom68k)
- os=coff
- ;;
- *-*bug)
- os=coff
- ;;
- *-apple)
- os=macos
- ;;
- *-atari*)
- os=mint
- ;;
- *-wrs)
- os=vxworks
- ;;
- *)
- os=none
- ;;
-esac
-
-fi
-
-# Now, validate our (potentially fixed-up) OS.
-case $os in
- # Sometimes we do "kernel-libc", so those need to count as OSes.
- musl* | newlib* | relibc* | uclibc*)
- ;;
- # Likewise for "kernel-abi"
- eabi* | gnueabi*)
- ;;
- # VxWorks passes extra cpu info in the 4th filed.
- simlinux | simwindows | spe)
- ;;
- # Now accept the basic system types.
- # The portable systems comes first.
- # Each alternative MUST end in a * to match a version number.
- gnu* | android* | bsd* | mach* | minix* | genix* | ultrix* | irix* \
- | *vms* | esix* | aix* | cnk* | sunos | sunos[34]* \
- | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \
- | sym* | plan9* | psp* | sim* | xray* | os68k* | v88r* \
- | hiux* | abug | nacl* | netware* | windows* \
- | os9* | macos* | osx* | ios* \
- | mpw* | magic* | mmixware* | mon960* | lnews* \
- | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
- | aos* | aros* | cloudabi* | sortix* | twizzler* \
- | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \
- | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \
- | mirbsd* | netbsd* | dicos* | openedition* | ose* \
- | bitrig* | openbsd* | secbsd* | solidbsd* | libertybsd* | os108* \
- | ekkobsd* | freebsd* | riscix* | lynxos* | os400* \
- | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
- | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
- | udi* | lites* | ieee* | go32* | aux* | hcos* \
- | chorusrdb* | cegcc* | glidix* | serenity* \
- | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
- | midipix* | mingw32* | mingw64* | mint* \
- | uxpv* | beos* | mpeix* | udk* | moxiebox* \
- | interix* | uwin* | mks* | rhapsody* | darwin* \
- | openstep* | oskit* | conix* | pw32* | nonstopux* \
- | storm-chaos* | tops10* | tenex* | tops20* | its* \
- | os2* | vos* | palmos* | uclinux* | nucleus* | morphos* \
- | scout* | superux* | sysv* | rtmk* | tpf* | windiss* \
- | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \
- | skyos* | haiku* | rdos* | toppers* | drops* | es* \
- | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
- | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
- | nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \
- | fiwix* | mlibc* )
- ;;
- # This one is extra strict with allowed versions
- sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
- # Don't forget version if it is 3.2v4 or newer.
- ;;
- none)
- ;;
- kernel* )
- # Restricted further below
- ;;
- *)
- echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
- exit 1
- ;;
-esac
-
-# As a final step for OS-related things, validate the OS-kernel combination
-# (given a valid OS), if there is a kernel.
-case $kernel-$os in
- linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \
- | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc* )
- ;;
- uclinux-uclibc* )
- ;;
- managarm-mlibc* | managarm-kernel* )
- ;;
- -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* )
- # These are just libc implementations, not actual OSes, and thus
- # require a kernel.
- echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2
- exit 1
- ;;
- -kernel* )
- echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2
- exit 1
- ;;
- *-kernel* )
- echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2
- exit 1
- ;;
- kfreebsd*-gnu* | kopensolaris*-gnu*)
- ;;
- vxworks-simlinux | vxworks-simwindows | vxworks-spe)
- ;;
- nto-qnx*)
- ;;
- os2-emx)
- ;;
- *-eabi* | *-gnueabi*)
- ;;
- -*)
- # Blank kernel with real OS is always fine.
- ;;
- *-*)
- echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2
- exit 1
- ;;
-esac
-
-# Here we handle the case where we know the os, and the CPU type, but not the
-# manufacturer. We pick the logical manufacturer.
-case $vendor in
- unknown)
- case $cpu-$os in
- *-riscix*)
- vendor=acorn
- ;;
- *-sunos*)
- vendor=sun
- ;;
- *-cnk* | *-aix*)
- vendor=ibm
- ;;
- *-beos*)
- vendor=be
- ;;
- *-hpux*)
- vendor=hp
- ;;
- *-mpeix*)
- vendor=hp
- ;;
- *-hiux*)
- vendor=hitachi
- ;;
- *-unos*)
- vendor=crds
- ;;
- *-dgux*)
- vendor=dg
- ;;
- *-luna*)
- vendor=omron
- ;;
- *-genix*)
- vendor=ns
- ;;
- *-clix*)
- vendor=intergraph
- ;;
- *-mvs* | *-opened*)
- vendor=ibm
- ;;
- *-os400*)
- vendor=ibm
- ;;
- s390-* | s390x-*)
- vendor=ibm
- ;;
- *-ptx*)
- vendor=sequent
- ;;
- *-tpf*)
- vendor=ibm
- ;;
- *-vxsim* | *-vxworks* | *-windiss*)
- vendor=wrs
- ;;
- *-aux*)
- vendor=apple
- ;;
- *-hms*)
- vendor=hitachi
- ;;
- *-mpw* | *-macos*)
- vendor=apple
- ;;
- *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*)
- vendor=atari
- ;;
- *-vos*)
- vendor=stratus
- ;;
- esac
- ;;
-esac
-
-echo "$cpu-$vendor-${kernel:+$kernel-}$os"
-exit
-
-# Local variables:
-# eval: (add-hook 'before-save-hook 'time-stamp)
-# time-stamp-start: "timestamp='"
-# time-stamp-format: "%:y-%02m-%02d"
-# time-stamp-end: "'"
-# End:
diff --git a/exec/configure.ac b/exec/configure.ac
index 9008c84f6a6..a473a1dc633 100644
--- a/exec/configure.ac
+++ b/exec/configure.ac
@@ -122,6 +122,7 @@ AH_TEMPLATE([SYSCALL_RET_REG], [Define to register holding value of system calls
AH_TEMPLATE([STACK_POINTER], [Define to register holding the stack pointer.])
AH_TEMPLATE([EXEC_SYSCALL], [Define to number of the `exec' system call.])
AH_TEMPLATE([USER_WORD], [Define to word type used by tracees.])
+AH_TEMPLATE([USER_SWORD], [Define to signed word type used by tracees.])
AH_TEMPLATE([EXEC_64], [Define to 1 if the system utilizes 64-bit ELF.])
AH_TEMPLATE([STACK_GROWS_DOWNWARDS], [Define to 1 if the stack grows downwards.])
AH_TEMPLATE([ABI_RED_ZONE], [Define to number of reserved bytes past the stack frame.])
@@ -131,6 +132,8 @@ AH_TEMPLATE([CLONE_SYSCALL], [Define to number of the `clone' system call.])
AH_TEMPLATE([CLONE3_SYSCALL], [Define to number of the `clone3' system call.])
AH_TEMPLATE([READLINK_SYSCALL], [Define to number of the `readlink' system call.])
AH_TEMPLATE([READLINKAT_SYSCALL], [Define to number of the `readlinkat' system call.])
+AH_TEMPLATE([OPEN_SYSCALL], [Define to number of the `open' system call.])
+AH_TEMPLATE([OPENAT_SYSCALL], [Define to number of the `openat' system call.])
AH_TEMPLATE([REENTRANT], [Define to 1 if the library is used within a signal handler.])
AC_CANONICAL_HOST
@@ -249,6 +252,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [rsp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([ABI_RED_ZONE], [128])
AC_DEFINE([EXECUTABLE_BASE], [0x555555554000])
@@ -257,6 +261,8 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
exec_CHECK_LINUX_CLONE3
# Make sure the loader doesn't conflict with other position
# dependent code.
@@ -279,12 +285,15 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [esp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0xaf000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
exec_CHECK_LINUX_CLONE3
# Make sure the loader doesn't conflict with other position
# dependent code.
@@ -307,13 +316,15 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [sp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x3000000000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
- # Note that aarch64 has no `readlink'.
+ # Note that aarch64 has neither `readlink' nor `open'.
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
exec_CHECK_LINUX_CLONE3
# Make sure the loader doesn't conflict with other position
# dependent code. ARM places rather significant restrictions on
@@ -337,12 +348,15 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
exec_CHECK_LINUX_CLONE3
LOADERFLAGS="$LOADERFLAGS $LDPREFIX-Ttext=0x20000000"
exec_loader=loader-armeabi.s],
@@ -359,12 +373,15 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
exec_CHECK_LINUX_CLONE3
LOADERFLAGS="$LOADERFLAGS $LDPREFIX-Ttext=0x20000000"
exec_loader=loader-armeabi.s],
@@ -387,12 +404,15 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
AC_CHECK_DECL([_MIPS_SIM], [exec_CHECK_MIPS_NABI],
[AC_MSG_ERROR([_MIPS_SIM could not be determined]),
[[
@@ -414,6 +434,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x400000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])
@@ -421,6 +442,8 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([CLONE_SYSCALL], [__NR_clone])
AC_DEFINE([READLINK_SYSCALL], [__NR_readlink])
AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat])
+ AC_DEFINE([OPEN_SYSCALL], [__NR_open])
+ AC_DEFINE([OPENAT_SYSCALL], [__NR_openat])
AC_CACHE_CHECK([whether as understands `daddi'],
[exec_cv_as_daddi],
[exec_cv_as_daddi=no
diff --git a/exec/exec.c b/exec/exec.c
index 254a983f25f..cbe22d4f18c 100644
--- a/exec/exec.c
+++ b/exec/exec.c
@@ -865,7 +865,7 @@ insert_args (struct exec_tracee *tracee, USER_REGS_STRUCT *regs,
result in *IN, and return a pointer to the byte after the
result. REM should be NULL. */
-static char *
+char *
format_pid (char *in, unsigned int pid)
{
unsigned int digits[32], *fill;
diff --git a/exec/exec.h b/exec/exec.h
index bed5edc9bab..3ce06c35311 100644
--- a/exec/exec.h
+++ b/exec/exec.h
@@ -148,6 +148,10 @@ struct exec_tracee
/* The next process being traced. */
struct exec_tracee *next;
+ /* Address of any stack pointer to restore after system call
+ completion. */
+ USER_WORD sp;
+
/* The thread ID of this process. */
pid_t pid;
@@ -176,6 +180,7 @@ extern int aarch64_set_regs (pid_t, USER_REGS_STRUCT *, bool);
+extern char *format_pid (char *, unsigned int);
extern USER_WORD user_alloca (struct exec_tracee *, USER_REGS_STRUCT *,
USER_REGS_STRUCT *, USER_WORD);
extern int user_copy (struct exec_tracee *, const unsigned char *,
diff --git a/exec/install-sh b/exec/install-sh
deleted file mode 100755
index e046efdf0a3..00000000000
--- a/exec/install-sh
+++ /dev/null
@@ -1,541 +0,0 @@
-#!/usr/bin/sh
-# install - install a program, script, or datafile
-
-scriptversion=2020-11-14.01; # UTC
-
-# This originates from X11R5 (mit/util/scripts/install.sh), which was
-# later released in X11R6 (xc/config/util/install.sh) with the
-# following copyright and license.
-#
-# Copyright (C) 1994 X Consortium
-#
-# Permission is hereby granted, free of charge, to any person obtaining a copy
-# of this software and associated documentation files (the "Software"), to
-# deal in the Software without restriction, including without limitation the
-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be included in
-# all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
-# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-#
-# Except as contained in this notice, the name of the X Consortium shall not
-# be used in advertising or otherwise to promote the sale, use or other deal-
-# ings in this Software without prior written authorization from the X Consor-
-# tium.
-#
-#
-# FSF changes to this file are in the public domain.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# 'make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.
-
-tab=' '
-nl='
-'
-IFS=" $tab$nl"
-
-# Set DOITPROG to "echo" to test this script.
-
-doit=${DOITPROG-}
-doit_exec=${doit:-exec}
-
-# Put in absolute file names if you don't have them in your path;
-# or use environment vars.
-
-chgrpprog=${CHGRPPROG-chgrp}
-chmodprog=${CHMODPROG-chmod}
-chownprog=${CHOWNPROG-chown}
-cmpprog=${CMPPROG-cmp}
-cpprog=${CPPROG-cp}
-mkdirprog=${MKDIRPROG-mkdir}
-mvprog=${MVPROG-mv}
-rmprog=${RMPROG-rm}
-stripprog=${STRIPPROG-strip}
-
-posix_mkdir=
-
-# Desired mode of installed file.
-mode=0755
-
-# Create dirs (including intermediate dirs) using mode 755.
-# This is like GNU 'install' as of coreutils 8.32 (2020).
-mkdir_umask=22
-
-backupsuffix=
-chgrpcmd=
-chmodcmd=$chmodprog
-chowncmd=
-mvcmd=$mvprog
-rmcmd="$rmprog -f"
-stripcmd=
-
-src=
-dst=
-dir_arg=
-dst_arg=
-
-copy_on_change=false
-is_target_a_directory=possibly
-
-usage="\
-Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
- or: $0 [OPTION]... SRCFILES... DIRECTORY
- or: $0 [OPTION]... -t DIRECTORY SRCFILES...
- or: $0 [OPTION]... -d DIRECTORIES...
-
-In the 1st form, copy SRCFILE to DSTFILE.
-In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
-In the 4th, create DIRECTORIES.
-
-Options:
- --help display this help and exit.
- --version display version info and exit.
-
- -c (ignored)
- -C install only if different (preserve data modification time)
- -d create directories instead of installing files.
- -g GROUP $chgrpprog installed files to GROUP.
- -m MODE $chmodprog installed files to MODE.
- -o USER $chownprog installed files to USER.
- -p pass -p to $cpprog.
- -s $stripprog installed files.
- -S SUFFIX attempt to back up existing files, with suffix SUFFIX.
- -t DIRECTORY install into DIRECTORY.
- -T report an error if DSTFILE is a directory.
-
-Environment variables override the default commands:
- CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
- RMPROG STRIPPROG
-
-By default, rm is invoked with -f; when overridden with RMPROG,
-it's up to you to specify -f if you want it.
-
-If -S is not specified, no backups are attempted.
-
-Email bug reports to bug-automake@gnu.org.
-Automake home page: https://www.gnu.org/software/automake/
-"
-
-while test $# -ne 0; do
- case $1 in
- -c) ;;
-
- -C) copy_on_change=true;;
-
- -d) dir_arg=true;;
-
- -g) chgrpcmd="$chgrpprog $2"
- shift;;
-
- --help) echo "$usage"; exit $?;;
-
- -m) mode=$2
- case $mode in
- *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
- echo "$0: invalid mode: $mode" >&2
- exit 1;;
- esac
- shift;;
-
- -o) chowncmd="$chownprog $2"
- shift;;
-
- -p) cpprog="$cpprog -p";;
-
- -s) stripcmd=$stripprog;;
-
- -S) backupsuffix="$2"
- shift;;
-
- -t)
- is_target_a_directory=always
- dst_arg=$2
- # Protect names problematic for 'test' and other utilities.
- case $dst_arg in
- -* | [=\(\)!]) dst_arg=./$dst_arg;;
- esac
- shift;;
-
- -T) is_target_a_directory=never;;
-
- --version) echo "$0 $scriptversion"; exit $?;;
-
- --) shift
- break;;
-
- -*) echo "$0: invalid option: $1" >&2
- exit 1;;
-
- *) break;;
- esac
- shift
-done
-
-# We allow the use of options -d and -T together, by making -d
-# take the precedence; this is for compatibility with GNU install.
-
-if test -n "$dir_arg"; then
- if test -n "$dst_arg"; then
- echo "$0: target directory not allowed when installing a directory." >&2
- exit 1
- fi
-fi
-
-if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
- # When -d is used, all remaining arguments are directories to create.
- # When -t is used, the destination is already specified.
- # Otherwise, the last argument is the destination. Remove it from $@.
- for arg
- do
- if test -n "$dst_arg"; then
- # $@ is not empty: it contains at least $arg.
- set fnord "$@" "$dst_arg"
- shift # fnord
- fi
- shift # arg
- dst_arg=$arg
- # Protect names problematic for 'test' and other utilities.
- case $dst_arg in
- -* | [=\(\)!]) dst_arg=./$dst_arg;;
- esac
- done
-fi
-
-if test $# -eq 0; then
- if test -z "$dir_arg"; then
- echo "$0: no input file specified." >&2
- exit 1
- fi
- # It's OK to call 'install-sh -d' without argument.
- # This can happen when creating conditional directories.
- exit 0
-fi
-
-if test -z "$dir_arg"; then
- if test $# -gt 1 || test "$is_target_a_directory" = always; then
- if test ! -d "$dst_arg"; then
- echo "$0: $dst_arg: Is not a directory." >&2
- exit 1
- fi
- fi
-fi
-
-if test -z "$dir_arg"; then
- do_exit='(exit $ret); exit $ret'
- trap "ret=129; $do_exit" 1
- trap "ret=130; $do_exit" 2
- trap "ret=141; $do_exit" 13
- trap "ret=143; $do_exit" 15
-
- # Set umask so as not to create temps with too-generous modes.
- # However, 'strip' requires both read and write access to temps.
- case $mode in
- # Optimize common cases.
- *644) cp_umask=133;;
- *755) cp_umask=22;;
-
- *[0-7])
- if test -z "$stripcmd"; then
- u_plus_rw=
- else
- u_plus_rw='% 200'
- fi
- cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
- *)
- if test -z "$stripcmd"; then
- u_plus_rw=
- else
- u_plus_rw=,u+rw
- fi
- cp_umask=$mode$u_plus_rw;;
- esac
-fi
-
-for src
-do
- # Protect names problematic for 'test' and other utilities.
- case $src in
- -* | [=\(\)!]) src=./$src;;
- esac
-
- if test -n "$dir_arg"; then
- dst=$src
- dstdir=$dst
- test -d "$dstdir"
- dstdir_status=$?
- # Don't chown directories that already exist.
- if test $dstdir_status = 0; then
- chowncmd=""
- fi
- else
-
- # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
- # might cause directories to be created, which would be especially bad
- # if $src (and thus $dsttmp) contains '*'.
- if test ! -f "$src" && test ! -d "$src"; then
- echo "$0: $src does not exist." >&2
- exit 1
- fi
-
- if test -z "$dst_arg"; then
- echo "$0: no destination specified." >&2
- exit 1
- fi
- dst=$dst_arg
-
- # If destination is a directory, append the input filename.
- if test -d "$dst"; then
- if test "$is_target_a_directory" = never; then
- echo "$0: $dst_arg: Is a directory" >&2
- exit 1
- fi
- dstdir=$dst
- dstbase=`basename "$src"`
- case $dst in
- */) dst=$dst$dstbase;;
- *) dst=$dst/$dstbase;;
- esac
- dstdir_status=0
- else
- dstdir=`dirname "$dst"`
- test -d "$dstdir"
- dstdir_status=$?
- fi
- fi
-
- case $dstdir in
- */) dstdirslash=$dstdir;;
- *) dstdirslash=$dstdir/;;
- esac
-
- obsolete_mkdir_used=false
-
- if test $dstdir_status != 0; then
- case $posix_mkdir in
- '')
- # With -d, create the new directory with the user-specified mode.
- # Otherwise, rely on $mkdir_umask.
- if test -n "$dir_arg"; then
- mkdir_mode=-m$mode
- else
- mkdir_mode=
- fi
-
- posix_mkdir=false
- # The $RANDOM variable is not portable (e.g., dash). Use it
- # here however when possible just to lower collision chance.
- tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
-
- trap '
- ret=$?
- rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
- exit $ret
- ' 0
-
- # Because "mkdir -p" follows existing symlinks and we likely work
- # directly in world-writeable /tmp, make sure that the '$tmpdir'
- # directory is successfully created first before we actually test
- # 'mkdir -p'.
- if (umask $mkdir_umask &&
- $mkdirprog $mkdir_mode "$tmpdir" &&
- exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
- then
- if test -z "$dir_arg" || {
- # Check for POSIX incompatibilities with -m.
- # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
- # other-writable bit of parent directory when it shouldn't.
- # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
- test_tmpdir="$tmpdir/a"
- ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
- case $ls_ld_tmpdir in
- d????-?r-*) different_mode=700;;
- d????-?--*) different_mode=755;;
- *) false;;
- esac &&
- $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
- ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
- test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
- }
- }
- then posix_mkdir=:
- fi
- rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
- else
- # Remove any dirs left behind by ancient mkdir implementations.
- rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
- fi
- trap '' 0;;
- esac
-
- if
- $posix_mkdir && (
- umask $mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
- )
- then :
- else
-
- # mkdir does not conform to POSIX,
- # or it failed possibly due to a race condition. Create the
- # directory the slow way, step by step, checking for races as we go.
-
- case $dstdir in
- /*) prefix='/';;
- [-=\(\)!]*) prefix='./';;
- *) prefix='';;
- esac
-
- oIFS=$IFS
- IFS=/
- set -f
- set fnord $dstdir
- shift
- set +f
- IFS=$oIFS
-
- prefixes=
-
- for d
- do
- test X"$d" = X && continue
-
- prefix=$prefix$d
- if test -d "$prefix"; then
- prefixes=
- else
- if $posix_mkdir; then
- (umask $mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
- # Don't fail if two instances are running concurrently.
- test -d "$prefix" || exit 1
- else
- case $prefix in
- *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
- *) qprefix=$prefix;;
- esac
- prefixes="$prefixes '$qprefix'"
- fi
- fi
- prefix=$prefix/
- done
-
- if test -n "$prefixes"; then
- # Don't fail if two instances are running concurrently.
- (umask $mkdir_umask &&
- eval "\$doit_exec \$mkdirprog $prefixes") ||
- test -d "$dstdir" || exit 1
- obsolete_mkdir_used=true
- fi
- fi
- fi
-
- if test -n "$dir_arg"; then
- { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
- { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
- { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
- test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
- else
-
- # Make a couple of temp file names in the proper directory.
- dsttmp=${dstdirslash}_inst.$$_
- rmtmp=${dstdirslash}_rm.$$_
-
- # Trap to clean up those temp files at exit.
- trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
-
- # Copy the file name to the temp name.
- (umask $cp_umask &&
- { test -z "$stripcmd" || {
- # Create $dsttmp read-write so that cp doesn't create it read-only,
- # which would cause strip to fail.
- if test -z "$doit"; then
- : >"$dsttmp" # No need to fork-exec 'touch'.
- else
- $doit touch "$dsttmp"
- fi
- }
- } &&
- $doit_exec $cpprog "$src" "$dsttmp") &&
-
- # and set any options; do chmod last to preserve setuid bits.
- #
- # If any of these fail, we abort the whole thing. If we want to
- # ignore errors from any of these, just make sure not to ignore
- # errors from the above "$doit $cpprog $src $dsttmp" command.
- #
- { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
- { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
- { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
- { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
-
- # If -C, don't bother to copy if it wouldn't change the file.
- if $copy_on_change &&
- old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
- new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
- set -f &&
- set X $old && old=:$2:$4:$5:$6 &&
- set X $new && new=:$2:$4:$5:$6 &&
- set +f &&
- test "$old" = "$new" &&
- $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
- then
- rm -f "$dsttmp"
- else
- # If $backupsuffix is set, and the file being installed
- # already exists, attempt a backup. Don't worry if it fails,
- # e.g., if mv doesn't support -f.
- if test -n "$backupsuffix" && test -f "$dst"; then
- $doit $mvcmd -f "$dst" "$dst$backupsuffix" 2>/dev/null
- fi
-
- # Rename the file to the real destination.
- $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
-
- # The rename failed, perhaps because mv can't rename something else
- # to itself, or perhaps because mv is so ancient that it does not
- # support -f.
- {
- # Now remove or move aside any old file at destination location.
- # We try this two ways since rm can't unlink itself on some
- # systems and the destination file might be busy for other
- # reasons. In this case, the final cleanup might fail but the new
- # file should still install successfully.
- {
- test ! -f "$dst" ||
- $doit $rmcmd "$dst" 2>/dev/null ||
- { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
- { $doit $rmcmd "$rmtmp" 2>/dev/null; :; }
- } ||
- { echo "$0: cannot unlink or rename $dst" >&2
- (exit 1); exit 1
- }
- } &&
-
- # Now rename the file to the real destination.
- $doit $mvcmd "$dsttmp" "$dst"
- }
- fi || exit 1
-
- trap '' 0
- fi
-done
-
-# Local variables:
-# eval: (add-hook 'before-save-hook 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC0"
-# time-stamp-end: "; # UTC"
-# End:
diff --git a/exec/trace.c b/exec/trace.c
index 8e190c94f79..05d862f5b9f 100644
--- a/exec/trace.c
+++ b/exec/trace.c
@@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>
+#include <fcntl.h>
#include "exec.h"
@@ -894,6 +895,98 @@ handle_exec (struct exec_tracee *tracee, USER_REGS_STRUCT *regs)
return 3;
}
+
+
+/* Define replacements for required string functions. */
+
+#if !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY
+
+/* Copy SRC to DEST, returning the address of the terminating '\0' in
+ DEST. */
+
+static char *
+rpl_stpcpy (char *dest, const char *src)
+{
+ register char *d;
+ register const char *s;
+
+ d = dest;
+ s = src;
+
+ do
+ *d++ = *s;
+ while (*s++ != '\0');
+
+ return d - 1;
+}
+
+#define stpcpy rpl_stpcpy
+#endif /* !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY */
+
+
+
+/* Modify BUFFER, of size SIZE, so that it holds the absolute name of
+ the file identified by BUFFER, relative to the current working
+ directory of TRACEE if FD be AT_FDCWD, or the file referenced by FD
+ otherwise.
+
+ Value is 1 if this information is unavailable (of which there are
+ variety of causes), and 0 on success. */
+
+static int
+canon_path (struct exec_tracee *tracee, int fd, char *buffer,
+ ptrdiff_t size)
+{
+ char link[sizeof "/proc//fd/" + 48], *p; /* Or /proc/pid/cwd. */
+ char target[PATH_MAX];
+ ssize_t rc, length;
+
+ if (buffer[0] == '/')
+ /* Absolute file name; return immediately. */
+ return 0;
+ else if (fd == AT_FDCWD)
+ {
+ p = stpcpy (link, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/cwd");
+ }
+ else if (fd < 0)
+ /* Invalid file descriptor. */
+ return 1;
+ else
+ {
+ p = stpcpy (link, "/proc/");
+ p = format_pid (p, tracee->pid);
+ p = stpcpy (p, "/fd/");
+ format_pid (p, fd);
+ }
+
+ /* Read LINK's target, and should it be oversized, punt. */
+ rc = readlink (link, target, PATH_MAX);
+ if (rc < 0 || rc >= PATH_MAX)
+ return 1;
+
+ /* Consider the amount by which BUFFER's existing contents should be
+ displaced. */
+
+ length = strlen (buffer) + 1;
+ if ((length + rc + (target[rc - 1] != '/')) > size)
+ /* Punt if this would overflow. */
+ return 1;
+
+ memmove ((buffer + rc + (target[rc - 1] != '/')),
+ buffer, length);
+
+ /* Copy the new file name into BUFFER. */
+ memcpy (buffer, target, rc);
+
+ /* Insert separator in between if need be. */
+ if (target[rc - 1] != '/')
+ buffer[rc] = '/';
+
+ return 0;
+}
+
/* Handle a `readlink' or `readlinkat' system call.
CALLNO is the system call number, and REGS are the current user
@@ -924,22 +1017,26 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs,
char buffer[PATH_MAX + 1];
USER_WORD address, return_buffer, size;
size_t length;
+ char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
+ int dirfd;
/* Read the file name. */
#ifdef READLINK_SYSCALL
if (callno == READLINK_SYSCALL)
{
- address = regs->SYSCALL_ARG_REG;
+ dirfd = AT_FDCWD;
+ address = regs->SYSCALL_ARG_REG;
return_buffer = regs->SYSCALL_ARG1_REG;
- size = regs->SYSCALL_ARG2_REG;
+ size = regs->SYSCALL_ARG2_REG;
}
else
#endif /* READLINK_SYSCALL */
{
- address = regs->SYSCALL_ARG1_REG;
+ dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
+ address = regs->SYSCALL_ARG1_REG;
return_buffer = regs->SYSCALL_ARG2_REG;
- size = regs->SYSCALL_ARG3_REG;
+ size = regs->SYSCALL_ARG3_REG;
}
read_memory (tracee, buffer, PATH_MAX, address);
@@ -952,16 +1049,29 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs,
return 1;
}
- /* Now check if the caller is looking for /proc/self/exe.
+ /* Expand BUFFER into an absolute file name. TODO:
+ AT_SYMLINK_FOLLOW? */
+
+ if (canon_path (tracee, dirfd, buffer, sizeof buffer))
+ return 0;
+
+ /* Now check if the caller is looking for /proc/self/exe or its
+ equivalent with the PID made explicit.
dirfd can be ignored, as for now only absolute file names are
handled. FIXME. */
- if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file)
+ p = stpcpy (proc_pid_exe, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/exe");
+
+ if ((strcmp (buffer, "/proc/self/exe")
+ && strcmp (buffer, proc_pid_exe))
+ || !tracee->exec_file)
return 0;
/* Copy over tracee->exec_file. Truncate it to PATH_MAX, length, or
- size, whichever is less. */
+ size, whichever is smaller. */
length = strlen (tracee->exec_file);
length = MIN (size, MIN (PATH_MAX, length));
@@ -979,6 +1089,119 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs,
#endif /* REENTRANT */
}
+/* Handle an `open' or `openat' system call.
+
+ CALLNO is the system call number, and REGS are the current user
+ registers of the TRACEE.
+
+ If the file name specified in such system call is `/proc/self/exe',
+ replace the file name with the executable loaded into the process
+ issuing this system call.
+
+ Value is 0 upon success and 1 upon failure. */
+
+static int
+handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs,
+ struct exec_tracee *tracee, USER_WORD *result)
+{
+#ifdef REENTRANT
+ /* readlinkat cannot be handled specially when the library is built
+ to be reentrant, as the file name information cannot be
+ recorded. */
+ return 0;
+#else /* !REENTRANT */
+ char buffer[PATH_MAX + 1];
+ USER_WORD address;
+ size_t length;
+ USER_REGS_STRUCT original;
+ char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
+ int dirfd;
+
+ /* Read the file name. */
+
+#ifdef OPEN_SYSCALL
+ if (callno == OPEN_SYSCALL)
+ {
+ dirfd = AT_FDCWD;
+ address = regs->SYSCALL_ARG_REG;
+ }
+ else
+#endif /* OPEN_SYSCALL */
+ {
+ dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
+ address = regs->SYSCALL_ARG1_REG;
+ }
+
+ /* Read the file name into the buffer and verify that it is NULL
+ terminated. */
+ read_memory (tracee, buffer, PATH_MAX, address);
+
+ if (!memchr (buffer, '\0', PATH_MAX))
+ {
+ errno = ENAMETOOLONG;
+ return 1;
+ }
+
+ /* Expand BUFFER into an absolute file name. TODO:
+ AT_SYMLINK_FOLLOW? */
+
+ if (canon_path (tracee, dirfd, buffer, sizeof buffer))
+ return 0;
+
+ /* Now check if the caller is looking for /proc/self/exe or its
+ equivalent with the PID made explicit.
+
+ dirfd can be ignored, as for now only absolute file names are
+ handled. FIXME. */
+
+ p = stpcpy (proc_pid_exe, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/exe");
+
+ if ((strcmp (buffer, "/proc/self/exe")
+ && strcmp (buffer, proc_pid_exe))
+ || !tracee->exec_file)
+ return 0;
+
+ /* Copy over tracee->exec_file. This doesn't correctly handle the
+ scenario where tracee->exec_file is longer than PATH_MAX, but
+ that has yet to be encountered in practice. */
+
+ original = *regs;
+ length = strlen (tracee->exec_file);
+ address = user_alloca (tracee, &original, regs, length + 1);
+
+ if (!address
+ || user_copy (tracee, (unsigned char *) tracee->exec_file,
+ address, length))
+ goto fail;
+
+ /* Replace the file name buffer with ADDRESS. */
+
+#ifdef OPEN_SYSCALL
+ if (callno == OPEN_SYSCALL)
+ regs->SYSCALL_ARG_REG = address;
+ else
+#endif /* OPEN_SYSCALL */
+ regs->SYSCALL_ARG1_REG = address;
+
+#ifdef __aarch64__
+ if (aarch64_set_regs (tracee->pid, regs, false))
+ goto fail;
+#else /* !__aarch64__ */
+ if (ptrace (PTRACE_SETREGS, tracee->pid, NULL, regs))
+ goto fail;
+#endif /* __aarch64__ */
+
+ /* Resume the system call. */
+ return 0;
+
+ fail:
+ errno = EIO;
+ return 1;
+#endif /* REENTRANT */
+}
+
/* Process the system call at which TRACEE is stopped. If the system
call is not known or not exec, send TRACEE on its way. Otherwise,
rewrite it to load the loader and perform an appropriate action. */
@@ -1056,9 +1279,50 @@ process_system_call (struct exec_tracee *tracee)
goto emulate_syscall;
}
+ goto continue_syscall;
+
+#ifdef OPEN_SYSCALL
+ case OPEN_SYSCALL:
+#endif /* OPEN_SYSCALL */
+ case OPENAT_SYSCALL:
+
+ /* This system call is already in progress if
+ TRACEE->waiting_for_syscall is true. */
+
+ if (!tracee->waiting_for_syscall)
+ {
+ /* Handle this open system call. */
+ rc = handle_openat (callno, &regs, tracee, &result);
+
+ /* rc means the same as in `handle_exec', except that `open'
+ is never emulated. */
+
+ if (rc == 1)
+ goto report_syscall_error;
+
+ /* The stack pointer must be restored after it was modified
+ by `user_alloca'; record sp in TRACEE, which will be
+ restored after this system call completes. */
+ tracee->sp = sp;
+ }
+ else
+ {
+ /* Restore that stack pointer. */
+ regs.STACK_POINTER = tracee->sp;
+
+#ifdef __aarch64__
+ if (aarch64_set_regs (tracee->pid, &regs, true))
+ return;
+#else /* !__aarch64__ */
+ if (ptrace (PTRACE_SETREGS, tracee->pid, NULL, &regs))
+ return;
+#endif /* __aarch64__ */
+ }
+
/* Fallthrough. */
default:
+ continue_syscall:
/* Don't wait for the system call to finish; instead, the system
will DTRT upon the next call to PTRACE_SYSCALL after the
syscall-trap signal is delivered. */
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index b18446bece0..563914fb02c 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -64,6 +64,132 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<uses-permission android:name="android.permission.RECORD_AUDIO" />
<uses-permission android:name="android.permission.CAMERA" />
+ <uses-permission android:name="android.permission.ACCEPT_HANDOVER" />
+ <uses-permission android:name="android.permission.ACCESS_BACKGROUND_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_FINE_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_MEDIA_LOCATION" />
+ <uses-permission android:name="android.permission.ACCESS_NOTIFICATIONS" />
+ <uses-permission android:name="android.permission.ACTIVITY_RECOGNITION" />
+ <uses-permission android:name="android.permission.ANSWER_PHONE_CALLS" />
+ <uses-permission android:name="android.permission.BLUETOOTH_ADVERTISE" />
+ <uses-permission android:name="android.permission.BLUETOOTH_CONNECT" />
+ <uses-permission android:name="android.permission.BLUETOOTH_SCAN" />
+ <uses-permission android:name="android.permission.BODY_SENSORS" />
+ <uses-permission android:name="android.permission.BODY_SENSORS_BACKGROUND" />
+ <uses-permission android:name="android.permission.CALL_PHONE" />
+ <uses-permission android:name="android.permission.CAPTURE_CONSENTLESS_BUGREPORT_ON_USERDEBUG_BUILD" />
+ <uses-permission android:name="android.permission.GET_ACCOUNTS" />
+ <uses-permission android:name="android.permission.INSTANT_APP_FOREGROUND_SERVICE" />
+ <uses-permission android:name="android.permission.INTERACT_ACROSS_PROFILES" />
+ <uses-permission android:name="android.permission.LOADER_USAGE_STATS" />
+ <uses-permission android:name="android.permission.MANAGE_IPSEC_TUNNELS" />
+ <uses-permission android:name="android.permission.MANAGE_MEDIA" />
+ <uses-permission android:name="android.permission.MANAGE_ONGOING_CALLS" />
+ <uses-permission android:name="android.permission.NEARBY_WIFI_DEVICES" />
+ <uses-permission android:name="android.permission.PACKAGE_USAGE_STATS" />
+ <uses-permission android:name="android.permission.PROCESS_OUTGOING_CALLS" />
+ <uses-permission android:name="android.permission.READ_CALL_LOG" />
+ <uses-permission android:name="android.permission.READ_CELL_BROADCASTS" />
+ <uses-permission android:name="android.permission.READ_MEDIA_AUDIO" />
+ <uses-permission android:name="android.permission.READ_MEDIA_IMAGES" />
+ <uses-permission android:name="android.permission.READ_MEDIA_VIDEO" />
+ <uses-permission android:name="android.permission.READ_MEDIA_VISUAL_USER_SELECTED" />
+ <uses-permission android:name="android.permission.READ_PHONE_NUMBERS" />
+ <uses-permission android:name="android.permission.READ_SMS" />
+ <uses-permission android:name="android.permission.RECEIVE_MMS" />
+ <uses-permission android:name="android.permission.RECEIVE_WAP_PUSH" />
+ <uses-permission android:name="android.permission.SCHEDULE_EXACT_ALARM" />
+ <uses-permission android:name="android.permission.SMS_FINANCIAL_TRANSACTIONS" />
+ <uses-permission android:name="android.permission.TURN_SCREEN_ON" />
+ <uses-permission android:name="android.permission.USE_FULL_SCREEN_INTENT" />
+ <uses-permission android:name="android.permission.USE_ICC_AUTH_WITH_DEVICE_IDENTIFIER" />
+ <uses-permission android:name="android.permission.USE_SIP" />
+ <uses-permission android:name="android.permission.UWB_RANGING" />
+ <uses-permission android:name="android.permission.WIFI_ACCESS_COEX_UNSAFE_CHANNELS" />
+ <uses-permission android:name="android.permission.WRITE_CALL_LOG" />
+ <uses-permission android:name="android.permission.WRITE_SETTINGS" />
+
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_AD_ID" />
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_ATTRIBUTION" />
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_CUSTOM_AUDIENCE" />
+ <uses-permission android:name="android.permission.ACCESS_ADSERVICES_TOPICS" />
+ <uses-permission android:name="android.permission.ACCESS_LOCATION_EXTRA_COMMANDS" />
+ <uses-permission android:name="android.permission.ACCESS_NOTIFICATION_POLICY" />
+ <uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
+ <uses-permission android:name="android.permission.AUTHENTICATE_ACCOUNTS" />
+ <uses-permission android:name="android.permission.BLUETOOTH" />
+ <uses-permission android:name="android.permission.BLUETOOTH_ADMIN" />
+ <uses-permission android:name="android.permission.BROADCAST_STICKY" />
+ <uses-permission android:name="android.permission.CHANGE_NETWORK_STATE" />
+ <uses-permission android:name="android.permission.CHANGE_WIFI_MULTICAST_STATE" />
+ <uses-permission android:name="android.permission.CHANGE_WIFI_STATE" />
+ <uses-permission android:name="android.permission.CREDENTIAL_MANAGER_QUERY_CANDIDATE_CREDENTIALS" />
+ <uses-permission android:name="android.permission.CREDENTIAL_MANAGER_SET_ALLOWED_PROVIDERS" />
+ <uses-permission android:name="android.permission.CREDENTIAL_MANAGER_SET_ORIGIN" />
+ <uses-permission android:name="android.permission.DELIVER_COMPANION_MESSAGES" />
+ <uses-permission android:name="android.permission.DETECT_SCREEN_CAPTURE" />
+ <uses-permission android:name="android.permission.DISABLE_KEYGUARD" />
+ <uses-permission android:name="android.permission.ENFORCE_UPDATE_OWNERSHIP" />
+ <uses-permission android:name="android.permission.EXPAND_STATUS_BAR" />
+ <uses-permission android:name="android.permission.FLASHLIGHT" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_CAMERA" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_CONNECTED_DEVICE" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_DATA_SYNC" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_FILE_MANAGEMENT" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_HEALTH" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_LOCATION" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_MEDIA_PLAYBACK" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_MEDIA_PROJECTION" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_MICROPHONE" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_PHONE_CALL" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_REMOTE_MESSAGING" />
+ <uses-permission android:name="android.permission.FOREGROUND_SERVICE_SYSTEM_EXEMPTED" />
+ <uses-permission android:name="android.permission.GET_PACKAGE_SIZE" />
+ <uses-permission android:name="android.permission.GET_TASKS" />
+ <uses-permission android:name="android.permission.HIDE_OVERLAY_WINDOWS" />
+ <uses-permission android:name="android.permission.HIGH_SAMPLING_RATE_SENSORS" />
+ <uses-permission android:name="android.permission.KILL_BACKGROUND_PROCESSES" />
+ <uses-permission android:name="android.permission.MANAGE_ACCOUNTS" />
+ <uses-permission android:name="android.permission.MANAGE_OWN_CALLS" />
+ <uses-permission android:name="android.permission.MODIFY_AUDIO_SETTINGS" />
+ <uses-permission android:name="android.permission.NFC_PREFERRED_PAYMENT_INFO" />
+ <uses-permission android:name="android.permission.NFC_TRANSACTION_EVENT" />
+ <uses-permission android:name="android.permission.PERSISTENT_ACTIVITY" />
+ <uses-permission android:name="android.permission.QUERY_ALL_PACKAGES" />
+ <uses-permission android:name="android.permission.READ_BASIC_PHONE_STATE" />
+ <uses-permission android:name="android.permission.READ_INSTALL_SESSIONS" />
+ <uses-permission android:name="android.permission.READ_NEARBY_STREAMING_POLICY" />
+ <uses-permission android:name="android.permission.READ_PROFILE" />
+ <uses-permission android:name="android.permission.READ_SOCIAL_STREAM" />
+ <uses-permission android:name="android.permission.READ_SYNC_SETTINGS" />
+ <uses-permission android:name="android.permission.READ_SYNC_STATS" />
+ <uses-permission android:name="android.permission.READ_USER_DICTIONARY" />
+ <uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
+ <uses-permission android:name="android.permission.REORDER_TASKS" />
+ <uses-permission android:name="android.permission.REQUEST_COMPANION_PROFILE_GLASSES" />
+ <uses-permission android:name="android.permission.REQUEST_COMPANION_PROFILE_WATCH" />
+ <uses-permission android:name="android.permission.REQUEST_COMPANION_RUN_IN_BACKGROUND" />
+ <uses-permission android:name="android.permission.REQUEST_COMPANION_START_FOREGROUND_SERVICES_FROM_BACKGROUND" />
+ <uses-permission android:name="android.permission.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND" />
+ <uses-permission android:name="android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS" />
+ <uses-permission android:name="android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE" />
+ <uses-permission android:name="android.permission.REQUEST_PASSWORD_COMPLEXITY" />
+ <uses-permission android:name="android.permission.RESTART_PACKAGES" />
+ <uses-permission android:name="android.permission.RUN_USER_INITIATED_JOBS" />
+ <uses-permission android:name="android.permission.SET_WALLPAPER_HINTS" />
+ <uses-permission android:name="android.permission.SUBSCRIBED_FEEDS_READ" />
+ <uses-permission android:name="android.permission.SUBSCRIBED_FEEDS_WRITE" />
+ <uses-permission android:name="android.permission.UPDATE_PACKAGES_WITHOUT_USER_ACTION" />
+ <uses-permission android:name="android.permission.USE_BIOMETRIC" />
+ <uses-permission android:name="android.permission.USE_CREDENTIALS" />
+ <uses-permission android:name="android.permission.USE_EXACT_ALARM" />
+ <uses-permission android:name="android.permission.USE_FINGERPRINT" />
+ <uses-permission android:name="android.permission.WRITE_PROFILE" />
+ <uses-permission android:name="android.permission.WRITE_SMS" />
+ <uses-permission android:name="android.permission.WRITE_SOCIAL_STREAM" />
+ <uses-permission android:name="android.permission.WRITE_SYNC_SETTINGS" />
+ <uses-permission android:name="android.permission.WRITE_USER_DICTIONARY" />
+
<!-- This is required on Android 11 or later to access /sdcard. -->
<uses-permission android:name="android.permission.MANAGE_EXTERNAL_STORAGE"/>
@@ -92,6 +218,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<activity android:name="org.gnu.emacs.EmacsActivity"
android:launchMode="singleInstance"
+ android:taskAffinity="emacs.primary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale">
@@ -103,7 +230,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsOpenActivity"
- android:taskAffinity="open.dialog"
+ android:taskAffinity="emacs.open_dialog"
android:excludeFromRecents="true"
android:exported="true">
@@ -147,6 +274,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsMultitaskActivity"
+ android:taskAffinity="emacs.secondary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale"/>
@@ -190,6 +318,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
</intent-filter>
</provider>
+ <receiver android:name=".EmacsDesktopNotification$CancellationReceiver"
+ android:exported="false">
+ <intent-filter>
+ <action android:name="org.gnu.emacs.DISMISSED" />
+ </intent-filter>
+ </receiver>
+
<service android:name="org.gnu.emacs.EmacsService"
android:directBootAware="false"
android:enabled="true"
diff --git a/java/INSTALL b/java/INSTALL
index 175ff2826b2..f1063b40c25 100644
--- a/java/INSTALL
+++ b/java/INSTALL
@@ -166,25 +166,21 @@ than a compressed package for a newer version of Android.
BUILDING C++ DEPENDENCIES
-With a new version of the NDK, dependencies containing C++ code should
-build without any further configuration. However, older versions
-require that you use the ``make_standalone_toolchain.py'' script in
-the NDK distribution to create a ``standalone toolchain'', and use
-that instead, in order for C++ headers to be found.
-
-See https://developer.android.com/ndk/guides/standalone_toolchain for
-more details; when a ``standalone toolchain'' is specified, the
-configure script will try to determine the location of the C++
-compiler based on the C compiler specified. If that automatic
-detection does not work, you can specify a C++ compiler yourself, like
-so:
-
- ./configure --with-ndk-cxx=/path/to/toolchain/bin/i686-linux-android-g++
-
-Some versions of the NDK have a bug, where GCC fails to locate
-``stddef.h'' after being copied to a standalone toolchain. To work
-around this problem (which normally exhibits itself when building C++
-code), add:
+In normal circumstances, Emacs should automatically detect and configure
+one of the C++ standard libraries part of the NDK when such a library is
+required to build a dependency specified under `--with-ndk-path'.
+
+Nevertheless, this process is not infalliable, and with certain versions
+of the NDK is liable to fail to locate a C++ compiler, requiring that
+you run the `make_standalone_toolchain.py' script in the NDK
+distribution to create a ``standalone toolchain'' and substitute the
+same for the regular compiler toolchain. See
+https://developer.android.com/ndk/guides/standalone_toolchain for
+further details.
+
+Some versions of the NDK that ship GCC 4.9.x exhibit a bug where the
+compiler cannot locate `stddef.h' after being copied to a standalone
+toolchain. To work around this problem, add:
-isystem /path/to/toolchain/include/c++/4.9.x
diff --git a/java/Makefile.in b/java/Makefile.in
index 60bd2ea086b..c23b52ed44e 100644
--- a/java/Makefile.in
+++ b/java/Makefile.in
@@ -256,15 +256,15 @@ install_temp/assets/build_info: install_temp
emacs.apk-in: install_temp install_temp/assets/directory-tree \
AndroidManifest.xml install_temp/assets/version \
- install_temp/assets/build_info
-# Package everything. Specifying the assets on this command line is
-# necessary for AAssetManager_getNextFileName to work on old versions
-# of Android. Make sure not to generate R.java, as it's already been
-# generated.
+ install_temp/assets/build_info classes.dex
+# Package everything. Redirect the generated R.java to install_temp, as
+# it must already have been generated as a prerequisite of
+# classes.dex's.
$(AM_V_AAPT) $(AAPT) p -I "$(ANDROID_JAR)" -F $@ \
-f -M AndroidManifest.xml $(AAPT_ASSET_ARGS) \
-A install_temp/assets \
-S $(top_srcdir)/java/res -J install_temp
+ $(AM_V_SILENT) $(AAPT) a $@ classes.dex
$(AM_V_SILENT) pushd install_temp &> /dev/null; \
$(AAPT) add ../$@ `find lib -type f`; \
popd &> /dev/null
@@ -311,10 +311,9 @@ classes.dex: $(CLASS_FILES)
.PHONY: clean maintainer-clean
-$(APK_NAME): classes.dex emacs.apk-in $(srcdir)/emacs.keystore
+$(APK_NAME): emacs.apk-in $(srcdir)/emacs.keystore
$(AM_V_GEN)
$(AM_V_SILENT) cp -f emacs.apk-in $@.unaligned
- $(AM_V_SILENT) $(AAPT) add $@.unaligned classes.dex
$(AM_V_SILENT) $(JARSIGNER) $(SIGN_EMACS) $@.unaligned "Emacs keystore"
$(AM_V_SILENT) $(ZIPALIGN) -f 4 $@.unaligned $@
# Signing must happen after alignment!
diff --git a/java/debug.sh b/java/debug.sh
index 8fc03d014cf..c5d40141355 100755
--- a/java/debug.sh
+++ b/java/debug.sh
@@ -104,13 +104,14 @@ if [ -z "$devices" ]; then
exit 1
fi
-if [ -z $device ]; then
- device=$devices
+if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z $device ]; then
+ echo "Multiple devices are available. Please specify one with"
+ echo "the option --device and try again."
+ exit 1
fi
-if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z device ]; then
- echo "Multiple devices are available. Please pick one using"
- echo "--device and try again."
+if [ -z $device ]; then
+ device=$devices
fi
echo "Looking for $package on device $device"
@@ -189,6 +190,8 @@ if [ "$attach_existing" != "yes" ]; then
package_pids=`awk -f tmp.awk <<< $package_pids`
fi
+rm tmp.awk
+
pid=$package_pids
num_pids=`wc -w <<< "$package_pids"`
diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java
index 3237f650240..e380b7bfc2a 100644
--- a/java/org/gnu/emacs/EmacsActivity.java
+++ b/java/org/gnu/emacs/EmacsActivity.java
@@ -20,9 +20,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
import java.lang.IllegalStateException;
+
import java.util.List;
import java.util.ArrayList;
+import java.util.concurrent.TimeUnit;
+
import android.app.Activity;
import android.content.ContentResolver;
@@ -31,6 +34,7 @@ import android.content.Intent;
import android.os.Build;
import android.os.Bundle;
+import android.os.SystemClock;
import android.util.Log;
@@ -78,13 +82,16 @@ public class EmacsActivity extends Activity
/* The last context menu to be closed. */
private static Menu lastClosedMenu;
+ /* The time of the most recent call to onStop. */
+ private static long timeOfLastInteraction;
+
static
{
focusedActivities = new ArrayList<EmacsActivity> ();
};
public static void
- invalidateFocus1 (EmacsWindow window)
+ invalidateFocus1 (EmacsWindow window, boolean resetWhenChildless)
{
if (window.view.isFocused ())
focusedWindow = window;
@@ -92,12 +99,23 @@ public class EmacsActivity extends Activity
synchronized (window.children)
{
for (EmacsWindow child : window.children)
- invalidateFocus1 (child);
+ invalidateFocus1 (child, false);
+
+ /* If no focused window was previously detected among WINDOW's
+ children and RESETWHENCHILDLESS is set (implying it is a
+ toplevel window), request that it be focused, to avoid
+ creating a situation where no windows exist focused or can be
+ transferred the input focus by user action. */
+ if (focusedWindow == null && resetWhenChildless)
+ {
+ window.view.requestFocus ();
+ focusedWindow = window;
+ }
}
}
public static void
- invalidateFocus ()
+ invalidateFocus (int whence)
{
EmacsWindow oldFocus;
@@ -110,7 +128,7 @@ public class EmacsActivity extends Activity
for (EmacsActivity activity : focusedActivities)
{
if (activity.window != null)
- invalidateFocus1 (activity.window);
+ invalidateFocus1 (activity.window, focusedWindow == null);
}
/* Send focus in- and out- events to the previous and current
@@ -144,7 +162,7 @@ public class EmacsActivity extends Activity
layout.removeView (window.view);
window = null;
- invalidateFocus ();
+ invalidateFocus (0);
}
}
@@ -172,8 +190,17 @@ public class EmacsActivity extends Activity
if (isPaused)
window.noticeIconified ();
- /* Invalidate the focus. */
- invalidateFocus ();
+ /* Invalidate the focus. Since attachWindow may be called from
+ either the main or the UI thread, post this to the UI thread. */
+
+ runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ invalidateFocus (1);
+ }
+ });
}
@Override
@@ -238,6 +265,10 @@ public class EmacsActivity extends Activity
}
super.onCreate (savedInstanceState);
+
+ /* Call `onWindowFocusChanged' to read the focus state, which fails
+ to be called after an activity is recreated. */
+ onWindowFocusChanged (false);
}
@Override
@@ -249,6 +280,50 @@ public class EmacsActivity extends Activity
@Override
public final void
+ onStop ()
+ {
+ timeOfLastInteraction = SystemClock.elapsedRealtime ();
+
+ super.onStop ();
+ }
+
+ /* Return whether the task is being finished in response to explicit
+ user action. That is to say, Activity.isFinished, but as
+ documented. */
+
+ public final boolean
+ isReallyFinishing ()
+ {
+ long atime, dtime;
+ int hours;
+
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
+ return isFinishing ();
+
+ /* When the number of tasks retained in the recents list exceeds a
+ threshold, Android 7 and later so destroy activities in trimming
+ them from recents on the expiry of a timeout that isFinishing
+ returns true, in direct contradiction to the documentation. This
+ timeout is generally 6 hours, but admits of customization by
+ individual system distributors, so to err on the side of the
+ caution, the timeout Emacs applies is a more conservative figure
+ of 4 hours. */
+
+ if (timeOfLastInteraction == 0)
+ return isFinishing ();
+
+ atime = timeOfLastInteraction;
+
+ /* Compare atime with the current system time. */
+ dtime = SystemClock.elapsedRealtime () - atime;
+ if (dtime + 1000000 < TimeUnit.HOURS.toMillis (4))
+ return isFinishing ();
+
+ return false;
+ }
+
+ @Override
+ public final void
onDestroy ()
{
EmacsWindowAttachmentManager manager;
@@ -259,9 +334,10 @@ public class EmacsActivity extends Activity
/* The activity will die shortly hereafter. If there is a window
attached, close it now. */
isMultitask = this instanceof EmacsMultitaskActivity;
- manager.removeWindowConsumer (this, isMultitask || isFinishing ());
+ manager.removeWindowConsumer (this, (isMultitask
+ || isReallyFinishing ()));
focusedActivities.remove (this);
- invalidateFocus ();
+ invalidateFocus (2);
/* Remove this activity from the static field, lest it leak. */
if (lastFocusedActivity == this)
@@ -274,9 +350,16 @@ public class EmacsActivity extends Activity
public final void
onWindowFocusChanged (boolean isFocused)
{
- if (isFocused && !focusedActivities.contains (this))
+ /* At times and on certain versions of Android ISFOCUSED does not
+ reflect whether the window actually holds focus, so replace it
+ with the value of `hasWindowFocus'. */
+ isFocused = hasWindowFocus ();
+
+ if (isFocused)
{
- focusedActivities.add (this);
+ if (!focusedActivities.contains (this))
+ focusedActivities.add (this);
+
lastFocusedActivity = this;
/* Update the window insets as the focus change may have
@@ -291,7 +374,7 @@ public class EmacsActivity extends Activity
else
focusedActivities.remove (this);
- invalidateFocus ();
+ invalidateFocus (3);
}
@Override
@@ -309,6 +392,7 @@ public class EmacsActivity extends Activity
onResume ()
{
isPaused = false;
+ timeOfLastInteraction = 0;
EmacsWindowAttachmentManager.MANAGER.noticeDeiconified (this);
super.onResume ();
@@ -433,6 +517,27 @@ public class EmacsActivity extends Activity
syncFullscreenWith (window);
}
+ @Override
+ public final void
+ onNewIntent (Intent intent)
+ {
+ String tag, action;
+
+ /* This function is called when EmacsActivity is relaunched from a
+ notification. */
+
+ if (intent == null || EmacsService.SERVICE == null)
+ return;
+
+ tag = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_TAG);
+ action
+ = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_ACTION);
+
+ if (tag == null || action == null)
+ return;
+
+ EmacsNative.sendNotificationAction (tag, action);
+ }
@Override
diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java
index 17e6033377d..2bbf2a313d6 100644
--- a/java/org/gnu/emacs/EmacsContextMenu.java
+++ b/java/org/gnu/emacs/EmacsContextMenu.java
@@ -361,8 +361,23 @@ public final class EmacsContextMenu
public Boolean
call ()
{
+ boolean rc;
+
lastMenuEventSerial = serial;
- return display1 (window, xPosition, yPosition);
+ rc = display1 (window, xPosition, yPosition);
+
+ /* Android 3.0 to Android 7.0 perform duplicate calls to
+ onContextMenuClosed the second time a context menu is
+ dismissed. Since the second call after such a dismissal is
+ otherwise liable to prematurely cancel any context menu
+ displayed immediately afterwards, ignore calls received
+ within 150 milliseconds of this menu's being displayed. */
+
+ if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB
+ && Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
+ wasSubmenuSelected = System.currentTimeMillis () - 150;
+
+ return rc;
}
});
diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java
index fb35e3fea1f..72569631a8c 100644
--- a/java/org/gnu/emacs/EmacsDesktopNotification.java
+++ b/java/org/gnu/emacs/EmacsDesktopNotification.java
@@ -24,9 +24,12 @@ import android.app.NotificationManager;
import android.app.NotificationChannel;
import android.app.PendingIntent;
+import android.content.BroadcastReceiver;
import android.content.Context;
import android.content.Intent;
+import android.net.Uri;
+
import android.os.Build;
import android.widget.RemoteViews;
@@ -44,6 +47,16 @@ import android.widget.RemoteViews;
public final class EmacsDesktopNotification
{
+ /* Intent tag for notification action data. */
+ public static final String NOTIFICATION_ACTION = "emacs:notification_action";
+
+ /* Intent tag for notification IDs. */
+ public static final String NOTIFICATION_TAG = "emacs:notification_tag";
+
+ /* Action ID assigned to the broadcast receiver which should be
+ notified of any notification's being dismissed. */
+ public static final String NOTIFICATION_DISMISSED = "org.gnu.emacs.DISMISSED";
+
/* The content of this desktop notification. */
public final String content;
@@ -66,10 +79,20 @@ public final class EmacsDesktopNotification
/* The importance of this notification's group. */
public final int importance;
+ /* Array of actions and their user-facing text to be offered by this
+ notification. */
+ public final String[] actions, titles;
+
+ /* Delay in miliseconds after which this notification should be
+ automatically dismissed. */
+ public final long delay;
+
public
EmacsDesktopNotification (String title, String content,
String group, String tag, int icon,
- int importance)
+ int importance,
+ String[] actions, String[] titles,
+ long delay)
{
this.content = content;
this.title = title;
@@ -77,12 +100,69 @@ public final class EmacsDesktopNotification
this.tag = tag;
this.icon = icon;
this.importance = importance;
+ this.actions = actions;
+ this.titles = titles;
+ this.delay = delay;
}
/* Functions for displaying desktop notifications. */
+ /* Insert each action in actions and titles into the notification
+ builder BUILDER, with pending intents created with CONTEXT holding
+ suitable metadata. */
+
+ @SuppressWarnings ("deprecation")
+ private void
+ insertActions (Context context, Notification.Builder builder)
+ {
+ int i;
+ PendingIntent pending;
+ Intent intent;
+ Notification.Action.Builder action;
+
+ if (actions == null)
+ return;
+
+ for (i = 0; i < actions.length; ++i)
+ {
+ /* Actions named default should not be displayed. */
+ if (actions[i].equals ("default"))
+ continue;
+
+ intent = new Intent (context, EmacsActivity.class);
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK);
+
+ /* Pending intents are specific to combinations of class, action
+ and data, but not information provided as extras. In order
+ that its target may be invoked with the action and tag set
+ below, generate a URL from those two elements and specify it
+ as the intent data, which ensures that the intent allocated
+ fully reflects the duo. */
+
+ intent.setData (new Uri.Builder ().scheme ("action")
+ .appendPath (tag).appendPath (actions[i])
+ .build ());
+ intent.putExtra (NOTIFICATION_ACTION, actions[i]);
+ intent.putExtra (NOTIFICATION_TAG, tag);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
+ pending = PendingIntent.getActivity (context, 0, intent,
+ PendingIntent.FLAG_IMMUTABLE);
+ else
+ pending = PendingIntent.getActivity (context, 0, intent, 0);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M)
+ {
+ action = new Notification.Action.Builder (0, titles[i], pending);
+ builder.addAction (action.build ());
+ }
+ else
+ builder.addAction (0, titles[i], pending);
+ }
+ }
+
/* Internal helper for `display' executed on the main thread. */
@SuppressWarnings ("deprecation") /* Notification.Builder (Context). */
@@ -97,6 +177,7 @@ public final class EmacsDesktopNotification
Intent intent;
PendingIntent pending;
int priority;
+ Notification.Builder builder;
tem = context.getSystemService (Context.NOTIFICATION_SERVICE);
manager = (NotificationManager) tem;
@@ -108,13 +189,18 @@ public final class EmacsDesktopNotification
(such as its importance) will be overridden. */
channel = new NotificationChannel (group, group, importance);
manager.createNotificationChannel (channel);
+ builder = new Notification.Builder (context, group);
- /* Create a notification object and display it. */
- notification = (new Notification.Builder (context, group)
- .setContentTitle (title)
- .setContentText (content)
- .setSmallIcon (icon)
- .build ());
+ /* Create and configure a notification object and display
+ it. */
+
+ builder.setContentTitle (title);
+ builder.setContentText (content);
+ builder.setSmallIcon (icon);
+ builder.setTimeoutAfter (delay);
+
+ insertActions (context, builder);
+ notification = builder.build ();
}
else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
{
@@ -122,31 +208,35 @@ public final class EmacsDesktopNotification
distinct categories, but permit an importance to be
assigned to each individual notification. */
- switch (importance)
+ builder = new Notification.Builder (context);
+ builder.setContentTitle (title);
+ builder.setContentText (content);
+ builder.setSmallIcon (icon);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN)
{
- case 2: /* IMPORTANCE_LOW */
- default:
- priority = Notification.PRIORITY_LOW;
- break;
-
- case 3: /* IMPORTANCE_DEFAULT */
- priority = Notification.PRIORITY_DEFAULT;
- break;
-
- case 4: /* IMPORTANCE_HIGH */
- priority = Notification.PRIORITY_HIGH;
- break;
+ switch (importance)
+ {
+ case 2: /* IMPORTANCE_LOW */
+ default:
+ priority = Notification.PRIORITY_LOW;
+ break;
+
+ case 3: /* IMPORTANCE_DEFAULT */
+ priority = Notification.PRIORITY_DEFAULT;
+ break;
+
+ case 4: /* IMPORTANCE_HIGH */
+ priority = Notification.PRIORITY_HIGH;
+ break;
+ }
+
+ builder.setPriority (priority);
+ insertActions (context, builder);
+ notification = builder.build ();
}
-
- notification = (new Notification.Builder (context)
- .setContentTitle (title)
- .setContentText (content)
- .setSmallIcon (icon)
- .setPriority (priority)
- .build ());
-
- if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN)
- notification.priority = priority;
+ else
+ notification = builder.getNotification ();
}
else
{
@@ -170,6 +260,12 @@ public final class EmacsDesktopNotification
intent = new Intent (context, EmacsActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK);
+ intent.setData (new Uri.Builder ()
+ .scheme ("action")
+ .appendPath (tag)
+ .build ());
+ intent.putExtra (NOTIFICATION_ACTION, "default");
+ intent.putExtra (NOTIFICATION_TAG, tag);
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
pending = PendingIntent.getActivity (context, 0, intent,
@@ -179,6 +275,25 @@ public final class EmacsDesktopNotification
notification.contentIntent = pending;
+ /* Provide a cancellation intent to respond to notification
+ dismissals. */
+
+ intent = new Intent (context, CancellationReceiver.class);
+ intent.setAction (NOTIFICATION_DISMISSED);
+ intent.setPackage ("org.gnu.emacs");
+ intent.setData (new Uri.Builder ()
+ .scheme ("action")
+ .appendPath (tag)
+ .build ());
+ intent.putExtra (NOTIFICATION_TAG, tag);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
+ pending = PendingIntent.getBroadcast (context, 0, intent,
+ PendingIntent.FLAG_IMMUTABLE);
+ else
+ pending = PendingIntent.getBroadcast (context, 0, intent, 0);
+
+ notification.deleteIntent = pending;
manager.notify (tag, 2, notification);
}
@@ -199,4 +314,31 @@ public final class EmacsDesktopNotification
}
});
}
+
+
+
+ /* Broadcast receiver. This is something of a system-wide callback
+ arranged to be invoked whenever a notification posted by Emacs is
+ dismissed, in order to relay news of its dismissal to
+ androidselect.c and run or remove callbacks as appropriate. */
+
+ public static class CancellationReceiver extends BroadcastReceiver
+ {
+ @Override
+ public void
+ onReceive (Context context, Intent intent)
+ {
+ String tag, action;
+
+ if (intent == null || EmacsService.SERVICE == null)
+ return;
+
+ tag = intent.getStringExtra (NOTIFICATION_TAG);
+
+ if (tag == null)
+ return;
+
+ EmacsNative.sendNotificationDeleted (tag);
+ }
+ };
};
diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java
index cd0e70923d1..654e94b1a7d 100644
--- a/java/org/gnu/emacs/EmacsNative.java
+++ b/java/org/gnu/emacs/EmacsNative.java
@@ -196,6 +196,12 @@ public final class EmacsNative
public static native long sendDndText (short window, int x, int y,
String text);
+ /* Send an ANDROID_NOTIFICATION_CANCELED event. */
+ public static native void sendNotificationDeleted (String tag);
+
+ /* Send an ANDROID_NOTIFICATION_ACTION event. */
+ public static native void sendNotificationAction (String tag, String action);
+
/* Return the file name associated with the specified file
descriptor, or NULL if there is none. */
public static native byte[] getProcName (int fd);
@@ -275,7 +281,7 @@ public final class EmacsNative
public static native int[] getSelection (short window);
- /* Graphics functions used as a replacement for potentially buggy
+ /* Graphics functions used as replacements for potentially buggy
Android APIs. */
public static native void blitRect (Bitmap src, Bitmap dest, int x1,
@@ -283,7 +289,6 @@ public final class EmacsNative
/* Increment the generation ID of the specified BITMAP, forcing its
texture to be re-uploaded to the GPU. */
-
public static native void notifyPixelsChanged (Bitmap bitmap);
@@ -307,6 +312,13 @@ public final class EmacsNative
in the process. */
public static native boolean ftruncate (int fd);
+
+ /* Functions that assist in generating content file names. */
+
+ /* Calculate an 8 digit checksum for the byte array DISPLAYNAME
+ suitable for inclusion in a content file name. */
+ public static native String displayNameHash (byte[] displayName);
+
static
{
/* Older versions of Android cannot link correctly with shared
@@ -317,7 +329,9 @@ public final class EmacsNative
Every time you add a new shared library dependency to Emacs,
please add it here as well. */
- libraryDeps = new String[] { "png_emacs", "selinux_emacs",
+ libraryDeps = new String[] { "c++_shared", "gnustl_shared",
+ "stlport_shared", "gabi++_shared",
+ "png_emacs", "selinux_emacs",
"crypto_emacs", "pcre_emacs",
"packagelistparser_emacs",
"gnutls_emacs", "gmp_emacs",
@@ -325,7 +339,7 @@ public final class EmacsNative
"tasn1_emacs", "hogweed_emacs",
"jansson_emacs", "jpeg_emacs",
"tiff_emacs", "xml2_emacs",
- "icuuc_emacs",
+ "icuuc_emacs", "harfbuzz_emacs",
"tree-sitter_emacs", };
for (String dependency : libraryDeps)
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java
index 9ae1bf353dd..327a53bc417 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -252,7 +252,7 @@ public final class EmacsOpenActivity extends Activity
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT)
{
- content = EmacsService.buildContentName (uri);
+ content = EmacsService.buildContentName (uri, getContentResolver ());
return content;
}
@@ -423,6 +423,7 @@ public final class EmacsOpenActivity extends Activity
/* Obtain the intent that started Emacs. */
intent = getIntent ();
action = intent.getAction ();
+ resolver = getContentResolver ();
if (action == null)
{
@@ -534,9 +535,19 @@ public final class EmacsOpenActivity extends Activity
uri = intent.getParcelableExtra (Intent.EXTRA_STREAM);
if ((scheme = uri.getScheme ()) != null
- && scheme.equals ("content"))
+ && scheme.equals ("content")
+ && (Build.VERSION.SDK_INT
+ >= Build.VERSION_CODES.KITKAT))
{
- tem1 = EmacsService.buildContentName (uri);
+ tem1 = EmacsService.buildContentName (uri, resolver);
+ attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
+ .replace ("\"", "\\\"")
+ .replace ("$", "\\$"))
+ + "\")");
+ }
+ else if (scheme != null && scheme.equals ("file"))
+ {
+ tem1 = uri.getPath ();
attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
.replace ("$", "\\$"))
@@ -566,9 +577,22 @@ public final class EmacsOpenActivity extends Activity
if (uri != null
&& (scheme = uri.getScheme ()) != null
- && scheme.equals ("content"))
+ && scheme.equals ("content")
+ && (Build.VERSION.SDK_INT
+ >= Build.VERSION_CODES.KITKAT))
+ {
+ tem1
+ = EmacsService.buildContentName (uri, resolver);
+ builder.append ("\"");
+ builder.append (tem1.replace ("\\", "\\\\")
+ .replace ("\"", "\\\"")
+ .replace ("$", "\\$"));
+ builder.append ("\"");
+ }
+ else if (scheme != null
+ && scheme.equals ("file"))
{
- tem1 = EmacsService.buildContentName (uri);
+ tem1 = uri.getPath ();
builder.append ("\"");
builder.append (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
@@ -602,14 +626,19 @@ public final class EmacsOpenActivity extends Activity
{
fileName = null;
- if (scheme.equals ("content"))
+ if (scheme.equals ("content")
+ /* Retrieving the native file descriptor of a
+ ParcelFileDescriptor requires Honeycomb, and
+ proceeding without this capability is pointless on
+ systems before KitKat, since Emacs doesn't support
+ opening content files on those. */
+ && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
{
/* This is one of the annoying Android ``content''
URIs. Most of the time, there is actually an
underlying file, but it cannot be found without
opening the file and doing readlink on its file
descriptor in /proc/self/fd. */
- resolver = getContentResolver ();
fd = null;
try
diff --git a/java/org/gnu/emacs/EmacsPreferencesActivity.java b/java/org/gnu/emacs/EmacsPreferencesActivity.java
index 330adbea223..766e2e11d46 100644
--- a/java/org/gnu/emacs/EmacsPreferencesActivity.java
+++ b/java/org/gnu/emacs/EmacsPreferencesActivity.java
@@ -38,8 +38,9 @@ import android.preference.*;
option, which would not be possible otherwise, as there is no
command line on Android.
- Android provides a preferences activity, but it is deprecated.
- Unfortunately, there is no alternative that looks the same way. */
+ This file extends a deprecated preferences activity, but no suitable
+ alternative exists that is identical in appearance to system settings
+ forms. */
@SuppressWarnings ("deprecation")
public class EmacsPreferencesActivity extends PreferenceActivity
diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java
index 5cb1ceca0aa..446cd26a3dd 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
+import java.io.ByteArrayOutputStream;
import java.io.FileNotFoundException;
import java.io.IOException;
import java.io.UnsupportedEncodingException;
@@ -45,9 +46,11 @@ import android.view.KeyEvent;
import android.view.inputmethod.CursorAnchorInfo;
import android.view.inputmethod.ExtractedText;
+import android.app.AlarmManager;
import android.app.Notification;
-import android.app.NotificationManager;
import android.app.NotificationChannel;
+import android.app.NotificationManager;
+import android.app.PendingIntent;
import android.app.Service;
import android.content.ClipboardManager;
@@ -60,6 +63,7 @@ import android.content.UriPermission;
import android.content.pm.PackageManager;
import android.content.res.AssetManager;
+import android.content.res.Configuration;
import android.hardware.input.InputManager;
@@ -78,6 +82,7 @@ import android.os.VibrationEffect;
import android.provider.DocumentsContract;
import android.provider.DocumentsContract.Document;
+import android.provider.OpenableColumns;
import android.provider.Settings;
import android.util.Log;
@@ -109,9 +114,10 @@ public final class EmacsService extends Service
private ContentResolver resolver;
/* Keep this in synch with androidgui.h. */
- public static final int IC_MODE_NULL = 0;
- public static final int IC_MODE_ACTION = 1;
- public static final int IC_MODE_TEXT = 2;
+ public static final int IC_MODE_NULL = 0;
+ public static final int IC_MODE_ACTION = 1;
+ public static final int IC_MODE_TEXT = 2;
+ public static final int IC_MODE_PASSWORD = 3;
/* Display metrics used by font backends. */
public DisplayMetrics metrics;
@@ -135,6 +141,10 @@ public final class EmacsService extends Service
been created yet. */
private EmacsSafThread storageThread;
+ /* The Thread object representing the Android user interface
+ thread. */
+ private Thread mainThread;
+
static
{
servicingQuery = new AtomicInteger ();
@@ -235,6 +245,7 @@ public final class EmacsService extends Service
/ metrics.density)
* pixelDensityX);
resolver = getContentResolver ();
+ mainThread = Thread.currentThread ();
/* If the density used to compute the text size is lesser than
160, there's likely a bug with display density computation.
@@ -383,7 +394,13 @@ public final class EmacsService extends Service
{
if (DEBUG_THREADS)
{
- if (Thread.currentThread () instanceof EmacsThread)
+ /* When SERVICE is NULL, Emacs is being executed non-interactively. */
+ if (SERVICE == null
+ /* It was previously assumed that only instances of
+ `EmacsThread' were valid for graphics calls, but this is
+ no longer true now that Lisp threads can be attached to
+ the JVM. */
+ || (Thread.currentThread () != SERVICE.mainThread))
return;
throw new RuntimeException ("Emacs thread function"
@@ -437,21 +454,6 @@ public final class EmacsService extends Service
EmacsDrawPoint.perform (drawable, gc, x, y);
}
- public void
- clearWindow (EmacsWindow window)
- {
- checkEmacsThread ();
- window.clearWindow ();
- }
-
- public void
- clearArea (EmacsWindow window, int x, int y, int width,
- int height)
- {
- checkEmacsThread ();
- window.clearArea (x, y, width, height);
- }
-
@SuppressWarnings ("deprecation")
public void
ringBell (int duration)
@@ -581,6 +583,15 @@ public final class EmacsService extends Service
return false;
}
+ public boolean
+ detectKeyboard ()
+ {
+ Configuration configuration;
+
+ configuration = getResources ().getConfiguration ();
+ return configuration.keyboard != Configuration.KEYBOARD_NOKEYS;
+ }
+
public String
nameKeysym (int keysym)
{
@@ -716,11 +727,29 @@ public final class EmacsService extends Service
restartEmacs ()
{
Intent intent;
+ PendingIntent pending;
+ AlarmManager manager;
intent = new Intent (this, EmacsActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_CLEAR_TASK);
- startActivity (intent);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT)
+ startActivity (intent);
+ else
+ {
+ /* Experimentation has established that Android 4.3 and earlier
+ versions do not attempt to recreate a process when it crashes
+ immediately after requesting that an intent for itself be
+ started. Schedule an intent to start some time after Emacs
+ exits instead. */
+
+ pending = PendingIntent.getActivity (this, 0, intent, 0);
+ manager = (AlarmManager) getSystemService (Context.ALARM_SERVICE);
+ manager.set (AlarmManager.RTC, System.currentTimeMillis () + 100,
+ pending);
+ }
+
System.exit (0);
}
@@ -905,48 +934,6 @@ public final class EmacsService extends Service
/* Content provider functions. */
- /* Return a ContentResolver capable of accessing as many files as
- possible, namely the content resolver of the last selected
- activity if available: only they posses the rights to access drag
- and drop files. */
-
- public ContentResolver
- getUsefulContentResolver ()
- {
- EmacsActivity activity;
-
- if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
- /* Since the system predates drag and drop, return this resolver
- to avoid any unforeseen difficulties. */
- return resolver;
-
- activity = EmacsActivity.lastFocusedActivity;
- if (activity == null)
- return resolver;
-
- return activity.getContentResolver ();
- }
-
- /* Return a context whose ContentResolver is granted access to most
- files, as in `getUsefulContentResolver'. */
-
- public Context
- getContentResolverContext ()
- {
- EmacsActivity activity;
-
- if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
- /* Since the system predates drag and drop, return this resolver
- to avoid any unforeseen difficulties. */
- return this;
-
- activity = EmacsActivity.lastFocusedActivity;
- if (activity == null)
- return this;
-
- return activity;
- }
-
/* Open a content URI described by the bytes BYTES, a non-terminated
string; make it writable if WRITABLE, and readable if READABLE.
Truncate the file if TRUNCATE.
@@ -960,9 +947,6 @@ public final class EmacsService extends Service
String name, mode;
ParcelFileDescriptor fd;
int i;
- ContentResolver resolver;
-
- resolver = getUsefulContentResolver ();
/* Figure out the file access mode. */
@@ -1024,12 +1008,8 @@ public final class EmacsService extends Service
ParcelFileDescriptor fd;
Uri uri;
int rc, flags;
- Context context;
- ContentResolver resolver;
ParcelFileDescriptor descriptor;
- context = getContentResolverContext ();
-
uri = Uri.parse (name);
flags = 0;
@@ -1039,7 +1019,7 @@ public final class EmacsService extends Service
if (writable)
flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION;
- rc = context.checkCallingUriPermission (uri, flags);
+ rc = checkCallingUriPermission (uri, flags);
if (rc == PackageManager.PERMISSION_GRANTED)
return true;
@@ -1053,7 +1033,6 @@ public final class EmacsService extends Service
try
{
- resolver = context.getContentResolver ();
descriptor = resolver.openFileDescriptor (uri, "r");
return true;
}
@@ -1077,22 +1056,114 @@ public final class EmacsService extends Service
return false;
}
+ /* Return a 8 character checksum for the string STRING, after encoding
+ as UTF-8 data. */
+
+ public static String
+ getDisplayNameHash (String string)
+ {
+ byte[] encoded;
+ ByteArrayOutputStream stream;
+ int i, ch;
+
+ /* Much of the VFS code expects file names to be encoded as modified
+ UTF-8 data, but Android's JNI implementation produces (while not
+ accepting!) regular UTF-8 sequences for all characters, even
+ non-Emoji ones. With no documentation to this effect, save for
+ two comments nestled in the source code of the Java virtual
+ machine, it is not sound to assume that this behavior will not be
+ revised in future or modified releases of Android, and as such,
+ encode STRING into modified UTF-8 by hand, to protect against
+ future changes in this respect. */
+
+ stream = new ByteArrayOutputStream ();
+
+ for (i = 0; i < string.length (); ++i)
+ {
+ ch = string.charAt (i);
+
+ if (ch != 0 && ch <= 127)
+ stream.write (ch);
+ else if (ch <= 2047)
+ {
+ stream.write (0xc0 | (0x1f & (ch >> 6)));
+ stream.write (0x80 | (0x3f & ch));
+ }
+ else
+ {
+ stream.write (0xe0 | (0x0f & (ch >> 12)));
+ stream.write (0x80 | (0x3f & (ch >> 6)));
+ stream.write (0x80 | (0x3f & ch));
+ }
+ }
+
+ encoded = stream.toByteArray ();
+
+ /* Closing a ByteArrayOutputStream has no effect.
+ encoded.close (); */
+
+ return EmacsNative.displayNameHash (encoded);
+ }
+
/* Build a content file name for URI.
Return a file name within the /contents/by-authority
pseudo-directory that `android_get_content_name' can then
transform back into an encoded URI.
+ If a display name can be requested from URI (using the resolver
+ RESOLVER), append it to this file name.
+
A content name consists of any number of unencoded path segments
separated by `/' characters, possibly followed by a question mark
and an encoded query string. */
public static String
- buildContentName (Uri uri)
+ buildContentName (Uri uri, ContentResolver resolver)
{
StringBuilder builder;
+ String displayName;
+ Cursor cursor;
+ int column;
+
+ displayName = null;
+ cursor = null;
+
+ try
+ {
+ cursor = resolver.query (uri, null, null, null, null);
+
+ if (cursor != null)
+ {
+ cursor.moveToFirst ();
+ column
+ = cursor.getColumnIndexOrThrow (OpenableColumns.DISPLAY_NAME);
+ displayName
+ = cursor.getString (column);
+
+ /* Verify that the display name is valid, i.e. it
+ contains no characters unsuitable for a file name and
+ is nonempty. */
+ if (displayName.isEmpty () || displayName.contains ("/"))
+ displayName = null;
+ }
+ }
+ catch (Exception e)
+ {
+ /* Ignored. */
+ }
+ finally
+ {
+ if (cursor != null)
+ cursor.close ();
+ }
+
+ /* If a display name is available, at this point it should be the
+ value of displayName. */
- builder = new StringBuilder ("/content/by-authority/");
+ builder = new StringBuilder (displayName != null
+ ? "/content/by-authority-named/"
+ : "/content/by-authority/");
builder.append (uri.getAuthority ());
/* First, append each path segment. */
@@ -1109,6 +1180,16 @@ public final class EmacsService extends Service
if (uri.getEncodedQuery () != null)
builder.append ('?').append (uri.getEncodedQuery ());
+ /* Append the display name. */
+
+ if (displayName != null)
+ {
+ builder.append ('/');
+ builder.append (getDisplayNameHash (displayName));
+ builder.append ('/');
+ builder.append (displayName);
+ }
+
return builder.toString ();
}
@@ -2011,4 +2092,29 @@ public final class EmacsService extends Service
else
requestStorageAccess30 ();
}
+
+
+
+ /* Notification miscellany. */
+
+ /* Cancel any notification displayed with the tag TAG. */
+
+ public void
+ cancelNotification (final String string)
+ {
+ Object tem;
+ final NotificationManager manager;
+
+ tem = getSystemService (Context.NOTIFICATION_SERVICE);
+ manager = (NotificationManager) tem;
+
+ runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ manager.cancel (string, 2);
+ }
+ });
+ }
};
diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java
index 136d8abc713..109208b2518 100644
--- a/java/org/gnu/emacs/EmacsView.java
+++ b/java/org/gnu/emacs/EmacsView.java
@@ -456,7 +456,6 @@ public final class EmacsView extends ViewGroup
{
Canvas canvas;
Rect damageRect;
- Bitmap bitmap;
/* Make sure this function is called only from the Emacs
thread. */
@@ -474,11 +473,12 @@ public final class EmacsView extends ViewGroup
damageRect = damageRegion.getBounds ();
damageRegion.setEmpty ();
- bitmap = getBitmap ();
-
- /* Transfer the bitmap to the surface view, then invalidate
- it. */
- surfaceView.setBitmap (bitmap, damageRect);
+ synchronized (this)
+ {
+ /* Transfer the bitmap to the surface view, then invalidate
+ it. */
+ surfaceView.setBitmap (bitmap, damageRect);
+ }
}
@Override
@@ -724,17 +724,20 @@ public final class EmacsView extends ViewGroup
public synchronized void
onDetachedFromWindow ()
{
- isAttachedToWindow = false;
-
- /* Recycle the bitmap and call GC. */
-
- if (bitmap != null)
- bitmap.recycle ();
+ Bitmap savedBitmap;
+ savedBitmap = bitmap;
+ isAttachedToWindow = false;
bitmap = null;
canvas = null;
+
surfaceView.setBitmap (null, null);
+ /* Recycle the bitmap and call GC. */
+
+ if (savedBitmap != null)
+ savedBitmap.recycle ();
+
/* Collect the bitmap storage; it could be large. */
Runtime.getRuntime ().gc ();
@@ -835,9 +838,13 @@ public final class EmacsView extends ViewGroup
EmacsNative.requestSelectionUpdate (window.handle);
}
- if (mode == EmacsService.IC_MODE_ACTION)
+ if (mode == EmacsService.IC_MODE_ACTION
+ || mode == EmacsService.IC_MODE_PASSWORD)
info.imeOptions |= EditorInfo.IME_ACTION_DONE;
+ if (mode == EmacsService.IC_MODE_PASSWORD)
+ info.inputType |= InputType.TYPE_TEXT_VARIATION_PASSWORD;
+
/* Set the initial selection fields. */
info.initialSelStart = selection[0];
info.initialSelEnd = selection[1];
diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java
index 207bd22c538..2baede1d2d0 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -23,12 +23,14 @@ import java.lang.IllegalStateException;
import java.util.ArrayList;
import java.util.List;
import java.util.ListIterator;
-import java.util.HashMap;
import java.util.LinkedHashMap;
import java.util.Map;
+import android.app.Activity;
+
import android.content.ClipData;
import android.content.ClipDescription;
+import android.content.ContentResolver;
import android.content.Context;
import android.graphics.Rect;
@@ -47,6 +49,7 @@ import android.view.View;
import android.view.ViewManager;
import android.view.WindowManager;
+import android.util.SparseArray;
import android.util.Log;
import android.os.Build;
@@ -106,7 +109,7 @@ public final class EmacsWindow extends EmacsHandleObject
/* Map between pointer identifiers and last known position. Used to
compute which pointer changed upon a touch event. */
- private HashMap<Integer, Coordinate> pointerMap;
+ private SparseArray<Coordinate> pointerMap;
/* The window consumer currently attached, if it exists. */
private EmacsWindowAttachmentManager.WindowConsumer attached;
@@ -163,7 +166,7 @@ public final class EmacsWindow extends EmacsHandleObject
super (handle);
rect = new Rect (x, y, x + width, y + height);
- pointerMap = new HashMap<Integer, Coordinate> ();
+ pointerMap = new SparseArray<Coordinate> ();
/* Create the view from the context's UI thread. The window is
unmapped, so the view is GONE. */
@@ -240,7 +243,7 @@ public final class EmacsWindow extends EmacsHandleObject
}
}
- EmacsActivity.invalidateFocus ();
+ EmacsActivity.invalidateFocus (4);
if (!children.isEmpty ())
throw new IllegalStateException ("Trying to destroy window with "
@@ -362,6 +365,9 @@ public final class EmacsWindow extends EmacsHandleObject
requestViewLayout ();
}
+ /* Return WM layout parameters for an override redirect window with
+ the geometry provided here. */
+
private WindowManager.LayoutParams
getWindowLayoutParams ()
{
@@ -384,15 +390,15 @@ public final class EmacsWindow extends EmacsHandleObject
return params;
}
- private Context
+ private Activity
findSuitableActivityContext ()
{
/* Find a recently focused activity. */
if (!EmacsActivity.focusedActivities.isEmpty ())
return EmacsActivity.focusedActivities.get (0);
- /* Return the service context, which probably won't work. */
- return EmacsService.SERVICE;
+ /* Resort to the last activity to be focused. */
+ return EmacsActivity.lastFocusedActivity;
}
public synchronized void
@@ -416,7 +422,7 @@ public final class EmacsWindow extends EmacsHandleObject
{
EmacsWindowAttachmentManager manager;
WindowManager windowManager;
- Context ctx;
+ Activity ctx;
Object tem;
WindowManager.LayoutParams params;
@@ -447,11 +453,23 @@ public final class EmacsWindow extends EmacsHandleObject
activity using the system window manager. */
ctx = findSuitableActivityContext ();
+
+ if (ctx == null)
+ {
+ Log.w (TAG, "failed to attach override-redirect window"
+ + " for want of activity");
+ return;
+ }
+
tem = ctx.getSystemService (Context.WINDOW_SERVICE);
windowManager = (WindowManager) tem;
- /* Calculate layout parameters. */
+ /* Calculate layout parameters and propagate the
+ activity's token into it. */
+
params = getWindowLayoutParams ();
+ params.token = (ctx.findViewById (android.R.id.content)
+ .getWindowToken ());
view.setLayoutParams (params);
/* Attach the view. */
@@ -644,7 +662,7 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onKeyDown (int keyCode, KeyEvent event)
{
- int state, state_1, num_lock_flag;
+ int state, state_1, extra_ignored;
long serial;
String characters;
@@ -665,23 +683,37 @@ public final class EmacsWindow extends EmacsHandleObject
state = eventModifiers (event);
- /* Num Lock and Scroll Lock aren't supported by systems older than
- Android 3.0. */
+ /* Num Lock, Scroll Lock and Meta aren't supported by systems older
+ than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- num_lock_flag = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON);
+ extra_ignored = (KeyEvent.META_NUM_LOCK_ON
+ | KeyEvent.META_SCROLL_LOCK_ON
+ | KeyEvent.META_META_MASK);
else
- num_lock_flag = 0;
+ extra_ignored = 0;
/* Ignore meta-state understood by Emacs for now, or key presses
- such as Ctrl+C and Meta+C will not be recognized as an ASCII
- key press event. */
+ such as Ctrl+C and Meta+C will not be recognized as ASCII key
+ press events. */
state_1
= state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK
- | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK
- | num_lock_flag);
+ | KeyEvent.META_SYM_ON | extra_ignored);
+
+ /* There's no distinction between Right Alt and Alt Gr on Android,
+ so restore META_ALT_RIGHT_ON if set in state to enable composing
+ characters. (bug#69321) */
+
+ if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0)
+ {
+ state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON;
+
+ /* If Alt is also not depressed, remove its bit from the mask
+ reported to Emacs. */
+ if ((state & KeyEvent.META_ALT_LEFT_ON) == 0)
+ state &= ~KeyEvent.META_ALT_MASK;
+ }
synchronized (eventStrings)
{
@@ -702,29 +734,43 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onKeyUp (int keyCode, KeyEvent event)
{
- int state, state_1, unicode_char, num_lock_flag;
+ int state, state_1, unicode_char, extra_ignored;
long time;
/* Compute the event's modifier mask. */
state = eventModifiers (event);
- /* Num Lock and Scroll Lock aren't supported by systems older than
- Android 3.0. */
+ /* Num Lock, Scroll Lock and Meta aren't supported by systems older
+ than Android 3.0. */
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
- num_lock_flag = (KeyEvent.META_NUM_LOCK_ON
- | KeyEvent.META_SCROLL_LOCK_ON);
+ extra_ignored = (KeyEvent.META_NUM_LOCK_ON
+ | KeyEvent.META_SCROLL_LOCK_ON
+ | KeyEvent.META_META_MASK);
else
- num_lock_flag = 0;
+ extra_ignored = 0;
/* Ignore meta-state understood by Emacs for now, or key presses
- such as Ctrl+C and Meta+C will not be recognized as an ASCII
- key press event. */
+ such as Ctrl+C and Meta+C will not be recognized as ASCII key
+ press events. */
state_1
= state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK
- | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK
- | num_lock_flag);
+ | KeyEvent.META_SYM_ON | extra_ignored);
+
+ /* There's no distinction between Right Alt and Alt Gr on Android,
+ so restore META_ALT_RIGHT_ON if set in state to enable composing
+ characters. */
+
+ if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0)
+ {
+ state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON;
+
+ /* If Alt is also not depressed, remove its bit from the mask
+ reported to Emacs. */
+ if ((state & KeyEvent.META_ALT_LEFT_ON) == 0)
+ state &= ~KeyEvent.META_ALT_MASK;
+ }
unicode_char = getEventUnicodeChar (event, state_1);
@@ -760,7 +806,7 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onFocusChanged (boolean gainFocus)
{
- EmacsActivity.invalidateFocus ();
+ EmacsActivity.invalidateFocus (gainFocus ? 6 : 5);
}
/* Notice that the activity has been detached or destroyed.
@@ -955,7 +1001,8 @@ public final class EmacsWindow extends EmacsHandleObject
case MotionEvent.ACTION_CANCEL:
/* Primary pointer released with index 0. */
pointerID = event.getPointerId (0);
- coordinate = pointerMap.remove (pointerID);
+ coordinate = pointerMap.get (pointerID);
+ pointerMap.delete (pointerID);
break;
case MotionEvent.ACTION_POINTER_DOWN:
@@ -974,7 +1021,8 @@ public final class EmacsWindow extends EmacsHandleObject
/* Pointer removed. Remove it from the map. */
pointerIndex = event.getActionIndex ();
pointerID = event.getPointerId (pointerIndex);
- coordinate = pointerMap.remove (pointerID);
+ coordinate = pointerMap.get (pointerID);
+ pointerMap.delete (pointerID);
break;
default:
@@ -1654,10 +1702,11 @@ public final class EmacsWindow extends EmacsHandleObject
ClipData data;
ClipDescription description;
int i, j, x, y, itemCount;
- String type;
+ String type, uriString;
Uri uri;
EmacsActivity activity;
StringBuilder builder;
+ ContentResolver resolver;
x = (int) event.getX ();
y = (int) event.getY ();
@@ -1746,7 +1795,7 @@ public final class EmacsWindow extends EmacsHandleObject
/* Attempt to acquire permissions for this URI;
failing which, insert it as text instead. */
-
+
if (uri != null
&& uri.getScheme () != null
&& uri.getScheme ().equals ("content")
@@ -1754,6 +1803,20 @@ public final class EmacsWindow extends EmacsHandleObject
{
if ((activity.requestDragAndDropPermissions (event) == null))
uri = null;
+ else
+ {
+ resolver = activity.getContentResolver ();
+
+ /* Substitute a content file name for the URI, if
+ possible. */
+ uriString = EmacsService.buildContentName (uri, resolver);
+
+ if (uriString != null)
+ {
+ builder.append (uriString).append ("\n");
+ continue;
+ }
+ }
}
if (uri != null)
@@ -1784,4 +1847,32 @@ public final class EmacsWindow extends EmacsHandleObject
return true;
}
+
+
+
+ /* Miscellaneous functions for debugging graphics code. */
+
+ /* Recreate the activity to which this window is attached, if any.
+ This is nonfunctional on Android 2.3.7 and earlier. */
+
+ public void
+ recreateActivity ()
+ {
+ final EmacsWindowAttachmentManager.WindowConsumer attached;
+
+ attached = this.attached;
+
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.HONEYCOMB)
+ return;
+
+ view.post (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ if (attached instanceof EmacsActivity)
+ ((EmacsActivity) attached).recreate ();
+ }
+ });
+ }
};
diff --git a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
index 18bdb6dbf60..aae4e2ee49b 100644
--- a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
+++ b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
@@ -124,10 +124,15 @@ public final class EmacsWindowAttachmentManager
intent = new Intent (EmacsService.SERVICE,
EmacsMultitaskActivity.class);
- intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT
- | Intent.FLAG_ACTIVITY_NEW_TASK
+
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_MULTIPLE_TASK);
+ /* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on
+ older systems than Lolipop. */
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP)
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT);
+
if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
EmacsService.SERVICE.startActivity (intent);
else
diff --git a/leim/Makefile.in b/leim/Makefile.in
index f7a23178919..bc1eeb5e634 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic:
## All of TIT_GB and TIT_BIG5.
${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit
$(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \
- -f batch-titdic-convert -dir ${leimdir}/quail $<
+ -f batch-tit-dic-convert -dir ${leimdir}/quail $<
misc_convert = $(AM_V_GEN)${RUN_EMACS} \
- -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail
+ -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail
## CTLau.el, CTLau-b5.el.
${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html
@@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option
-f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<"
${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map
- $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@
+ $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@
.PHONY: bootstrap-clean distclean maintainer-clean gen-clean
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 7c059640862..3cdf1620781 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -319,7 +319,7 @@ maybe-blessmail: $(BLESSMAIL_TARGET)
## up if chown or chgrp fails, as the package responsible for
## installing Emacs can fix this problem later.
$(DESTDIR)${archlibdir}: all
- $(info $ )
+ $(info $.)
$(info Installing utilities run internally by Emacs.)
umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}"
exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \
@@ -361,7 +361,7 @@ $(DESTDIR)${archlibdir}: all
.PHONY: bootstrap-clean check tags
install: $(DESTDIR)${archlibdir}
- $(info $ )
+ $(info $.)
$(info Installing utilities for users to run.)
umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}"
for file in ${INSTALLABLES} ; do \
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 506366141e6..032cfa8010b 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -3825,7 +3825,7 @@ C_entries (int c_ext, /* extension of C */
{
case fstartlist:
/* This prevents tagging fb in
- void (__attribute__((noreturn)) *fb) (void);
+ void (__attribute__ ((noreturn)) *fb) (void);
Fixing this is not easy and not very important. */
fvdef = finlist;
continue;
@@ -4380,14 +4380,14 @@ Yacc_entries (FILE *inf)
#define LOOKING_AT(cp, kw) /* kw is the keyword, a literal string */ \
((assert ("" kw), true) /* syntax error if not a literal string */ \
- && strneq ((cp), kw, sizeof (kw)-1) /* cp points at kw */ \
+ && strneq (cp, kw, sizeof (kw) - 1) /* cp points at kw */ \
&& notinname ((cp)[sizeof (kw)-1]) /* end of kw */ \
&& ((cp) = skip_spaces ((cp) + sizeof (kw) - 1), true)) /* skip spaces */
/* Similar to LOOKING_AT but does not use notinname, does not skip */
#define LOOKING_AT_NOCASE(cp, kw) /* the keyword is a literal string */ \
((assert ("" kw), true) /* syntax error if not a literal string */ \
- && strncaseeq ((cp), kw, sizeof (kw)-1) /* cp points at kw */ \
+ && strncaseeq (cp, kw, sizeof (kw) - 1) /* cp points at kw */ \
&& ((cp) += sizeof (kw) - 1, true)) /* skip spaces */
/*
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
index 8846e6aedae..0aeb6e8d88a 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -114,7 +114,7 @@ set_attribute (enum scmp_filter_attr attr, uint32_t value)
{ \
const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \
enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \
- int status = seccomp_rule_add_array (ctx, (action), (syscall), \
+ int status = seccomp_rule_add_array (ctx, action, syscall, \
arg_cnt, arg_array); \
if (status < 0) \
fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \
@@ -143,7 +143,7 @@ export_filter (const char *file,
}
#define EXPORT_FILTER(file, function) \
- export_filter ((file), (function), #function)
+ export_filter (file, function, #function)
int
main (int argc, char **argv)
diff --git a/lib/acl-internal.h b/lib/acl-internal.h
index 4de891d3f22..ef1f84dc243 100644
--- a/lib/acl-internal.h
+++ b/lib/acl-internal.h
@@ -52,9 +52,6 @@ extern int aclsort (int, int, struct acl *);
#include <errno.h>
#include <limits.h>
-#ifndef MIN
-# define MIN(a,b) ((a) < (b) ? (a) : (b))
-#endif
#ifndef SIZE_MAX
# define SIZE_MAX ((size_t) -1)
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index 49c86125b69..6aa47df8ec3 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -1,7 +1,7 @@
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2024 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
diff --git a/lib/attribute.h b/lib/attribute.h
index 9504c625e59..710341ba417 100644
--- a/lib/attribute.h
+++ b/lib/attribute.h
@@ -182,6 +182,8 @@
/* The function does not throw exceptions. */
/* Applies to: functions. */
+/* After a function's parameter list, this attribute must come first, before
+ other attributes. */
#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW
/* Do not inline the function. */
diff --git a/lib/binary-io.h b/lib/binary-io.h
index 33e3de1d1de..0cc5c11748c 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -1,6 +1,5 @@
/* Binary mode I/O.
- Copyright (C) 2001, 2003, 2005, 2008-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 2001, 2003, 2005, 2008-2024 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
diff --git a/lib/boot-time-aux.h b/lib/boot-time-aux.h
index a7babf6dc64..8b966fe691f 100644
--- a/lib/boot-time-aux.h
+++ b/lib/boot-time-aux.h
@@ -86,15 +86,21 @@ get_linux_uptime (struct timespec *p_uptime)
static int
get_linux_boot_time_fallback (struct timespec *p_boot_time)
{
- /* On Alpine Linux, UTMP_FILE is not filled. It is always empty.
- So, get the time stamp of a file that gets touched only during the
- boot process. */
+ /* On Devuan with the 'runit' init system and on Artix with the 's6' init
+ system, UTMP_FILE contains USER_PROCESS and other entries, but no
+ BOOT_TIME entry.
+ On Alpine Linux, UTMP_FILE is not filled. It is always empty.
+ So, in both cases, get the time stamp of a file that gets touched only
+ during the boot process. */
const char * const boot_touched_files[] =
{
"/var/lib/systemd/random-seed", /* seen on distros with systemd */
- "/var/run/utmp", /* seen on distros with OpenRC */
- "/var/lib/random-seed" /* seen on older distros */
+ "/var/lib/urandom/random-seed", /* seen on Devuan with runit */
+ "/var/lib/random-seed", /* seen on Artix with s6 */
+ /* This must come last, since on several distros /var/run/utmp is
+ modified when a user logs in, i.e. long after boot. */
+ "/var/run/utmp" /* seen on Alpine Linux with OpenRC */
};
for (idx_t i = 0; i < SIZEOF (boot_touched_files); i++)
{
diff --git a/lib/boot-time.c b/lib/boot-time.c
index f560914962b..c1171e8024d 100644
--- a/lib/boot-time.c
+++ b/lib/boot-time.c
@@ -203,7 +203,14 @@ get_boot_time_uncached (struct timespec *p_boot_time)
}
# endif
-# else /* old FreeBSD, OpenBSD, native Windows */
+# else /* AdƩlie Linux, old FreeBSD, OpenBSD, native Windows */
+
+# if defined __linux__ && !defined __ANDROID__
+ /* Workaround for AdƩlie Linux: */
+ get_linux_boot_time_fallback (&found_boot_time);
+ if (found_boot_time.tv_sec == 0)
+ get_linux_boot_time_final_fallback (&found_boot_time);
+# endif
# if defined __OpenBSD__
/* Workaround for OpenBSD: */
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index 016fe7c3b11..b582de4a7fd 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -5,8 +5,7 @@
<ctype.h> functions' behaviour depends on the current locale set via
setlocale.
- Copyright (C) 2000-2003, 2006, 2008-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 2000-2003, 2006, 2008-2024 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
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
index a4bad4f2e2f..1fa575a8562 100644
--- a/lib/c-strcasecmp.c
+++ b/lib/c-strcasecmp.c
@@ -1,6 +1,5 @@
/* c-strcasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2024 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
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
index 693601586be..4c8b0b6b841 100644
--- a/lib/c-strncasecmp.c
+++ b/lib/c-strncasecmp.c
@@ -1,6 +1,5 @@
/* c-strncasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-2024 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
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index 9d77aa7067a..f308b6963ae 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -1,7 +1,7 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2001, 2003-2004, 2007, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 2001, 2003-2004, 2007, 2009-2024 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
diff --git a/lib/cdefs.h b/lib/cdefs.h
index 87ddce319dc..d38382ad9d8 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -42,8 +42,8 @@
#if (defined __has_attribute \
&& (!defined __clang_minor__ \
|| (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+ ? 7000000 <= __apple_build_version__ \
+ : 5 <= __clang_major__)))
# define __glibc_has_attribute(attr) __has_attribute (attr)
#else
# define __glibc_has_attribute(attr) 0
diff --git a/lib/cloexec.c b/lib/cloexec.c
index b4279752880..cdb0d740eb7 100644
--- a/lib/cloexec.c
+++ b/lib/cloexec.c
@@ -1,7 +1,6 @@
/* cloexec.c - set or clear the close-on-exec descriptor flag
- Copyright (C) 1991, 2004-2006, 2009-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1991, 2004-2006, 2009-2024 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
diff --git a/lib/close-stream.c b/lib/close-stream.c
index ae53f93aabe..81094c6863c 100644
--- a/lib/close-stream.c
+++ b/lib/close-stream.c
@@ -1,7 +1,6 @@
/* Close a stream, with nicer error checking than fclose's.
- Copyright (C) 1998-2002, 2004, 2006-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1998-2002, 2004, 2006-2024 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/diffseq.h b/lib/diffseq.h
index 7f8fa0bc6d3..0c5bc9cbc6d 100644
--- a/lib/diffseq.h
+++ b/lib/diffseq.h
@@ -1,7 +1,7 @@
/* Analyze differences between two vectors.
- Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2024 Free Software
+ Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index 425550ab3ab..f05b880077f 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -237,12 +237,6 @@ _GL_WARN_ON_USE (rewinddir, "rewinddir is not portable - "
_GL_FUNCDECL_RPL (dirfd, int, (DIR *) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (dirfd, int, (DIR *));
-# ifdef __KLIBC__
-/* Gnulib internal hooks needed to maintain the dirfd metadata. */
-_GL_EXTERN_C int _gl_register_dirp_fd (int fd, DIR *dirp)
- _GL_ARG_NONNULL ((2));
-_GL_EXTERN_C void _gl_unregister_dirp_fd (int fd);
-# endif
# else
# if defined __cplusplus && defined GNULIB_NAMESPACE && defined dirfd
/* dirfd is defined as a macro and not as a function.
diff --git a/lib/dirfd.c b/lib/dirfd.c
index 70600f2a75a..afcf382e301 100644
--- a/lib/dirfd.c
+++ b/lib/dirfd.c
@@ -26,59 +26,6 @@
# include "dirent-private.h"
#endif
-#ifdef __KLIBC__
-# include <stdlib.h>
-# include <io.h>
-
-static struct dirp_fd_list
-{
- DIR *dirp;
- int fd;
- struct dirp_fd_list *next;
-} *dirp_fd_start = NULL;
-
-/* Register fd associated with dirp to dirp_fd_list. */
-int
-_gl_register_dirp_fd (int fd, DIR *dirp)
-{
- struct dirp_fd_list *new_dirp_fd = malloc (sizeof *new_dirp_fd);
- if (!new_dirp_fd)
- return -1;
-
- new_dirp_fd->dirp = dirp;
- new_dirp_fd->fd = fd;
- new_dirp_fd->next = dirp_fd_start;
-
- dirp_fd_start = new_dirp_fd;
-
- return 0;
-}
-
-/* Unregister fd from dirp_fd_list with closing it */
-void
-_gl_unregister_dirp_fd (int fd)
-{
- struct dirp_fd_list *dirp_fd;
- struct dirp_fd_list *dirp_fd_prev;
-
- for (dirp_fd_prev = NULL, dirp_fd = dirp_fd_start; dirp_fd;
- dirp_fd_prev = dirp_fd, dirp_fd = dirp_fd->next)
- {
- if (dirp_fd->fd == fd)
- {
- if (dirp_fd_prev)
- dirp_fd_prev->next = dirp_fd->next;
- else /* dirp_fd == dirp_fd_start */
- dirp_fd_start = dirp_fd_start->next;
-
- close (fd);
- free (dirp_fd);
- break;
- }
- }
-}
-#endif
-
int
dirfd (DIR *dir_p)
{
@@ -90,19 +37,7 @@ dirfd (DIR *dir_p)
#else
int fd = DIR_TO_FD (dir_p);
if (fd == -1)
-# ifndef __KLIBC__
errno = ENOTSUP;
-# else
- {
- struct dirp_fd_list *dirp_fd;
-
- for (dirp_fd = dirp_fd_start; dirp_fd; dirp_fd = dirp_fd->next)
- if (dirp_fd->dirp == dir_p)
- return dirp_fd->fd;
-
- errno = EINVAL;
- }
-# endif
return fd;
#endif
diff --git a/lib/dup2.c b/lib/dup2.c
index 7e1960e48d3..916e113dd89 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -1,7 +1,6 @@
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1999, 2004-2007, 2009-2024 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
diff --git a/lib/faccessat.c b/lib/faccessat.c
index f82eca2dbe3..8178ca8632e 100644
--- a/lib/faccessat.c
+++ b/lib/faccessat.c
@@ -40,10 +40,14 @@ orig_faccessat (int fd, char const *name, int mode, int flag)
}
#endif
+#ifdef __osf__
/* Write "unistd.h" here, not <unistd.h>, otherwise OSF/1 5.1 DTK cc
eliminates this include because of the preliminary #include <unistd.h>
above. */
-#include "unistd.h"
+# include "unistd.h"
+#else
+# include <unistd.h>
+#endif
#ifndef HAVE_ACCESS
/* Mingw lacks access, but it also lacks real vs. effective ids, so
diff --git a/lib/fdopendir.c b/lib/fdopendir.c
index e49abec4f62..bdbb2ea912f 100644
--- a/lib/fdopendir.c
+++ b/lib/fdopendir.c
@@ -44,42 +44,6 @@ fdopendir (int fd)
return dirp;
}
-# elif defined __KLIBC__
-
-# include <InnoTekLIBC/backend.h>
-
-DIR *
-fdopendir (int fd)
-{
- char path[_MAX_PATH];
- DIR *dirp;
-
- /* Get a path from fd */
- if (__libc_Back_ioFHToPath (fd, path, sizeof (path)))
- return NULL;
-
- dirp = opendir (path);
- if (!dirp)
- return NULL;
-
- /* Unregister fd registered by opendir() */
- _gl_unregister_dirp_fd (dirfd (dirp));
-
- /* Register our fd */
- if (_gl_register_dirp_fd (fd, dirp))
- {
- int saved_errno = errno;
-
- closedir (dirp);
-
- errno = saved_errno;
-
- dirp = NULL;
- }
-
- return dirp;
-}
-
# else
/* We are not in control of the file descriptor of a DIR, and therefore have to
play tricks with file descriptors before and after a call to opendir(). */
diff --git a/lib/filemode.h b/lib/filemode.h
index bb601c11d3f..2dee82f0be1 100644
--- a/lib/filemode.h
+++ b/lib/filemode.h
@@ -1,7 +1,7 @@
/* Make a string describing file modes.
- Copyright (C) 1998-1999, 2003, 2006, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1998-1999, 2003, 2006, 2009-2024 Free Software Foundation,
+ Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/fpending.c b/lib/fpending.c
index 8d90bdee51b..51468955844 100644
--- a/lib/fpending.c
+++ b/lib/fpending.c
@@ -1,6 +1,6 @@
/* fpending.c -- return the number of pending output bytes on a stream
- Copyright (C) 2000, 2004, 2006-2007, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2004, 2006-2007, 2009-2024 Free Software Foundation,
+ Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/fpending.h b/lib/fpending.h
index 15122915254..28db3b403d9 100644
--- a/lib/fpending.h
+++ b/lib/fpending.h
@@ -1,7 +1,7 @@
/* Declare __fpending.
- Copyright (C) 2000, 2003, 2005-2006, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2003, 2005-2006, 2009-2024 Free Software Foundation,
+ Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/fsusage.c b/lib/fsusage.c
index d99a02f01f3..97d0eef7aa8 100644
--- a/lib/fsusage.c
+++ b/lib/fsusage.c
@@ -1,7 +1,7 @@
/* fsusage.c -- return space usage of mounted file systems
- Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2024 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
diff --git a/lib/getgroups.c b/lib/getgroups.c
index 346954adaad..9f4908e9977 100644
--- a/lib/getgroups.c
+++ b/lib/getgroups.c
@@ -1,7 +1,6 @@
/* provide consistent interface to getgroups for systems that don't allow N==0
- Copyright (C) 1996, 1999, 2003, 2006-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1996, 1999, 2003, 2006-2024 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
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index 7f0a236c870..c940e4c7ee0 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -1,7 +1,7 @@
/* Get the system load averages.
- Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2024 Free Software
+ Foundation, Inc.
NOTE: The canonical source of this file is maintained with gnulib.
Bugs can be reported to bug-gnulib@gnu.org.
diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h
index 7a791392de5..a1d304d49e8 100644
--- a/lib/getopt-cdefs.in.h
+++ b/lib/getopt-cdefs.in.h
@@ -57,7 +57,11 @@
#ifndef __THROW
# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4)
-# define __THROW throw ()
+# if __cplusplus >= 201103L
+# define __THROW noexcept (true)
+# else
+# define __THROW throw ()
+# endif
# else
# define __THROW
# endif
diff --git a/lib/getopt.c b/lib/getopt.c
index e2951f74601..f66f119ec50 100644
--- a/lib/getopt.c
+++ b/lib/getopt.c
@@ -21,7 +21,7 @@
# include <config.h>
#endif
-#include "getopt.h"
+#include <getopt.h>
#include <stdio.h>
#include <stdlib.h>
@@ -223,8 +223,9 @@ process_long_option (int argc, char **argv, const char *optstring,
{
/* Didn't find an exact match, so look for abbreviations. */
unsigned char *ambig_set = NULL;
- int ambig_malloced = 0;
- int ambig_fallback = 0;
+ /* Use simpler fallback diagnostic if ambig_set == &ambig_fallback. */
+ unsigned char ambig_fallback;
+ void *ambig_malloced = NULL;
int indfound = -1;
for (p = longopts, option_index = 0; p->name; p++, option_index++)
@@ -242,39 +243,42 @@ process_long_option (int argc, char **argv, const char *optstring,
|| pfound->val != p->val)
{
/* Second or later nonexact match found. */
- if (!ambig_fallback)
+ if (ambig_set != &ambig_fallback)
{
if (!print_errors)
/* Don't waste effort tracking the ambig set if
we're not going to print it anyway. */
- ambig_fallback = 1;
+ ambig_set = &ambig_fallback;
else if (!ambig_set)
{
if (__libc_use_alloca (n_options))
ambig_set = alloca (n_options);
- else if ((ambig_set = malloc (n_options)) == NULL)
- /* Fall back to simpler error message. */
- ambig_fallback = 1;
else
- ambig_malloced = 1;
+ {
+ ambig_malloced = malloc (n_options);
+ /* Fall back to simpler diagnostic if
+ memory allocation fails. */
+ ambig_set = (ambig_malloced ? ambig_malloced
+ : &ambig_fallback);
+ }
- if (ambig_set)
+ if (ambig_set != &ambig_fallback)
{
memset (ambig_set, 0, n_options);
ambig_set[indfound] = 1;
}
}
- if (ambig_set)
+ if (ambig_set && ambig_set != &ambig_fallback)
ambig_set[option_index] = 1;
}
}
}
- if (ambig_set || ambig_fallback)
+ if (ambig_set)
{
if (print_errors)
{
- if (ambig_fallback)
+ if (ambig_set == &ambig_fallback)
fprintf (stderr, _("%s: option '%s%s' is ambiguous\n"),
argv[0], prefix, d->__nextchar);
else
@@ -296,8 +300,7 @@ process_long_option (int argc, char **argv, const char *optstring,
funlockfile (stderr);
}
}
- if (ambig_malloced)
- free (ambig_set);
+ free (ambig_malloced);
d->__nextchar += strlen (d->__nextchar);
d->optind++;
d->optopt = 0;
diff --git a/lib/getopt1.c b/lib/getopt1.c
index 0c8e29b5b91..c42d29f8b57 100644
--- a/lib/getopt1.c
+++ b/lib/getopt1.c
@@ -21,7 +21,7 @@
# include <config.h>
#endif
-#include "getopt.h"
+#include <getopt.h>
#include "getopt_int.h"
int
diff --git a/lib/gettext.h b/lib/gettext.h
index 970032306e5..39d5ae4daa5 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -1,6 +1,6 @@
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2024 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
diff --git a/lib/gettime.c b/lib/gettime.c
index 1f6d960713b..38d36859415 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -1,7 +1,6 @@
/* gettime -- get the system clock
- Copyright (C) 2002, 2004-2007, 2009-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 2002, 2004-2007, 2009-2024 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
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index ddef1425a4d..8dd26f73c03 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -1,7 +1,6 @@
/* Provide gettimeofday for systems that don't have it or for which it's broken.
- Copyright (C) 2001-2003, 2005-2007, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 2001-2003, 2005-2007, 2009-2024 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
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index add29f83883..711ddcf1260 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -34,6 +34,7 @@
# --no-libtool \
# --macro-prefix=gl \
# --no-vc-files \
+# --avoid=access \
# --avoid=btowc \
# --avoid=chmod \
# --avoid=close \
@@ -46,6 +47,7 @@
# --avoid=iswdigit \
# --avoid=iswxdigit \
# --avoid=langinfo \
+# --avoid=localename-unsafe-limited \
# --avoid=lock \
# --avoid=mbrtowc \
# --avoid=mbsinit \
@@ -563,6 +565,7 @@ GL_GNULIB_PUTS = @GL_GNULIB_PUTS@
GL_GNULIB_PWRITE = @GL_GNULIB_PWRITE@
GL_GNULIB_QSORT_R = @GL_GNULIB_QSORT_R@
GL_GNULIB_RAISE = @GL_GNULIB_RAISE@
+GL_GNULIB_RAND = @GL_GNULIB_RAND@
GL_GNULIB_RANDOM = @GL_GNULIB_RANDOM@
GL_GNULIB_RANDOM_R = @GL_GNULIB_RANDOM_R@
GL_GNULIB_RAWMEMCHR = @GL_GNULIB_RAWMEMCHR@
@@ -1123,6 +1126,7 @@ REPLACE_EXECVE = @REPLACE_EXECVE@
REPLACE_EXECVP = @REPLACE_EXECVP@
REPLACE_EXECVPE = @REPLACE_EXECVPE@
REPLACE_FACCESSAT = @REPLACE_FACCESSAT@
+REPLACE_FCHDIR = @REPLACE_FCHDIR@
REPLACE_FCHMODAT = @REPLACE_FCHMODAT@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
@@ -1182,6 +1186,7 @@ REPLACE_MB_CUR_MAX = @REPLACE_MB_CUR_MAX@
REPLACE_MEMCHR = @REPLACE_MEMCHR@
REPLACE_MEMMEM = @REPLACE_MEMMEM@
REPLACE_MEMPCPY = @REPLACE_MEMPCPY@
+REPLACE_MEMSET_EXPLICIT = @REPLACE_MEMSET_EXPLICIT@
REPLACE_MKDIR = @REPLACE_MKDIR@
REPLACE_MKFIFO = @REPLACE_MKFIFO@
REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@
@@ -1212,6 +1217,7 @@ REPLACE_PUTENV = @REPLACE_PUTENV@
REPLACE_PWRITE = @REPLACE_PWRITE@
REPLACE_QSORT_R = @REPLACE_QSORT_R@
REPLACE_RAISE = @REPLACE_RAISE@
+REPLACE_RAND = @REPLACE_RAND@
REPLACE_RANDOM = @REPLACE_RANDOM@
REPLACE_RANDOM_R = @REPLACE_RANDOM_R@
REPLACE_READ = @REPLACE_READ@
@@ -1261,11 +1267,13 @@ REPLACE_STRTOUL = @REPLACE_STRTOUL@
REPLACE_STRTOULL = @REPLACE_STRTOULL@
REPLACE_STRTOUMAX = @REPLACE_STRTOUMAX@
REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@
+REPLACE_STRVERSCMP = @REPLACE_STRVERSCMP@
REPLACE_SYMLINK = @REPLACE_SYMLINK@
REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@
REPLACE_TIME = @REPLACE_TIME@
REPLACE_TIMEGM = @REPLACE_TIMEGM@
REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@
+REPLACE_TIMESPEC_GETRES = @REPLACE_TIMESPEC_GETRES@
REPLACE_TMPFILE = @REPLACE_TMPFILE@
REPLACE_TRUNCATE = @REPLACE_TRUNCATE@
REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@
@@ -2738,7 +2746,9 @@ ifeq (,$(OMIT_GNULIB_MODULE_nstrftime))
libgnu_a_SOURCES += nstrftime.c
-EXTRA_DIST += strftime.h
+EXTRA_DIST += strftime.c strftime.h
+
+EXTRA_libgnu_a_SOURCES += strftime.c
endif
## end gnulib module nstrftime
@@ -3326,6 +3336,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_PTSNAME_R''@/$(GL_GNULIB_PTSNAME_R)/g' \
-e 's/@''GNULIB_PUTENV''@/$(GL_GNULIB_PUTENV)/g' \
-e 's/@''GNULIB_QSORT_R''@/$(GL_GNULIB_QSORT_R)/g' \
+ -e 's/@''GNULIB_RAND''@/$(GL_GNULIB_RAND)/g' \
-e 's/@''GNULIB_RANDOM''@/$(GL_GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GL_GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_GNU''@/$(GL_GNULIB_REALLOC_GNU)/g' \
@@ -3423,6 +3434,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
-e 's|@''REPLACE_QSORT_R''@|$(REPLACE_QSORT_R)|g' \
+ -e 's|@''REPLACE_RAND''@|$(REPLACE_RAND)|g' \
-e 's|@''REPLACE_RANDOM''@|$(REPLACE_RANDOM)|g' \
-e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \
-e 's|@''REPLACE_REALLOC_FOR_REALLOC_GNU''@|$(REPLACE_REALLOC_FOR_REALLOC_GNU)|g' \
@@ -3553,6 +3565,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
-e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
-e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \
+ -e 's|@''REPLACE_MEMSET_EXPLICIT''@|$(REPLACE_MEMSET_EXPLICIT)|g' \
-e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \
-e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \
-e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \
@@ -3568,6 +3581,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \
-e 's|@''REPLACE_STRERRORNAME_NP''@|$(REPLACE_STRERRORNAME_NP)|g' \
-e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
+ -e 's|@''REPLACE_STRVERSCMP''@|$(REPLACE_STRVERSCMP)|g' \
-e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
@@ -3884,6 +3898,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \
-e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \
-e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \
+ -e 's|@''REPLACE_TIMESPEC_GETRES''@|$(REPLACE_TIMESPEC_GETRES)|g' \
-e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \
-e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \
-e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \
@@ -4141,6 +4156,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_EXECVP''@|$(REPLACE_EXECVP)|g' \
-e 's|@''REPLACE_EXECVPE''@|$(REPLACE_EXECVPE)|g' \
-e 's|@''REPLACE_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \
+ -e 's|@''REPLACE_FCHDIR''@|$(REPLACE_FCHDIR)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
-e 's|@''REPLACE_FDATASYNC''@|$(REPLACE_FDATASYNC)|g' \
-e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
diff --git a/lib/group-member.c b/lib/group-member.c
index 300d58bdbaa..43b49831003 100644
--- a/lib/group-member.c
+++ b/lib/group-member.c
@@ -1,7 +1,7 @@
/* group-member.c -- determine whether group id is in calling user's group list
- Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2024 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
diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h
index dcbf537786a..c8a87d2bb27 100644
--- a/lib/intprops-internal.h
+++ b/lib/intprops-internal.h
@@ -20,6 +20,11 @@
#include <limits.h>
+/* Pacify GCC 13.2 in some calls to _GL_EXPR_SIGNED. */
+#if defined __GNUC__ && 4 < __GNUC__ + (3 <= __GNUC_MINOR__)
+# pragma GCC diagnostic ignored "-Wtype-limits"
+#endif
+
/* Return a value with the common real type of E and V and the value of V.
Do not evaluate E. */
#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v))
diff --git a/lib/limits.in.h b/lib/limits.in.h
index 236fc58e525..c65eb4c1cfe 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -130,7 +130,7 @@
# define BOOL_WIDTH 1
# define BOOL_MAX 1
# elif ! defined BOOL_MAX
-# define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1)
+# define BOOL_MAX 1
# endif
#endif
diff --git a/lib/malloc.c b/lib/malloc.c
index 7b954ae1129..2a7867a1d1f 100644
--- a/lib/malloc.c
+++ b/lib/malloc.c
@@ -1,7 +1,6 @@
/* malloc() function that is glibc compatible.
- Copyright (C) 1997-1998, 2006-2007, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1997-1998, 2006-2007, 2009-2024 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
diff --git a/lib/md5-stream.c b/lib/md5-stream.c
index ca82b067e42..c82f18145e0 100644
--- a/lib/md5-stream.c
+++ b/lib/md5-stream.c
@@ -1,7 +1,7 @@
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This file is free software: you can redistribute it and/or modify
diff --git a/lib/md5.c b/lib/md5.c
index 1818216a4b9..8e02f15d14d 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -1,7 +1,7 @@
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This file is free software: you can redistribute it and/or modify
diff --git a/lib/md5.h b/lib/md5.h
index 99f56ef0eec..2f470703f5c 100644
--- a/lib/md5.h
+++ b/lib/md5.h
@@ -1,7 +1,7 @@
/* Declaration of functions and data types used for MD5 sum computing
library functions.
- Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2024 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This file is free software: you can redistribute it and/or modify
@@ -32,7 +32,21 @@
# ifndef OPENSSL_API_COMPAT
# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */
# endif
-# include <openssl/md5.h>
+/* If <openssl/macros.h> would give a compile-time error, don't use OpenSSL. */
+# include <openssl/opensslv.h>
+# if OPENSSL_VERSION_MAJOR >= 3
+# include <openssl/configuration.h>
+# if (OPENSSL_CONFIGURED_API \
+ < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \
+ ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \
+ + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \
+ + ((OPENSSL_API_COMPAT >> 12) & 0xFF)))
+# undef HAVE_OPENSSL_MD5
+# endif
+# endif
+# if HAVE_OPENSSL_MD5
+# include <openssl/md5.h>
+# endif
# endif
#define MD5_DIGEST_SIZE 16
@@ -49,7 +63,11 @@
#ifndef __THROW
# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4)
-# define __THROW throw ()
+# if __cplusplus >= 201103L
+# define __THROW noexcept (true)
+# else
+# define __THROW throw ()
+# endif
# else
# define __THROW
# endif
diff --git a/lib/memmem.c b/lib/memmem.c
index 6fbc36e6654..e9b8c5392b6 100644
--- a/lib/memmem.c
+++ b/lib/memmem.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2024 Free
- Software Foundation, Inc.
+/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2024 Free Software
+ Foundation, Inc.
This file is part of the GNU C Library.
This file is free software: you can redistribute it and/or modify
diff --git a/lib/memrchr.c b/lib/memrchr.c
index 025869b6022..3df1f479c78 100644
--- a/lib/memrchr.c
+++ b/lib/memrchr.c
@@ -1,7 +1,7 @@
/* memrchr -- find the last occurrence of a byte in a memory block
- Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2024 Free Software
+ Foundation, Inc.
Based on strlen implementation by Torbjorn Granlund (tege@sics.se),
with help from Dan Sahlin (dan@sics.se) and
diff --git a/lib/nanosleep.c b/lib/nanosleep.c
index c998515ebaa..c6a76ec0eb4 100644
--- a/lib/nanosleep.c
+++ b/lib/nanosleep.c
@@ -1,7 +1,6 @@
/* Provide a replacement for the POSIX nanosleep function.
- Copyright (C) 1999-2000, 2002, 2004-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1999-2000, 2002, 2004-2024 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
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 69e4164dc0c..88490064297 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1991-2024 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
+/* Generate time strings.
+
+ Copyright (C) 2024 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
@@ -14,1497 +15,5 @@
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/>. */
-#ifdef _LIBC
-# define USE_IN_EXTENDED_LOCALE_MODEL 1
-# define HAVE_STRUCT_ERA_ENTRY 1
-# define HAVE_TM_GMTOFF 1
-# define HAVE_STRUCT_TM_TM_ZONE 1
-# define HAVE_TZNAME 1
-# include "../locale/localeinfo.h"
-#else
-# include <libc-config.h>
-# if FPRINTFTIME
-# include "fprintftime.h"
-# else
-# include "strftime.h"
-# endif
-# include "time-internal.h"
-#endif
-
-#include <ctype.h>
-#include <errno.h>
-#include <time.h>
-
-#if HAVE_TZNAME && !HAVE_DECL_TZNAME
-extern char *tzname[];
-#endif
-
-/* Do multibyte processing if multibyte encodings are supported, unless
- multibyte sequences are safe in formats. Multibyte sequences are
- safe if they cannot contain byte sequences that look like format
- conversion specifications. The multibyte encodings used by the
- C library on the various platforms (UTF-8, GB2312, GBK, CP936,
- GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949,
- SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%'
- cannot occur in a multibyte character except in the first byte.
-
- The DEC-HANYU encoding used on OSF/1 is not safe for formats, but
- this encoding has never been seen in real-life use, so we ignore
- it. */
-#if !(defined __osf__ && 0)
-# define MULTIBYTE_IS_FORMAT_SAFE 1
-#endif
-#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE)
-
-#if DO_MULTIBYTE
-# include <wchar.h>
- static const mbstate_t mbstate_zero;
-#endif
-
-#include <limits.h>
-#include <stdckdint.h>
-#include <stddef.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include "attribute.h"
-#include <intprops.h>
-
-#ifdef COMPILE_WIDE
-# include <endian.h>
-# define CHAR_T wchar_t
-# define UCHAR_T unsigned int
-# define L_(Str) L##Str
-# define NLW(Sym) _NL_W##Sym
-
-# define MEMCPY(d, s, n) __wmemcpy (d, s, n)
-# define STRLEN(s) __wcslen (s)
-
-#else
-# define CHAR_T char
-# define UCHAR_T unsigned char
-# define L_(Str) Str
-# define NLW(Sym) Sym
-# define ABALTMON_1 _NL_ABALTMON_1
-
-# define MEMCPY(d, s, n) memcpy (d, s, n)
-# define STRLEN(s) strlen (s)
-
-#endif
-
-/* Shift A right by B bits portably, by dividing A by 2**B and
- truncating towards minus infinity. A and B should be free of side
- effects, and B should be in the range 0 <= B <= INT_BITS - 2, where
- INT_BITS is the number of useful bits in an int. GNU code can
- assume that INT_BITS is at least 32.
-
- ISO C99 says that A >> B is implementation-defined if A < 0. Some
- implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift
- right in the usual way when A < 0, so SHR falls back on division if
- ordinary A >> B doesn't seem to be the usual signed shift. */
-#define SHR(a, b) \
- (-1 >> 1 == -1 \
- ? (a) >> (b) \
- : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0))
-
-#define TM_YEAR_BASE 1900
-
-#ifndef __isleap
-/* Nonzero if YEAR is a leap year (every 4 years,
- except every 100th isn't, and every 400th is). */
-# define __isleap(year) \
- ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0))
-#endif
-
-
-#ifdef _LIBC
-# define mktime_z(tz, tm) mktime (tm)
-# define tzname __tzname
-# define tzset __tzset
-#endif
-
-#ifndef FPRINTFTIME
-# define FPRINTFTIME 0
-#endif
-
-#if FPRINTFTIME
-# define STREAM_OR_CHAR_T FILE
-# define STRFTIME_ARG(x) /* empty */
-#else
-# define STREAM_OR_CHAR_T CHAR_T
-# define STRFTIME_ARG(x) x,
-#endif
-
-#if FPRINTFTIME
-# define memset_byte(P, Len, Byte) \
- do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0)
-# define memset_space(P, Len) memset_byte (P, Len, ' ')
-# define memset_zero(P, Len) memset_byte (P, Len, '0')
-#elif defined COMPILE_WIDE
-# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len))
-# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len))
-#else
-# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len))
-# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len))
-#endif
-
-#if FPRINTFTIME
-# define advance(P, N)
-#else
-# define advance(P, N) ((P) += (N))
-#endif
-
-#define add(n, f) width_add (width, n, f)
-#define width_add(width, n, f) \
- do \
- { \
- size_t _n = (n); \
- size_t _w = pad == L_('-') || width < 0 ? 0 : width; \
- size_t _incr = _n < _w ? _w : _n; \
- if (_incr >= maxsize - i) \
- { \
- errno = ERANGE; \
- return 0; \
- } \
- if (p) \
- { \
- if (_n < _w) \
- { \
- size_t _delta = _w - _n; \
- if (pad == L_('0') || pad == L_('+')) \
- memset_zero (p, _delta); \
- else \
- memset_space (p, _delta); \
- } \
- f; \
- advance (p, _n); \
- } \
- i += _incr; \
- } while (0)
-
-#define add1(c) width_add1 (width, c)
-#if FPRINTFTIME
-# define width_add1(width, c) width_add (width, 1, fputc (c, p))
-#else
-# define width_add1(width, c) width_add (width, 1, *p = c)
-#endif
-
-#define cpy(n, s) width_cpy (width, n, s)
-#if FPRINTFTIME
-# define width_cpy(width, n, s) \
- width_add (width, n, \
- do \
- { \
- if (to_lowcase) \
- fwrite_lowcase (p, (s), _n); \
- else if (to_uppcase) \
- fwrite_uppcase (p, (s), _n); \
- else \
- { \
- /* Ignore the value of fwrite. The caller can determine whether \
- an error occurred by inspecting ferror (P). All known fwrite \
- implementations set the stream's error indicator when they \
- fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \
- not require this. */ \
- fwrite (s, _n, 1, p); \
- } \
- } \
- while (0) \
- )
-#else
-# define width_cpy(width, n, s) \
- width_add (width, n, \
- if (to_lowcase) \
- memcpy_lowcase (p, (s), _n LOCALE_ARG); \
- else if (to_uppcase) \
- memcpy_uppcase (p, (s), _n LOCALE_ARG); \
- else \
- MEMCPY ((void *) p, (void const *) (s), _n))
-#endif
-
-#ifdef COMPILE_WIDE
-# ifndef USE_IN_EXTENDED_LOCALE_MODEL
-# undef __mbsrtowcs_l
-# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st)
-# endif
-#endif
-
-
-#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
-/* We use this code also for the extended locale handling where the
- function gets as an additional argument the locale which has to be
- used. To access the values we have to redefine the _NL_CURRENT
- macro. */
-# define strftime __strftime_l
-# define wcsftime __wcsftime_l
-# undef _NL_CURRENT
-# define _NL_CURRENT(category, item) \
- (current->values[_NL_ITEM_INDEX (item)].string)
-# define LOCALE_PARAM , locale_t loc
-# define LOCALE_ARG , loc
-# define HELPER_LOCALE_ARG , current
-#else
-# define LOCALE_PARAM
-# define LOCALE_ARG
-# ifdef _LIBC
-# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME)
-# else
-# define HELPER_LOCALE_ARG
-# endif
-#endif
-
-#ifdef COMPILE_WIDE
-# ifdef USE_IN_EXTENDED_LOCALE_MODEL
-# define TOUPPER(Ch, L) __towupper_l (Ch, L)
-# define TOLOWER(Ch, L) __towlower_l (Ch, L)
-# else
-# define TOUPPER(Ch, L) towupper (Ch)
-# define TOLOWER(Ch, L) towlower (Ch)
-# endif
-#else
-# ifdef USE_IN_EXTENDED_LOCALE_MODEL
-# define TOUPPER(Ch, L) __toupper_l (Ch, L)
-# define TOLOWER(Ch, L) __tolower_l (Ch, L)
-# else
-# define TOUPPER(Ch, L) toupper (Ch)
-# define TOLOWER(Ch, L) tolower (Ch)
-# endif
-#endif
-/* We don't use 'isdigit' here since the locale dependent
- interpretation is not what we want here. We only need to accept
- the arabic digits in the ASCII range. One day there is perhaps a
- more reliable way to accept other sets of digits. */
-#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9)
-
-/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds
- maximum object size 9223372036854775807", caused by insufficient data flow
- analysis and value propagation of the 'width_add' expansion when GCC is not
- optimizing. Cf. <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88443>. */
-#if __GNUC__ >= 7 && !__OPTIMIZE__
-# pragma GCC diagnostic ignored "-Wstringop-overflow"
-#endif
-
-#if FPRINTFTIME
-static void
-fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len)
-{
- while (len-- > 0)
- {
- fputc (TOLOWER ((UCHAR_T) *src, loc), fp);
- ++src;
- }
-}
-
-static void
-fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len)
-{
- while (len-- > 0)
- {
- fputc (TOUPPER ((UCHAR_T) *src, loc), fp);
- ++src;
- }
-}
-#else
-static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src,
- size_t len LOCALE_PARAM);
-
-static CHAR_T *
-memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
-{
- while (len-- > 0)
- dest[len] = TOLOWER ((UCHAR_T) src[len], loc);
- return dest;
-}
-
-static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src,
- size_t len LOCALE_PARAM);
-
-static CHAR_T *
-memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
-{
- while (len-- > 0)
- dest[len] = TOUPPER ((UCHAR_T) src[len], loc);
- return dest;
-}
-#endif
-
-
-#if ! HAVE_TM_GMTOFF
-/* Yield the difference between *A and *B,
- measured in seconds, ignoring leap seconds. */
-# define tm_diff ftime_tm_diff
-static int tm_diff (const struct tm *, const struct tm *);
-static int
-tm_diff (const struct tm *a, const struct tm *b)
-{
- /* Compute intervening leap days correctly even if year is negative.
- Take care to avoid int overflow in leap day calculations,
- but it's OK to assume that A and B are close to each other. */
- int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3);
- int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3);
- int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0);
- int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0);
- int a400 = SHR (a100, 2);
- int b400 = SHR (b100, 2);
- int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
- int years = a->tm_year - b->tm_year;
- int days = (365 * years + intervening_leap_days
- + (a->tm_yday - b->tm_yday));
- return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
- + (a->tm_min - b->tm_min))
- + (a->tm_sec - b->tm_sec));
-}
-#endif /* ! HAVE_TM_GMTOFF */
-
-
-
-/* The number of days from the first day of the first ISO week of this
- year to the year day YDAY with week day WDAY. ISO weeks start on
- Monday; the first ISO week has the year's first Thursday. YDAY may
- be as small as YDAY_MINIMUM. */
-#define ISO_WEEK_START_WDAY 1 /* Monday */
-#define ISO_WEEK1_WDAY 4 /* Thursday */
-#define YDAY_MINIMUM (-366)
-static int iso_week_days (int, int);
-static __inline int
-iso_week_days (int yday, int wday)
-{
- /* Add enough to the first operand of % to make it nonnegative. */
- int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7;
- return (yday
- - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7
- + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY);
-}
-
-
-/* When compiling this file, GNU applications can #define my_strftime
- to a symbol (typically nstrftime) to get an extended strftime with
- extra arguments TZ and NS. */
-
-#if FPRINTFTIME
-# undef my_strftime
-# define my_strftime fprintftime
-#endif
-
-#ifdef my_strftime
-# define extra_args , tz, ns
-# define extra_args_spec , timezone_t tz, int ns
-#else
-# if defined COMPILE_WIDE
-# define my_strftime wcsftime
-# define nl_get_alt_digit _nl_get_walt_digit
-# else
-# define my_strftime strftime
-# define nl_get_alt_digit _nl_get_alt_digit
-# endif
-# define extra_args
-# define extra_args_spec
-/* We don't have this information in general. */
-# define tz 1
-# define ns 0
-#endif
-
-static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t)
- const CHAR_T *, const struct tm *,
- bool, int, int, bool *
- extra_args_spec LOCALE_PARAM);
-
-/* Write information from TP into S according to the format
- string FORMAT, writing no more that MAXSIZE characters
- (including the terminating '\0') and returning number of
- characters written. If S is NULL, nothing will be written
- anywhere, so to determine how many characters would be
- written, use NULL for S and (size_t) -1 for MAXSIZE. */
-size_t
-my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
- const CHAR_T *format,
- const struct tm *tp extra_args_spec LOCALE_PARAM)
-{
- bool tzset_called = false;
- return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false,
- 0, -1, &tzset_called extra_args LOCALE_ARG);
-}
-libc_hidden_def (my_strftime)
-
-/* Just like my_strftime, above, but with more parameters.
- UPCASE indicates that the result should be converted to upper case.
- YR_SPEC and WIDTH specify the padding and width for the year.
- *TZSET_CALLED indicates whether tzset has been called here. */
-static size_t
-__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
- const CHAR_T *format,
- const struct tm *tp, bool upcase,
- int yr_spec, int width, bool *tzset_called
- extra_args_spec LOCALE_PARAM)
-{
-#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
- struct __locale_data *const current = loc->__locales[LC_TIME];
-#endif
-#if FPRINTFTIME
- size_t maxsize = (size_t) -1;
-#endif
-
- int saved_errno = errno;
- int hour12 = tp->tm_hour;
-#ifdef _NL_CURRENT
- /* We cannot make the following values variables since we must delay
- the evaluation of these values until really needed since some
- expressions might not be valid in every situation. The 'struct tm'
- might be generated by a strptime() call that initialized
- only a few elements. Dereference the pointers only if the format
- requires this. Then it is ok to fail if the pointers are invalid. */
-# define a_wkday \
- ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday)))
-# define f_wkday \
- ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday)))
-# define a_month \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon)))
-# define f_month \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon)))
-# define a_altmonth \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon)))
-# define f_altmonth \
- ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
- ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon)))
-# define ampm \
- ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \
- ? NLW(PM_STR) : NLW(AM_STR)))
-
-# define aw_len STRLEN (a_wkday)
-# define am_len STRLEN (a_month)
-# define aam_len STRLEN (a_altmonth)
-# define ap_len STRLEN (ampm)
-#endif
-#if HAVE_TZNAME
- char **tzname_vec = tzname;
-#endif
- const char *zone;
- size_t i = 0;
- STREAM_OR_CHAR_T *p = s;
- const CHAR_T *f;
-#if DO_MULTIBYTE && !defined COMPILE_WIDE
- const char *format_end = NULL;
-#endif
-
- zone = NULL;
-#if HAVE_STRUCT_TM_TM_ZONE
- /* The POSIX test suite assumes that setting
- the environment variable TZ to a new value before calling strftime()
- will influence the result (the %Z format) even if the information in
- TP is computed with a totally different time zone.
- This is bogus: though POSIX allows bad behavior like this,
- POSIX does not require it. Do the right thing instead. */
- zone = (const char *) tp->tm_zone;
-#endif
-#if HAVE_TZNAME
- if (!tz)
- {
- if (! (zone && *zone))
- zone = "GMT";
- }
- else
- {
-# if !HAVE_STRUCT_TM_TM_ZONE
- /* Infer the zone name from *TZ instead of from TZNAME. */
- tzname_vec = tz->tzname_copy;
-# endif
- }
- /* The tzset() call might have changed the value. */
- if (!(zone && *zone) && tp->tm_isdst >= 0)
- {
- /* POSIX.1 requires that local time zone information be used as
- though strftime called tzset. */
-# ifndef my_strftime
- if (!*tzset_called)
- {
- tzset ();
- *tzset_called = true;
- }
-# endif
- zone = tzname_vec[tp->tm_isdst != 0];
- }
-#endif
- if (! zone)
- zone = "";
-
- if (hour12 > 12)
- hour12 -= 12;
- else
- if (hour12 == 0)
- hour12 = 12;
-
- for (f = format; *f != '\0'; width = -1, f++)
- {
- int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */
- int modifier; /* Field modifier ('E', 'O', or 0). */
- int digits = 0; /* Max digits for numeric format. */
- int number_value; /* Numeric value to be printed. */
- unsigned int u_number_value; /* (unsigned int) number_value. */
- bool negative_number; /* The number is negative. */
- bool always_output_a_sign; /* +/- should always be output. */
- int tz_colon_mask; /* Bitmask of where ':' should appear. */
- const CHAR_T *subfmt;
- CHAR_T *bufp;
- CHAR_T buf[1
- + 2 /* for the two colons in a %::z or %:::z time zone */
- + (sizeof (int) < sizeof (time_t)
- ? INT_STRLEN_BOUND (time_t)
- : INT_STRLEN_BOUND (int))];
- bool to_lowcase = false;
- bool to_uppcase = upcase;
- size_t colons;
- bool change_case = false;
- int format_char;
- int subwidth;
-
-#if DO_MULTIBYTE && !defined COMPILE_WIDE
- switch (*f)
- {
- case L_('%'):
- break;
-
- case L_('\b'): case L_('\t'): case L_('\n'):
- case L_('\v'): case L_('\f'): case L_('\r'):
- case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'):
- case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'):
- case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'):
- case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'):
- case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'):
- case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'):
- case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'):
- case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'):
- case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'):
- case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'):
- case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'):
- case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'):
- case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'):
- case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'):
- case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'):
- case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'):
- case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'):
- case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'):
- case L_('~'):
- /* The C Standard requires these 98 characters (plus '%') to
- be in the basic execution character set. None of these
- characters can start a multibyte sequence, so they need
- not be analyzed further. */
- add1 (*f);
- continue;
-
- default:
- /* Copy this multibyte sequence until we reach its end, find
- an error, or come back to the initial shift state. */
- {
- mbstate_t mbstate = mbstate_zero;
- size_t len = 0;
- size_t fsize;
-
- if (! format_end)
- format_end = f + strlen (f) + 1;
- fsize = format_end - f;
-
- do
- {
- size_t bytes = mbrlen (f + len, fsize - len, &mbstate);
-
- if (bytes == 0)
- break;
-
- if (bytes == (size_t) -2)
- {
- len += strlen (f + len);
- break;
- }
-
- if (bytes == (size_t) -1)
- {
- len++;
- break;
- }
-
- len += bytes;
- }
- while (! mbsinit (&mbstate));
-
- cpy (len, f);
- f += len - 1;
- continue;
- }
- }
-
-#else /* ! DO_MULTIBYTE */
-
- /* Either multibyte encodings are not supported, they are
- safe for formats, so any non-'%' byte can be copied through,
- or this is the wide character version. */
- if (*f != L_('%'))
- {
- add1 (*f);
- continue;
- }
-
-#endif /* ! DO_MULTIBYTE */
-
- char const *percent = f;
-
- /* Check for flags that can modify a format. */
- while (1)
- {
- switch (*++f)
- {
- /* This influences the number formats. */
- case L_('_'):
- case L_('-'):
- case L_('+'):
- case L_('0'):
- pad = *f;
- continue;
-
- /* This changes textual output. */
- case L_('^'):
- to_uppcase = true;
- continue;
- case L_('#'):
- change_case = true;
- continue;
-
- default:
- break;
- }
- break;
- }
-
- if (ISDIGIT (*f))
- {
- width = 0;
- do
- {
- if (ckd_mul (&width, width, 10)
- || ckd_add (&width, width, *f - L_('0')))
- width = INT_MAX;
- ++f;
- }
- while (ISDIGIT (*f));
- }
-
- /* Check for modifiers. */
- switch (*f)
- {
- case L_('E'):
- case L_('O'):
- modifier = *f++;
- break;
-
- default:
- modifier = 0;
- break;
- }
-
- /* Now do the specified format. */
- format_char = *f;
- switch (format_char)
- {
-#define DO_NUMBER(d, v) \
- do \
- { \
- digits = d; \
- number_value = v; \
- goto do_number; \
- } \
- while (0)
-#define DO_SIGNED_NUMBER(d, negative, v) \
- DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number)
-#define DO_YEARISH(d, negative, v) \
- DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish)
-#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \
- do \
- { \
- digits = d; \
- negative_number = negative; \
- u_number_value = v; \
- goto label; \
- } \
- while (0)
-
- /* The mask is not what you might think.
- When the ordinal i'th bit is set, insert a colon
- before the i'th digit of the time zone representation. */
-#define DO_TZ_OFFSET(d, mask, v) \
- do \
- { \
- digits = d; \
- tz_colon_mask = mask; \
- u_number_value = v; \
- goto do_tz_offset; \
- } \
- while (0)
-#define DO_NUMBER_SPACEPAD(d, v) \
- do \
- { \
- digits = d; \
- number_value = v; \
- goto do_number_spacepad; \
- } \
- while (0)
-
- case L_('%'):
- if (f - 1 != percent)
- goto bad_percent;
- add1 (*f);
- break;
-
- case L_('a'):
- if (modifier != 0)
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- cpy (aw_len, a_wkday);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case 'A':
- if (modifier != 0)
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- cpy (STRLEN (f_wkday), f_wkday);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('b'):
- case L_('h'):
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
- if (modifier == L_('E'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (modifier == L_('O'))
- cpy (aam_len, a_altmonth);
- else
- cpy (am_len, a_month);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('B'):
- if (modifier == L_('E'))
- goto bad_format;
- if (change_case)
- {
- to_uppcase = true;
- to_lowcase = false;
- }
-#ifdef _NL_CURRENT
- if (modifier == L_('O'))
- cpy (STRLEN (f_altmonth), f_altmonth);
- else
- cpy (STRLEN (f_month), f_month);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('c'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME,
- NLW(ERA_D_T_FMT)))
- != '\0')))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT));
-#else
- goto underlying_strftime;
-#endif
-
- subformat:
- subwidth = -1;
- subformat_width:
- {
- size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1)
- subfmt, tp, to_uppcase,
- pad, subwidth, tzset_called
- extra_args LOCALE_ARG);
- add (len, __strftime_internal (p,
- STRFTIME_ARG (maxsize - i)
- subfmt, tp, to_uppcase,
- pad, subwidth, tzset_called
- extra_args LOCALE_ARG));
- }
- break;
-
-#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY)
- underlying_strftime:
- {
- /* The relevant information is available only via the
- underlying strftime implementation, so use that. */
- char ufmt[5];
- char *u = ufmt;
- char ubuf[1024]; /* enough for any single format in practice */
- size_t len;
- /* Make sure we're calling the actual underlying strftime.
- In some cases, config.h contains something like
- "#define strftime rpl_strftime". */
-# ifdef strftime
-# undef strftime
- size_t strftime ();
-# endif
-
- /* The space helps distinguish strftime failure from empty
- output. */
- *u++ = ' ';
- *u++ = '%';
- if (modifier != 0)
- *u++ = modifier;
- *u++ = format_char;
- *u = '\0';
- len = strftime (ubuf, sizeof ubuf, ufmt, tp);
- if (len != 0)
- cpy (len - 1, ubuf + 1);
- }
- break;
-#endif
-
- case L_('C'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
-# ifdef COMPILE_WIDE
- size_t len = __wcslen (era->era_wname);
- cpy (len, era->era_wname);
-# else
- size_t len = strlen (era->era_name);
- cpy (len, era->era_name);
-# endif
- break;
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- {
- bool negative_year = tp->tm_year < - TM_YEAR_BASE;
- bool zero_thru_1899 = !negative_year & (tp->tm_year < 0);
- int century = ((tp->tm_year - 99 * zero_thru_1899) / 100
- + TM_YEAR_BASE / 100);
- DO_YEARISH (2, negative_year, century);
- }
-
- case L_('x'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT)))
- != L_('\0'))))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT));
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
- case L_('D'):
- if (modifier != 0)
- goto bad_format;
- subfmt = L_("%m/%d/%y");
- goto subformat;
-
- case L_('d'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_mday);
-
- case L_('e'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, tp->tm_mday);
-
- /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE)
- and then jump to one of these labels. */
-
- do_tz_offset:
- always_output_a_sign = true;
- goto do_number_body;
-
- do_yearish:
- if (pad == 0)
- pad = yr_spec;
- always_output_a_sign
- = (pad == L_('+')
- && ((digits == 2 ? 99 : 9999) < u_number_value
- || digits < width));
- goto do_maybe_signed_number;
-
- do_number_spacepad:
- if (pad == 0)
- pad = L_('_');
-
- do_number:
- /* Format NUMBER_VALUE according to the MODIFIER flag. */
- negative_number = number_value < 0;
- u_number_value = number_value;
-
- do_signed_number:
- always_output_a_sign = false;
-
- do_maybe_signed_number:
- tz_colon_mask = 0;
-
- do_number_body:
- /* Format U_NUMBER_VALUE according to the MODIFIER flag.
- NEGATIVE_NUMBER is nonzero if the original number was
- negative; in this case it was converted directly to
- unsigned int (i.e., modulo (UINT_MAX + 1)) without
- negating it. */
- if (modifier == L_('O') && !negative_number)
- {
-#ifdef _NL_CURRENT
- /* Get the locale specific alternate representation of
- the number. If none exist NULL is returned. */
- const CHAR_T *cp = nl_get_alt_digit (u_number_value
- HELPER_LOCALE_ARG);
-
- if (cp != NULL)
- {
- size_t digitlen = STRLEN (cp);
- if (digitlen != 0)
- {
- cpy (digitlen, cp);
- break;
- }
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- bufp = buf + sizeof (buf) / sizeof (buf[0]);
-
- if (negative_number)
- u_number_value = - u_number_value;
-
- do
- {
- if (tz_colon_mask & 1)
- *--bufp = ':';
- tz_colon_mask >>= 1;
- *--bufp = u_number_value % 10 + L_('0');
- u_number_value /= 10;
- }
- while (u_number_value != 0 || tz_colon_mask != 0);
-
- do_number_sign_and_padding:
- if (pad == 0)
- pad = L_('0');
- if (width < 0)
- width = digits;
-
- {
- CHAR_T sign_char = (negative_number ? L_('-')
- : always_output_a_sign ? L_('+')
- : 0);
- int numlen = buf + sizeof buf / sizeof buf[0] - bufp;
- int shortage = width - !!sign_char - numlen;
- int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage;
-
- if (sign_char)
- {
- if (pad == L_('_'))
- {
- if (p)
- memset_space (p, padding);
- i += padding;
- width -= padding;
- }
- width_add1 (0, sign_char);
- width--;
- }
-
- cpy (numlen, bufp);
- }
- break;
-
- case L_('F'):
- if (modifier != 0)
- goto bad_format;
- if (pad == 0 && width < 0)
- {
- pad = L_('+');
- subwidth = 4;
- }
- else
- {
- subwidth = width - 6;
- if (subwidth < 0)
- subwidth = 0;
- }
- subfmt = L_("%Y-%m-%d");
- goto subformat_width;
-
- case L_('H'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_hour);
-
- case L_('I'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, hour12);
-
- case L_('k'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, tp->tm_hour);
-
- case L_('l'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER_SPACEPAD (2, hour12);
-
- case L_('j'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U);
-
- case L_('M'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_min);
-
- case L_('m'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U);
-
-#ifndef _LIBC
- case L_('N'): /* GNU extension. */
- if (modifier == L_('E'))
- goto bad_format;
- {
- int n = ns, ns_digits = 9;
- if (width <= 0)
- width = ns_digits;
- int ndigs = ns_digits;
- while (width < ndigs || (1 < ndigs && n % 10 == 0))
- ndigs--, n /= 10;
- for (int j = ndigs; 0 < j; j--)
- buf[j - 1] = n % 10 + L_('0'), n /= 10;
- if (!pad)
- pad = L_('0');
- width_cpy (0, ndigs, buf);
- width_add (width - ndigs, 0, (void) 0);
- }
- break;
-#endif
-
- case L_('n'):
- add1 (L_('\n'));
- break;
-
- case L_('P'):
- to_lowcase = true;
-#ifndef _NL_CURRENT
- format_char = L_('p');
-#endif
- FALLTHROUGH;
- case L_('p'):
- if (change_case)
- {
- to_uppcase = false;
- to_lowcase = true;
- }
-#ifdef _NL_CURRENT
- cpy (ap_len, ampm);
- break;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('q'): /* GNU extension. */
- DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1);
-
- case L_('R'):
- subfmt = L_("%H:%M");
- goto subformat;
-
- case L_('r'):
-#ifdef _NL_CURRENT
- if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME,
- NLW(T_FMT_AMPM)))
- == L_('\0'))
- subfmt = L_("%I:%M:%S %p");
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
-
- case L_('S'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, tp->tm_sec);
-
- case L_('s'): /* GNU extension. */
- {
- struct tm ltm;
- time_t t;
-
- ltm = *tp;
- ltm.tm_yday = -1;
- t = mktime_z (tz, &ltm);
- if (ltm.tm_yday < 0)
- {
- errno = EOVERFLOW;
- return 0;
- }
-
- /* Generate string value for T using time_t arithmetic;
- this works even if sizeof (long) < sizeof (time_t). */
-
- bufp = buf + sizeof (buf) / sizeof (buf[0]);
- negative_number = t < 0;
-
- do
- {
- int d = t % 10;
- t /= 10;
- *--bufp = (negative_number ? -d : d) + L_('0');
- }
- while (t != 0);
-
- digits = 1;
- always_output_a_sign = false;
- goto do_number_sign_and_padding;
- }
-
- case L_('X'):
- if (modifier == L_('O'))
- goto bad_format;
-#ifdef _NL_CURRENT
- if (! (modifier == L_('E')
- && (*(subfmt =
- (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT)))
- != L_('\0'))))
- subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT));
- goto subformat;
-#else
- goto underlying_strftime;
-#endif
- case L_('T'):
- subfmt = L_("%H:%M:%S");
- goto subformat;
-
- case L_('t'):
- add1 (L_('\t'));
- break;
-
- case L_('u'):
- DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1);
-
- case L_('U'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7);
-
- case L_('V'):
- case L_('g'):
- case L_('G'):
- if (modifier == L_('E'))
- goto bad_format;
- {
- /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE)
- is a leap year, except that YEAR and YEAR - 1 both work
- correctly even when (tp->tm_year + TM_YEAR_BASE) would
- overflow. */
- int year = (tp->tm_year
- + (tp->tm_year < 0
- ? TM_YEAR_BASE % 400
- : TM_YEAR_BASE % 400 - 400));
- int year_adjust = 0;
- int days = iso_week_days (tp->tm_yday, tp->tm_wday);
-
- if (days < 0)
- {
- /* This ISO week belongs to the previous year. */
- year_adjust = -1;
- days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)),
- tp->tm_wday);
- }
- else
- {
- int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)),
- tp->tm_wday);
- if (0 <= d)
- {
- /* This ISO week belongs to the next year. */
- year_adjust = 1;
- days = d;
- }
- }
-
- switch (*f)
- {
- case L_('g'):
- {
- int yy = (tp->tm_year % 100 + year_adjust) % 100;
- DO_YEARISH (2, false,
- (0 <= yy
- ? yy
- : tp->tm_year < -TM_YEAR_BASE - year_adjust
- ? -yy
- : yy + 100));
- }
-
- case L_('G'):
- DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust,
- (tp->tm_year + (unsigned int) TM_YEAR_BASE
- + year_adjust));
-
- default:
- DO_NUMBER (2, days / 7 + 1);
- }
- }
-
- case L_('W'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7);
-
- case L_('w'):
- if (modifier == L_('E'))
- goto bad_format;
-
- DO_NUMBER (1, tp->tm_wday);
-
- case L_('Y'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
-# ifdef COMPILE_WIDE
- subfmt = era->era_wformat;
-# else
- subfmt = era->era_format;
-# endif
- if (pad == 0)
- pad = yr_spec;
- goto subformat;
- }
-#else
- goto underlying_strftime;
-#endif
- }
- if (modifier == L_('O'))
- goto bad_format;
-
- DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE,
- tp->tm_year + (unsigned int) TM_YEAR_BASE);
-
- case L_('y'):
- if (modifier == L_('E'))
- {
-#if HAVE_STRUCT_ERA_ENTRY
- struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
- if (era)
- {
- int delta = tp->tm_year - era->start_date[0];
- if (pad == 0)
- pad = yr_spec;
- DO_NUMBER (2, (era->offset
- + delta * era->absolute_direction));
- }
-#else
- goto underlying_strftime;
-#endif
- }
-
- {
- int yy = tp->tm_year % 100;
- if (yy < 0)
- yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100;
- DO_YEARISH (2, false, yy);
- }
-
- case L_('Z'):
- if (change_case)
- {
- to_uppcase = false;
- to_lowcase = true;
- }
-
-#ifdef COMPILE_WIDE
- {
- /* The zone string is always given in multibyte form. We have
- to convert it to wide character. */
- size_t w = pad == L_('-') || width < 0 ? 0 : width;
- char const *z = zone;
- mbstate_t st = {0};
- size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc);
- if (len == (size_t) -1)
- return 0;
- size_t incr = len < w ? w : len;
- if (incr >= maxsize - i)
- {
- errno = ERANGE;
- return 0;
- }
- if (p)
- {
- if (len < w)
- {
- size_t delta = w - len;
- __wmemmove (p + delta, p, len);
- wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' ';
- wmemset (p, wc, delta);
- }
- p += incr;
- }
- i += incr;
- }
-#else
- cpy (strlen (zone), zone);
-#endif
- break;
-
- case L_(':'):
- /* :, ::, and ::: are valid only just before 'z'.
- :::: etc. are rejected later. */
- for (colons = 1; f[colons] == L_(':'); colons++)
- continue;
- if (f[colons] != L_('z'))
- goto bad_format;
- f += colons;
- goto do_z_conversion;
-
- case L_('z'):
- colons = 0;
-
- do_z_conversion:
- if (tp->tm_isdst < 0)
- break;
-
- {
- int diff;
- int hour_diff;
- int min_diff;
- int sec_diff;
-#if HAVE_TM_GMTOFF
- diff = tp->tm_gmtoff;
-#else
- if (!tz)
- diff = 0;
- else
- {
- struct tm gtm;
- struct tm ltm;
- time_t lt;
-
- /* POSIX.1 requires that local time zone information be used as
- though strftime called tzset. */
-# ifndef my_strftime
- if (!*tzset_called)
- {
- tzset ();
- *tzset_called = true;
- }
-# endif
-
- ltm = *tp;
- ltm.tm_wday = -1;
- lt = mktime_z (tz, &ltm);
- if (ltm.tm_wday < 0 || ! localtime_rz (0, &lt, &gtm))
- break;
- diff = tm_diff (&ltm, &gtm);
- }
-#endif
-
- negative_number = diff < 0 || (diff == 0 && *zone == '-');
- hour_diff = diff / 60 / 60;
- min_diff = diff / 60 % 60;
- sec_diff = diff % 60;
-
- switch (colons)
- {
- case 0: /* +hhmm */
- DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff);
-
- case 1: tz_hh_mm: /* +hh:mm */
- DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff);
-
- case 2: tz_hh_mm_ss: /* +hh:mm:ss */
- DO_TZ_OFFSET (9, 024,
- hour_diff * 10000 + min_diff * 100 + sec_diff);
-
- case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */
- if (sec_diff != 0)
- goto tz_hh_mm_ss;
- if (min_diff != 0)
- goto tz_hh_mm;
- DO_TZ_OFFSET (3, 0, hour_diff);
-
- default:
- goto bad_format;
- }
- }
-
- case L_('\0'): /* GNU extension: % at end of format. */
- bad_percent:
- --f;
- FALLTHROUGH;
- default:
- /* Unknown format; output the format, including the '%',
- since this is most likely the right thing to do if a
- multibyte string has been misparsed. */
- bad_format:
- cpy (f - percent + 1, percent);
- break;
- }
- }
-
-#if ! FPRINTFTIME
- if (p && maxsize != 0)
- *p = L_('\0');
-#endif
-
- errno = saved_errno;
- return i;
-}
+#define my_strftime nstrftime
+#include "strftime.c"
diff --git a/lib/open.c b/lib/open.c
index adcac458a78..e690c9ea779 100644
--- a/lib/open.c
+++ b/lib/open.c
@@ -38,9 +38,13 @@ orig_open (const char *filename, int flags, mode_t mode)
}
/* Specification. */
+#ifdef __osf__
/* Write "fcntl.h" here, not <fcntl.h>, otherwise OSF/1 5.1 DTK cc eliminates
this include because of the preliminary #include <fcntl.h> above. */
-#include "fcntl.h"
+# include "fcntl.h"
+#else
+# include <fcntl.h>
+#endif
#include "cloexec.h"
diff --git a/lib/rawmemchr.c b/lib/rawmemchr.c
index 37639287f01..013e7f8cced 100644
--- a/lib/rawmemchr.c
+++ b/lib/rawmemchr.c
@@ -19,7 +19,7 @@
/* Specification. */
#include <string.h>
-/* A function definition is only needed if HAVE_RAWMEMCHR is not defined. */
+/* A function definition is needed only if HAVE_RAWMEMCHR is not defined. */
#if !HAVE_RAWMEMCHR
# include <limits.h>
@@ -30,19 +30,30 @@
void *
rawmemchr (const void *s, int c_in)
{
- /* Change this typedef to experiment with performance. */
+# ifdef __CHERI_PURE_CAPABILITY__
+ /* Most architectures let you read an aligned word,
+ even if the unsigned char array at S ends in the middle of the word.
+ However CHERI does not, so call memchr
+ with the underlying object's remaining length.
+ This cannot return NULL if S points to a C_IN-terminated array.
+ Use builtins rather than including <cheri.h> which is less stable. */
+ return memchr (s, c_in, (__builtin_cheri_length_get (s)
+ - __builtin_cheri_offset_get (s)));
+# else
+
+ /* You can change this typedef to experiment with performance. */
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. */
- static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword));
+ /* Verify that the longword type lacks padding bits. */
+ static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (uintptr_t));
const unsigned char *char_ptr;
unsigned char c = c_in;
/* Handle the first few bytes by reading one byte at a time.
- Do this until CHAR_PTR is aligned on a longword boundary. */
+ Do this until CHAR_PTR is aligned on a natural longword boundary,
+ as using alignof (longword) might be slower. */
for (char_ptr = (const unsigned char *) s;
- (uintptr_t) char_ptr % alignof (longword) != 0;
+ (uintptr_t) char_ptr % sizeof (longword) != 0;
++char_ptr)
if (*char_ptr == c)
return (void *) char_ptr;
@@ -118,6 +129,7 @@ rawmemchr (const void *s, int c_in)
while (*char_ptr != c)
char_ptr++;
return (void *) char_ptr;
+# endif
}
#endif
diff --git a/lib/readutmp.h b/lib/readutmp.h
index b62eb3beaa1..dcfd44dbbc9 100644
--- a/lib/readutmp.h
+++ b/lib/readutmp.h
@@ -114,21 +114,21 @@ enum { UT_HOST_SIZE = -1 };
Field Type Platforms
---------- ------ ---------
- āŽ” ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, IRIX, Solaris, Cygwin
+ āŽ” ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
āŽ£ ut_name char[] NetBSD, Minix
- ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
- ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
- ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
- ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
- āŽ” ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
+ ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
+ ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
+ ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
+ ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
+ āŽ” ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
āŽ¢ { tv_sec; tv_usec; }
āŽ£ ut_time time_t Cygwin
- ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin
- ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, IRIX, Solaris
+ ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android
+ ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, IRIX, Solaris, Android
{ e_termination; e_exit; }
- ut_session [long] int glibc, musl, NetBSD, Minix, IRIX, Solaris
+ ut_session [long] int glibc, musl, NetBSD, Minix, IRIX, Solaris, Android
āŽ” ut_addr [long] int HP-UX, Cygwin
- āŽ¢ ut_addr_v6 [u]int[4] glibc, musl
+ āŽ¢ ut_addr_v6 [u]int[4] glibc, musl, Android
āŽ£ ut_ss struct sockaddr_storage NetBSD, Minix
*/
@@ -177,6 +177,10 @@ struct utmpx32
# define UTMP_NAME_FUNCTION utmpxname
# elif defined UTXDB_ACTIVE /* FreeBSD */
# define UTMP_NAME_FUNCTION(x) setutxdb (UTXDB_ACTIVE, x)
+# elif defined __ANDROID__ /* Android */
+/* As of Android NDK r26, the getutxent, setutxent functions are no-ops.
+ Therefore we can ignore the file name. */
+# define UTMP_NAME_FUNCTION(x) ((void) (x))
# endif
#elif HAVE_UTMP_H
diff --git a/lib/regex.c b/lib/regex.c
index 08031cecc04..4b1a6ed68e3 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -26,10 +26,6 @@
# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
# pragma GCC diagnostic ignored "-Wvla"
# endif
-# if __GNUC_PREREQ (4, 3)
-# pragma GCC diagnostic ignored "-Wold-style-definition"
-# pragma GCC diagnostic ignored "-Wtype-limits"
-# endif
#endif
/* Make sure no one compiles this code with a C++ compiler. */
diff --git a/lib/save-cwd.h b/lib/save-cwd.h
index 79900ee0b08..692e4b97be2 100644
--- a/lib/save-cwd.h
+++ b/lib/save-cwd.h
@@ -1,7 +1,7 @@
/* Save and restore current working directory.
- Copyright (C) 1995, 1997-1998, 2003, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1995, 1997-1998, 2003, 2009-2024 Free Software Foundation,
+ Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/set-permissions.c b/lib/set-permissions.c
index a3d4cc839e5..83a355faa5c 100644
--- a/lib/set-permissions.c
+++ b/lib/set-permissions.c
@@ -22,6 +22,7 @@
#include "acl.h"
#include "acl-internal.h"
+#include "minmax.h"
#if USE_ACL
# if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
diff --git a/lib/sha1.c b/lib/sha1.c
index 454d68e266d..24fcd0b0139 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -1,8 +1,7 @@
/* sha1.c - Functions to compute SHA1 message digest of files or
memory blocks according to the NIST specification FIPS-180-1.
- Copyright (C) 2000-2001, 2003-2006, 2008-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 2000-2001, 2003-2006, 2008-2024 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
diff --git a/lib/sha1.h b/lib/sha1.h
index 15bfa043e3b..940163eb528 100644
--- a/lib/sha1.h
+++ b/lib/sha1.h
@@ -31,7 +31,21 @@
# ifndef OPENSSL_API_COMPAT
# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */
# endif
-# include <openssl/sha.h>
+/* If <openssl/macros.h> would give a compile-time error, don't use OpenSSL. */
+# include <openssl/opensslv.h>
+# if OPENSSL_VERSION_MAJOR >= 3
+# include <openssl/configuration.h>
+# if (OPENSSL_CONFIGURED_API \
+ < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \
+ ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \
+ + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \
+ + ((OPENSSL_API_COMPAT >> 12) & 0xFF)))
+# undef HAVE_OPENSSL_SHA1
+# endif
+# endif
+# if HAVE_OPENSSL_SHA1
+# include <openssl/sha.h>
+# endif
# endif
# ifdef __cplusplus
diff --git a/lib/sha256.h b/lib/sha256.h
index daf5edd2dd9..a9d7abb8a2c 100644
--- a/lib/sha256.h
+++ b/lib/sha256.h
@@ -30,7 +30,21 @@
# ifndef OPENSSL_API_COMPAT
# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */
# endif
-# include <openssl/sha.h>
+/* If <openssl/macros.h> would give a compile-time error, don't use OpenSSL. */
+# include <openssl/opensslv.h>
+# if OPENSSL_VERSION_MAJOR >= 3
+# include <openssl/configuration.h>
+# if (OPENSSL_CONFIGURED_API \
+ < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \
+ ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \
+ + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \
+ + ((OPENSSL_API_COMPAT >> 12) & 0xFF)))
+# undef HAVE_OPENSSL_SHA256
+# endif
+# endif
+# if HAVE_OPENSSL_SHA256
+# include <openssl/sha.h>
+# endif
# endif
# ifdef __cplusplus
diff --git a/lib/sha512.h b/lib/sha512.h
index 35fa3b52849..f6bac85488e 100644
--- a/lib/sha512.h
+++ b/lib/sha512.h
@@ -30,7 +30,21 @@
# ifndef OPENSSL_API_COMPAT
# define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */
# endif
-# include <openssl/sha.h>
+/* If <openssl/macros.h> would give a compile-time error, don't use OpenSSL. */
+# include <openssl/opensslv.h>
+# if OPENSSL_VERSION_MAJOR >= 3
+# include <openssl/configuration.h>
+# if (OPENSSL_CONFIGURED_API \
+ < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \
+ ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \
+ + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \
+ + ((OPENSSL_API_COMPAT >> 12) & 0xFF)))
+# undef HAVE_OPENSSL_SHA512
+# endif
+# endif
+# if HAVE_OPENSSL_SHA512
+# include <openssl/sha.h>
+# endif
# endif
# ifdef __cplusplus
diff --git a/lib/sig2str.c b/lib/sig2str.c
index ac20be041a4..c6b91e38498 100644
--- a/lib/sig2str.c
+++ b/lib/sig2str.c
@@ -1,7 +1,6 @@
/* sig2str.c -- convert between signal names and numbers
- Copyright (C) 2002, 2004, 2006, 2009-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 2002, 2004, 2006, 2009-2024 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/lib/stat-time.h b/lib/stat-time.h
index c43d578e144..3cd8478f310 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -52,11 +52,13 @@ extern "C" {
#if _GL_WINDOWS_STAT_TIMESPEC || defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
# if _GL_WINDOWS_STAT_TIMESPEC || defined TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim)
+# define STAT_TIMESPEC_OFFSETOF(st_xtim) offsetof (struct stat, st_xtim)
# else
# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec)
# endif
#elif defined HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim##espec)
+# define STAT_TIMESPEC_OFFSETOF(st_xtim) offsetof (struct stat, st_xtim##espec)
#elif defined HAVE_STRUCT_STAT_ST_ATIMENSEC
# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim##ensec)
#elif defined HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
@@ -194,20 +196,21 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st)
}
/* If a stat-like function returned RESULT, normalize the timestamps
- in *ST, in case this platform suffers from the Solaris 11 bug where
+ in *ST, if this platform suffers from a macOS and Solaris bug where
tv_nsec might be negative. Return the adjusted RESULT, setting
errno to EOVERFLOW if normalization overflowed. This function
is intended to be private to this .h file. */
_GL_STAT_TIME_INLINE int
stat_time_normalize (int result, _GL_UNUSED struct stat *st)
{
-#if defined __sun && defined STAT_TIMESPEC
+#if (((defined __APPLE__ && defined __MACH__) || defined __sun) \
+ && defined STAT_TIMESPEC_OFFSETOF)
if (result == 0)
{
long int timespec_hz = 1000000000;
- short int const ts_off[] = { offsetof (struct stat, st_atim),
- offsetof (struct stat, st_mtim),
- offsetof (struct stat, st_ctim) };
+ short int const ts_off[] = { STAT_TIMESPEC_OFFSETOF (st_atim),
+ STAT_TIMESPEC_OFFSETOF (st_mtim),
+ STAT_TIMESPEC_OFFSETOF (st_ctim) };
int i;
for (i = 0; i < sizeof ts_off / sizeof *ts_off; i++)
{
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 0f1d73ea49d..fa8998d9b72 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -58,7 +58,7 @@
/* On AIX 7.2, with xlc in 64-bit mode, <stddef.h> defines max_align_t to a
type with alignment 4, but 'long' has alignment 8. */
-# if defined _AIX && defined __LP64__
+# if defined _AIX && defined __LP64__ && !@HAVE_MAX_ALIGN_T@
# if !GNULIB_defined_max_align_t
# ifdef _MAX_ALIGN_T
/* /usr/include/stddef.h has already defined max_align_t. Override it. */
@@ -101,11 +101,33 @@ typedef long max_align_t;
# ifndef _@GUARD_PREFIX@_STDDEF_H
# define _@GUARD_PREFIX@_STDDEF_H
-/* This file uses _Noreturn. */
+/* This file uses _Noreturn, _GL_ATTRIBUTE_NOTHROW. */
#if !_GL_CONFIG_H_INCLUDED
#error "Please include config.h first."
#endif
+/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
+ */
+#ifndef _GL_ATTRIBUTE_NOTHROW
+# if defined __cplusplus
+# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# else
+# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# endif
+#endif
+
/* Some platforms lack wchar_t. */
#if !@HAVE_WCHAR_T@
# define wchar_t int
@@ -178,7 +200,7 @@ extern
_Noreturn
void abort (void)
# if defined __cplusplus && (__GLIBC__ >= 2)
-throw ()
+_GL_ATTRIBUTE_NOTHROW
# endif
;
# define unreachable() abort ()
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index 446f29ecb57..fea7483b9cc 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -306,6 +306,8 @@ typedef gl_uint_fast32_t gl_uint_fast16_t;
uintptr_t to avoid conflicting declarations of system functions like
_findclose in <io.h>. */
# if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \
+ || (defined __INTPTR_WIDTH__ \
+ && __INTPTR_WIDTH__ != (defined _WIN64 ? LLONG_WIDTH : LONG_WIDTH)) \
|| defined __MINGW32__)
# undef intptr_t
# undef uintptr_t
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 7fcb4c7b008..4947307e578 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -38,8 +38,14 @@
/* Suppress macOS deprecation warnings for sprintf and vsprintf. */
#if (defined __APPLE__ && defined __MACH__) && !defined _POSIX_C_SOURCE
-# define _POSIX_C_SOURCE 200809L
-# define _GL_DEFINED__POSIX_C_SOURCE
+# ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
+# include <AvailabilityMacros.h>
+# endif
+# if (defined MAC_OS_X_VERSION_MIN_REQUIRED \
+ && 130000 <= MAC_OS_X_VERSION_MIN_REQUIRED)
+# define _POSIX_C_SOURCE 200809L
+# define _GL_DEFINED__POSIX_C_SOURCE
+# endif
#endif
#define _GL_ALREADY_INCLUDING_STDIO_H
@@ -58,7 +64,8 @@
#define _@GUARD_PREFIX@_STDIO_H
/* This file uses _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_FORMAT,
- _GL_ATTRIBUTE_MALLOC, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */
+ _GL_ATTRIBUTE_MALLOC, _GL_ATTRIBUTE_NOTHROW, GNULIB_POSIXCHECK,
+ HAVE_RAW_DECL_*. */
#if !_GL_CONFIG_H_INCLUDED
#error "Please include config.h first."
#endif
@@ -143,6 +150,28 @@
# endif
#endif
+/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
+ */
+#ifndef _GL_ATTRIBUTE_NOTHROW
+# if defined __cplusplus
+# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# else
+# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# endif
+#endif
+
/* An __attribute__ __format__ specifier for a function that takes a format
string and arguments, where the format string directives are the ones
standardized by ISO C99 and POSIX.
@@ -344,10 +373,18 @@ _GL_CXXALIAS_MDA (fdopen, FILE *, (int fd, const char *mode));
# else
# if __GNUC__ >= 11
/* For -Wmismatched-dealloc: Associate fdopen with fclose or rpl_fclose. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
_GL_FUNCDECL_SYS (fdopen, FILE *,
(int fd, const char *mode)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1)
_GL_ATTRIBUTE_MALLOC);
+# else
+_GL_FUNCDECL_SYS (fdopen, FILE *,
+ (int fd, const char *mode)
+ _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1)
+ _GL_ATTRIBUTE_MALLOC);
+# endif
# endif
_GL_CXXALIAS_SYS (fdopen, FILE *, (int fd, const char *mode));
# endif
@@ -355,10 +392,18 @@ _GL_CXXALIASWARN (fdopen);
#else
# if @GNULIB_FCLOSE@ && __GNUC__ >= 11 && !defined fdopen
/* For -Wmismatched-dealloc: Associate fdopen with fclose or rpl_fclose. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
_GL_FUNCDECL_SYS (fdopen, FILE *,
(int fd, const char *mode)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1)
_GL_ATTRIBUTE_MALLOC);
+# else
+_GL_FUNCDECL_SYS (fdopen, FILE *,
+ (int fd, const char *mode)
+ _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1)
+ _GL_ATTRIBUTE_MALLOC);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef fdopen
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index ffa86eef0dc..b901d175aeb 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -1,7 +1,6 @@
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 1995, 2001-2004, 2006-2024 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
@@ -39,7 +38,8 @@
#define _@GUARD_PREFIX@_STDLIB_H
/* This file uses _Noreturn, _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_MALLOC,
- _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */
+ _GL_ATTRIBUTE_NOTHROW, _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK,
+ HAVE_RAW_DECL_*. */
#if !_GL_CONFIG_H_INCLUDED
#error "Please include config.h first."
#endif
@@ -133,6 +133,28 @@ struct random_data
# endif
#endif
+/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
+ */
+#ifndef _GL_ATTRIBUTE_NOTHROW
+# if defined __cplusplus
+# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# else
+# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# endif
+#endif
+
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
#ifndef _GL_ATTRIBUTE_PURE
@@ -201,7 +223,7 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - "
# define free rpl_free
# endif
# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2)
-_GL_FUNCDECL_RPL (free, void, (void *ptr) throw ());
+_GL_FUNCDECL_RPL (free, void, (void *ptr) _GL_ATTRIBUTE_NOTHROW);
# else
_GL_FUNCDECL_RPL (free, void, (void *ptr));
# endif
@@ -235,9 +257,16 @@ _GL_CXXALIAS_RPL (aligned_alloc, void *, (size_t alignment, size_t size));
# if @HAVE_ALIGNED_ALLOC@
# if __GNUC__ >= 11
/* For -Wmismatched-dealloc: Associate aligned_alloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 16) > 2
+_GL_FUNCDECL_SYS (aligned_alloc, void *,
+ (size_t alignment, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (aligned_alloc, void *,
(size_t alignment, size_t size)
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (aligned_alloc, void *, (size_t alignment, size_t size));
# endif
@@ -248,9 +277,16 @@ _GL_CXXALIASWARN (aligned_alloc);
#else
# if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined aligned_alloc
/* For -Wmismatched-dealloc: Associate aligned_alloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 16) > 2
+_GL_FUNCDECL_SYS (aligned_alloc, void *,
+ (size_t alignment, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (aligned_alloc, void *,
(size_t alignment, size_t size)
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef aligned_alloc
@@ -293,9 +329,16 @@ _GL_CXXALIAS_RPL (calloc, void *, (size_t nmemb, size_t size));
# else
# if __GNUC__ >= 11
/* For -Wmismatched-dealloc: Associate calloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
+_GL_FUNCDECL_SYS (calloc, void *,
+ (size_t nmemb, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (calloc, void *,
(size_t nmemb, size_t size)
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (calloc, void *, (size_t nmemb, size_t size));
# endif
@@ -305,9 +348,16 @@ _GL_CXXALIASWARN (calloc);
#else
# if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined calloc
/* For -Wmismatched-dealloc: Associate calloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
_GL_FUNCDECL_SYS (calloc, void *,
(size_t nmemb, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (calloc, void *,
+ (size_t nmemb, size_t size)
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef calloc
@@ -329,10 +379,18 @@ _GL_FUNCDECL_RPL (canonicalize_file_name, char *,
_GL_CXXALIAS_RPL (canonicalize_file_name, char *, (const char *name));
# else
# if !@HAVE_CANONICALIZE_FILE_NAME@ || __GNUC__ >= 11
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
+_GL_FUNCDECL_SYS (canonicalize_file_name, char *,
+ (const char *name)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (canonicalize_file_name, char *,
(const char *name)
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name));
# endif
@@ -345,10 +403,18 @@ _GL_CXXALIASWARN (canonicalize_file_name);
# if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined canonicalize_file_name
/* For -Wmismatched-dealloc: Associate canonicalize_file_name with free or
rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
_GL_FUNCDECL_SYS (canonicalize_file_name, char *,
(const char *name)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (canonicalize_file_name, char *,
+ (const char *name)
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef canonicalize_file_name
@@ -570,9 +636,16 @@ _GL_CXXALIAS_RPL (malloc, void *, (size_t size));
# else
# if __GNUC__ >= 11
/* For -Wmismatched-dealloc: Associate malloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
_GL_FUNCDECL_SYS (malloc, void *,
(size_t size)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (malloc, void *,
+ (size_t size)
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (malloc, void *, (size_t size));
# endif
@@ -582,9 +655,16 @@ _GL_CXXALIASWARN (malloc);
#else
# if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined malloc
/* For -Wmismatched-dealloc: Associate malloc with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
+_GL_FUNCDECL_SYS (malloc, void *,
+ (size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (malloc, void *,
(size_t size)
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK && !_GL_USE_STDLIB_ALLOC
# undef malloc
@@ -967,6 +1047,10 @@ _GL_CXXALIAS_RPL (putenv, int, (char *string));
# define putenv _putenv
# endif
_GL_CXXALIAS_MDA (putenv, int, (char *string));
+# elif defined __KLIBC__
+/* Need to cast, because on OS/2 kLIBC, the first parameter is
+ const char *string. */
+_GL_CXXALIAS_SYS_CAST (putenv, int, (char *string));
# else
_GL_CXXALIAS_SYS (putenv, int, (char *string));
# endif
@@ -983,6 +1067,10 @@ _GL_CXXALIASWARN (putenv);
/* Need to cast, because on mingw, the parameter is either
'const char *string' or 'char *string'. */
_GL_CXXALIAS_MDA_CAST (putenv, int, (char *string));
+# elif defined __KLIBC__
+/* Need to cast, because on OS/2 kLIBC, the first parameter is
+ const char *string. */
+_GL_CXXALIAS_SYS_CAST (putenv, int, (char *string));
# else
_GL_CXXALIAS_SYS (putenv, int, (char *string));
# endif
@@ -1024,7 +1112,9 @@ _GL_CXXALIAS_SYS (qsort_r, void, (void *base, size_t nmemb, size_t size,
_gl_qsort_r_compar_fn compare,
void *arg));
# endif
+# if __GLIBC__ >= 2
_GL_CXXALIASWARN (qsort_r);
+# endif
#elif defined GNULIB_POSIXCHECK
# undef qsort_r
# if HAVE_RAW_DECL_QSORT_R
@@ -1034,11 +1124,26 @@ _GL_WARN_ON_USE (qsort_r, "qsort_r is not portable - "
#endif
-#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
-# ifndef RAND_MAX
-# define RAND_MAX 2147483647
+#if @GNULIB_RAND@ || (@GNULIB_RANDOM_R@ && !@HAVE_RANDOM_R@)
+# ifndef RAND_MAX
+# define RAND_MAX 2147483647
+# endif
+#endif
+
+
+#if @GNULIB_RAND@
+# if @REPLACE_RAND@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef rand
+# define rand rpl_rand
# endif
+_GL_FUNCDECL_RPL (rand, int, (void));
+_GL_CXXALIAS_RPL (rand, int, (void));
+# else
+_GL_CXXALIAS_SYS (rand, int, (void));
+# endif
+# if __GLIBC__ >= 2
+_GL_CXXALIASWARN (rand);
# endif
#endif
@@ -1293,8 +1398,16 @@ _GL_CXXALIAS_RPL (realloc, void *, (void *ptr, size_t size));
# else
# if __GNUC__ >= 11
/* For -Wmismatched-dealloc: Associate realloc with free or rpl_free. */
-_GL_FUNCDECL_SYS (realloc, void *, (void *ptr, size_t size)
- _GL_ATTRIBUTE_DEALLOC_FREE);
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
+_GL_FUNCDECL_SYS (realloc, void *,
+ (void *ptr, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (realloc, void *,
+ (void *ptr, size_t size)
+ _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (realloc, void *, (void *ptr, size_t size));
# endif
@@ -1304,8 +1417,16 @@ _GL_CXXALIASWARN (realloc);
#else
# if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined realloc
/* For -Wmismatched-dealloc: Associate realloc with free or rpl_free. */
-_GL_FUNCDECL_SYS (realloc, void *, (void *ptr, size_t size)
- _GL_ATTRIBUTE_DEALLOC_FREE);
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2
+_GL_FUNCDECL_SYS (realloc, void *,
+ (void *ptr, size_t size)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (realloc, void *,
+ (void *ptr, size_t size)
+ _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK && !_GL_USE_STDLIB_ALLOC
# undef realloc
diff --git a/lib/strftime.c b/lib/strftime.c
new file mode 100644
index 00000000000..128176cad40
--- /dev/null
+++ b/lib/strftime.c
@@ -0,0 +1,2051 @@
+/* Copyright (C) 1991-2024 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ 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 3 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/>. */
+
+#ifndef FPRINTFTIME
+# define FPRINTFTIME 0
+#endif
+
+#ifndef USE_C_LOCALE
+# define USE_C_LOCALE 0
+#endif
+
+#ifdef _LIBC
+# define USE_IN_EXTENDED_LOCALE_MODEL 1
+# define HAVE_STRUCT_ERA_ENTRY 1
+# define HAVE_TM_GMTOFF 1
+# define HAVE_STRUCT_TM_TM_ZONE 1
+# define HAVE_TZNAME 1
+# include "../locale/localeinfo.h"
+#else
+# include <libc-config.h>
+# if FPRINTFTIME
+# include "fprintftime.h"
+# else
+# include "strftime.h"
+# endif
+# include "time-internal.h"
+#endif
+
+/* Whether to require GNU behavior for AM and PM indicators, even on
+ other platforms. This matters only in non-C locales.
+ The default is to require it; you can override this via
+ AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], 1) and if you do that
+ you may be able to omit Gnulib's localename module and its dependencies. */
+#ifndef REQUIRE_GNUISH_STRFTIME_AM_PM
+# define REQUIRE_GNUISH_STRFTIME_AM_PM true
+#endif
+#if USE_C_LOCALE
+# undef REQUIRE_GNUISH_STRFTIME_AM_PM
+# define REQUIRE_GNUISH_STRFTIME_AM_PM false
+#endif
+
+#if USE_C_LOCALE
+# include "c-ctype.h"
+#else
+# include <ctype.h>
+#endif
+#include <errno.h>
+#include <time.h>
+
+#if HAVE_TZNAME && !HAVE_DECL_TZNAME
+extern char *tzname[];
+#endif
+
+/* Do multibyte processing if multibyte encodings are supported, unless
+ multibyte sequences are safe in formats. Multibyte sequences are
+ safe if they cannot contain byte sequences that look like format
+ conversion specifications. The multibyte encodings used by the
+ C library on the various platforms (UTF-8, GB2312, GBK, CP936,
+ GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949,
+ SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%'
+ cannot occur in a multibyte character except in the first byte.
+
+ The DEC-HANYU encoding used on OSF/1 is not safe for formats, but
+ this encoding has never been seen in real-life use, so we ignore
+ it. */
+#if !(defined __osf__ && 0)
+# define MULTIBYTE_IS_FORMAT_SAFE 1
+#endif
+#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE)
+
+#if DO_MULTIBYTE
+# include <wchar.h>
+ static const mbstate_t mbstate_zero;
+#endif
+
+#include <limits.h>
+#include <stdckdint.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if USE_C_LOCALE && HAVE_STRFTIME_L
+# include <locale.h>
+#endif
+
+#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM
+# include <locale.h>
+# include "localename.h"
+#endif
+
+#include "attribute.h"
+#include <intprops.h>
+
+#ifdef COMPILE_WIDE
+# include <endian.h>
+# define CHAR_T wchar_t
+# define UCHAR_T unsigned int
+# define L_(Str) L##Str
+# define NLW(Sym) _NL_W##Sym
+
+# define MEMCPY(d, s, n) __wmemcpy (d, s, n)
+# define STRLEN(s) __wcslen (s)
+
+#else
+# define CHAR_T char
+# define UCHAR_T unsigned char
+# define L_(Str) Str
+# define NLW(Sym) Sym
+# define ABALTMON_1 _NL_ABALTMON_1
+
+# define MEMCPY(d, s, n) memcpy (d, s, n)
+# define STRLEN(s) strlen (s)
+
+#endif
+
+/* Shift A right by B bits portably, by dividing A by 2**B and
+ truncating towards minus infinity. A and B should be free of side
+ effects, and B should be in the range 0 <= B <= INT_BITS - 2, where
+ INT_BITS is the number of useful bits in an int. GNU code can
+ assume that INT_BITS is at least 32.
+
+ ISO C99 says that A >> B is implementation-defined if A < 0. Some
+ implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift
+ right in the usual way when A < 0, so SHR falls back on division if
+ ordinary A >> B doesn't seem to be the usual signed shift. */
+#define SHR(a, b) \
+ (-1 >> 1 == -1 \
+ ? (a) >> (b) \
+ : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0))
+
+#define TM_YEAR_BASE 1900
+
+#ifndef __isleap
+/* Nonzero if YEAR is a leap year (every 4 years,
+ except every 100th isn't, and every 400th is). */
+# define __isleap(year) \
+ ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0))
+#endif
+
+
+#ifdef _LIBC
+# define mktime_z(tz, tm) mktime (tm)
+# define tzname __tzname
+# define tzset __tzset
+
+# define time_t __time64_t
+# define __gmtime_r(t, tp) __gmtime64_r (t, tp)
+# define mktime(tp) __mktime64 (tp)
+#endif
+
+#if FPRINTFTIME
+# define STREAM_OR_CHAR_T FILE
+# define STRFTIME_ARG(x) /* empty */
+#else
+# define STREAM_OR_CHAR_T CHAR_T
+# define STRFTIME_ARG(x) x,
+#endif
+
+#if FPRINTFTIME
+# define memset_byte(P, Len, Byte) \
+ do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0)
+# define memset_space(P, Len) memset_byte (P, Len, ' ')
+# define memset_zero(P, Len) memset_byte (P, Len, '0')
+#elif defined COMPILE_WIDE
+# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len))
+# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len))
+#else
+# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len))
+# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len))
+#endif
+
+#if FPRINTFTIME
+# define advance(P, N)
+#else
+# define advance(P, N) ((P) += (N))
+#endif
+
+#define add(n, f) width_add (width, n, f)
+#define width_add(width, n, f) \
+ do \
+ { \
+ size_t _n = (n); \
+ size_t _w = pad == L_('-') || width < 0 ? 0 : width; \
+ size_t _incr = _n < _w ? _w : _n; \
+ if (_incr >= maxsize - i) \
+ { \
+ errno = ERANGE; \
+ return 0; \
+ } \
+ if (p) \
+ { \
+ if (_n < _w) \
+ { \
+ size_t _delta = _w - _n; \
+ if (pad == L_('0') || pad == L_('+')) \
+ memset_zero (p, _delta); \
+ else \
+ memset_space (p, _delta); \
+ } \
+ f; \
+ advance (p, _n); \
+ } \
+ i += _incr; \
+ } while (0)
+
+#define add1(c) width_add1 (width, c)
+#if FPRINTFTIME
+# define width_add1(width, c) width_add (width, 1, fputc (c, p))
+#else
+# define width_add1(width, c) width_add (width, 1, *p = c)
+#endif
+
+#define cpy(n, s) width_cpy (width, n, s)
+#if FPRINTFTIME
+# define width_cpy(width, n, s) \
+ width_add (width, n, \
+ do \
+ { \
+ if (to_lowcase) \
+ fwrite_lowcase (p, (s), _n); \
+ else if (to_uppcase) \
+ fwrite_uppcase (p, (s), _n); \
+ else \
+ { \
+ /* Ignore the value of fwrite. The caller can determine whether \
+ an error occurred by inspecting ferror (P). All known fwrite \
+ implementations set the stream's error indicator when they \
+ fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \
+ not require this. */ \
+ fwrite (s, _n, 1, p); \
+ } \
+ } \
+ while (0) \
+ )
+#else
+# define width_cpy(width, n, s) \
+ width_add (width, n, \
+ if (to_lowcase) \
+ memcpy_lowcase (p, (s), _n LOCALE_ARG); \
+ else if (to_uppcase) \
+ memcpy_uppcase (p, (s), _n LOCALE_ARG); \
+ else \
+ MEMCPY ((void *) p, (void const *) (s), _n))
+#endif
+
+#ifdef COMPILE_WIDE
+# ifndef USE_IN_EXTENDED_LOCALE_MODEL
+# undef __mbsrtowcs_l
+# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st)
+# endif
+#endif
+
+
+#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
+/* We use this code also for the extended locale handling where the
+ function gets as an additional argument the locale which has to be
+ used. To access the values we have to redefine the _NL_CURRENT
+ macro. */
+# define strftime __strftime_l
+# define wcsftime __wcsftime_l
+# undef _NL_CURRENT
+# define _NL_CURRENT(category, item) \
+ (current->values[_NL_ITEM_INDEX (item)].string)
+# define LOCALE_PARAM , locale_t loc
+# define LOCALE_ARG , loc
+# define HELPER_LOCALE_ARG , current
+#else
+# define LOCALE_PARAM
+# define LOCALE_ARG
+# ifdef _LIBC
+# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME)
+# else
+# define HELPER_LOCALE_ARG
+# endif
+#endif
+
+#ifdef COMPILE_WIDE
+# ifdef USE_IN_EXTENDED_LOCALE_MODEL
+# define TOUPPER(Ch, L) __towupper_l (Ch, L)
+# define TOLOWER(Ch, L) __towlower_l (Ch, L)
+# else
+# define TOUPPER(Ch, L) towupper (Ch)
+# define TOLOWER(Ch, L) towlower (Ch)
+# endif
+#else
+# ifdef USE_IN_EXTENDED_LOCALE_MODEL
+# define TOUPPER(Ch, L) __toupper_l (Ch, L)
+# define TOLOWER(Ch, L) __tolower_l (Ch, L)
+# else
+# if USE_C_LOCALE
+# define TOUPPER(Ch, L) c_toupper (Ch)
+# define TOLOWER(Ch, L) c_tolower (Ch)
+# else
+# define TOUPPER(Ch, L) toupper (Ch)
+# define TOLOWER(Ch, L) tolower (Ch)
+# endif
+# endif
+#endif
+/* We don't use 'isdigit' here since the locale dependent
+ interpretation is not what we want here. We only need to accept
+ the arabic digits in the ASCII range. One day there is perhaps a
+ more reliable way to accept other sets of digits. */
+#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9)
+
+/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds
+ maximum object size 9223372036854775807", caused by insufficient data flow
+ analysis and value propagation of the 'width_add' expansion when GCC is not
+ optimizing. Cf. <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88443>. */
+#if __GNUC__ >= 7 && !__OPTIMIZE__
+# pragma GCC diagnostic ignored "-Wstringop-overflow"
+#endif
+
+#if FPRINTFTIME
+static void
+fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len)
+{
+ while (len-- > 0)
+ {
+ fputc (TOLOWER ((UCHAR_T) *src, loc), fp);
+ ++src;
+ }
+}
+
+static void
+fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len)
+{
+ while (len-- > 0)
+ {
+ fputc (TOUPPER ((UCHAR_T) *src, loc), fp);
+ ++src;
+ }
+}
+#else
+static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src,
+ size_t len LOCALE_PARAM);
+
+static CHAR_T *
+memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
+{
+ while (len-- > 0)
+ dest[len] = TOLOWER ((UCHAR_T) src[len], loc);
+ return dest;
+}
+
+static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src,
+ size_t len LOCALE_PARAM);
+
+static CHAR_T *
+memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
+{
+ while (len-- > 0)
+ dest[len] = TOUPPER ((UCHAR_T) src[len], loc);
+ return dest;
+}
+#endif
+
+
+#if USE_C_LOCALE && HAVE_STRFTIME_L
+
+/* Cache for the C locale object.
+ Marked volatile so that different threads see the same value
+ (avoids locking). */
+static volatile locale_t c_locale_cache;
+
+/* Return the C locale object, or (locale_t) 0 with errno set
+ if it cannot be created. */
+static locale_t
+c_locale (void)
+{
+ if (!c_locale_cache)
+ c_locale_cache = newlocale (LC_ALL_MASK, "C", (locale_t) 0);
+ return c_locale_cache;
+}
+
+#endif
+
+
+#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM
+
+/* Return true if an AM/PM indicator should be removed. */
+static bool
+should_remove_ampm (void)
+{
+ /* According to glibc's 'am_pm' attribute in the locale database, an AM/PM
+ indicator should be absent in the locales for the following languages:
+ ab an ast az be ber bg br bs ce cs csb cv da de dsb eo et eu fa fi fo fr
+ fur fy ga gl gv hr hsb ht hu hy it ka kk kl ku kv kw ky lb lg li lij ln
+ lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro
+ ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm
+ uz ve wae wo xh zu */
+ const char *loc = gl_locale_name_unsafe (LC_TIME, "LC_TIME");
+ bool remove_ampm = false;
+ switch (loc[0])
+ {
+ case 'a':
+ switch (loc[1])
+ {
+ case 'b': case 'n': case 'z':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 't' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'b':
+ switch (loc[1])
+ {
+ case 'e':
+ if (loc[2] == '\0' || loc[2] == '_'
+ || (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')))
+ remove_ampm = true;
+ break;
+ case 'g': case 'r': case 's':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'c':
+ switch (loc[1])
+ {
+ case 'e': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == '\0' || loc[2] == '_'
+ || (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'd':
+ switch (loc[1])
+ {
+ case 'a': case 'e':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'e':
+ switch (loc[1])
+ {
+ case 'o': case 't': case 'u':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'f':
+ switch (loc[1])
+ {
+ case 'a': case 'i': case 'o': case 'r': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'u':
+ if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'g':
+ switch (loc[1])
+ {
+ case 'a': case 'l': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'h':
+ switch (loc[1])
+ {
+ case 'r': case 't': case 'u': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'i':
+ switch (loc[1])
+ {
+ case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'k':
+ switch (loc[1])
+ {
+ case 'a': case 'k': case 'l': case 'u': case 'v': case 'w': case 'y':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'l':
+ switch (loc[1])
+ {
+ case 'b': case 'g': case 'n': case 't': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'i':
+ if (loc[2] == 'j' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'm':
+ switch (loc[1])
+ {
+ case 'g': case 'i': case 'k': case 'n': case 's': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'h':
+ if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'n':
+ switch (loc[1])
+ {
+ case 'b': case 'l': case 'n': case 'r':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'd':
+ if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'h':
+ if (loc[2] == 'n' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 's':
+ if (loc[2] == 'o' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'o':
+ switch (loc[1])
+ {
+ case 'c': case 's':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'p':
+ switch (loc[1])
+ {
+ case 'l': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'a':
+ if (loc[2] == 'p' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'r':
+ switch (loc[1])
+ {
+ case 'o': case 'u': case 'w':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 's':
+ switch (loc[1])
+ {
+ case 'c': case 'e': case 'k': case 'l': case 'm': case 'r': case 's':
+ case 't': case 'u': case 'v':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'a':
+ if (loc[2] == 'h' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'g':
+ if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'z':
+ if (loc[2] == 'l' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 't':
+ switch (loc[1])
+ {
+ case 'g': case 'k': case 'n': case 's': case 't':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'u':
+ switch (loc[1])
+ {
+ case 'g': case 'k': case 'z':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ case 'n':
+ if (loc[2] == 'm'&& (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'v':
+ switch (loc[1])
+ {
+ case 'e':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'w':
+ switch (loc[1])
+ {
+ case 'a':
+ if (loc[2] == 'e' && (loc[3] == '\0' || loc[3] == '_'))
+ remove_ampm = true;
+ break;
+ case 'o':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'x':
+ switch (loc[1])
+ {
+ case 'h':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ case 'z':
+ switch (loc[1])
+ {
+ case 'u':
+ if (loc[2] == '\0' || loc[2] == '_')
+ remove_ampm = true;
+ break;
+ default:
+ break;
+ }
+ break;
+ default:
+ break;
+ }
+ return remove_ampm;
+}
+
+#endif
+
+
+#if ! HAVE_TM_GMTOFF
+/* Yield the difference between *A and *B,
+ measured in seconds, ignoring leap seconds. */
+# define tm_diff ftime_tm_diff
+static int tm_diff (const struct tm *, const struct tm *);
+static int
+tm_diff (const struct tm *a, const struct tm *b)
+{
+ /* Compute intervening leap days correctly even if year is negative.
+ Take care to avoid int overflow in leap day calculations,
+ but it's OK to assume that A and B are close to each other. */
+ int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3);
+ int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3);
+ int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0);
+ int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0);
+ int a400 = SHR (a100, 2);
+ int b400 = SHR (b100, 2);
+ int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
+ int years = a->tm_year - b->tm_year;
+ int days = (365 * years + intervening_leap_days
+ + (a->tm_yday - b->tm_yday));
+ return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
+ + (a->tm_min - b->tm_min))
+ + (a->tm_sec - b->tm_sec));
+}
+#endif /* ! HAVE_TM_GMTOFF */
+
+
+
+/* The number of days from the first day of the first ISO week of this
+ year to the year day YDAY with week day WDAY. ISO weeks start on
+ Monday; the first ISO week has the year's first Thursday. YDAY may
+ be as small as YDAY_MINIMUM. */
+#define ISO_WEEK_START_WDAY 1 /* Monday */
+#define ISO_WEEK1_WDAY 4 /* Thursday */
+#define YDAY_MINIMUM (-366)
+static int iso_week_days (int, int);
+static __inline int
+iso_week_days (int yday, int wday)
+{
+ /* Add enough to the first operand of % to make it nonnegative. */
+ int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7;
+ return (yday
+ - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7
+ + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY);
+}
+
+
+#if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L)
+static CHAR_T const c_weekday_names[][sizeof "Wednesday"] =
+ {
+ L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"),
+ L_("Thursday"), L_("Friday"), L_("Saturday")
+ };
+static CHAR_T const c_month_names[][sizeof "September"] =
+ {
+ L_("January"), L_("February"), L_("March"), L_("April"), L_("May"),
+ L_("June"), L_("July"), L_("August"), L_("September"), L_("October"),
+ L_("November"), L_("December")
+ };
+#endif
+
+
+/* When compiling this file, GNU applications can #define my_strftime
+ to a symbol (typically nstrftime) to get an extended strftime with
+ extra arguments TZ and NS. */
+
+#ifdef my_strftime
+# define extra_args , tz, ns
+# define extra_args_spec , timezone_t tz, int ns
+#else
+# if defined COMPILE_WIDE
+# define my_strftime wcsftime
+# define nl_get_alt_digit _nl_get_walt_digit
+# else
+# define my_strftime strftime
+# define nl_get_alt_digit _nl_get_alt_digit
+# endif
+# define extra_args
+# define extra_args_spec
+/* We don't have this information in general. */
+# define tz 1
+# define ns 0
+#endif
+
+static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t)
+ const CHAR_T *, const struct tm *,
+ bool, int, int, bool *
+ extra_args_spec LOCALE_PARAM);
+
+/* Write information from TP into S according to the format
+ string FORMAT, writing no more that MAXSIZE characters
+ (including the terminating '\0') and returning number of
+ characters written. If S is NULL, nothing will be written
+ anywhere, so to determine how many characters would be
+ written, use NULL for S and (size_t) -1 for MAXSIZE. */
+size_t
+my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
+ const CHAR_T *format,
+ const struct tm *tp extra_args_spec LOCALE_PARAM)
+{
+ bool tzset_called = false;
+ return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false,
+ 0, -1, &tzset_called extra_args LOCALE_ARG);
+}
+libc_hidden_def (my_strftime)
+
+/* Just like my_strftime, above, but with more parameters.
+ UPCASE indicates that the result should be converted to upper case.
+ YR_SPEC and WIDTH specify the padding and width for the year.
+ *TZSET_CALLED indicates whether tzset has been called here. */
+static size_t
+__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
+ const CHAR_T *format,
+ const struct tm *tp, bool upcase,
+ int yr_spec, int width, bool *tzset_called
+ extra_args_spec LOCALE_PARAM)
+{
+#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL
+ struct __locale_data *const current = loc->__locales[LC_TIME];
+#endif
+#if FPRINTFTIME
+ size_t maxsize = (size_t) -1;
+#endif
+
+ int saved_errno = errno;
+ int hour12 = tp->tm_hour;
+#ifdef _NL_CURRENT
+ /* We cannot make the following values variables since we must delay
+ the evaluation of these values until really needed since some
+ expressions might not be valid in every situation. The 'struct tm'
+ might be generated by a strptime() call that initialized
+ only a few elements. Dereference the pointers only if the format
+ requires this. Then it is ok to fail if the pointers are invalid. */
+# define a_wkday \
+ ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday)))
+# define f_wkday \
+ ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday)))
+# define a_month \
+ ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon)))
+# define f_month \
+ ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon)))
+# define a_altmonth \
+ ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon)))
+# define f_altmonth \
+ ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \
+ ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon)))
+# define ampm \
+ ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \
+ ? NLW(PM_STR) : NLW(AM_STR)))
+
+# define aw_len STRLEN (a_wkday)
+# define am_len STRLEN (a_month)
+# define aam_len STRLEN (a_altmonth)
+# define ap_len STRLEN (ampm)
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+/* The English abbreviated weekday names are just the first 3 characters of the
+ English full weekday names. */
+# define a_wkday \
+ (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday])
+# define aw_len 3
+# define f_wkday \
+ (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday])
+/* The English abbreviated month names are just the first 3 characters of the
+ English full month names. */
+# define a_month \
+ (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon])
+# define am_len 3
+# define f_month \
+ (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon])
+/* The English AM/PM strings happen to have the same length, namely 2. */
+# define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11))
+# define ap_len 2
+#endif
+#if HAVE_TZNAME
+ char **tzname_vec = tzname;
+#endif
+ const char *zone;
+ size_t i = 0;
+ STREAM_OR_CHAR_T *p = s;
+ const CHAR_T *f;
+#if DO_MULTIBYTE && !defined COMPILE_WIDE
+ const char *format_end = NULL;
+#endif
+
+ zone = NULL;
+#if HAVE_STRUCT_TM_TM_ZONE
+ /* The POSIX test suite assumes that setting
+ the environment variable TZ to a new value before calling strftime()
+ will influence the result (the %Z format) even if the information in
+ TP is computed with a totally different time zone.
+ This is bogus: though POSIX allows bad behavior like this,
+ POSIX does not require it. Do the right thing instead. */
+ zone = (const char *) tp->tm_zone;
+#endif
+#if HAVE_TZNAME
+ if (!tz)
+ {
+ if (! (zone && *zone))
+ zone = "GMT";
+ }
+ else
+ {
+# if !HAVE_STRUCT_TM_TM_ZONE
+ /* Infer the zone name from *TZ instead of from TZNAME. */
+ tzname_vec = tz->tzname_copy;
+# endif
+ }
+ /* The tzset() call might have changed the value. */
+ if (!(zone && *zone) && tp->tm_isdst >= 0)
+ {
+ /* POSIX.1 requires that local time zone information be used as
+ though strftime called tzset. */
+# ifndef my_strftime
+ if (!*tzset_called)
+ {
+ tzset ();
+ *tzset_called = true;
+ }
+# endif
+ zone = tzname_vec[tp->tm_isdst != 0];
+ }
+#endif
+ if (! zone)
+ zone = "";
+
+ if (hour12 > 12)
+ hour12 -= 12;
+ else
+ if (hour12 == 0)
+ hour12 = 12;
+
+ for (f = format; *f != '\0'; width = -1, f++)
+ {
+ int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */
+ int modifier; /* Field modifier ('E', 'O', or 0). */
+ int digits = 0; /* Max digits for numeric format. */
+ int number_value; /* Numeric value to be printed. */
+ unsigned int u_number_value; /* (unsigned int) number_value. */
+ bool negative_number; /* The number is negative. */
+ bool always_output_a_sign; /* +/- should always be output. */
+ int tz_colon_mask; /* Bitmask of where ':' should appear. */
+ const CHAR_T *subfmt;
+ CHAR_T *bufp;
+ CHAR_T buf[1
+ + 2 /* for the two colons in a %::z or %:::z time zone */
+ + (sizeof (int) < sizeof (time_t)
+ ? INT_STRLEN_BOUND (time_t)
+ : INT_STRLEN_BOUND (int))];
+ bool to_lowcase = false;
+ bool to_uppcase = upcase;
+ size_t colons;
+ bool change_case = false;
+ int format_char;
+ int subwidth;
+
+#if DO_MULTIBYTE && !defined COMPILE_WIDE
+ switch (*f)
+ {
+ case L_('%'):
+ break;
+
+ case L_('\b'): case L_('\t'): case L_('\n'):
+ case L_('\v'): case L_('\f'): case L_('\r'):
+ case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'):
+ case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'):
+ case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'):
+ case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'):
+ case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'):
+ case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'):
+ case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'):
+ case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'):
+ case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'):
+ case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'):
+ case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'):
+ case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'):
+ case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'):
+ case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'):
+ case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'):
+ case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'):
+ case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'):
+ case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'):
+ case L_('~'):
+ /* The C Standard requires these 98 characters (plus '%') to
+ be in the basic execution character set. None of these
+ characters can start a multibyte sequence, so they need
+ not be analyzed further. */
+ add1 (*f);
+ continue;
+
+ default:
+ /* Copy this multibyte sequence until we reach its end, find
+ an error, or come back to the initial shift state. */
+ {
+ mbstate_t mbstate = mbstate_zero;
+ size_t len = 0;
+ size_t fsize;
+
+ if (! format_end)
+ format_end = f + strlen (f) + 1;
+ fsize = format_end - f;
+
+ do
+ {
+ size_t bytes = mbrlen (f + len, fsize - len, &mbstate);
+
+ if (bytes == 0)
+ break;
+
+ if (bytes == (size_t) -2)
+ {
+ len += strlen (f + len);
+ break;
+ }
+
+ if (bytes == (size_t) -1)
+ {
+ len++;
+ break;
+ }
+
+ len += bytes;
+ }
+ while (! mbsinit (&mbstate));
+
+ cpy (len, f);
+ f += len - 1;
+ continue;
+ }
+ }
+
+#else /* ! DO_MULTIBYTE */
+
+ /* Either multibyte encodings are not supported, they are
+ safe for formats, so any non-'%' byte can be copied through,
+ or this is the wide character version. */
+ if (*f != L_('%'))
+ {
+ add1 (*f);
+ continue;
+ }
+
+#endif /* ! DO_MULTIBYTE */
+
+ char const *percent = f;
+
+ /* Check for flags that can modify a format. */
+ while (1)
+ {
+ switch (*++f)
+ {
+ /* This influences the number formats. */
+ case L_('_'):
+ case L_('-'):
+ case L_('+'):
+ case L_('0'):
+ pad = *f;
+ continue;
+
+ /* This changes textual output. */
+ case L_('^'):
+ to_uppcase = true;
+ continue;
+ case L_('#'):
+ change_case = true;
+ continue;
+
+ default:
+ break;
+ }
+ break;
+ }
+
+ if (ISDIGIT (*f))
+ {
+ width = 0;
+ do
+ {
+ if (ckd_mul (&width, width, 10)
+ || ckd_add (&width, width, *f - L_('0')))
+ width = INT_MAX;
+ ++f;
+ }
+ while (ISDIGIT (*f));
+ }
+
+ /* Check for modifiers. */
+ switch (*f)
+ {
+ case L_('E'):
+ case L_('O'):
+ modifier = *f++;
+ break;
+
+ default:
+ modifier = 0;
+ break;
+ }
+
+ /* Now do the specified format. */
+ format_char = *f;
+ switch (format_char)
+ {
+#define DO_NUMBER(d, v) \
+ do \
+ { \
+ digits = d; \
+ number_value = v; \
+ goto do_number; \
+ } \
+ while (0)
+#define DO_SIGNED_NUMBER(d, negative, v) \
+ DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number)
+#define DO_YEARISH(d, negative, v) \
+ DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish)
+#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \
+ do \
+ { \
+ digits = d; \
+ negative_number = negative; \
+ u_number_value = v; \
+ goto label; \
+ } \
+ while (0)
+
+ /* The mask is not what you might think.
+ When the ordinal i'th bit is set, insert a colon
+ before the i'th digit of the time zone representation. */
+#define DO_TZ_OFFSET(d, mask, v) \
+ do \
+ { \
+ digits = d; \
+ tz_colon_mask = mask; \
+ u_number_value = v; \
+ goto do_tz_offset; \
+ } \
+ while (0)
+#define DO_NUMBER_SPACEPAD(d, v) \
+ do \
+ { \
+ digits = d; \
+ number_value = v; \
+ goto do_number_spacepad; \
+ } \
+ while (0)
+
+ case L_('%'):
+ if (f - 1 != percent)
+ goto bad_percent;
+ add1 (*f);
+ break;
+
+ case L_('a'):
+ if (modifier != 0)
+ goto bad_format;
+ if (change_case)
+ {
+ to_uppcase = true;
+ to_lowcase = false;
+ }
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
+ cpy (aw_len, a_wkday);
+ break;
+#else
+ goto underlying_strftime;
+#endif
+
+ case 'A':
+ if (modifier != 0)
+ goto bad_format;
+ if (change_case)
+ {
+ to_uppcase = true;
+ to_lowcase = false;
+ }
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
+ cpy (STRLEN (f_wkday), f_wkday);
+ break;
+#else
+ goto underlying_strftime;
+#endif
+
+ case L_('b'):
+ case L_('h'):
+ if (change_case)
+ {
+ to_uppcase = true;
+ to_lowcase = false;
+ }
+ if (modifier == L_('E'))
+ goto bad_format;
+#ifdef _NL_CURRENT
+ if (modifier == L_('O'))
+ cpy (aam_len, a_altmonth);
+ else
+ cpy (am_len, a_month);
+ break;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ cpy (am_len, a_month);
+ break;
+#else
+ goto underlying_strftime;
+#endif
+
+ case L_('B'):
+ if (modifier == L_('E'))
+ goto bad_format;
+ if (change_case)
+ {
+ to_uppcase = true;
+ to_lowcase = false;
+ }
+#ifdef _NL_CURRENT
+ if (modifier == L_('O'))
+ cpy (STRLEN (f_altmonth), f_altmonth);
+ else
+ cpy (STRLEN (f_month), f_month);
+ break;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ cpy (STRLEN (f_month), f_month);
+ break;
+#else
+ goto underlying_strftime;
+#endif
+
+ case L_('c'):
+ if (modifier == L_('O'))
+ goto bad_format;
+#ifdef _NL_CURRENT
+ if (! (modifier == L_('E')
+ && (*(subfmt =
+ (const CHAR_T *) _NL_CURRENT (LC_TIME,
+ NLW(ERA_D_T_FMT)))
+ != '\0')))
+ subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT));
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%a %b %e %H:%M:%S %Y");
+#else
+ goto underlying_strftime;
+#endif
+
+ subformat:
+ subwidth = -1;
+ subformat_width:
+ {
+ size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1)
+ subfmt, tp, to_uppcase,
+ pad, subwidth, tzset_called
+ extra_args LOCALE_ARG);
+ add (len, __strftime_internal (p,
+ STRFTIME_ARG (maxsize - i)
+ subfmt, tp, to_uppcase,
+ pad, subwidth, tzset_called
+ extra_args LOCALE_ARG));
+ }
+ break;
+
+#if !((defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) || (USE_C_LOCALE && !HAVE_STRFTIME_L))
+ underlying_strftime:
+ {
+ /* The relevant information is available only via the
+ underlying strftime implementation, so use that. */
+ char ufmt[5];
+ char *u = ufmt;
+ char ubuf[1024]; /* enough for any single format in practice */
+ size_t len;
+ /* Make sure we're calling the actual underlying strftime.
+ In some cases, config.h contains something like
+ "#define strftime rpl_strftime". */
+# ifdef strftime
+# undef strftime
+ size_t strftime (char *, size_t, const char *, struct tm const *);
+# endif
+
+ /* The space helps distinguish strftime failure from empty
+ output. */
+ *u++ = ' ';
+ *u++ = '%';
+ if (modifier != 0)
+ *u++ = modifier;
+ *u++ = format_char;
+ *u = '\0';
+
+# if USE_C_LOCALE /* implies HAVE_STRFTIME_L */
+ locale_t locale = c_locale ();
+ if (!locale)
+ return 0; /* errno is set here */
+ len = strftime_l (ubuf, sizeof ubuf, ufmt, tp, locale);
+# else
+ len = strftime (ubuf, sizeof ubuf, ufmt, tp);
+# endif
+ if (len != 0)
+ {
+# if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */
+ if (format_char == L_('c'))
+ {
+ /* The output of the strftime %c directive consists of the
+ date, the time, and the time zone. But the time zone is
+ wrong, since neither TZ nor ZONE was passed as argument.
+ Therefore, remove the the last space-delimited word.
+ In order not to accidentally remove a date or a year
+ (that contains no letter) or an AM/PM indicator (that has
+ length 2), remove that last word only if it contains a
+ letter and has length >= 3. */
+ char *space;
+ for (space = ubuf + len - 1; *space != ' '; space--)
+ ;
+ if (space > ubuf)
+ {
+ /* Found a space. */
+ if (strlen (space + 1) >= 3)
+ {
+ /* The last word has length >= 3. */
+ bool found_letter = false;
+ const char *p;
+ for (p = space + 1; *p != '\0'; p++)
+ if ((*p >= 'A' && *p <= 'Z')
+ || (*p >= 'a' && *p <= 'z'))
+ {
+ found_letter = true;
+ break;
+ }
+ if (found_letter)
+ {
+ /* The last word contains a letter. */
+ *space = '\0';
+ len = space - ubuf;
+ }
+ }
+ }
+ }
+# if REQUIRE_GNUISH_STRFTIME_AM_PM
+ /* The output of the strftime %p and %r directives contains
+ an AM/PM indicator even for locales where it is not
+ suitable, such as French. Remove this indicator. */
+ else if (format_char == L_('p'))
+ {
+ bool found_ampm = (len > 1);
+ if (found_ampm && should_remove_ampm ())
+ {
+ ubuf[1] = '\0';
+ len = 1;
+ }
+ }
+ else if (format_char == L_('r'))
+ {
+ char last_char = ubuf[len - 1];
+ bool found_ampm = !(last_char >= '0' && last_char <= '9');
+ if (found_ampm && should_remove_ampm ())
+ {
+ char *space;
+ for (space = ubuf + len - 1; *space != ' '; space--)
+ ;
+ if (space > ubuf)
+ {
+ *space = '\0';
+ len = space - ubuf;
+ }
+ }
+ }
+# endif
+# endif
+ cpy (len - 1, ubuf + 1);
+ }
+ }
+ break;
+#endif
+
+ case L_('C'):
+ if (modifier == L_('E'))
+ {
+#if HAVE_STRUCT_ERA_ENTRY
+ struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
+ if (era)
+ {
+# ifdef COMPILE_WIDE
+ size_t len = __wcslen (era->era_wname);
+ cpy (len, era->era_wname);
+# else
+ size_t len = strlen (era->era_name);
+ cpy (len, era->era_name);
+# endif
+ break;
+ }
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+#else
+ goto underlying_strftime;
+#endif
+ }
+
+ {
+ bool negative_year = tp->tm_year < - TM_YEAR_BASE;
+ bool zero_thru_1899 = !negative_year & (tp->tm_year < 0);
+ int century = ((tp->tm_year - 99 * zero_thru_1899) / 100
+ + TM_YEAR_BASE / 100);
+ DO_YEARISH (2, negative_year, century);
+ }
+
+ case L_('x'):
+ if (modifier == L_('O'))
+ goto bad_format;
+#ifdef _NL_CURRENT
+ if (! (modifier == L_('E')
+ && (*(subfmt =
+ (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT)))
+ != L_('\0'))))
+ subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT));
+ goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%m/%d/%y");
+ goto subformat;
+#else
+ goto underlying_strftime;
+#endif
+ case L_('D'):
+ if (modifier != 0)
+ goto bad_format;
+ subfmt = L_("%m/%d/%y");
+ goto subformat;
+
+ case L_('d'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, tp->tm_mday);
+
+ case L_('e'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER_SPACEPAD (2, tp->tm_mday);
+
+ /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE)
+ and then jump to one of these labels. */
+
+ do_tz_offset:
+ always_output_a_sign = true;
+ goto do_number_body;
+
+ do_yearish:
+ if (pad == 0)
+ pad = yr_spec;
+ always_output_a_sign
+ = (pad == L_('+')
+ && ((digits == 2 ? 99 : 9999) < u_number_value
+ || digits < width));
+ goto do_maybe_signed_number;
+
+ do_number_spacepad:
+ if (pad == 0)
+ pad = L_('_');
+
+ do_number:
+ /* Format NUMBER_VALUE according to the MODIFIER flag. */
+ negative_number = number_value < 0;
+ u_number_value = number_value;
+
+ do_signed_number:
+ always_output_a_sign = false;
+
+ do_maybe_signed_number:
+ tz_colon_mask = 0;
+
+ do_number_body:
+ /* Format U_NUMBER_VALUE according to the MODIFIER flag.
+ NEGATIVE_NUMBER is nonzero if the original number was
+ negative; in this case it was converted directly to
+ unsigned int (i.e., modulo (UINT_MAX + 1)) without
+ negating it. */
+ if (modifier == L_('O') && !negative_number)
+ {
+#ifdef _NL_CURRENT
+ /* Get the locale specific alternate representation of
+ the number. If none exist NULL is returned. */
+ const CHAR_T *cp = nl_get_alt_digit (u_number_value
+ HELPER_LOCALE_ARG);
+
+ if (cp != NULL)
+ {
+ size_t digitlen = STRLEN (cp);
+ if (digitlen != 0)
+ {
+ cpy (digitlen, cp);
+ break;
+ }
+ }
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+#else
+ goto underlying_strftime;
+#endif
+ }
+
+ bufp = buf + sizeof (buf) / sizeof (buf[0]);
+
+ if (negative_number)
+ u_number_value = - u_number_value;
+
+ do
+ {
+ if (tz_colon_mask & 1)
+ *--bufp = ':';
+ tz_colon_mask >>= 1;
+ *--bufp = u_number_value % 10 + L_('0');
+ u_number_value /= 10;
+ }
+ while (u_number_value != 0 || tz_colon_mask != 0);
+
+ do_number_sign_and_padding:
+ if (pad == 0)
+ pad = L_('0');
+ if (width < 0)
+ width = digits;
+
+ {
+ CHAR_T sign_char = (negative_number ? L_('-')
+ : always_output_a_sign ? L_('+')
+ : 0);
+ int numlen = buf + sizeof buf / sizeof buf[0] - bufp;
+ int shortage = width - !!sign_char - numlen;
+ int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage;
+
+ if (sign_char)
+ {
+ if (pad == L_('_'))
+ {
+ if (p)
+ memset_space (p, padding);
+ i += padding;
+ width -= padding;
+ }
+ width_add1 (0, sign_char);
+ width--;
+ }
+
+ cpy (numlen, bufp);
+ }
+ break;
+
+ case L_('F'):
+ if (modifier != 0)
+ goto bad_format;
+ if (pad == 0 && width < 0)
+ {
+ pad = L_('+');
+ subwidth = 4;
+ }
+ else
+ {
+ subwidth = width - 6;
+ if (subwidth < 0)
+ subwidth = 0;
+ }
+ subfmt = L_("%Y-%m-%d");
+ goto subformat_width;
+
+ case L_('H'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, tp->tm_hour);
+
+ case L_('I'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, hour12);
+
+ case L_('k'): /* GNU extension. */
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER_SPACEPAD (2, tp->tm_hour);
+
+ case L_('l'): /* GNU extension. */
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER_SPACEPAD (2, hour12);
+
+ case L_('j'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U);
+
+ case L_('M'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, tp->tm_min);
+
+ case L_('m'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U);
+
+#ifndef _LIBC
+ case L_('N'): /* GNU extension. */
+ if (modifier == L_('E'))
+ goto bad_format;
+ {
+ int n = ns, ns_digits = 9;
+ if (width <= 0)
+ width = ns_digits;
+ int ndigs = ns_digits;
+ while (width < ndigs || (1 < ndigs && n % 10 == 0))
+ ndigs--, n /= 10;
+ for (int j = ndigs; 0 < j; j--)
+ buf[j - 1] = n % 10 + L_('0'), n /= 10;
+ if (!pad)
+ pad = L_('0');
+ width_cpy (0, ndigs, buf);
+ width_add (width - ndigs, 0, (void) 0);
+ }
+ break;
+#endif
+
+ case L_('n'):
+ add1 (L_('\n'));
+ break;
+
+ case L_('P'):
+ to_lowcase = true;
+#ifndef _NL_CURRENT
+ format_char = L_('p');
+#endif
+ FALLTHROUGH;
+ case L_('p'):
+ if (change_case)
+ {
+ to_uppcase = false;
+ to_lowcase = true;
+ }
+#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
+ cpy (ap_len, ampm);
+ break;
+#else
+ goto underlying_strftime;
+#endif
+
+ case L_('q'): /* GNU extension. */
+ DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1);
+
+ case L_('R'):
+ subfmt = L_("%H:%M");
+ goto subformat;
+
+ case L_('r'):
+#ifdef _NL_CURRENT
+ if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME,
+ NLW(T_FMT_AMPM)))
+ == L_('\0'))
+ subfmt = L_("%I:%M:%S %p");
+ goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%I:%M:%S %p");
+ goto subformat;
+#elif (defined __APPLE__ && defined __MACH__) || defined __FreeBSD__
+ /* macOS, FreeBSD strftime() may produce empty output for "%r". */
+ subfmt = L_("%I:%M:%S %p");
+ goto subformat;
+#else
+ goto underlying_strftime;
+#endif
+
+ case L_('S'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, tp->tm_sec);
+
+ case L_('s'): /* GNU extension. */
+ {
+ struct tm ltm;
+ time_t t;
+
+ ltm = *tp;
+ ltm.tm_yday = -1;
+ t = mktime_z (tz, &ltm);
+ if (ltm.tm_yday < 0)
+ {
+ errno = EOVERFLOW;
+ return 0;
+ }
+
+ /* Generate string value for T using time_t arithmetic;
+ this works even if sizeof (long) < sizeof (time_t). */
+
+ bufp = buf + sizeof (buf) / sizeof (buf[0]);
+ negative_number = t < 0;
+
+ do
+ {
+ int d = t % 10;
+ t /= 10;
+ *--bufp = (negative_number ? -d : d) + L_('0');
+ }
+ while (t != 0);
+
+ digits = 1;
+ always_output_a_sign = false;
+ goto do_number_sign_and_padding;
+ }
+
+ case L_('X'):
+ if (modifier == L_('O'))
+ goto bad_format;
+#ifdef _NL_CURRENT
+ if (! (modifier == L_('E')
+ && (*(subfmt =
+ (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT)))
+ != L_('\0'))))
+ subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT));
+ goto subformat;
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+ subfmt = L_("%H:%M:%S");
+ goto subformat;
+#else
+ goto underlying_strftime;
+#endif
+ case L_('T'):
+ subfmt = L_("%H:%M:%S");
+ goto subformat;
+
+ case L_('t'):
+ add1 (L_('\t'));
+ break;
+
+ case L_('u'):
+ DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1);
+
+ case L_('U'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7);
+
+ case L_('V'):
+ case L_('g'):
+ case L_('G'):
+ if (modifier == L_('E'))
+ goto bad_format;
+ {
+ /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE)
+ is a leap year, except that YEAR and YEAR - 1 both work
+ correctly even when (tp->tm_year + TM_YEAR_BASE) would
+ overflow. */
+ int year = (tp->tm_year
+ + (tp->tm_year < 0
+ ? TM_YEAR_BASE % 400
+ : TM_YEAR_BASE % 400 - 400));
+ int year_adjust = 0;
+ int days = iso_week_days (tp->tm_yday, tp->tm_wday);
+
+ if (days < 0)
+ {
+ /* This ISO week belongs to the previous year. */
+ year_adjust = -1;
+ days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)),
+ tp->tm_wday);
+ }
+ else
+ {
+ int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)),
+ tp->tm_wday);
+ if (0 <= d)
+ {
+ /* This ISO week belongs to the next year. */
+ year_adjust = 1;
+ days = d;
+ }
+ }
+
+ switch (*f)
+ {
+ case L_('g'):
+ {
+ int yy = (tp->tm_year % 100 + year_adjust) % 100;
+ DO_YEARISH (2, false,
+ (0 <= yy
+ ? yy
+ : tp->tm_year < -TM_YEAR_BASE - year_adjust
+ ? -yy
+ : yy + 100));
+ }
+
+ case L_('G'):
+ DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust,
+ (tp->tm_year + (unsigned int) TM_YEAR_BASE
+ + year_adjust));
+
+ default:
+ DO_NUMBER (2, days / 7 + 1);
+ }
+ }
+
+ case L_('W'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7);
+
+ case L_('w'):
+ if (modifier == L_('E'))
+ goto bad_format;
+
+ DO_NUMBER (1, tp->tm_wday);
+
+ case L_('Y'):
+ if (modifier == L_('E'))
+ {
+#if HAVE_STRUCT_ERA_ENTRY
+ struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
+ if (era)
+ {
+# ifdef COMPILE_WIDE
+ subfmt = era->era_wformat;
+# else
+ subfmt = era->era_format;
+# endif
+ if (pad == 0)
+ pad = yr_spec;
+ goto subformat;
+ }
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+#else
+ goto underlying_strftime;
+#endif
+ }
+ if (modifier == L_('O'))
+ goto bad_format;
+
+ DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE,
+ tp->tm_year + (unsigned int) TM_YEAR_BASE);
+
+ case L_('y'):
+ if (modifier == L_('E'))
+ {
+#if HAVE_STRUCT_ERA_ENTRY
+ struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG);
+ if (era)
+ {
+ int delta = tp->tm_year - era->start_date[0];
+ if (pad == 0)
+ pad = yr_spec;
+ DO_NUMBER (2, (era->offset
+ + delta * era->absolute_direction));
+ }
+#elif USE_C_LOCALE && !HAVE_STRFTIME_L
+#else
+ goto underlying_strftime;
+#endif
+ }
+
+ {
+ int yy = tp->tm_year % 100;
+ if (yy < 0)
+ yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100;
+ DO_YEARISH (2, false, yy);
+ }
+
+ case L_('Z'):
+ if (change_case)
+ {
+ to_uppcase = false;
+ to_lowcase = true;
+ }
+
+#ifdef COMPILE_WIDE
+ {
+ /* The zone string is always given in multibyte form. We have
+ to convert it to wide character. */
+ size_t w = pad == L_('-') || width < 0 ? 0 : width;
+ char const *z = zone;
+ mbstate_t st = {0};
+ size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc);
+ if (len == (size_t) -1)
+ return 0;
+ size_t incr = len < w ? w : len;
+ if (incr >= maxsize - i)
+ {
+ errno = ERANGE;
+ return 0;
+ }
+ if (p)
+ {
+ if (len < w)
+ {
+ size_t delta = w - len;
+ __wmemmove (p + delta, p, len);
+ wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' ';
+ wmemset (p, wc, delta);
+ }
+ p += incr;
+ }
+ i += incr;
+ }
+#else
+ cpy (strlen (zone), zone);
+#endif
+ break;
+
+ case L_(':'):
+ /* :, ::, and ::: are valid only just before 'z'.
+ :::: etc. are rejected later. */
+ for (colons = 1; f[colons] == L_(':'); colons++)
+ continue;
+ if (f[colons] != L_('z'))
+ goto bad_format;
+ f += colons;
+ goto do_z_conversion;
+
+ case L_('z'):
+ colons = 0;
+
+ do_z_conversion:
+ if (tp->tm_isdst < 0)
+ break;
+
+ {
+ int diff;
+ int hour_diff;
+ int min_diff;
+ int sec_diff;
+#if HAVE_TM_GMTOFF
+ diff = tp->tm_gmtoff;
+#else
+ if (!tz)
+ diff = 0;
+ else
+ {
+ struct tm gtm;
+ struct tm ltm;
+ time_t lt;
+
+ /* POSIX.1 requires that local time zone information be used as
+ though strftime called tzset. */
+# ifndef my_strftime
+ if (!*tzset_called)
+ {
+ tzset ();
+ *tzset_called = true;
+ }
+# endif
+
+ ltm = *tp;
+ ltm.tm_wday = -1;
+ lt = mktime_z (tz, &ltm);
+ if (ltm.tm_wday < 0 || ! localtime_rz (0, &lt, &gtm))
+ break;
+ diff = tm_diff (&ltm, &gtm);
+ }
+#endif
+
+ negative_number = diff < 0 || (diff == 0 && *zone == '-');
+ hour_diff = diff / 60 / 60;
+ min_diff = diff / 60 % 60;
+ sec_diff = diff % 60;
+
+ switch (colons)
+ {
+ case 0: /* +hhmm */
+ DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff);
+
+ case 1: tz_hh_mm: /* +hh:mm */
+ DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff);
+
+ case 2: tz_hh_mm_ss: /* +hh:mm:ss */
+ DO_TZ_OFFSET (9, 024,
+ hour_diff * 10000 + min_diff * 100 + sec_diff);
+
+ case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */
+ if (sec_diff != 0)
+ goto tz_hh_mm_ss;
+ if (min_diff != 0)
+ goto tz_hh_mm;
+ DO_TZ_OFFSET (3, 0, hour_diff);
+
+ default:
+ goto bad_format;
+ }
+ }
+
+ case L_('\0'): /* GNU extension: % at end of format. */
+ bad_percent:
+ --f;
+ FALLTHROUGH;
+ default:
+ /* Unknown format; output the format, including the '%',
+ since this is most likely the right thing to do if a
+ multibyte string has been misparsed. */
+ bad_format:
+ cpy (f - percent + 1, percent);
+ break;
+ }
+ }
+
+#if ! FPRINTFTIME
+ if (p && maxsize != 0)
+ *p = L_('\0');
+#endif
+
+ errno = saved_errno;
+ return i;
+}
diff --git a/lib/strftime.h b/lib/strftime.h
index d6efdb848a3..8ce62cdb6d7 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -21,17 +21,68 @@
extern "C" {
#endif
-/* Just like strftime, but with two more arguments:
- POSIX requires that strftime use the local timezone information.
- Use the timezone __TZ instead. Use __NS as the number of
- nanoseconds in the %N directive.
-
- On error, set errno and return 0. Otherwise, return the number of
- bytes generated (not counting the trailing NUL), preserving errno
- if the number is 0. This errno behavior is in draft POSIX 202x
- plus some requested changes to POSIX. */
-size_t nstrftime (char *restrict, size_t, char const *, struct tm const *,
- timezone_t __tz, int __ns);
+/* Formats the broken-down time *__TP, with additional __NS nanoseconds,
+ into the buffer __S of size __MAXSIZE, according to the rules of the
+ LC_TIME category of the current locale.
+
+ Uses the time zone __TZ.
+ If *__TP represents local time, __TZ should be set to
+ tzalloc (getenv ("TZ")).
+ If *__TP represents universal time (a.k.a. GMT), __TZ should be set to
+ (timezone_t) 0.
+
+ The format string __FORMAT, including GNU extensions, is described in
+ the GNU libc's strftime() documentation:
+ <https://www.gnu.org/software/libc/manual/html_node/Formatting-Calendar-Time.html>
+ Additionally, the following conversion is supported:
+ %N The number of nanoseconds, passed as __NS argument.
+ Here's a summary of the available conversions (= format directives):
+ literal characters %n %t %%
+ date:
+ century %C
+ year %Y %y
+ week-based year %G %g
+ month (in year) %m %B %b %h
+ week in year %U %W %V
+ day in year %j
+ day (in month) %d %e
+ day in week %u %w %A %a
+ year, month, day %x %F %D
+ time:
+ half-day %p %P
+ hour %H %k %I %l
+ minute (in hour) %M
+ hour, minute %R
+ second (in minute) %S
+ hour, minute, second %r %T %X
+ second (since epoch) %s
+ date and time: %c
+ time zone: %z %Z
+ nanosecond %N
+
+ Stores the result, as a string with a trailing NUL character, at the
+ beginning of the array __S[0..__MAXSIZE-1], if it fits, and returns
+ the length of that string, not counting the trailing NUL. In this case,
+ errno is preserved if the return value is 0.
+ If it does not fit, this function sets errno to ERANGE and returns 0.
+ Upon other errors, this function sets errno and returns 0 as well.
+
+ Note: The errno behavior is in draft POSIX 202x plus some requested
+ changes to POSIX.
+
+ This function is like strftime, but with two more arguments:
+ * __TZ instead of the local timezone information,
+ * __NS as the number of nanoseconds in the %N directive.
+ */
+size_t nstrftime (char *restrict __s, size_t __maxsize,
+ char const *__format,
+ struct tm const *__tp, timezone_t __tz, int __ns);
+
+/* Like nstrftime, except that it uses the "C" locale instead of the
+ current locale. */
+size_t c_nstrftime (char *restrict __s, size_t __maxsize,
+ char const *__format,
+ struct tm const *__tp, timezone_t __tz, int __ns);
#ifdef __cplusplus
}
diff --git a/lib/string.in.h b/lib/string.in.h
index 70239c33bea..44ec2e7ecdb 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -45,7 +45,8 @@
#define _@GUARD_PREFIX@_STRING_H
/* This file uses _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_MALLOC,
- _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */
+ _GL_ATTRIBUTE_NOTHROW, _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK,
+ HAVE_RAW_DECL_*. */
#if !_GL_CONFIG_H_INCLUDED
#error "Please include config.h first."
#endif
@@ -110,6 +111,28 @@
# endif
#endif
+/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
+ */
+#ifndef _GL_ATTRIBUTE_NOTHROW
+# if defined __cplusplus
+# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# else
+# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# endif
+#endif
+
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
#ifndef _GL_ATTRIBUTE_PURE
@@ -133,7 +156,7 @@
&& !(defined __cplusplus && defined GNULIB_NAMESPACE))
/* We can't do '#define free rpl_free' here. */
# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2)
-_GL_EXTERN_C void rpl_free (void *) throw ();
+_GL_EXTERN_C void rpl_free (void *) _GL_ATTRIBUTE_NOTHROW;
# else
_GL_EXTERN_C void rpl_free (void *);
# endif
@@ -148,7 +171,7 @@ _GL_EXTERN_C
void __cdecl free (void *);
# else
# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2)
-_GL_EXTERN_C void free (void *) throw ();
+_GL_EXTERN_C void free (void *) _GL_ATTRIBUTE_NOTHROW;
# else
_GL_EXTERN_C void free (void *);
# endif
@@ -163,7 +186,7 @@ _GL_EXTERN_C
void __cdecl free (void *);
# else
# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2)
-_GL_EXTERN_C void free (void *) throw ();
+_GL_EXTERN_C void free (void *) _GL_ATTRIBUTE_NOTHROW;
# else
_GL_EXTERN_C void free (void *);
# endif
@@ -266,9 +289,12 @@ _GL_CXXALIAS_SYS_CAST2 (memchr,
# if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
-_GL_CXXALIASWARN1 (memchr, void *, (void *__s, int __c, size_t __n) throw ());
+_GL_CXXALIASWARN1 (memchr, void *,
+ (void *__s, int __c, size_t __n)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (memchr, void const *,
- (void const *__s, int __c, size_t __n) throw ());
+ (void const *__s, int __c, size_t __n)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (memchr);
# endif
@@ -368,8 +394,12 @@ _GL_CXXALIAS_SYS_CAST2 (memrchr,
# if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
-_GL_CXXALIASWARN1 (memrchr, void *, (void *, int, size_t) throw ());
-_GL_CXXALIASWARN1 (memrchr, void const *, (void const *, int, size_t) throw ());
+_GL_CXXALIASWARN1 (memrchr, void *,
+ (void *, int, size_t)
+ _GL_ATTRIBUTE_NOTHROW);
+_GL_CXXALIASWARN1 (memrchr, void const *,
+ (void const *, int, size_t)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (memrchr);
# endif
@@ -384,11 +414,21 @@ _GL_WARN_ON_USE (memrchr, "memrchr is unportable - "
/* Overwrite a block of memory. The compiler will not optimize
effects away, even if the block is dead after the call. */
#if @GNULIB_MEMSET_EXPLICIT@
-# if ! @HAVE_MEMSET_EXPLICIT@
+# if @REPLACE_MEMSET_EXPLICIT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef memset_explicit
+# define memset_explicit rpl_memset_explicit
+# endif
+_GL_FUNCDECL_RPL (memset_explicit, void *,
+ (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (memset_explicit, void *, (void *__dest, int __c, size_t __n));
+# else
+# if !@HAVE_MEMSET_EXPLICIT@
_GL_FUNCDECL_SYS (memset_explicit, void *,
(void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1)));
-# endif
+# endif
_GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n));
+# endif
_GL_CXXALIASWARN (memset_explicit);
#elif defined GNULIB_POSIXCHECK
# undef memset_explicit
@@ -416,9 +456,12 @@ _GL_CXXALIAS_SYS_CAST2 (rawmemchr,
# if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
-_GL_CXXALIASWARN1 (rawmemchr, void *, (void *__s, int __c_in) throw ());
+_GL_CXXALIASWARN1 (rawmemchr, void *,
+ (void *__s, int __c_in)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (rawmemchr, void const *,
- (void const *__s, int __c_in) throw ());
+ (void const *__s, int __c_in)
+ _GL_ATTRIBUTE_NOTHROW);
# else
_GL_CXXALIASWARN (rawmemchr);
# endif
@@ -538,9 +581,12 @@ _GL_CXXALIAS_SYS_CAST2 (strchrnul,
# if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
-_GL_CXXALIASWARN1 (strchrnul, char *, (char *__s, int __c_in) throw ());
+_GL_CXXALIASWARN1 (strchrnul, char *,
+ (char *__s, int __c_in)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (strchrnul, char const *,
- (char const *__s, int __c_in) throw ());
+ (char const *__s, int __c_in)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (strchrnul);
# endif
@@ -576,10 +622,18 @@ _GL_CXXALIAS_MDA (strdup, char *, (char const *__s));
# undef strdup
# endif
# if (!@HAVE_DECL_STRDUP@ || __GNUC__ >= 11) && !defined strdup
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
+_GL_FUNCDECL_SYS (strdup, char *,
+ (char const *__s)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (strdup, char *,
(char const *__s)
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (strdup, char *, (char const *__s));
# endif
@@ -587,10 +641,18 @@ _GL_CXXALIASWARN (strdup);
#else
# if __GNUC__ >= 11 && !defined strdup
/* For -Wmismatched-dealloc: Associate strdup with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
_GL_FUNCDECL_SYS (strdup, char *,
(char const *__s)
+ _GL_ATTRIBUTE_NOTHROW
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
+_GL_FUNCDECL_SYS (strdup, char *,
+ (char const *__s)
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef strdup
@@ -659,10 +721,18 @@ _GL_FUNCDECL_RPL (strndup, char *,
_GL_CXXALIAS_RPL (strndup, char *, (char const *__s, size_t __n));
# else
# if !@HAVE_DECL_STRNDUP@ || (__GNUC__ >= 11 && !defined strndup)
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
+_GL_FUNCDECL_SYS (strndup, char *,
+ (char const *__s, size_t __n)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (strndup, char *,
(char const *__s, size_t __n)
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
_GL_CXXALIAS_SYS (strndup, char *, (char const *__s, size_t __n));
# endif
@@ -670,10 +740,18 @@ _GL_CXXALIASWARN (strndup);
#else
# if __GNUC__ >= 11 && !defined strndup
/* For -Wmismatched-dealloc: Associate strndup with free or rpl_free. */
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
+_GL_FUNCDECL_SYS (strndup, char *,
+ (char const *__s, size_t __n)
+ _GL_ATTRIBUTE_NOTHROW
+ _GL_ARG_NONNULL ((1))
+ _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# else
_GL_FUNCDECL_SYS (strndup, char *,
(char const *__s, size_t __n)
_GL_ARG_NONNULL ((1))
_GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE);
+# endif
# endif
# if defined GNULIB_POSIXCHECK
# undef strndup
@@ -742,9 +820,12 @@ _GL_CXXALIAS_SYS_CAST2 (strpbrk,
# if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
-_GL_CXXALIASWARN1 (strpbrk, char *, (char *__s, char const *__accept) throw ());
+_GL_CXXALIASWARN1 (strpbrk, char *,
+ (char *__s, char const *__accept)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (strpbrk, char const *,
- (char const *__s, char const *__accept) throw ());
+ (char const *__s, char const *__accept)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (strpbrk);
# endif
@@ -852,9 +933,11 @@ _GL_CXXALIAS_SYS_CAST2 (strstr,
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
_GL_CXXALIASWARN1 (strstr, char *,
- (char *haystack, const char *needle) throw ());
+ (char *haystack, const char *needle)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (strstr, const char *,
- (const char *haystack, const char *needle) throw ());
+ (const char *haystack, const char *needle)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (strstr);
# endif
@@ -903,9 +986,11 @@ _GL_CXXALIAS_SYS_CAST2 (strcasestr,
&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \
|| defined __clang__)
_GL_CXXALIASWARN1 (strcasestr, char *,
- (char *haystack, const char *needle) throw ());
+ (char *haystack, const char *needle)
+ _GL_ATTRIBUTE_NOTHROW);
_GL_CXXALIASWARN1 (strcasestr, const char *,
- (const char *haystack, const char *needle) throw ());
+ (const char *haystack, const char *needle)
+ _GL_ATTRIBUTE_NOTHROW);
# elif __GLIBC__ >= 2
_GL_CXXALIASWARN (strcasestr);
# endif
@@ -1344,12 +1429,22 @@ _GL_WARN_ON_USE (strsignal, "strsignal is unportable - "
#endif
#if @GNULIB_STRVERSCMP@
-# if !@HAVE_STRVERSCMP@
+# if @REPLACE_STRVERSCMP@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define strverscmp rpl_strverscmp
+# endif
+_GL_FUNCDECL_RPL (strverscmp, int, (const char *, const char *)
+ _GL_ATTRIBUTE_PURE
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (strverscmp, int, (const char *, const char *));
+# else
+# if !@HAVE_STRVERSCMP@
_GL_FUNCDECL_SYS (strverscmp, int, (const char *, const char *)
_GL_ATTRIBUTE_PURE
_GL_ARG_NONNULL ((1, 2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (strverscmp, int, (const char *, const char *));
+# endif
_GL_CXXALIASWARN (strverscmp);
#elif defined GNULIB_POSIXCHECK
# undef strverscmp
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index be6cd1fb7dd..1bc62621ec5 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -1,7 +1,7 @@
/* Convert string representation of a number into an intmax_t value.
- Copyright (C) 1999, 2001-2004, 2006, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1999, 2001-2004, 2006, 2009-2024 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
diff --git a/lib/strtol.c b/lib/strtol.c
index b0e7c358800..914cf5b57ab 100644
--- a/lib/strtol.c
+++ b/lib/strtol.c
@@ -1,7 +1,7 @@
/* Convert string representation of a number into an integer value.
- Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2024 Free
- Software Foundation, Inc.
+ Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2024 Free Software
+ Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
Library. Bugs can be reported to bug-glibc@gnu.org.
diff --git a/lib/strtoll.c b/lib/strtoll.c
index 840a03b11e8..d3f5e47fc12 100644
--- a/lib/strtoll.c
+++ b/lib/strtoll.c
@@ -1,6 +1,6 @@
/* Function to parse a 'long long int' from text.
- Copyright (C) 1995-1997, 1999, 2001, 2009-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1995-1997, 1999, 2001, 2009-2024 Free Software Foundation,
+ Inc.
This file is part of the GNU C Library.
This file is free software: you can redistribute it and/or modify
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 7593fee54a8..bf08f33536d 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -55,17 +55,41 @@
#ifndef _@GUARD_PREFIX@_SYS_STAT_H
#define _@GUARD_PREFIX@_SYS_STAT_H
-/* This file uses GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */
+/* This file uses _GL_ATTRIBUTE_NOTHROW, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */
#if !_GL_CONFIG_H_INCLUDED
#error "Please include config.h first."
#endif
+
+/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
+ */
+#ifndef _GL_ATTRIBUTE_NOTHROW
+# if defined __cplusplus
+# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# else
+# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
+# endif
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_ARG_NONNULL is copied here. */
/* The definition of _GL_WARN_ON_USE is copied here. */
+
/* Before doing "#define mknod rpl_mknod" below, we need to include all
headers that may declare mknod(). OS/2 kLIBC declares mknod() in
<unistd.h>, not in <sys/stat.h>. */
@@ -575,7 +599,11 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - "
#if @GNULIB_GETUMASK@
# if !@HAVE_GETUMASK@
+# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2
+_GL_FUNCDECL_SYS (getumask, mode_t, (void) _GL_ATTRIBUTE_NOTHROW);
+# else
_GL_FUNCDECL_SYS (getumask, mode_t, (void));
+# endif
# endif
_GL_CXXALIAS_SYS (getumask, mode_t, (void));
# if @HAVE_GETUMASK@
diff --git a/lib/tempname.c b/lib/tempname.c
index fec5f7b29d6..446ddeaef19 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -193,7 +193,7 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
char *XXXXXX;
unsigned int count;
int fd = -1;
- int save_errno = errno;
+ int saved_errno = errno;
/* A lower bound on the number of temporary files to attempt to
generate. The maximum total number of temporary file names that
@@ -258,7 +258,7 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
fd = tryfunc (tmpl, args);
if (fd >= 0)
{
- __set_errno (save_errno);
+ __set_errno (saved_errno);
return fd;
}
else if (errno != EEXIST)
diff --git a/lib/time.in.h b/lib/time.in.h
index 58e103af07c..df99c8abca9 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -154,11 +154,21 @@ _GL_WARN_ON_USE (timespec_get, "timespec_get is unportable - "
/* Set *TS to the current time resolution, and return BASE.
Upon failure, return 0. */
# if @GNULIB_TIMESPEC_GETRES@
-# if ! @HAVE_TIMESPEC_GETRES@
+# if @REPLACE_TIMESPEC_GETRES@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef timespec_getres
+# define timespec_getres rpl_timespec_getres
+# endif
+_GL_FUNCDECL_RPL (timespec_getres, int, (struct timespec *ts, int base)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (timespec_getres, int, (struct timespec *ts, int base));
+# else
+# if !@HAVE_TIMESPEC_GETRES@
_GL_FUNCDECL_SYS (timespec_getres, int, (struct timespec *ts, int base)
_GL_ARG_NONNULL ((1)));
-# endif
+# endif
_GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base));
+# endif
_GL_CXXALIASWARN (timespec_getres);
# elif defined GNULIB_POSIXCHECK
# undef timespec_getres
@@ -428,11 +438,7 @@ _GL_CXXALIAS_SYS (ctime, char *, (time_t const *__tp));
_GL_CXXALIASWARN (ctime);
# endif
# elif defined GNULIB_POSIXCHECK
-# undef ctime
-# if HAVE_RAW_DECL_CTIME
-_GL_WARN_ON_USE (ctime, "ctime has portability problems - "
- "use gnulib module ctime for portability");
-# endif
+/* No need to warn about portability, as a more serious warning is below. */
# endif
/* Convert *TP to a date and time string. See
diff --git a/lib/time_r.c b/lib/time_r.c
index 4201e73f743..b724f3b38de 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -1,7 +1,6 @@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2024 Free Software Foundation,
- Inc.
+ Copyright (C) 2003, 2006-2007, 2010-2024 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
@@ -22,6 +21,11 @@
#include <time.h>
+/* The replacement functions in this file are only used on native Windows.
+ They are multithread-safe, because the gmtime() and localtime() functions
+ on native Windows ā€” both in the ucrt and in the older MSVCRT ā€” return a
+ pointer to a 'struct tm' in thread-local memory. */
+
static struct tm *
copy_tm_result (struct tm *dest, struct tm const *src)
{
diff --git a/lib/unistd.c b/lib/unistd.c
index 50b75ff44b7..f3b3f7bd2fe 100644
--- a/lib/unistd.c
+++ b/lib/unistd.c
@@ -18,5 +18,5 @@
#include <config.h>
#define _GL_UNISTD_INLINE _GL_EXTERN_INLINE
-#include "unistd.h"
+#include <unistd.h>
typedef int dummy;
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 661cec2770f..b412966367d 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -971,23 +971,28 @@ _GL_WARN_ON_USE (faccessat, "faccessat is not portable - "
Return 0 if successful, otherwise -1 and errno set.
See the POSIX:2008 specification
<https://pubs.opengroup.org/onlinepubs/9699919799/functions/fchdir.html>. */
-# if ! @HAVE_FCHDIR@
+# if @REPLACE_FCHDIR@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fchdir
+# define fchdir rpl_fchdir
+# endif
+_GL_FUNCDECL_RPL (fchdir, int, (int /*fd*/));
+_GL_CXXALIAS_RPL (fchdir, int, (int /*fd*/));
+# else
+# if !@HAVE_FCHDIR@ || !@HAVE_DECL_FCHDIR@
_GL_FUNCDECL_SYS (fchdir, int, (int /*fd*/));
-
+# endif
+_GL_CXXALIAS_SYS (fchdir, int, (int /*fd*/));
+# endif
+_GL_CXXALIASWARN (fchdir);
+# if @REPLACE_FCHDIR@ || !@HAVE_FCHDIR@
/* Gnulib internal hooks needed to maintain the fchdir metadata. */
_GL_EXTERN_C int _gl_register_fd (int fd, const char *filename)
_GL_ARG_NONNULL ((2));
_GL_EXTERN_C void _gl_unregister_fd (int fd);
_GL_EXTERN_C int _gl_register_dup (int oldfd, int newfd);
_GL_EXTERN_C const char *_gl_directory_name (int fd);
-
-# else
-# if !@HAVE_DECL_FCHDIR@
-_GL_FUNCDECL_SYS (fchdir, int, (int /*fd*/));
-# endif
# endif
-_GL_CXXALIAS_SYS (fchdir, int, (int /*fd*/));
-_GL_CXXALIASWARN (fchdir);
#elif defined GNULIB_POSIXCHECK
# undef fchdir
# if HAVE_RAW_DECL_FCHDIR
@@ -1113,10 +1118,10 @@ _GL_WARN_ON_USE (ftruncate, "ftruncate is unportable - "
or SIZE was too small.
See the POSIX:2008 specification
<https://pubs.opengroup.org/onlinepubs/9699919799/functions/getcwd.html>.
- Additionally, the gnulib module 'getcwd' guarantees the following GNU
- extension: If BUF is NULL, an array is allocated with 'malloc'; the array
- is SIZE bytes long, unless SIZE == 0, in which case it is as big as
- necessary. */
+ Additionally, the gnulib module 'getcwd' or 'getcwd-lgpl' guarantees the
+ following GNU extension: If BUF is NULL, an array is allocated with
+ 'malloc'; the array is SIZE bytes long, unless SIZE == 0, in which case
+ it is as big as necessary. */
# if @REPLACE_GETCWD@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define getcwd rpl_getcwd
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h
index b27c3fdcd6f..0cd9bbf3c98 100644
--- a/lib/unlocked-io.h
+++ b/lib/unlocked-io.h
@@ -101,7 +101,7 @@
# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
# endif
-# if HAVE_DECL_GETC_UNLOCKED || defined get_unlocked
+# if HAVE_DECL_GETC_UNLOCKED || defined getc_unlocked
# undef getc
# define getc(x) getc_unlocked (x)
# else
diff --git a/lib/utimens.c b/lib/utimens.c
index dca9a01252a..4bfb9c91a7b 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -231,8 +231,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
The same bug occurs in Solaris 11.1 (Apr 2013).
- FIXME: Simplify this for Linux in 2016 and for Solaris in
- 2024, when file system bugs are no longer common. */
+ FIXME: Simplify this in 2024, when these file system bugs are
+ no longer common on Gnulib target platforms. */
if (adjustment_needed == 2)
{
if (fd < 0 ? stat (file, &st) : fstat (fd, &st))
diff --git a/lib/verify.h b/lib/verify.h
index a80f22c694a..08268c2498f 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -188,9 +188,9 @@ template <int w>
_gl_verify_type<(R) ? 1 : -1>
#elif defined _GL_HAVE__STATIC_ASSERT
# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
- struct { \
- _Static_assert (R, DIAGNOSTIC); \
- int _gl_dummy; \
+ struct { \
+ _Static_assert (R, DIAGNOSTIC); \
+ int _gl_dummy; \
}
#else
# define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \
@@ -212,8 +212,8 @@ template <int w>
#elif defined _GL_HAVE__STATIC_ASSERT
# define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
#else
-# define _GL_VERIFY(R, DIAGNOSTIC, ...) \
- extern int (*_GL_GENSYM (_gl_verify_function) (void)) \
+# define _GL_VERIFY(R, DIAGNOSTIC, ...) \
+ extern int (*_GL_GENSYM (_gl_verify_function) (void)) \
[_GL_VERIFY_TRUE (R, DIAGNOSTIC)]
# if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
# pragma GCC diagnostic ignored "-Wnested-externs"
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 8f4d40dcbeb..701013a07f4 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -32,6 +32,10 @@
_GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline'
linkage.
+ _GL_WARN_ON_USE should not be used more than once for a given function
+ in a given compilation unit (because this may generate a warning even
+ if the function is never called).
+
However, one of the reasons that a function is a portability trap is
if it has the wrong signature. Declaring FUNCTION with a different
signature in C is a compilation error, so this macro must use the
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
index 2be82cd275d..7f30f83e769 100644
--- a/lib/xalloc-oversized.h
+++ b/lib/xalloc-oversized.h
@@ -1,7 +1,6 @@
/* xalloc-oversized.h -- memory allocation size checking
- Copyright (C) 1990-2000, 2003-2004, 2006-2024 Free Software
- Foundation, Inc.
+ Copyright (C) 1990-2000, 2003-2004, 2006-2024 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
@@ -30,8 +29,7 @@
is SIZE_MAX - 1. */
#define __xalloc_oversized(n, s) \
((s) != 0 \
- && ((size_t) (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) \
- < (n)))
+ && (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) < (n))
/* Return 1 if and only if an array of N objects, each of size S,
cannot exist reliably because its total size in bytes would exceed
@@ -49,13 +47,13 @@
#if 7 <= __GNUC__ && !defined __clang__ && PTRDIFF_MAX < SIZE_MAX
# define xalloc_oversized(n, s) \
__builtin_mul_overflow_p (n, s, (ptrdiff_t) 1)
-#elif (5 <= __GNUC__ && !defined __ICC && !__STRICT_ANSI__ \
- && PTRDIFF_MAX < SIZE_MAX)
+#elif 5 <= __GNUC__ && !defined __ICC && PTRDIFF_MAX < SIZE_MAX
# define xalloc_oversized(n, s) \
(__builtin_constant_p (n) && __builtin_constant_p (s) \
? __xalloc_oversized (n, s) \
- : ({ ptrdiff_t __xalloc_count; \
- __builtin_mul_overflow (n, s, &__xalloc_count); }))
+ : __extension__ \
+ ({ ptrdiff_t __xalloc_count; \
+ __builtin_mul_overflow (n, s, &__xalloc_count); }))
/* Other compilers use integer division; this may be slower but is
more portable. */
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 4e26136e8f8..188eeb720c0 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.")
"Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty."
(setq abbrevs-changed t)
(let* ((sym (obarray-get table "")))
- (dotimes (i (length table))
- (aset table i 0))
+ (obarray-clear table)
;; Preserve the table's properties.
(cl-assert sym)
(let ((newsym (obarray-put table "")))
@@ -721,7 +720,7 @@ either a single abbrev table or a list of abbrev tables."
;; to treat the distinction between a single table and a list of tables.
(cond
((consp tables) tables)
- ((vectorp tables) (list tables))
+ ((obarrayp tables) (list tables))
(t
(let ((tables (if (listp local-abbrev-table)
(append local-abbrev-table
@@ -1275,7 +1274,7 @@ which see."
(setq font-lock-multiline nil))
(defun abbrev--possibly-save (query &optional arg)
- "Hook function for use by `save-some-buffer-functions'.
+ "Hook function for use by `save-some-buffers-functions'.
Maybe save abbrevs, and record whether we either saved them or asked to."
;; Query mode.
diff --git a/lisp/align.el b/lisp/align.el
index fa95f24fa02..81ccc4b5e2d 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -181,13 +181,12 @@ If nil, then no messages will ever be printed to the minibuffer."
:type '(choice (const :tag "Align a large region silently" nil) integer)
:group 'align)
-(defcustom align-c++-modes '( c++-mode c-mode java-mode
- c-ts-mode c++-ts-mode)
+(defcustom align-c++-modes '( c++-mode c-mode java-mode)
"A list of modes whose syntax resembles C/C++."
:type '(repeat symbol)
:group 'align)
-(defcustom align-perl-modes '(perl-mode cperl-mode)
+(defcustom align-perl-modes '(perl-mode)
"A list of modes where Perl syntax is to be seen."
:type '(repeat symbol)
:group 'align)
@@ -576,13 +575,13 @@ The possible settings for `align-region-separate' are:
"="
(group (zero-or-more (syntax whitespace)))))
(group . (1 2))
- (modes . '(conf-toml-mode toml-ts-mode lua-mode lua-ts-mode)))
+ (modes . '(conf-toml-mode lua-mode)))
(double-dash-comment
(regexp . ,(rx (group (zero-or-more (syntax whitespace)))
"--"
(zero-or-more nonl)))
- (modes . '(lua-mode lua-ts-mode))
+ (modes . '(lua-mode))
(column . comment-column)
(valid . ,(lambda ()
(save-excursion
diff --git a/lisp/allout.el b/lisp/allout.el
index 95b73c54934..e3fe8d08841 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables, `allout-command-prefix',
(defcustom allout-command-prefix "\C-c "
"Key sequence to be used as prefix for outline mode command key bindings.
-Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
-willing to let allout use a bunch of \C-c keybindings."
- :type 'string
+Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're
+willing to let allout use a bunch of \\`C-c' keybindings."
+ :type 'key-sequence
:group 'allout-keybindings
:set #'allout-compose-and-institute-keymap)
;;;_ = allout-keybindings-binding
@@ -6195,7 +6195,7 @@ for details on preparing Emacs for automatic allout activation."
(allout-open-topic 2)
(insert (substitute-command-keys
(concat "Dummy outline topic header -- see"
- " `allout-mode' docstring: `\\[describe-mode]'.")))
+ " `allout-mode' docstring: \\[describe-mode]")))
(allout-adjust-file-variable
"allout-layout" (or allout-layout '(-1 : 0))))))
;;;_ > allout-file-vars-section-data ()
diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el
index 7e686193f69..8dbaeb45132 100644
--- a/lisp/ansi-osc.el
+++ b/lisp/ansi-osc.el
@@ -121,7 +121,8 @@ 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))))
+ ;; Use `downcase' to match `url-generic-parse-url' behavior
+ (string= (url-host url) (downcase (system-name)))))
(ignore-errors
(cd-absolute (url-unhex-string (url-filename url)))))))
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 369cf4dca2e..5f5629d9cfc 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -233,8 +233,8 @@ EPA/EPG set up, the file will be encrypted and decrypted
automatically. See Info node `(epa)Encrypting/decrypting gpg files'
for details.
-It's best to customize this with `\\[customize-variable]' because the choices
-can get pretty complex."
+It's best to customize this with \\[customize-variable] because
+the choices can get pretty complex."
:version "26.1" ; neither new nor changed default
:type `(repeat :tag "Authentication Sources"
(choice
@@ -330,7 +330,6 @@ If the value is not a list, symmetric encryption will be used."
(defun auth-source-read-char-choice (prompt choices)
"Read one of CHOICES by `read-char-choice', or `read-char'.
-`dropdown-list' support is disabled because it doesn't work reliably.
Only one of CHOICES will be returned. The PROMPT is augmented
with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)."
(when choices
@@ -1946,18 +1945,20 @@ entries for git.gnus.org:
(returned-keys (delete-dups (append
'(:host :login :port :secret)
search-keys)))
- ;; Extract host and port from spec
+ ;; Extract host, port and user from spec
(hosts (plist-get spec :host))
- (hosts (if (and hosts (listp hosts)) hosts `(,hosts)))
+ (hosts (if (consp hosts) hosts `(,hosts)))
(ports (plist-get spec :port))
- (ports (if (and ports (listp ports)) ports `(,ports)))
+ (ports (if (consp ports) ports `(,ports)))
(users (plist-get spec :user))
- (users (if (and users (listp users)) users `(,users)))
+ (users (if (consp users) users `(,users)))
;; Loop through all combinations of host/port and pass each of these to
- ;; auth-source-macos-keychain-search-items
+ ;; auth-source-macos-keychain-search-items. Convert numeric port to
+ ;; string (bug#68376).
(items (catch 'match
(dolist (host hosts)
(dolist (port ports)
+ (when (numberp port) (setq port (number-to-string port)))
(dolist (user users)
(let ((items (apply
#'auth-source-macos-keychain-search-items
@@ -1984,7 +1985,7 @@ entries for git.gnus.org:
(defun auth-source--decode-octal-string (string)
- "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"."
+ "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"."
(let ((list (string-to-list string))
(size (length string)))
(decode-coding-string
@@ -2019,7 +2020,7 @@ entries for git.gnus.org:
(when port
(if keychain-generic
(setq args (append args (list "-s" port)))
- (setq args (append args (if (string-match "[0-9]+" port)
+ (setq args (append args (if (string-match-p "\\`[[:digit:]]+\\'" port)
(list "-P" port)
(list "-r" (substring
(format "%-4s" port)
diff --git a/lisp/bind-key.el b/lisp/bind-key.el
index 94a39f795cd..780314fecbd 100644
--- a/lisp/bind-key.el
+++ b/lisp/bind-key.el
@@ -155,6 +155,7 @@ add keys to that keymap."
(add-to-list 'emulation-mode-map-alists
`((override-global-mode . ,override-global-map)))
+;;;###autoload
(defvar personal-keybindings nil
"List of bindings performed by `bind-key'.
@@ -452,31 +453,28 @@ other modes. See `override-global-mode'."
(macroexp-progn (bind-keys-form args 'override-global-map)))
(defun bind-key--get-binding-description (elem)
- (cond
- ((listp elem)
+ (let (doc)
(cond
- ((memq (car elem) '(lambda function))
- (if (and bind-key-describe-special-forms
- (stringp (nth 2 elem)))
- (nth 2 elem)
- "#<lambda>"))
- ((eq 'closure (car elem))
- (if (and bind-key-describe-special-forms
- (stringp (nth 3 elem)))
- (nth 3 elem)
- "#<closure>"))
- ((eq 'keymap (car elem))
- "#<keymap>")
+ ((symbolp elem)
+ (cond
+ ((and bind-key-describe-special-forms (keymapp elem)
+ ;; FIXME: Is this really ever better than the symbol-name?
+ ;; FIXME: `variable-documentation' describe what's in
+ ;; elem's `symbol-value', whereas `elem' here stands for
+ ;; its `symbol-function'.
+ (stringp (setq doc (get elem 'variable-documentation))))
+ doc)
+ (t elem)))
+ ((and bind-key-describe-special-forms (functionp elem)
+ (stringp (setq doc (documentation elem))))
+ doc) ;;FIXME: Keep only the first line?
+ ;; FIXME: Use `help-fns-function-name'?
+ ((consp elem)
+ (if (symbolp (car elem))
+ (format "#<%s>" (car elem))
+ elem))
(t
- elem)))
- ;; must be a symbol, non-symbol keymap case covered above
- ((and bind-key-describe-special-forms (keymapp elem))
- (let ((doc (get elem 'variable-documentation)))
- (if (stringp doc) doc elem)))
- ((symbolp elem)
- elem)
- (t
- "#<byte-compiled lambda>")))
+ (format "#<%s>" (type-of elem))))))
(defun bind-key--compare-keybindings (l r)
(let* ((regex bind-key-segregation-regexp)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 893fdffb7ce..bf2357207d8 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -142,7 +142,7 @@ Nil means don't prompt for confirmation."
"Non-nil means show annotations when jumping to a bookmark."
:type 'boolean)
-(defconst bookmark-bmenu-buffer "*Bookmark List*"
+(defvar bookmark-bmenu-buffer "*Bookmark List*"
"Name of buffer used for Bookmark List.")
(defvar bookmark-bmenu-use-header-line t
@@ -515,10 +515,11 @@ See user option `bookmark-fringe-mark'."
(non-essential t)
overlays found temp)
(when (and pos filename)
- (setq filename (expand-file-name filename))
+ (setq filename (abbreviate-file-name (expand-file-name filename)))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (when (equal filename buffer-file-name)
+ (when (equal filename
+ (ignore-errors (bookmark-buffer-file-name)))
(setq overlays
(save-excursion
(goto-char pos)
@@ -1192,6 +1193,8 @@ it to the name of the bookmark currently being set, advancing
(if (stringp dired-directory)
dired-directory
(car dired-directory)))
+ ((and (boundp 'Info-current-file) (stringp Info-current-file))
+ Info-current-file)
(t (error "Buffer not visiting a file or directory")))))
(defvar bookmark--watch-already-asked-mtime nil
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 82afea3d053..ec5337e3fda 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -95,11 +95,35 @@ as it is by default."
:group 'Buffer-menu
:version "22.1")
+(defcustom Buffer-menu-group-by nil
+ "If non-nil, a function to call to divide buffer-menu buffers into groups.
+This function is called with one argument: a list of entries in the same
+format as in `tabulated-list-entries', and should return a list in the
+format suitable for `tabulated-list-groups'. Also, when this variable
+is non-nil, `outline-minor-mode' is enabled in the Buffer Menu and you
+can use Outline minor mode commands to show/hide groups of buffers,
+according to the value of `outline-regexp'.
+The default options can group by a mode, and by a root directory of
+a project or just `default-directory'.
+If this is nil, buffers are not divided into groups."
+ :type '(choice (const :tag "No grouping" nil)
+ (function-item :tag "Group by mode"
+ Buffer-menu-group-by-mode)
+ (function-item :tag "Group by project root or directory"
+ Buffer-menu-group-by-root)
+ (function :tag "Custom function"))
+ :group 'Buffer-menu
+ :version "30.1")
+
(defvar-local Buffer-menu-files-only nil
"Non-nil if the current Buffer Menu lists only file buffers.
This is set by the prefix argument to `buffer-menu' and related
commands.")
+(defvar-local Buffer-menu-show-internal nil
+ "Non-nil if the current Buffer Menu lists internal buffers.
+Internal buffers are those whose names start with a space.")
+
(defvar-local Buffer-menu-filter-predicate nil
"Function to filter out buffers in the buffer list.
Buffers that don't satisfy the predicate will be skipped.
@@ -140,6 +164,7 @@ then the buffer will be displayed in the buffer list.")
"V" #'Buffer-menu-view
"O" #'Buffer-menu-view-other-window
"T" #'Buffer-menu-toggle-files-only
+ "I" #'Buffer-menu-toggle-internal
"M-s a C-s" #'Buffer-menu-isearch-buffers
"M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
"M-s a C-o" #'Buffer-menu-multi-occur
@@ -197,6 +222,10 @@ then the buffer will be displayed in the buffer list.")
:help "Toggle whether the current buffer-menu displays only file buffers"
:style toggle
:selected Buffer-menu-files-only]
+ ["Show Internal Buffers" Buffer-menu-toggle-internal
+ :help "Toggle whether the current buffer-menu displays internal buffers"
+ :style toggle
+ :selected Buffer-menu-show-internal]
"---"
["Refresh" revert-buffer
:help "Refresh the *Buffer List* buffer contents"]
@@ -317,6 +346,11 @@ ARG, show only buffers that are visiting files."
(interactive "P")
(display-buffer (list-buffers-noselect arg)))
+(defun Buffer-menu--selection-message ()
+ (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.")
+ (Buffer-menu-show-internal "Showing all buffers.")
+ (t "Showing all buffers except internal ones."))))
+
(defun Buffer-menu-toggle-files-only (arg)
"Toggle whether the current `buffer-menu' displays only file buffers.
With a positive ARG, display only file buffers. With zero or
@@ -325,9 +359,18 @@ negative ARG, display other buffers as well."
(setq Buffer-menu-files-only
(cond ((not arg) (not Buffer-menu-files-only))
((> (prefix-numeric-value arg) 0) t)))
- (message (if Buffer-menu-files-only
- "Showing only file-visiting buffers."
- "Showing all non-internal buffers."))
+ (Buffer-menu--selection-message)
+ (revert-buffer))
+
+(defun Buffer-menu-toggle-internal (arg)
+ "Toggle whether the current `buffer-menu' displays internal buffers.
+With a positive ARG, don't show internal buffers. With zero or
+negative ARG, display internal buffers as well."
+ (interactive "P" Buffer-menu-mode)
+ (setq Buffer-menu-show-internal
+ (cond ((not arg) (not Buffer-menu-show-internal))
+ ((> (prefix-numeric-value arg) 0) t)))
+ (Buffer-menu--selection-message)
(revert-buffer))
(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort
@@ -385,14 +428,12 @@ When called interactively prompt for MARK; RET remove all marks."
(interactive "cRemove marks (RET means all):" Buffer-menu-mode)
(save-excursion
(goto-char (point-min))
- (when (tabulated-list-header-overlay-p)
- (forward-line))
(while (not (eobp))
- (let ((xmarks (list (aref (tabulated-list-get-entry) 0)
- (aref (tabulated-list-get-entry) 2))))
- (when (or (char-equal mark ?\r)
- (member (char-to-string mark) xmarks))
- (Buffer-menu--unmark)))
+ (when-let ((entry (tabulated-list-get-entry)))
+ (let ((xmarks (list (aref entry 0) (aref entry 2))))
+ (when (or (char-equal mark ?\r)
+ (member (char-to-string mark) xmarks))
+ (Buffer-menu--unmark))))
(forward-line))))
(defun Buffer-menu-unmark-all ()
@@ -416,7 +457,7 @@ When called interactively prompt for MARK; RET remove all marks."
(defun Buffer-menu-delete (&optional arg)
"Mark the buffer on this Buffer Menu buffer line for deletion.
-A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
+A subsequent \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command \
will delete it.
If prefix argument ARG is non-nil, it specifies the number of
@@ -437,16 +478,16 @@ buffers to delete; a negative ARG means to delete backwards."
(defun Buffer-menu-delete-backwards (&optional arg)
"Mark the buffer on this Buffer Menu line for deletion, and move up.
-A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]'
-command will delete the marked buffer. Prefix ARG means move
-that many lines."
+A subsequent \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command \
+will delete the marked buffer. Prefix ARG
+ means move that many lines."
(interactive "p" Buffer-menu-mode)
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
"Mark the buffer on this Buffer Menu line for saving.
-A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
-will save it."
+A subsequent \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] \
+command will save it."
(interactive nil Buffer-menu-mode)
(when (Buffer-menu-buffer)
(tabulated-list-set-col 2 "S" t)
@@ -463,8 +504,8 @@ it as modified."
(defun Buffer-menu-execute ()
"Save and/or delete marked buffers in the Buffer Menu.
-Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
-Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
+Buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] are saved.
+Buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] are deleted."
(interactive nil Buffer-menu-mode)
(save-excursion
(Buffer-menu-beginning)
@@ -492,7 +533,7 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted
(defun Buffer-menu-select ()
"Select this line's buffer; also, display buffers marked with `>'.
-You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
+You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
This command deletes and replaces all the previously existing windows
in the selected frame, and will remove any marks."
@@ -515,15 +556,16 @@ in the selected frame, and will remove any marks."
(defun Buffer-menu-marked-buffers (&optional unmark)
"Return the list of buffers marked with `Buffer-menu-mark'.
If UNMARK is non-nil, unmark them."
- (let (buffers)
- (Buffer-menu-beginning)
- (while (re-search-forward "^>" nil t)
- (let ((buffer (Buffer-menu-buffer)))
- (if (and buffer unmark)
- (tabulated-list-set-col 0 " " t))
- (if (buffer-live-p buffer)
- (push buffer buffers))))
- (nreverse buffers)))
+ (save-excursion
+ (let (buffers)
+ (Buffer-menu-beginning)
+ (while (re-search-forward "^>" nil t)
+ (let ((buffer (Buffer-menu-buffer)))
+ (if (and buffer unmark)
+ (tabulated-list-set-col 0 " " t))
+ (if (buffer-live-p buffer)
+ (push buffer buffers))))
+ (nreverse buffers))))
(defun Buffer-menu-isearch-buffers ()
"Search for a string through all marked buffers using Isearch."
@@ -569,13 +611,17 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-other-window ()
"Select this line's buffer in other window, leaving buffer menu visible."
(interactive nil Buffer-menu-mode)
- (switch-to-buffer-other-window (Buffer-menu-buffer t)))
+ (let ((display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (switch-to-buffer-other-window (Buffer-menu-buffer t))))
(defun Buffer-menu-switch-other-window ()
"Make the other window select this line's buffer.
The current window remains selected."
(interactive nil Buffer-menu-mode)
- (display-buffer (Buffer-menu-buffer t) t))
+ (let ((display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (display-buffer (Buffer-menu-buffer t) t)))
(defun Buffer-menu-2-window ()
"Select this line's buffer, with previous buffer in second window."
@@ -647,7 +693,12 @@ See more at `Buffer-menu-filter-predicate'."
(setq Buffer-menu-buffer-list buffer-list)
(setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
- (tabulated-list-print))
+ (tabulated-list-print)
+ (when tabulated-list-groups
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'in-margins)
+ (outline-minor-mode 1)))
buffer))
(defun Buffer-menu-mouse-select (event)
@@ -667,6 +718,7 @@ See more at `Buffer-menu-filter-predicate'."
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
+ (show-internal Buffer-menu-show-internal)
(filter-predicate (and (functionp Buffer-menu-filter-predicate)
Buffer-menu-filter-predicate))
entries name-width)
@@ -686,7 +738,8 @@ See more at `Buffer-menu-filter-predicate'."
(file buffer-file-name))
(when (and (buffer-live-p buffer)
(or buffer-list
- (and (or (not (string= (substring name 0 1) " "))
+ (and (or show-internal
+ (not (string= (substring name 0 1) " "))
file)
(not (eq buffer buffer-menu-buffer))
(or file show-non-file)
@@ -721,7 +774,11 @@ See more at `Buffer-menu-filter-predicate'."
`("Mode" ,Buffer-menu-mode-width t)
'("File" 1 t)))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line)
- (setq tabulated-list-entries (nreverse entries)))
+ (setq tabulated-list-entries (nreverse entries))
+ (when Buffer-menu-group-by
+ (setq tabulated-list-groups
+ (seq-group-by Buffer-menu-group-by
+ tabulated-list-entries))))
(tabulated-list-init-header))
(defun tabulated-list-entry-size-> (entry1 entry2)
@@ -740,4 +797,14 @@ See more at `Buffer-menu-filter-predicate'."
(abbreviate-file-name list-buffers-directory))
(t "")))
+(defun Buffer-menu-group-by-mode (entry)
+ (concat "* " (aref (cadr entry) 5)))
+
+(declare-function project-root "project" (project))
+(defun Buffer-menu-group-by-root (entry)
+ (concat "* " (with-current-buffer (car entry)
+ (if-let ((project (project-current)))
+ (project-root project)
+ default-directory))))
+
;;; buff-menu.el ends here
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 08e8d9fcd6f..a21efc0238d 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -505,6 +505,7 @@ The value t means abort and give an error message.")
("ā…" "(5:8)") ; 5/8
("ā…ž" "(7:8)") ; 7/8
("ā…Ÿ" "1:") ; 1/...
+ ("ā„" ":") ; arbitrary fractions of the form 123ā„456
;; superscripts
("ā°" "0") ; 0
("Ā¹" "1") ; 1
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 03210995eb3..8dff7f1f264 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1225,13 +1225,17 @@ Redefine the corresponding command."
(interactive)
(calc-kbd-if))
+(defun calc--at-end-of-kmacro-p ()
+ (and (arrayp executing-kbd-macro)
+ (>= executing-kbd-macro-index (length executing-kbd-macro))))
+
(defun calc-kbd-skip-to-else-if (else-okay)
(let ((count 0)
ch)
(while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z[ in keyboard macro"))
+ (setq ch (read-char))
(if (= ch ?Z)
(progn
(setq ch (read-char))
@@ -1299,9 +1303,9 @@ Redefine the corresponding command."
(or executing-kbd-macro
(message "Reading loop body..."))
(while (>= count 0)
- (setq ch (read-event))
- (if (eq ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z%c in keyboard macro" open))
+ (setq ch (read-event))
(if (eq ch ?Z)
(progn
(setq ch (read-event)
@@ -1427,9 +1431,9 @@ Redefine the corresponding command."
(if defining-kbd-macro
(message "Reading body..."))
(while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z` in keyboard macro"))
+ (setq ch (read-char))
(if (= ch ?Z)
(progn
(setq ch (read-char)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index a25684f7b5d..10c86571804 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1985,7 +1985,7 @@ Gregorian date Sunday, December 31, 1 BC. This function does not
handle dates in years BC."
;; For an explanation, see the footnote on page 384 of "Calendrical
;; Calculations, Part II: Three Historical Calendars" by
- ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
+ ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; Software--Practice and Experience, Volume 23, Number 4 (April,
;; 1993), pages 383-404 <https://doi.org/10.1002/spe.4380230404>
;; <http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.6421&rep=rep1&type=pdf>.
@@ -2337,10 +2337,12 @@ returned is (month year)."
(defmon (aref month-array (1- (calendar-extract-month default-date))))
(completion-ignore-case t)
(month (cdr (assoc-string
- (completing-read
- (format-prompt "Month name" defmon)
- (append month-array nil)
- nil t nil nil defmon)
+ (let ((completion-extra-properties
+ '(:category calendar-month)))
+ (completing-read
+ (format-prompt "Month name" defmon)
+ (append month-array nil)
+ nil t nil nil defmon))
(calendar-make-alist month-array 1) t)))
(defday (calendar-extract-day default-date))
(last (calendar-last-day-of-month month year)))
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 7989fff9466..12287299a7f 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -677,7 +677,7 @@ current (i.e., last displayed) category.
In Todo mode just the category's unfinished todo items are shown
by default. The done items are hidden, but typing
-`\\[todo-toggle-view-done-items]' displays them below the todo
+\\[todo-toggle-view-done-items] displays them below the todo
items. With non-nil user option `todo-show-with-done' both todo
and done items are always shown on visiting a category."
(interactive "P\np")
@@ -1553,7 +1553,7 @@ the archive of the file moved to, creating it if it does not exist."
(prin1 todo-categories (current-buffer)))
;; If archive was just created, save it to avoid "File
;; <xyz> no longer exists!" message on invoking
- ;; `todo-view-archived-items'.
+ ;; `todo-find-archive'.
(unless (file-exists-p (buffer-file-name))
(save-buffer))
(todo-category-number (or new cat))
@@ -1612,7 +1612,7 @@ archive file and the source category is deleted."
(garchive (concat (file-name-sans-extension gfile) ".toda"))
(archived-count (todo-get-count 'archived))
here)
- (with-current-buffer (get-buffer (find-file-noselect tfile))
+ (with-current-buffer (find-file-noselect tfile)
(widen)
(let* ((inhibit-read-only t)
(cbeg (progn
@@ -1638,7 +1638,7 @@ archive file and the source category is deleted."
(todo-count (todo-get-count 'todo cat))
(done-count (todo-get-count 'done cat)))
;; Merge into goal todo category.
- (with-current-buffer (get-buffer (find-file-noselect gfile))
+ (with-current-buffer (find-file-noselect gfile)
(unless (derived-mode-p 'todo-mode) (todo-mode))
(widen)
(goto-char (point-min))
@@ -1677,7 +1677,7 @@ archive file and the source category is deleted."
(mapc (lambda (m) (set-marker m nil))
(list cbeg tbeg dbeg tend cend))))
(when (> archived-count 0)
- (with-current-buffer (get-buffer (find-file-noselect tarchive))
+ (with-current-buffer (find-file-noselect tarchive)
(widen)
(goto-char (point-min))
(let* ((inhibit-read-only t)
@@ -1697,7 +1697,7 @@ archive file and the source category is deleted."
(forward-line)
(buffer-substring-no-properties (point) cend))))
;; Merge into goal archive category, if it exists, else create it.
- (with-current-buffer (get-buffer (find-file-noselect garchive))
+ (with-current-buffer (find-file-noselect garchive)
(let ((gbeg (when (re-search-forward
(concat "^" (regexp-quote
(concat todo-category-beg goal))
@@ -3570,12 +3570,12 @@ categories display according to priority."
In the initial display the lines of the table are numbered,
indicating the current order of the categories when sequentially
-navigating through the todo file with `\\[todo-forward-category]'
-and `\\[todo-backward-category]'. You can reorder the lines, and
-hence the category sequence, by typing `\\[todo-raise-category]'
-or `\\[todo-lower-category]' to raise or lower the category at
-point, or by typing `\\[todo-set-category-number]' and entering a
-number at the prompt or by typing `\\[todo-set-category-number]'
+navigating through the todo file with \\[todo-forward-category]
+and \\[todo-backward-category]. You can reorder the lines, and
+hence the category sequence, by typing \\[todo-raise-category]
+or \\[todo-lower-category] to raise or lower the category at
+point, or by typing \\[todo-set-category-number] and entering a
+number at the prompt or by typing \\[todo-set-category-number]
with a numeric prefix. If you save the todo file after
reordering the categories, the new order persists in subsequent
Emacs sessions.
@@ -3584,8 +3584,8 @@ The labels above the category names and item counts are buttons,
and clicking these changes the display: sorted by category name
or by the respective item counts (alternately descending or
ascending). In these displays the categories are not numbered
-and `\\[todo-set-category-number]', `\\[todo-raise-category]' and
-`\\[todo-lower-category]' are disabled. (Programmatically, the
+and \\[todo-set-category-number], \\[todo-raise-category] and
+\\[todo-lower-category] are disabled. (Programmatically, the
sorting is triggered by passing a non-nil SORTKEY argument.)
In addition, the lines with the category names and item counts
@@ -4065,8 +4065,8 @@ face."
(defcustom todo-top-priorities-overrides nil
"List of rules specifying number of top priority items to show.
These rules override `todo-top-priorities' on invocations of
-`\\[todo-filter-top-priorities]' and
-`\\[todo-filter-top-priorities-multifile]'. Each rule is a list
+\\[todo-filter-top-priorities] and
+\\[todo-filter-top-priorities-multifile]. Each rule is a list
of the form (FILE NUM ALIST), where FILE is a member of
`todo-files', NUM is a number specifying the default number of
top priority items for each category in that file, and ALIST,
@@ -4075,8 +4075,8 @@ number specifying the default number of top priority items in
that category, which overrides NUM.
This variable should be set interactively by
-`\\[todo-set-top-priorities-in-file]' or
-`\\[todo-set-top-priorities-in-category]'."
+\\[todo-set-top-priorities-in-file] or
+\\[todo-set-top-priorities-in-category]."
:type 'sexp
:group 'todo-filtered)
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 28f14232704..9f11b9707bd 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 27 Apr 2004
@@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols.
FUNCTION does not have arguments."
(setq modes (ensure-list modes))
(mode-local-map-file-buffers
- function (lambda () (apply #'derived-mode-p modes))))
+ function (lambda () (derived-mode-p modes))))
;;; Hook machinery
;;
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index a4be5bf67e2..f63d316c1ac 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -153,13 +153,13 @@ The search priority is:
"Return the dynamic macro map for the current buffer."
(or semantic-lex-spp-dynamic-macro-symbol-obarray
(setq semantic-lex-spp-dynamic-macro-symbol-obarray
- (make-vector 13 0))))
+ (obarray-make 13))))
(defsubst semantic-lex-spp-dynamic-map-stack ()
"Return the dynamic macro map for the current buffer."
(or semantic-lex-spp-dynamic-macro-symbol-obarray-stack
(setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack
- (make-vector 13 0))))
+ (obarray-make 13))))
(defun semantic-lex-spp-value-valid-p (value)
"Return non-nil if VALUE is valid."
@@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define.
REPLACEMENT a string that would be substituted in for NAME."
;; Create the symbol hash table
- (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0))
+ (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13))
spec)
;; fill it with stuff
(while specs
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index b32cb96bed9..f3d671ac312 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and
apply those properties.
PROPSPECS must be a list of (NAME PROPERTY VALUE) elements."
;; Create the symbol hash table
- (let ((semantic-flex-keywords-obarray (make-vector 13 0))
+ (let ((semantic-flex-keywords-obarray (obarray-make 13))
spec)
;; fill it with stuff
(while specs
@@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and
apply those properties.
PROPSPECS must be a list of (TYPE PROPERTY VALUE)."
;; Create the symbol hash table
- (let* ((semantic-lex-types-obarray (make-vector 13 0))
+ (let* ((semantic-lex-types-obarray (obarray-make 13))
spec type tokens token alist default)
;; fill it with stuff
(while specs
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index 83e3bc36073..cc4d1546c85 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -44,9 +44,7 @@ those hits returned.")
(defvar semantic-symref-filepattern-alist
'((c-mode "*.[ch]")
- (c-ts-mode "*.[ch]")
(c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
- (c++-ts-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
(html-mode "*.html" "*.shtml" "*.php")
(mhtml-mode "*.html" "*.shtml" "*.php") ; FIXME: remove
; duplication of
@@ -55,12 +53,8 @@ those hits returned.")
; major mode definition?
(ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
"Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
- (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
- "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
(python-mode "*.py" "*.pyi" "*.pyw")
- (python-ts-mode "*.py" "*.pyi" "*.pyw")
(perl-mode "*.pl" "*.PL")
- (cperl-mode "*.pl" "*.PL")
(lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs")
)
"List of major modes and file extension pattern.
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 18a0b4caee2..a0843dd5df9 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -349,6 +349,9 @@ If TAG is unlinked, but has a :filename property, then that is used."
;; If an error occurs, then it most certainly is not a tag.
(error nil)))
+;; Used in `semantic-utest-ia.el'.
+(cl-deftype semantic-tag () `(satisfies semantic-tag-p))
+
(defsubst semantic-tag-of-class-p (tag class)
"Return non-nil if class of TAG is CLASS."
(eq (semantic-tag-class tag) class))
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index a620d4d8dc3..4d9644216d8 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -214,7 +214,7 @@
equiv))
equiv)))
-(defconst char-fold-table
+(defvar char-fold-table
(eval-when-compile
(char-fold--make-table))
"Used for folding characters of the same group during search.
diff --git a/lisp/comint.el b/lisp/comint.el
index 0a9cdb44bef..a8fe095e99c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -254,7 +254,7 @@ This variable is buffer-local."
See also `comint-read-input-ring' and `comint-write-input-ring'.
`comint-mode' makes this a buffer-local variable. You probably want
to set this in a mode hook, rather than customize the default value."
- :type '(choice (const :tag "nil" nil)
+ :type '(choice (const :tag "Disable input history" nil)
file)
:group 'comint)
@@ -3510,7 +3510,7 @@ the completions."
;; Read the next key, to process SPC.
(let (key first)
- (if (with-current-buffer (get-buffer "*Completions*")
+ (if (with-current-buffer "*Completions*"
(setq-local comint-displayed-dynamic-completions
completions)
(setq key (read-key-sequence nil)
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index baadb4714b1..e827da43a08 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -52,6 +52,8 @@
;;; Code:
+(require 'mwheel)
+
(defgroup completion-preview nil
"In-buffer completion preview."
:group 'completion)
@@ -128,19 +130,19 @@ If this option is nil, these commands do not display any message."
;; "M-p" #'completion-preview-prev-candidate
)
-(defvar mouse-wheel-up-event)
-(defvar mouse-wheel-up-alternate-event)
-(defvar mouse-wheel-down-event)
-(defvar mouse-wheel-down-alternate-event)
(defvar-keymap completion-preview--mouse-map
:doc "Keymap for mouse clicks on the completion preview."
"<down-mouse-1>" #'completion-preview-insert
"C-<down-mouse-1>" #'completion-at-point
"<down-mouse-2>" #'completion-at-point
- (format "<%s>" mouse-wheel-up-event) #'completion-preview-prev-candidate
- (format "<%s>" mouse-wheel-up-alternate-event) #'completion-preview-prev-candidate
- (format "<%s>" mouse-wheel-down-event) #'completion-preview-next-candidate
- (format "<%s>" mouse-wheel-down-alternate-event) #'completion-preview-next-candidate)
+ ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events
+ ;; and vice versa!!
+ "<wheel-up>" #'completion-preview-prev-candidate
+ "<wheel-down>" #'completion-preview-next-candidate
+ (key-description (vector mouse-wheel-up-event))
+ #'completion-preview-next-candidate
+ (key-description (vector mouse-wheel-down-event))
+ #'completion-preview-prev-candidate)
(defvar-local completion-preview--overlay nil)
@@ -300,21 +302,21 @@ point, otherwise hide it."
;; never display a stale preview and that the preview doesn't
;; flicker, even with slow completion backends.
(let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (max (point) (overlay-start completion-preview--overlay)))
(cands (completion-preview--get 'completion-preview-cands))
(index (completion-preview--get 'completion-preview-index))
(cand (nth index cands))
- (len (length cand))
- (end (+ beg len))
- (cur (point))
- (face (get-text-property 0 'face (completion-preview--get 'after-string))))
- (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand))
+ (after (completion-preview--get 'after-string))
+ (face (get-text-property 0 'face after)))
+ (if (and (<= beg (point) end (1- (+ beg (length cand))))
+ (string-prefix-p (buffer-substring beg end) cand))
;; The previous preview is still applicable, update it.
(overlay-put (completion-preview--make-overlay
- cur (propertize (substring cand (- cur beg))
+ end (propertize (substring cand (- end beg))
'face face
'mouse-face 'completion-preview-highlight
'keymap completion-preview--mouse-map))
- 'completion-preview-end cur)
+ 'completion-preview-end end)
;; The previous preview is no longer applicable, hide it.
(completion-preview-active-mode -1))))
;; Run `completion-at-point-functions' to get a new candidate.
@@ -364,16 +366,16 @@ prefix argument and defaults to 1."
(interactive "p")
(when completion-preview-active-mode
(let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (completion-preview--get 'completion-preview-end))
(all (completion-preview--get 'completion-preview-cands))
(cur (completion-preview--get 'completion-preview-index))
(len (length all))
(new (mod (+ cur direction) len))
- (str (nth new all))
- (pos (point)))
- (while (or (<= (+ beg (length str)) pos)
- (not (string-prefix-p (buffer-substring beg pos) str)))
+ (str (nth new all)))
+ (while (or (<= (+ beg (length str)) end)
+ (not (string-prefix-p (buffer-substring beg end) str)))
(setq new (mod (+ new direction) len) str (nth new all)))
- (let ((aft (propertize (substring str (- pos beg))
+ (let ((aft (propertize (substring str (- end beg))
'face (if (< 1 len)
'completion-preview
'completion-preview-exact)
diff --git a/lisp/completion.el b/lisp/completion.el
index ab7f2a7bc52..6c758e56eab 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'."
;; GNU implements obarrays
(defconst cmpl-obarray-length 511)
-(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
+(defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length)
"An obarray used to store the downcased completion prefixes.
Each symbol is bound to a list of completion entries.")
-(defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
+(defvar cmpl-obarray (obarray-make cmpl-obarray-length)
"An obarray used to store the downcased completions.
Each symbol is bound to a single completion entry.")
@@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.")
(defun clear-all-completions ()
"Initialize the completion storage. All existing completions are lost."
(interactive)
- (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
- (setq cmpl-obarray (make-vector cmpl-obarray-length 0)))
+ (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length))
+ (setq cmpl-obarray (obarray-make cmpl-obarray-length)))
(defun list-all-completions ()
"Return a list of all the known completion entries."
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 0eeca7c2f31..f004002333b 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1159,14 +1159,15 @@ argument or if the current major mode has no known group, prompt
for the MODE to customize."
(interactive
(list
- (let ((completion-regexp-list '("-mode\\'"))
- (group (custom-group-of-mode major-mode)))
+ (let ((group (custom-group-of-mode major-mode)))
(if (and group (not current-prefix-arg))
major-mode
(intern
(completing-read (format-prompt "Mode" (and group major-mode))
obarray
- 'custom-group-of-mode
+ (lambda (s)
+ (and (string-match "-mode\\'" (symbol-name s))
+ (custom-group-of-mode s)))
t nil nil (if group (symbol-name major-mode))))))))
(customize-group (custom-group-of-mode mode)))
@@ -1228,6 +1229,41 @@ If OTHER-WINDOW is non-nil, display in another window."
(message "`%s' is an alias for `%s'" symbol basevar))))
;;;###autoload
+(defun customize-toggle-option (symbol)
+ "Toggle the value of boolean option SYMBOL for this session."
+ (interactive (let ((prompt "Toggle boolean option: ") opts)
+ (mapatoms
+ (lambda (sym)
+ (when (eq (get sym 'custom-type) 'boolean)
+ (push sym opts))))
+ (list (intern (completing-read prompt opts nil nil nil nil
+ (symbol-at-point))))))
+ (let* ((setter (or (get symbol 'custom-set) #'set-default))
+ (getter (or (get symbol 'custom-get) #'symbol-value))
+ (value (condition-case nil
+ (funcall getter symbol)
+ (void-variable (error "`%s' is not bound" symbol))))
+ (type (get symbol 'custom-type)))
+ (cond
+ ((eq type 'boolean))
+ ((and (null type)
+ (yes-or-no-p
+ (format "`%s' doesn't have a type, and has the value %S. \
+Proceed to toggle?" symbol value))))
+ ((yes-or-no-p
+ (format "`%s' is of type %s, and has the value %S. \
+Proceed to toggle?"
+ symbol type value)))
+ ((error "Abort toggling of option `%s'" symbol)))
+ (message "%s user options `%s'."
+ (if (funcall setter symbol (not value))
+ "Enabled" "Disabled")
+ symbol)))
+
+;;;###autoload
+(defalias 'toggle-option #'customize-toggle-option)
+
+;;;###autoload
(defalias 'customize-variable-other-window 'customize-option-other-window)
;;;###autoload
@@ -5389,9 +5425,49 @@ The following properties have special meanings for this widget:
:hidden-states '(standard)
:action #'custom-icon-action
:custom-set #'custom-icon-set
- :custom-reset-current #'custom-redraw)
- ;; Not implemented yet.
- ;; :custom-reset-saved 'custom-icon-reset-saved)
+ :custom-mark-to-save #'custom-icon-mark-to-save
+ :custom-reset-current #'custom-redraw
+ :custom-reset-saved #'custom-icon-reset-saved
+ :custom-state-set-and-redraw #'custom-icon-state-set-and-redraw
+ :custom-reset-standard #'custom-icon-reset-standard
+ :custom-mark-to-reset-standard #'custom-icon-mark-to-reset-standard)
+
+(defun custom-icon-mark-to-save (widget)
+ "Mark user customization for icon edited by WIDGET to be saved later."
+ (let* ((icon (widget-value widget))
+ (value (custom--icons-widget-value
+ (car (widget-get widget :children)))))
+ (custom-push-theme 'theme-icon icon 'user 'set value)))
+
+(defun custom-icon-reset-saved (widget)
+ "Restore icon customized by WIDGET to the icon's default attributes.
+
+If there's a theme value for the icon, resets to that. Otherwise, resets to
+its standard value."
+ (let* ((icon (widget-value widget)))
+ (custom-push-theme 'theme-icon icon 'user 'reset)
+ (custom-icon-state-set widget)
+ (custom-redraw widget)))
+
+(defun custom-icon-state-set-and-redraw (widget)
+ "Set state of icon widget WIDGET and redraw it with up-to-date settings."
+ (custom-icon-state-set widget)
+ (custom-redraw-magic widget))
+
+(defun custom-icon-reset-standard (widget)
+ "Reset icon edited by WIDGET to its standard value."
+ (let* ((icon (widget-value widget))
+ (themes (get icon 'theme-icon)))
+ (dolist (theme themes)
+ (custom-push-theme 'theme-icon icon (car theme) 'reset))
+ (custom-save-all))
+ (widget-put widget :custom-state 'unknown)
+ (custom-redraw widget))
+
+(defun custom-icon-mark-to-reset-standard (widget)
+ "Reset icon edited by WIDGET to its standard value."
+ ;; Don't mark for now, there aren't that many icons.
+ (custom-icon-reset-standard widget))
(defvar custom-icon-extended-menu
(let ((map (make-sparse-keymap)))
@@ -5410,6 +5486,18 @@ The following properties have special meanings for this widget:
:enable (memq
(widget-get custom-actioned-widget :custom-state)
'(modified changed))))
+ (define-key-after map [custom-icon-reset-saved]
+ '(menu-item "Revert This Session's Customization"
+ custom-icon-reset-saved
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed rogue))))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-icon-reset-standard]
+ '(menu-item "Erase Customization" custom-icon-reset-standard
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed saved rogue)))))
map)
"A menu for `custom-icon' widgets.
Used in `custom-icon-action' to show a menu to the user.")
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 0c8b6b0b97c..47afa841f5e 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -32,7 +32,7 @@
(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but with FACE evaluated as a normal argument."
(when (and doc
- (not (stringp doc)))
+ (not (documentation-stringp doc)))
(error "Invalid (or missing) doc string %S" doc))
(unless (get face 'face-defface-spec)
(face-spec-set face (purecopy spec) 'face-defface-spec)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 36879029282..165296d2242 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(auto-save-timeout auto-save (choice (const :tag "off" nil)
(integer :format "%v")))
(echo-keystrokes minibuffer number)
+ (echo-keystrokes-help minibuffer boolean "30.1")
(polling-period keyboard float)
(double-click-time mouse (restricted-sexp
:match-alternatives (integerp 'nil 't)))
@@ -606,6 +607,8 @@ This should only be chosen under exceptional circumstances,
since it could result in memory overflow and make Emacs crash."
nil))
"27.1")
+ ;; w32fns.c
+ (w32-follow-system-dark-mode display boolean "30.1")
;; window.c
(temp-buffer-show-function windows (choice (const nil) function))
(next-screen-context-lines windows integer)
@@ -843,6 +846,8 @@ since it could result in memory overflow and make Emacs crash."
(x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
(font-use-system-font font-selection boolean "23.2")
+ ;; xwidget.c
+ (xwidget-webkit-disable-javascript xwidget boolean "30.1")
;; haikuterm.c
(haiku-debug-on-fatal-error debug boolean "29.1")
;; haikufns.c
@@ -903,6 +908,8 @@ since it could result in memory overflow and make Emacs crash."
(symbol-name symbol))
;; Any function from fontset.c will do.
(fboundp 'new-fontset))
+ ((string-match "xwidget-" (symbol-name symbol))
+ (boundp 'xwidget-internal))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index eeab995c37d..524a6474cd4 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -42,26 +42,6 @@
(insert-text-button
"(widget)Top" 'type 'help-info 'help-args '("(widget)Top")))
-(defun describe-text-sexp (sexp)
- "Insert a short description of SEXP in the current buffer."
- (let ((pp (condition-case signal
- (pp-to-string sexp)
- (error (prin1-to-string signal)))))
- (when (string-match-p "\n\\'" pp)
- (setq pp (substring pp 0 (1- (length pp)))))
-
- (if (and (not (string-search "\n" pp))
- (<= (length pp) (- (window-width) (current-column))))
- (insert pp)
- (insert-text-button
- "[Show]"
- 'follow-link t
- 'action (lambda (&rest _ignore)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ pp)))
- 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
-
(defun describe-property-list (properties)
"Insert a description of PROPERTIES in the current buffer.
PROPERTIES should be a list of overlay or text properties.
@@ -92,7 +72,9 @@ into help buttons that call `describe-text-category' or
(format "%S" value)
'type 'help-face 'help-args (list value)))
(t
- (describe-text-sexp value))))
+ (require 'pp)
+ (declare-function pp-insert-short-sexp "pp" (sexp &optional width))
+ (pp-insert-short-sexp value))))
(insert "\n")))
;;; Describe-Text Commands.
@@ -522,24 +504,24 @@ The character information includes:
(setcar composition
(concat
" with the surrounding characters \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring from pos) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring from pos))
"\" and \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring (1+ pos) to) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring (1+ pos) to))
"\""))
(setcar composition
(concat
" with the preceding character(s) \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring from pos) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring from pos))
"\"")))
(if (< (1+ pos) to)
(setcar composition
(concat
" with the following character(s) \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring (1+ pos) to) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring (1+ pos) to))
"\""))
(setcar composition nil)))
(setcar (cdr composition)
@@ -568,7 +550,7 @@ The character information includes:
("character"
,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)"
char-description
- (apply 'propertize char-description
+ (apply #'propertize char-description
(text-properties-at pos))
char char char))
("charset"
@@ -620,7 +602,7 @@ The character information includes:
(if (consp key-list)
(list "type"
(concat "\""
- (mapconcat 'identity
+ (mapconcat #'identity
key-list "\" or \"")
"\"")
"with"
@@ -721,7 +703,7 @@ The character information includes:
(let ((unicodedata (describe-char-unicode-data char)))
(if unicodedata
(cons (list "Unicode data" "") unicodedata))))))
- (setq max-width (apply 'max (mapcar (lambda (x)
+ (setq max-width (apply #'max (mapcar (lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
(set-buffer src-buf)
@@ -736,7 +718,7 @@ The character information includes:
(dolist (clm (cdr elt))
(cond ((eq (car-safe clm) 'insert-text-button)
(insert " ")
- (eval clm))
+ (eval clm t))
((not (zerop (length clm)))
(insert " " clm))))
(insert "\n"))))
@@ -855,7 +837,7 @@ The character information includes:
(insert "\n")
(dolist (elt
(cond ((eq describe-char-unidata-list t)
- (nreverse (mapcar 'car char-code-property-alist)))
+ (nreverse (mapcar #'car char-code-property-alist)))
((< char 32)
;; Temporary fix (2016-05-22): The
;; decomposition item for \n corrupts the
@@ -898,7 +880,7 @@ characters."
(setq width (- width (length (car last)) 1)))
(let ((ellipsis (and (cdr last) "...")))
(setcdr last nil)
- (concat (mapconcat 'identity words " ") ellipsis)))
+ (concat (mapconcat #'identity words " ") ellipsis)))
"")))
(defun describe-char-eldoc--format (ch &optional width)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index ff113c85e12..3fa09ce6a41 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -163,13 +163,22 @@ Used at desktop read to provide backward compatibility.")
(define-minor-mode desktop-save-mode
"Toggle desktop saving (Desktop Save mode).
-When Desktop Save mode is enabled, the state of Emacs is saved from
-one session to another. In particular, Emacs will save the desktop when
-it exits (this may prompt you; see the option `desktop-save'). The next
-time Emacs starts, if this mode is active it will restore the desktop.
+When Desktop Save mode is enabled, the state of Emacs is saved from one
+session to another. The saved Emacs \"desktop configuration\" includes the
+buffers, their file names, major modes, buffer positions, window and frame
+configuration, and some important global variables.
-To manually save the desktop at any time, use the command `\\[desktop-save]'.
-To load it, use `\\[desktop-read]'.
+To enable this feature for future sessions, customize `desktop-save-mode'
+to t, or add this line in your init file:
+
+ (desktop-save-mode 1)
+
+When this mode is enabled, Emacs will save the desktop when it exits
+(this may prompt you, see the option `desktop-save'). The next time
+Emacs starts, if this mode is active it will restore the desktop.
+
+To manually save the desktop at any time, use the command \\[desktop-save].
+To load it, use \\[desktop-read].
Once a desktop file exists, Emacs will auto-save it according to the
option `desktop-auto-save-timeout'.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index f091101ea27..a2ce3083cfe 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1467,7 +1467,7 @@ With a prefix argument, kill that many lines starting with the current line.
(defun dired-do-kill-lines (&optional arg fmt init-count)
"Remove all marked lines, or the next ARG lines.
The files or directories on those lines are _not_ deleted. Only the
-Dired listing is affected. To restore the removals, use `\\[revert-buffer]'.
+Dired listing is affected. To restore the removals, use \\[revert-buffer].
With a numeric prefix arg, remove that many lines going forward,
starting with the current line. (A negative prefix arg removes lines
@@ -2871,7 +2871,7 @@ similar to the \"-d\" option for the \"cp\" shell command.
But if `dired-copy-dereference' is non-nil, the symbolic
links are dereferenced and then copied, similar to the \"-L\"
option for the \"cp\" shell command. If ARG is a cons with
-element 4 (`\\[universal-argument]'), the inverted value of
+element 4 (\\[universal-argument]), the inverted value of
`dired-copy-dereference' will be used.
Also see `dired-do-revert-buffer'."
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 62fdd916e69..753d3054d2f 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -77,12 +77,17 @@ files not writable by you are visited read-only."
(other :tag "non-writable only" if-file-read-only))
:group 'dired-x)
-(defcustom dired-omit-size-limit 100000
- "Maximum size for the \"omitting\" feature.
+(defcustom dired-omit-size-limit 300000
+ "Maximum buffer size for `dired-omit-mode'.
+
+Omitting will be disabled if the directory listing exceeds this size in
+bytes. This variable is ignored when `dired-omit-mode' is called
+interactively.
+
If nil, there is no maximum size."
:type '(choice (const :tag "no maximum" nil) integer)
:group 'dired-x
- :version "29.1")
+ :version "30.1")
(defcustom dired-omit-case-fold 'filesystem
"Determine whether \"omitting\" patterns are case-sensitive.
@@ -506,14 +511,23 @@ status message."
(re-search-forward dired-re-mark nil t))))
count)))
+(defvar dired-omit--extension-regexp-cache
+ nil
+ "A cache of `regexp-opt' applied to `dired-omit-extensions'.
+
+This is a cons whose car is a list of strings and whose cdr is a
+regexp produced by `regexp-opt'.")
+
(defun dired-omit-regexp ()
+ (unless (equal dired-omit-extensions (car dired-omit--extension-regexp-cache))
+ (setq dired-omit--extension-regexp-cache
+ (cons dired-omit-extensions (regexp-opt dired-omit-extensions))))
(concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
(if (and dired-omit-files dired-omit-extensions) "\\|" "")
(if dired-omit-extensions
(concat ".";; a non-extension part should exist
- "\\("
- (mapconcat 'regexp-quote dired-omit-extensions "\\|")
- "\\)$")
+ (cdr dired-omit--extension-regexp-cache)
+ "$")
"")))
;; Returns t if any work was done, nil otherwise.
diff --git a/lisp/dired.el b/lisp/dired.el
index 69fa15dde73..9e3b888df14 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2817,7 +2817,9 @@ is controlled by `dired-movement-style'."
(dired--trivial-next-line arg)))
(defun dired--move-to-next-line (arg jumpfun)
- (let ((old-position (progn
+ (let ((wrapped nil)
+ (old-arg arg)
+ (old-position (progn
;; It's always true that we should move
;; to the filename when possible.
(dired-move-to-filename)
@@ -2832,16 +2834,27 @@ is controlled by `dired-movement-style'."
(when (= old-position (point))
;; Now point is at beginning/end of movable area,
;; but it still wants to move farther.
- (if (eq dired-movement-style 'cycle)
- ;; `cycle': go to the other end.
+ (cond
+ ;; `cycle': go to the other end.
+ ((eq dired-movement-style 'cycle)
+ ;; Argument not changing on the second wrap
+ ;; means infinite loop with no files found.
+ (if (and wrapped (eq old-arg arg))
+ (setq arg 0)
(goto-char (if (cl-plusp moving-down)
(point-min)
- (point-max)))
- ;; `bounded': go back to the last non-empty line.
- (while (dired-between-files)
- (funcall jumpfun (- moving-down)))
+ (point-max))))
+ (setq wrapped t))
+ ;; `bounded': go back to the last non-empty line.
+ ((eq dired-movement-style 'bounded)
+ (while (and (dired-between-files) (not (zerop arg)))
+ (funcall jumpfun (- moving-down))
+ ;; Point not moving means infinite loop.
+ (if (= old-position (point))
+ (setq arg 0)
+ (setq old-position (point))))
;; Encountered a boundary, so let's stop movement.
- (setq arg moving-down)))
+ (setq arg (if (dired-between-files) 0 moving-down)))))
(unless (dired-between-files)
;; Has moved to a non-empty line. This movement does
;; make sense.
@@ -4308,6 +4321,11 @@ this subdir."
(prefix-numeric-value arg)
(lambda ()
(when (or (not (looking-at-p dired-re-dot))
+ ;; Don't skip symlinks to ".", "..", etc.
+ (save-excursion
+ (re-search-forward
+ dired-permission-flags-regexp nil t)
+ (eq (char-after (match-beginning 1)) ?l))
(not (equal dired-marker-char dired-del-marker)))
(delete-char 1)
(insert dired-marker-char))))))))
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 22cb18359a3..1fc1ab45b84 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -453,7 +453,10 @@ on FRAME itself.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
-`down-mouse-1' (or similar) event."
+`down-mouse-1' (or similar) event.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging text from Emacs is not supported by this window system"))
(gui-set-selection 'XdndSelection text)
@@ -513,7 +516,10 @@ nil, any drops on FRAME itself will be ignored.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
-`down-mouse-1' (or similar) event."
+`down-mouse-1' (or similar) event.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)
@@ -580,7 +586,10 @@ FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
FILES is a list of files that will be dragged. If the drop
target doesn't support dropping multiple files, the first file in
-FILES will be dragged."
+FILES will be dragged.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)
diff --git a/lisp/dom.el b/lisp/dom.el
index f7043ba8252..b329379fdc3 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -288,7 +288,7 @@ If XML, generate XML instead of HTML."
(insert ">")
(dolist (child children)
(if (stringp child)
- (insert child)
+ (insert (url-insert-entities-in-string child))
(setq non-text t)
(when pretty
(insert "\n" (make-string (+ column 2) ?\s)))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 362ec0ecbb4..abfc380d154 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -124,9 +124,9 @@ from `kmacro-edit-lossage'."
(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
"Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
-keyboard macro, `\\[view-lossage]' to edit the last 300
-keystrokes as a keyboard macro, or `\\[execute-extended-command]'
+Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last
+keyboard macro, \\[view-lossage] to edit the last 300
+keystrokes as a keyboard macro, or \\[execute-extended-command]
to edit a macro by its command name.
With a prefix argument, format the macro in a more concise way."
(interactive
@@ -720,17 +720,15 @@ This function assumes that the events can be stored in a string."
(setf (aref seq i) (logand (aref seq i) 127)))
seq)
-;; These are needed in a --without-x build.
-(defvar mouse-wheel-down-event)
-(defvar mouse-wheel-up-event)
-(defvar mouse-wheel-right-event)
-(defvar mouse-wheel-left-event)
-
(defun edmacro-fix-menu-commands (macro &optional noerror)
(if (vectorp macro)
(let (result)
;; Not preloaded in a --without-x build.
(require 'mwheel)
+ (defvar mouse-wheel-down-event)
+ (defvar mouse-wheel-up-event)
+ (defvar mouse-wheel-right-event)
+ (defvar mouse-wheel-left-event)
;; Make a list of the elements.
(setq macro (append macro nil))
(dolist (ev macro)
@@ -746,9 +744,9 @@ This function assumes that the events can be stored in a string."
;; info is recorded in macros to make this possible.
((or (mouse-event-p ev) (mouse-movement-p ev)
(memq (event-basic-type ev)
- (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-right-event
- mouse-wheel-left-event)))
+ `( ,mouse-wheel-down-event ,mouse-wheel-up-event
+ ,mouse-wheel-right-event ,mouse-wheel-left-event
+ wheel-down wheel-up wheel-left wheel-right)))
nil)
(noerror nil)
(t
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 9489a9fd1b3..752660156b9 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2042,8 +2042,6 @@ in that CLASS."
function class name)))
(error "ad-remove-advice: `%s' is not advised" function)))
-(declare-function comp-subr-trampoline-install "comp-run")
-
;;;###autoload
(defun ad-add-advice (function advice class position)
"Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 73745e8c7ac..42ba89ba2c1 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -204,6 +204,9 @@
('str (bindat--unpack-str len))
('strz (bindat--unpack-strz len))
('vec
+ (when (> len (length bindat-raw))
+ (error "Vector length %d is greater than raw data length %d"
+ len (length bindat-raw)))
(let ((v (make-vector len 0)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
@@ -941,9 +944,13 @@ a bindat type expression."
(bindat-defmacro sint (bitlen le)
"Signed integer of size BITLEN.
Big-endian if LE is nil and little-endian if not."
+ (unless lexical-binding
+ (error "The `sint' type requires 'lexical-binding'"))
(let ((bl (make-symbol "bitlen"))
(max (make-symbol "max"))
(wrap (make-symbol "wrap")))
+ ;; FIXME: This `let*' around the `struct' results in code which the
+ ;; byte-compiler does not handle efficiently. šŸ™
`(let* ((,bl ,bitlen)
(,max (ash 1 (1- ,bl)))
(,wrap (+ ,max ,max)))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index add13a5c312..ea163723a3e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -482,9 +482,6 @@ There can be multiple entries for the same NAME if it has several aliases.")
(push name byte-optimize--dynamic-vars)
`(,fn ,name . ,optimized-rest)))
- (`(,(pred byte-code-function-p) . ,exps)
- (cons fn (mapcar #'byte-optimize-form exps)))
-
((guard (when for-effect
(if-let ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
@@ -1448,7 +1445,8 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-apply (form)
(let ((len (length form)))
- (if (>= len 2)
+ ;; Single-arg `apply' is an abomination that we don't bother optimizing.
+ (if (> len 2)
(let ((fn (nth 1 form))
(last (nth (1- len) form)))
(cond
@@ -1774,7 +1772,7 @@ See Info node `(elisp) Integer Basics'."
string-version-lessp
substring substring-no-properties
sxhash-eq sxhash-eql sxhash-equal sxhash-equal-including-properties
- take vconcat
+ take value< vconcat
;; frame.c
frame-ancestor-p frame-bottom-divider-width frame-char-height
frame-char-width frame-child-frame-border-width frame-focus
@@ -1975,7 +1973,7 @@ See Info node `(elisp) Integer Basics'."
hash-table-p identity length length< length=
length> member memq memql nth nthcdr proper-list-p rassoc rassq
safe-length string-bytes string-distance string-equal string-lessp
- string-search string-version-lessp take
+ string-search string-version-lessp take value<
;; search.c
regexp-quote
;; syntax.c
@@ -3115,7 +3113,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;;
(eval-when-compile
(or (compiled-function-p (symbol-function 'byte-optimize-form))
- (assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))
(mapc (lambda (x)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1ef3f0fba6d..2b5eb34e571 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -231,17 +231,8 @@ This includes variable references and calls to functions such as `car'."
:type 'boolean)
(defvar byte-compile-dynamic nil
- "If non-nil, compile function bodies so they load lazily.
-They are hidden in comments in the compiled file,
-and each one is brought into core when the
-function is called.
-
-To enable this option, make it a file-local variable
-in the source file you want it to apply to.
-For example, add -*-byte-compile-dynamic: t;-*- on the first line.
-
-When this option is true, if you load the compiled file and then move it,
-the functions you loaded will not be able to run.")
+ "Formerly used to compile function bodies so they load lazily.
+This variable no longer has any effect.")
(make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1")
;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
@@ -262,7 +253,7 @@ This option is enabled by default because it reduces Emacs memory usage."
:type 'boolean)
;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
-(defconst byte-compile-log-buffer "*Compile-Log*"
+(defvar byte-compile-log-buffer "*Compile-Log*"
"Name of the byte-compiler's log buffer.")
(defvar byte-compile--known-dynamic-vars nil
@@ -294,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'."
(defconst byte-compile-warning-types
'( callargs constants
docstrings docstrings-non-ascii-quotes docstrings-wide
+ docstrings-control-chars
empty-body free-vars ignored-return-value interactive-only
lexical lexical-dynamic make-local
mapcar ; obsolete
@@ -316,6 +308,8 @@ Elements of the list may be:
docstrings that are too wide, containing lines longer than both
`byte-compile-docstring-max-column' and `fill-column' characters.
Only enabled when `docstrings' also is.
+ docstrings-control-chars
+ docstrings that contain control characters other than NL and TAB
empty-body body argument to a special form or macro is empty.
free-vars references to variables not in the current lexical scope.
ignored-return-value
@@ -354,7 +348,7 @@ A value of `all' really means all."
'(docstrings-non-ascii-quotes)
"List of warning types that are only enabled during Emacs builds.
This is typically either warning types that are being phased in
-(but shouldn't be enabled for packages yet), or that are only relevant
+\(but shouldn't be enabled for packages yet), or that are only relevant
for the Emacs build itself.")
(defvar byte-compile--suppressed-warnings nil
@@ -1749,68 +1743,100 @@ Also ignore URLs."
The byte-compiler will emit a warning for documentation strings
containing lines wider than this. If `fill-column' has a larger
value, it will override this variable."
- :group 'bytecomp
:type 'natnum
:safe #'natnump
:version "28.1")
-(define-obsolete-function-alias 'byte-compile-docstring-length-warn
- 'byte-compile-docstring-style-warn "29.1")
-
-(defun byte-compile-docstring-style-warn (form)
- "Warn if there are stylistic problems with the docstring in FORM.
-Warn if documentation string of FORM is too wide.
+(defun byte-compile--list-with-n (list n elem)
+ "Return LIST with its Nth element replaced by ELEM."
+ (if (eq elem (nth n list))
+ list
+ (nconc (take n list)
+ (list elem)
+ (nthcdr (1+ n) list))))
+
+(defun byte-compile--docstring-style-warn (docs kind name)
+ "Warn if there are stylistic problems in the docstring DOCS.
+Warn if documentation string is too wide.
It is too wide if it has any lines longer than the largest of
`fill-column' and `byte-compile-docstring-max-column'."
(when (byte-compile-warning-enabled-p 'docstrings)
- (let* ((kind nil) (name nil) (docs nil)
+ (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name))
(prefix (lambda ()
(format "%s%s"
kind
- (if name (format-message " `%s' " name) "")))))
- (pcase (car form)
- ((or 'autoload 'custom-declare-variable 'defalias
- 'defconst 'define-abbrev-table
- 'defvar 'defvaralias
- 'custom-declare-face)
- (setq kind (nth 0 form))
- (setq name (nth 1 form))
- (when (and (consp name) (eq (car name) 'quote))
- (setq name (cadr name)))
- (setq docs (nth 3 form)))
- ('lambda
- (setq kind "") ; can't be "function", unfortunately
- (setq docs (nth 2 form))))
- (when (and kind docs (stringp docs))
- (let ((col (max byte-compile-docstring-max-column fill-column)))
- (when (and (byte-compile-warning-enabled-p 'docstrings-wide)
- (byte-compile--wide-docstring-p docs col))
- (byte-compile-warn-x
- name
- "%sdocstring wider than %s characters" (funcall prefix) col)))
- ;; There's a "naked" ' character before a symbol/list, so it
- ;; should probably be quoted with \=.
- (when (string-match-p (rx (| (in " \t") bol)
- (? (in "\"#"))
- "'"
- (in "A-Za-z" "("))
+ (if name (format-message " `%S' " name) "")))))
+ (let ((col (max byte-compile-docstring-max-column fill-column)))
+ (when (and (byte-compile-warning-enabled-p 'docstrings-wide)
+ (byte-compile--wide-docstring-p docs col))
+ (byte-compile-warn-x
+ name
+ "%sdocstring wider than %s characters" (funcall prefix) col)))
+
+ (when (byte-compile-warning-enabled-p 'docstrings-control-chars)
+ (let ((start 0)
+ (len (length docs)))
+ (while (and (< start len)
+ (string-match (rx (intersection (in (0 . 31) 127)
+ (not (in "\n\t"))))
+ docs start))
+ (let* ((ofs (match-beginning 0))
+ (c (aref docs ofs)))
+ ;; FIXME: it should be possible to use the exact source position
+ ;; of the control char in most cases, and it would be helpful
+ (byte-compile-warn-x
+ name
+ "%sdocstring contains control char #x%02x (position %d)"
+ (funcall prefix) c ofs)
+ (setq start (1+ ofs))))))
+
+ ;; There's a "naked" ' character before a symbol/list, so it
+ ;; should probably be quoted with \=.
+ (when (string-match-p (rx (| (in " \t") bol)
+ (? (in "\"#"))
+ "'"
+ (in "A-Za-z" "("))
+ docs)
+ (byte-compile-warn-x
+ name
+ (concat "%sdocstring has wrong usage of unescaped single quotes"
+ " (use \\=%c or different quoting such as %c...%c)")
+ (funcall prefix) ?' ?` ?'))
+ ;; There's a "Unicode quote" in the string -- it should probably
+ ;; be an ASCII one instead.
+ (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
+ (when (string-match-p (rx (| " \"" (in " \t") bol)
+ (in "ā€˜ā€™"))
docs)
(byte-compile-warn-x
name
- (concat "%sdocstring has wrong usage of unescaped single quotes"
- " (use \\=%c or different quoting such as %c...%c)")
- (funcall prefix) ?' ?` ?'))
- ;; There's a "Unicode quote" in the string -- it should probably
- ;; be an ASCII one instead.
- (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
- (when (string-match-p (rx (| " \"" (in " \t") bol)
- (in "ā€˜ā€™"))
- docs)
- (byte-compile-warn-x
- name
- "%sdocstring uses curved single quotes; use %s instead of ā€˜...ā€™"
- (funcall prefix) "`...'"))))))
- form)
+ "%sdocstring uses curved single quotes; use %s instead of ā€˜...ā€™"
+ (funcall prefix) "`...'"))))))
+
+(defvar byte-compile--\#$) ; Special value that will print as `#$'.
+(defvar byte-compile--docstrings nil "Table of already compiled docstrings.")
+
+(defun byte-compile--docstring (doc kind name &optional is-a-value)
+ (byte-compile--docstring-style-warn doc kind name)
+ ;; Make docstrings dynamic, when applicable.
+ (cond
+ ((and byte-compile-dynamic-docstrings
+ ;; The native compiler doesn't use those dynamic docstrings.
+ (not byte-native-compiling)
+ ;; Docstrings can only be dynamic when compiling a file.
+ byte-compile--\#$)
+ (let* ((byte-pos (with-memoization
+ ;; Reuse a previously written identical docstring.
+ ;; This is not done out of thriftiness but to try and
+ ;; make sure that "equal" functions remain `equal'.
+ ;; (Often those identical docstrings come from
+ ;; `help-add-fundoc-usage').
+ ;; Needed e.g. for `advice-tests-nadvice'.
+ (gethash doc byte-compile--docstrings)
+ (byte-compile-output-as-comment doc nil)))
+ (newdoc (cons byte-compile--\#$ byte-pos)))
+ (if is-a-value newdoc (macroexp-quote newdoc))))
+ (t doc)))
;; If we have compiled any calls to functions which are not known to be
;; defined, issue a warning enumerating them.
@@ -1845,6 +1871,8 @@ It is too wide if it has any lines longer than the largest of
;; macroenvironment.
(copy-alist byte-compile-initial-macro-environment))
(byte-compile--outbuffer nil)
+ (byte-compile--\#$ nil)
+ (byte-compile--docstrings (make-hash-table :test 'equal))
(overriding-plist-environment nil)
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
@@ -1858,7 +1886,6 @@ It is too wide if it has any lines longer than the largest of
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
- (byte-compile-dynamic byte-compile-dynamic)
(byte-compile-dynamic-docstrings
byte-compile-dynamic-docstrings)
(byte-compile-warnings byte-compile-warnings)
@@ -1874,39 +1901,44 @@ It is too wide if it has any lines longer than the largest of
(setq byte-to-native-plist-environment
overriding-plist-environment)))))
-(defmacro displaying-byte-compile-warnings (&rest body)
+(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: namespace!
(declare (debug (def-body)))
`(bytecomp--displaying-warnings (lambda () ,@body)))
(defun bytecomp--displaying-warnings (body-fn)
- (let* ((warning-series-started
+ (let* ((wrapped-body
+ (lambda ()
+ (if byte-compile-debug
+ (funcall body-fn)
+ ;; Use a `handler-bind' to remember the `byte-compile-form-stack'
+ ;; active at the time the error is signaled, so as to
+ ;; get more precise error locations.
+ (let ((form-stack nil))
+ (condition-case error-info
+ (handler-bind
+ ((error (lambda (_err)
+ (setq form-stack byte-compile-form-stack))))
+ (funcall body-fn))
+ (error (let ((byte-compile-form-stack form-stack))
+ (byte-compile-report-error error-info))))))))
+ (warning-series-started
(and (markerp warning-series)
(eq (marker-buffer warning-series)
(get-buffer byte-compile-log-buffer))))
(byte-compile-form-stack byte-compile-form-stack))
- (if (or (eq warning-series 'byte-compile-warning-series)
+ (if (or (eq warning-series #'byte-compile-warning-series)
warning-series-started)
;; warning-series does come from compilation,
;; so don't bind it, but maybe do set it.
- (let (tem)
- ;; Log the file name. Record position of that text.
- (setq tem (byte-compile-log-file))
+ (let ((tem (byte-compile-log-file))) ;; Log the file name.
(unless warning-series-started
- (setq warning-series (or tem 'byte-compile-warning-series)))
- (if byte-compile-debug
- (funcall body-fn)
- (condition-case error-info
- (funcall body-fn)
- (error (byte-compile-report-error error-info)))))
+ (setq warning-series (or tem #'byte-compile-warning-series)))
+ (funcall wrapped-body))
;; warning-series does not come from compilation, so bind it.
(let ((warning-series
;; Log the file name. Record position of that text.
- (or (byte-compile-log-file) 'byte-compile-warning-series)))
- (if byte-compile-debug
- (funcall body-fn)
- (condition-case error-info
- (funcall body-fn)
- (error (byte-compile-report-error error-info))))))))
+ (or (byte-compile-log-file) #'byte-compile-warning-series)))
+ (funcall wrapped-body)))))
;;;###autoload
(defun byte-force-recompile (directory)
@@ -2368,7 +2400,12 @@ With argument ARG, insert value in current buffer after the form."
(setq case-fold-search nil))
(displaying-byte-compile-warnings
(with-current-buffer inbuffer
- (when byte-compile-current-file
+ (when byte-compile-dest-file
+ (setq byte-compile--\#$
+ (copy-sequence ;It needs to be a fresh new object.
+ ;; Also it stands for the `load-file-name' when the `.elc' will
+ ;; be loaded, so make it look like it.
+ byte-compile-dest-file))
(byte-compile-insert-header byte-compile-current-file
byte-compile--outbuffer)
;; Instruct native-comp to ignore this file.
@@ -2423,8 +2460,7 @@ With argument ARG, insert value in current buffer after the form."
(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
Call from the source buffer."
- (let ((dynamic byte-compile-dynamic)
- (optimize byte-optimize))
+ (let ((optimize byte-optimize))
(with-current-buffer outbuffer
(goto-char (point-min))
;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
@@ -2458,18 +2494,11 @@ Call from the source buffer."
((eq optimize 'byte) " byte-level optimization only")
(optimize " all optimizations")
(t "out optimization"))
- ".\n"
- (if dynamic ";;; Function definitions are lazy-loaded.\n"
- "")
- "\n\n"))))
+ ".\n\n\n"))))
(defun byte-compile-output-file-form (form)
;; Write the given form to the output buffer, being careful of docstrings
- ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias,
- ;; defconst, autoload, and custom-declare-variable.
- ;; defalias calls are output directly by byte-compile-file-form-defmumble;
- ;; it does not pay to first build the defalias in defmumble and then parse
- ;; it here.
+ ;; (for `byte-compile-dynamic-docstrings').
(when byte-native-compiling
;; Spill output for the native compiler here
(push (make-byte-to-native-top-level :form form :lexical lexical-binding)
@@ -2479,152 +2508,17 @@ Call from the source buffer."
(print-level nil)
(print-quoted t)
(print-gensym t)
- (print-circle t)) ; Handle circular data structures.
- (if (memq (car-safe form) '(defvar defvaralias defconst
- autoload custom-declare-variable))
- (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil
- (memq (car form)
- '(defvaralias autoload
- custom-declare-variable)))
- (princ "\n" byte-compile--outbuffer)
- (prin1 form byte-compile--outbuffer)
- nil)))
+ (print-circle t)
+ (print-continuous-numbering t)
+ (print-number-table (make-hash-table :test #'eq)))
+ (when byte-compile--\#$
+ (puthash byte-compile--\#$ "#$" print-number-table))
+ (princ "\n" byte-compile--outbuffer)
+ (prin1 form byte-compile--outbuffer)
+ nil))
(defvar byte-compile--for-effect)
-(defun byte-compile--output-docform-recurse
- (info position form cvecindex docindex specindex quoted)
- "Print a form with a doc string. INFO is (prefix postfix).
-POSITION is where the next doc string is to be inserted.
-CVECINDEX is the index in the FORM of the constant vector, or nil.
-DOCINDEX is the index of the doc string (or nil) in the FORM.
-If SPECINDEX is non-nil, it is the index in FORM
-of the function bytecode string. In that case,
-we output that argument and the following argument
-\(the constants vector) together, for lazy loading.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`defvaralias', `autoload' and `custom-declare-variable' need that.
-
-Return the position after any inserted docstrings as comments."
- (let ((index 0)
- doc-string-position)
- ;; Insert the doc string, and make it a comment with #@LENGTH.
- (when (and byte-compile-dynamic-docstrings
- (stringp (nth docindex form)))
- (goto-char position)
- (setq doc-string-position
- (byte-compile-output-as-comment
- (nth docindex form) nil)
- position (point))
- (goto-char (point-max)))
-
- (insert (car info))
- (prin1 (car form) byte-compile--outbuffer)
- (while (setq form (cdr form))
- (setq index (1+ index))
- (insert " ")
- (cond ((and (numberp specindex) (= index specindex)
- ;; Don't handle the definition dynamically
- ;; if it refers (or might refer)
- ;; to objects already output
- ;; (for instance, gensyms in the arg list).
- (let (non-nil)
- (when (hash-table-p print-number-table)
- (maphash (lambda (_k v) (if v (setq non-nil t)))
- print-number-table))
- (not non-nil)))
- ;; Output the byte code and constants specially
- ;; for lazy dynamic loading.
- (goto-char position)
- (let ((lazy-position (byte-compile-output-as-comment
- (cons (car form) (nth 1 form))
- t)))
- (setq position (point))
- (goto-char (point-max))
- (princ (format "(#$ . %d) nil" lazy-position)
- byte-compile--outbuffer)
- (setq form (cdr form))
- (setq index (1+ index))))
- ((eq index cvecindex)
- (let* ((cvec (car form))
- (len (length cvec))
- (index2 0)
- elt)
- (insert "[")
- (while (< index2 len)
- (setq elt (aref cvec index2))
- (if (byte-code-function-p elt)
- (setq position
- (byte-compile--output-docform-recurse
- '("#[" "]") position
- (append elt nil) ; Convert the vector to a list.
- 2 4 specindex nil))
- (prin1 elt byte-compile--outbuffer))
- (setq index2 (1+ index2))
- (unless (eq index2 len)
- (insert " ")))
- (insert "]")))
- ((= index docindex)
- (cond
- (doc-string-position
- (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
- doc-string-position)
- byte-compile--outbuffer))
- ((stringp (car form))
- (let ((print-escape-newlines nil))
- (goto-char (prog1 (1+ (point))
- (prin1 (car form)
- byte-compile--outbuffer)))
- (insert "\\\n")
- (goto-char (point-max))))
- (t (prin1 (car form) byte-compile--outbuffer))))
- (t (prin1 (car form) byte-compile--outbuffer))))
- (insert (cadr info))
- position))
-
-(defun byte-compile-output-docform (preface tailpiece name info form
- cvecindex docindex
- specindex quoted)
- "Print a form with a doc string. INFO is (prefix postfix).
-If PREFACE, NAME, and TAILPIECE are non-nil, print them too,
-before/after INFO and the FORM but after the doc string itself.
-CVECINDEX is the index in the FORM of the constant vector, or nil.
-DOCINDEX is the index of the doc string (or nil) in the FORM.
-If SPECINDEX is non-nil, it is the index in FORM
-of the function bytecode string. In that case,
-we output that argument and the following argument
-\(the constants vector) together, for lazy loading.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`defvaralias', `autoload' and `custom-declare-variable' need that."
- ;; We need to examine byte-compile-dynamic-docstrings
- ;; in the input buffer (now current), not in the output buffer.
- (let ((byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings))
- (with-current-buffer byte-compile--outbuffer
- (let ((position (point))
- (print-continuous-numbering t)
- print-number-table
- ;; FIXME: The bindings below are only needed for when we're
- ;; called from ...-defmumble.
- (print-escape-newlines t)
- (print-length nil)
- (print-level nil)
- (print-quoted t)
- (print-gensym t)
- (print-circle t)) ; Handle circular data structures.
- (when preface
- ;; FIXME: We don't handle uninterned names correctly.
- ;; E.g. if cl-define-compiler-macro uses uninterned name we get:
- ;; (defalias '#1=#:foo--cmacro #[514 ...])
- ;; (put 'foo 'compiler-macro '#:foo--cmacro)
- (insert preface)
- (prin1 name byte-compile--outbuffer))
- (byte-compile--output-docform-recurse
- info position form cvecindex docindex specindex quoted)
- (when tailpiece
- (insert tailpiece))))))
-
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-one-form form t)))
@@ -2644,7 +2538,7 @@ list that represents a doc string reference.
(if byte-compile-output
(let ((form (byte-compile-out-toplevel t 'file)))
(cond ((eq (car-safe form) 'progn)
- (mapc 'byte-compile-output-file-form (cdr form)))
+ (mapc #'byte-compile-output-file-form (cdr form)))
(form
(byte-compile-output-file-form form)))
(setq byte-compile-constants nil
@@ -2719,12 +2613,12 @@ list that represents a doc string reference.
(setq byte-compile-unresolved-functions
(delq (assq funsym byte-compile-unresolved-functions)
byte-compile-unresolved-functions)))))
- (if (stringp (nth 3 form))
- (prog1
- form
- (byte-compile-docstring-style-warn form))
- ;; No doc string, so we can compile this as a normal form.
- (byte-compile-keep-pending form 'byte-compile-normal-call)))
+ (let* ((doc (nth 3 form))
+ (newdoc (if (not (stringp doc)) doc
+ (byte-compile--docstring
+ doc 'autoload (nth 1 form)))))
+ (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc)
+ #'byte-compile-normal-call)))
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
@@ -2736,9 +2630,10 @@ list that represents a doc string reference.
(byte-compile-warn-x
sym "global/dynamic var `%s' lacks a prefix" sym)))
-(defun byte-compile--declare-var (sym)
+(defun byte-compile--declare-var (sym &optional not-toplevel)
(byte-compile--check-prefixed-var sym)
- (when (memq sym byte-compile-lexical-variables)
+ (when (and (not not-toplevel)
+ (memq sym byte-compile-lexical-variables))
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
(when (byte-compile-warning-enabled-p 'lexical sym)
@@ -2747,19 +2642,7 @@ list that represents a doc string reference.
(push sym byte-compile--seen-defvars))
(defun byte-compile-file-form-defvar (form)
- (let ((sym (nth 1 form)))
- (byte-compile--declare-var sym)
- (if (eq (car form) 'defconst)
- (push sym byte-compile-const-variables)))
- (if (and (null (cddr form)) ;No `value' provided.
- (eq (car form) 'defvar)) ;Just a declaration.
- nil
- (byte-compile-docstring-style-warn form)
- (setq form (copy-sequence form))
- (when (consp (nth 2 form))
- (setcar (cdr (cdr form))
- (byte-compile-top-level (nth 2 form) nil 'file)))
- form))
+ (byte-compile-defvar form 'toplevel))
(put 'define-abbrev-table 'byte-hunk-handler
'byte-compile-file-form-defvar-function)
@@ -2767,26 +2650,37 @@ list that represents a doc string reference.
(defun byte-compile-file-form-defvar-function (form)
(pcase-let (((or `',name (let name nil)) (nth 1 form)))
- (if name (byte-compile--declare-var name)))
- ;; Variable aliases are better declared before the corresponding variable,
- ;; since it makes it more likely that only one of the two vars has a value
- ;; before the `defvaralias' gets executed, which avoids the need to
- ;; merge values.
- (pcase form
- (`(defvaralias ,_ ',newname . ,_)
- (when (memq newname byte-compile-bound-variables)
- (if (byte-compile-warning-enabled-p 'suspicious)
- (byte-compile-warn-x
- newname
- "Alias for `%S' should be declared before its referent" newname)))))
- (byte-compile-docstring-style-warn form)
- (byte-compile-keep-pending form))
+ (if name (byte-compile--declare-var name))
+ ;; Variable aliases are better declared before the corresponding variable,
+ ;; since it makes it more likely that only one of the two vars has a value
+ ;; before the `defvaralias' gets executed, which avoids the need to
+ ;; merge values.
+ (pcase form
+ (`(defvaralias ,_ ',newname . ,_)
+ (when (memq newname byte-compile-bound-variables)
+ (if (byte-compile-warning-enabled-p 'suspicious)
+ (byte-compile-warn-x
+ newname
+ "Alias for `%S' should be declared before its referent"
+ newname)))))
+ (let ((doc (nth 3 form)))
+ (when (stringp doc)
+ (setcar (nthcdr 3 form)
+ (byte-compile--docstring doc (nth 0 form) name))))
+ (byte-compile-keep-pending form)))
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-defvar-function)
(put 'custom-declare-face 'byte-hunk-handler
- 'byte-compile-docstring-style-warn)
+ #'byte-compile--custom-declare-face)
+(defun byte-compile--custom-declare-face (form)
+ (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form)))
+ (when (stringp docs)
+ (let ((newdocs (byte-compile--docstring docs kind name)))
+ (unless (eq docs newdocs)
+ (setq form (byte-compile--list-with-n form 3 newdocs)))))
+ form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
@@ -2940,34 +2834,24 @@ not to take responsibility for the actual compilation of the code."
(cons (cons bare-name code)
(symbol-value this-kind))))
- (if rest
- ;; There are additional args to `defalias' (like maybe a docstring)
- ;; that the code below can't handle: punt!
- nil
- ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
- ;; special code to allow dynamic docstrings and byte-code.
- (byte-compile-flush-pending)
+ (byte-compile-flush-pending)
+ (let ((newform `(defalias ',bare-name
+ ,(if macro `'(macro . ,code) code) ,@rest)))
(when byte-native-compiling
- ;; Spill output for the native compiler here.
+ ;; Don't let `byte-compile-output-file-form' push the form to
+ ;; `byte-to-native-top-level-forms' because we want to use
+ ;; `make-byte-to-native-func-def' when possible.
(push
- (if macro
+ (if (or macro rest)
(make-byte-to-native-top-level
- :form `(defalias ',name '(macro . ,code) nil)
+ :form newform
:lexical lexical-binding)
(make-byte-to-native-func-def :name name
:byte-func code))
byte-to-native-top-level-forms))
- ;; Output the form by hand, that's much simpler than having
- ;; b-c-output-file-form analyze the defalias.
- (byte-compile-output-docform
- "\n(defalias '" ")"
- bare-name
- (if macro '(" '(macro . #[" "])") '(" #[" "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- 2 4
- (and (atom code) byte-compile-dynamic 1)
- nil)
- t)))))
+ (let ((byte-native-compiling nil))
+ (byte-compile-output-file-form newform)))
+ t))))
(defun byte-compile-output-as-comment (exp quoted)
"Print Lisp object EXP in the output file at point, inside a comment.
@@ -3012,18 +2896,10 @@ otherwise, print without quoting."
(defun byte-compile--reify-function (fun)
"Return an expression which will evaluate to a function value FUN.
-FUN should be either a `lambda' value or a `closure' value."
- (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
- `(closure ,env ,args . ,body))
- fun)
- (preamble nil)
+FUN should be an interpreted closure."
+ (pcase-let* ((`(closure ,env ,args . ,body) fun)
+ (`(,preamble . ,body) (macroexp-parse-body body))
(renv ()))
- ;; Split docstring and `interactive' form from body.
- (when (stringp (car body))
- (push (pop body) preamble))
- (when (eq (car-safe (car body)) 'interactive)
- (push (pop body) preamble))
- (setq preamble (nreverse preamble))
;; Turn the function's closed vars (if any) into local let bindings.
(dolist (binding env)
(cond
@@ -3045,41 +2921,39 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(fun (if (symbolp form)
(symbol-function form)
form))
- (macro (eq (car-safe fun) 'macro)))
- (if macro
- (setq fun (cdr fun)))
- (prog1
- (cond
- ;; Up until Emacs-24.1, byte-compile silently did nothing
- ;; when asked to compile something invalid. So let's tone
- ;; down the complaint from an error to a simple message for
- ;; the known case where signaling an error causes problems.
- ((compiled-function-p fun)
- (message "Function %s is already compiled"
- (if (symbolp form) form "provided"))
- fun)
- (t
- (let (final-eval)
- (when (or (symbolp form) (eq (car-safe fun) 'closure))
- ;; `fun' is a function *value*, so try to recover its corresponding
- ;; source code.
- (setq lexical-binding (eq (car fun) 'closure))
- (setq fun (byte-compile--reify-function fun))
- (setq final-eval t))
- ;; Expand macros.
- (setq fun (byte-compile-preprocess fun))
- (setq fun (byte-compile-top-level fun nil 'eval))
- (if (symbolp form)
- ;; byte-compile-top-level returns an *expression* equivalent to the
- ;; `fun' expression, so we need to evaluate it, tho normally
- ;; this is not needed because the expression is just a constant
- ;; byte-code object, which is self-evaluating.
- (setq fun (eval fun t)))
- (if final-eval
- (setq fun (eval fun t)))
- (if macro (push 'macro fun))
- (if (symbolp form) (fset form fun))
- fun))))))))
+ (macro (eq (car-safe fun) 'macro))
+ (need-a-value nil))
+ (when macro
+ (setq need-a-value t)
+ (setq fun (cdr fun)))
+ (cond
+ ;; Up until Emacs-24.1, byte-compile silently did nothing
+ ;; when asked to compile something invalid. So let's tone
+ ;; down the complaint from an error to a simple message for
+ ;; the known case where signaling an error causes problems.
+ ((compiled-function-p fun)
+ (message "Function %s is already compiled"
+ (if (symbolp form) form "provided"))
+ fun)
+ (t
+ (when (or (symbolp form) (eq (car-safe fun) 'closure))
+ ;; `fun' is a function *value*, so try to recover its
+ ;; corresponding source code.
+ (when (setq lexical-binding (eq (car-safe fun) 'closure))
+ (setq fun (byte-compile--reify-function fun)))
+ (setq need-a-value t))
+ ;; Expand macros.
+ (setq fun (byte-compile-preprocess fun))
+ (setq fun (byte-compile-top-level fun nil 'eval))
+ (when need-a-value
+ ;; `byte-compile-top-level' returns an *expression* equivalent to
+ ;; the `fun' expression, so we need to evaluate it, tho normally
+ ;; this is not needed because the expression is just a constant
+ ;; byte-code object, which is self-evaluating.
+ (setq fun (eval fun lexical-binding)))
+ (if macro (push 'macro fun))
+ (if (symbolp form) (fset form fun))
+ fun))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
@@ -3178,27 +3052,32 @@ lambda-expression."
(setq fun (cons 'lambda fun))
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun)))
- (byte-compile-docstring-style-warn fun)
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
+ (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun.
(arglistvars (byte-run-strip-symbol-positions
(byte-compile-arglist-vars arglist)))
(byte-compile-bound-variables
(append (if (not lexical-binding) arglistvars)
byte-compile-bound-variables))
(body (cdr (cdr fun)))
- (doc (if (stringp (car body))
+ ;; Treat a final string literal as a value, not a doc string.
+ (doc (if (and (cdr body) (stringp (car body)))
(prog1 (car body)
- ;; Discard the doc string
- ;; unless it is the last element of the body.
- (if (cdr body)
- (setq body (cdr body))))))
+ ;; Discard the doc string from the body.
+ (setq body (cdr body)))))
(int (assq 'interactive body))
command-modes)
(when lexical-binding
+ (when arglist
+ ;; byte-compile-make-args-desc lost the args's names,
+ ;; so preserve them in the docstring.
+ (setq doc (help-add-fundoc-usage doc bare-arglist)))
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
(byte-compile--warn-lexical-dynamic var 'lambda))))
+ (when (stringp doc)
+ (setq doc (byte-compile--docstring doc "" nil 'is-a-value)))
;; Process the interactive spec.
(when int
;; Skip (interactive) if it is in front (the most usual location).
@@ -3242,8 +3121,7 @@ lambda-expression."
(and lexical-binding
(byte-compile-make-lambda-lexenv
arglistvars))
- reserved-csts))
- (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun.
+ reserved-csts)))
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(let ((out
@@ -3255,12 +3133,7 @@ lambda-expression."
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
- (cond ((and lexical-binding arglist)
- ;; byte-compile-make-args-desc lost the args's names,
- ;; so preserve them in the docstring.
- (list (help-add-fundoc-usage doc bare-arglist)))
- ((or doc int)
- (list doc)))
+ (when (or doc int) (list doc))
;; optionally, the interactive spec (and the modes the
;; command applies to).
(cond
@@ -3572,6 +3445,7 @@ lambda-expression."
((and (or sef (function-get (car form) 'important-return-value))
;; Don't warn for arguments to `ignore'.
(not (eq byte-compile--for-effect 'for-effect-no-warn))
+ (bytecomp--actually-important-return-value-p form)
(byte-compile-warning-enabled-p
'ignored-return-value (car form)))
(byte-compile-warn-x
@@ -3598,6 +3472,15 @@ lambda-expression."
(if byte-compile--for-effect
(byte-compile-discard)))))
+(defun bytecomp--actually-important-return-value-p (form)
+ "Whether FORM is really a call with a return value that should not go unused.
+This assumes the function has the `important-return-value' property."
+ (cond ((eq (car form) 'sort)
+ ;; For `sort', we only care about non-destructive uses.
+ (and (zerop (% (length form) 2)) ; new-style call
+ (not (plist-get (cddr form) :in-place))))
+ (t t)))
+
(let ((important-return-value-fns
'(
;; These functions are side-effect-free except for the
@@ -3605,9 +3488,11 @@ lambda-expression."
mapcar mapcan mapconcat
assoc plist-get plist-member
- ;; It's safe to ignore the value of `sort' and `nreverse'
+ ;; It's safe to ignore the value of `nreverse'
;; when used on arrays, but most calls pass lists.
- nreverse sort
+ nreverse
+
+ sort ; special handling (non-destructive calls only)
match-data
@@ -3814,7 +3699,6 @@ lambda-expression."
(alen (length (cdr form)))
(dynbinds ())
lap)
- (fetch-bytecode fun)
(setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t))
;; optimized switch bytecode makes it impossible to guess the correct
;; `byte-compile-depth', which can result in incorrect inlined code.
@@ -5141,49 +5025,49 @@ binding slots have been popped."
(push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
(byte-compile-normal-call form))
-(defun byte-compile-defvar (form)
- ;; This is not used for file-level defvar/consts.
- (when (and (symbolp (nth 1 form))
- (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
- (byte-compile-warning-enabled-p 'lexical (nth 1 form)))
- (byte-compile-warn-x
- (nth 1 form)
- "global/dynamic var `%s' lacks a prefix"
- (nth 1 form)))
- (byte-compile-docstring-style-warn form)
- (let ((fun (nth 0 form))
- (var (nth 1 form))
- (value (nth 2 form))
- (string (nth 3 form)))
- (when (or (> (length form) 4)
- (and (eq fun 'defconst) (null (cddr form))))
- (let ((ncall (length (cdr form))))
- (byte-compile-warn-x
- fun
- "`%s' called with %d argument%s, but %s %s"
- fun ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall 2) "requires" "accepts only")
- "2-3")))
- (push var byte-compile-bound-variables)
+(defun byte-compile-defvar (form &optional toplevel)
+ (let* ((fun (nth 0 form))
+ (var (nth 1 form))
+ (value (nth 2 form))
+ (string (nth 3 form)))
+ (byte-compile--declare-var var (not toplevel))
(if (eq fun 'defconst)
(push var byte-compile-const-variables))
- (when (and string (not (stringp string)))
+ (cond
+ ((stringp string)
+ (setq string (byte-compile--docstring string fun var 'is-a-value)))
+ (string
(byte-compile-warn-x
string
"third arg to `%s %s' is not a string: %s"
- fun var string))
- ;; Delegate the actual work to the function version of the
- ;; special form, named with a "-1" suffix.
- (byte-compile-form-do-effect
- (cond
- ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form)))
- ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo.
- (t `(defvar-1 ',var
- ;; Don't eval `value' if `defvar' wouldn't eval it either.
- ,(if (macroexp-const-p value) value
- `(if (boundp ',var) nil ,value))
- ,@(nthcdr 3 form)))))))
+ fun var string)))
+ (if toplevel
+ ;; At top-level we emit calls to defvar/defconst.
+ (if (and (null (cddr form)) ;No `value' provided.
+ (eq (car form) 'defvar)) ;Just a declaration.
+ nil
+ (let ((tail (nthcdr 4 form)))
+ (when (or tail string) (push string tail))
+ (when (cddr form)
+ (push (if (not (consp value)) value
+ (byte-compile-top-level value nil 'file))
+ tail))
+ `(,fun ,var ,@tail)))
+ ;; At non-top-level, since there is no byte code for
+ ;; defvar/defconst, we delegate the actual work to the function
+ ;; version of the special form, named with a "-1" suffix.
+ (byte-compile-form-do-effect
+ (cond
+ ((eq fun 'defconst)
+ `(defconst-1 ',var ,@(byte-compile--list-with-n
+ (nthcdr 2 form) 1 (macroexp-quote string))))
+ ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo.
+ (t `(defvar-1 ',var
+ ;; Don't eval `value' if `defvar' wouldn't eval it either.
+ ,(if (macroexp-const-p value) value
+ `(if (boundp ',var) nil ,value))
+ ,@(byte-compile--list-with-n
+ (nthcdr 3 form) 0 (macroexp-quote string)))))))))
(defun byte-compile-autoload (form)
(and (macroexp-const-p (nth 1 form))
@@ -5209,14 +5093,6 @@ binding slots have been popped."
;; For the compilation itself, we could largely get rid of this hunk-handler,
;; if it weren't for the fact that we need to figure out when a defalias
;; defines a macro, so as to add it to byte-compile-macro-environment.
- ;;
- ;; FIXME: we also use this hunk-handler to implement the function's
- ;; dynamic docstring feature (via byte-compile-file-form-defmumble).
- ;; We should probably actually implement it (more elegantly) in
- ;; byte-compile-lambda so it applies to all lambdas. We did it here
- ;; so the resulting .elc format was recognizable by make-docfile,
- ;; but since then we stopped using DOC for the docstrings of
- ;; preloaded elc files so that obstacle is gone.
(let ((byte-compile-free-references nil)
(byte-compile-free-assignments nil))
(pcase form
@@ -5225,7 +5101,11 @@ binding slots have been popped."
;; - `arg' is the expression to which it is defined.
;; - `rest' is the rest of the arguments.
(`(,_ ',name ,arg . ,rest)
- (byte-compile-docstring-style-warn form)
+ (let ((doc (car rest)))
+ (when (stringp doc)
+ (setq rest (byte-compile--list-with-n
+ rest 0
+ (byte-compile--docstring doc (nth 0 form) name)))))
(pcase-let*
;; `macro' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').
@@ -5668,23 +5548,14 @@ invoked interactively."
(if (null f)
" <top level>";; shouldn't insert nil then, actually -sk
" <not defined>"))
- ((subrp (setq f (symbol-function f)))
- " <subr>")
- ((symbolp f)
+ ((symbolp (setq f (symbol-function f))) ;; An alias.
(format " ==> %s" f))
- ((byte-code-function-p f)
- "<compiled function>")
((not (consp f))
- "<malformed function>")
+ (format " <%s>" (type-of f)))
((eq 'macro (car f))
- (if (or (compiled-function-p (cdr f))
- ;; FIXME: Can this still happen?
- (assq 'byte-code (cdr (cdr (cdr f)))))
+ (if (compiled-function-p (cdr f))
" <compiled macro>"
" <macro>"))
- ((assq 'byte-code (cdr (cdr f)))
- ;; FIXME: Can this still happen?
- "<compiled lambda>")
((eq 'lambda (car f))
"<function>")
(t "???"))
@@ -5894,6 +5765,16 @@ and corresponding effects."
(eval form)
form)))
+;; Report comma operator used outside of backquote.
+;; Inside backquote, backquote will transform it before it gets here.
+
+(put '\, 'compiler-macro #'bytecomp--report-comma)
+(defun bytecomp--report-comma (form &rest _ignore)
+ (macroexp-warn-and-return
+ (format-message "`%s' called -- perhaps used not within backquote"
+ (car form))
+ form (list 'suspicious (car form)) t))
+
;; Check for (in)comparable constant values in calls to `eq', `memq' etc.
(defun bytecomp--dodgy-eq-arg-p (x number-ok)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e210cfdf5ce..4ff47971351 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -621,12 +621,16 @@ places where they originally did not directly appear."
(cconv-convert exp env extend))
(`(,func . ,forms)
- (if (symbolp func)
+ (if (or (symbolp func) (functionp func))
;; First element is function or whatever function-like forms are:
;; or, and, if, catch, progn, prog1, while, until
- `(,func . ,(mapcar (lambda (form)
- (cconv-convert form env extend))
- forms))
+ (let ((args (mapcar (lambda (form) (cconv-convert form env extend))
+ forms)))
+ (unless (symbolp func)
+ (byte-compile-warn-x
+ form
+ "Use `funcall' instead of `%s' in the function position" func))
+ `(,func . ,args))
(byte-compile-warn-x form "Malformed function `%S'" func)
nil))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 0362c7d2c24..faa7824c8bd 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -40,7 +40,7 @@
;;; Code:
-(defconst check-declare-warning-buffer "*Check Declarations Warnings*"
+(defvar check-declare-warning-buffer "*Check Declarations Warnings*"
"Name of buffer used to display any `check-declare' warnings.")
(defun check-declare-locate (file basefile)
@@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)."
(let (alist)
(with-temp-buffer
(insert-file-contents file)
+ ;; Ensure shorthands available, as we will be `read'ing Elisp
+ ;; (bug#67523)
+ (let (enable-local-variables) (hack-local-variables))
;; FIXME we could theoretically be inside a string.
(while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t)
(let ((pos (match-beginning 1)))
@@ -145,64 +148,70 @@ is a string giving details of the error."
(if (file-regular-p fnfile)
(with-temp-buffer
(insert-file-contents fnfile)
+ (unless cflag
+ ;; If in Elisp, ensure syntax and shorthands available
+ ;; (bug#67523)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (let (enable-local-variables) (hack-local-variables)))
;; defsubst's don't _have_ to be known at compile time.
- (setq re (format (if cflag
- "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
- "^[ \t]*(\\(fset[ \t]+'\\|\
+ (setq re (if cflag
+ (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
+ (regexp-opt (mapcar 'cadr fnlist) t))
+ "^[ \t]*(\\(fset[ \t]+'\\|\
cl-def\\(?:generic\\|method\\|un\\)\\|\
def\\(?:un\\|subst\\|foo\\|method\\|class\\|\
ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\
\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\
ine-overloadable-function\\)\\)\
-[ \t]*%s\\([ \t;]+\\|$\\)")
- (regexp-opt (mapcar 'cadr fnlist) t)))
+[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)"))
(while (re-search-forward re nil t)
(skip-chars-forward " \t\n")
- (setq fn (match-string 2)
- type (match-string 1)
- ;; (min . max) for a fixed number of arguments, or
- ;; arglists with optional elements.
- ;; (min) for arglists with &rest.
- ;; sig = 'err means we could not find an arglist.
- sig (cond (cflag
- (or
- (when (search-forward "," nil t 3)
- (skip-chars-forward " \t\n")
- ;; Assuming minargs and maxargs on same line.
- (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
+ (setq fn (symbol-name (car (read-from-string (match-string 2)))))
+ (when (member fn (mapcar 'cadr fnlist))
+ (setq type (match-string 1)
+ ;; (min . max) for a fixed number of arguments, or
+ ;; arglists with optional elements.
+ ;; (min) for arglists with &rest.
+ ;; sig = 'err means we could not find an arglist.
+ sig (cond (cflag
+ (or
+ (when (search-forward "," nil t 3)
+ (skip-chars-forward " \t\n")
+ ;; Assuming minargs and maxargs on same line.
+ (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
\\([0-9]+\\|MANY\\|UNEVALLED\\)")
- (setq minargs (string-to-number
- (match-string 1))
- maxargs (match-string 2))
- (cons minargs (unless (string-match "[^0-9]"
- maxargs)
- (string-to-number
- maxargs)))))
- 'err))
- ((string-match
- "\\`define-\\(derived\\|generic\\)-mode\\'"
- type)
- '(0 . 0))
- ((string-match
- "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
- type)
- '(0 . 1))
- ;; Prompt to update.
- ((string-match
- "\\`define-obsolete-function-alias\\>"
- type)
- 'obsolete)
- ;; Can't easily check arguments in these cases.
- ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
+ (setq minargs (string-to-number
+ (match-string 1))
+ maxargs (match-string 2))
+ (cons minargs (unless (string-match "[^0-9]"
+ maxargs)
+ (string-to-number
+ maxargs)))))
+ 'err))
+ ((string-match
+ "\\`define-\\(derived\\|generic\\)-mode\\'"
+ type)
+ '(0 . 0))
+ ((string-match
+ "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
+ type)
+ '(0 . 1))
+ ;; Prompt to update.
+ ((string-match
+ "\\`define-obsolete-function-alias\\>"
+ type)
+ 'obsolete)
+ ;; Can't easily check arguments in these cases.
+ ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
- t)
- ((looking-at "\\((\\|nil\\)")
- (byte-compile-arglist-signature
- (read (current-buffer))))
- (t
- 'err))
- ;; alist of functions and arglist signatures.
- siglist (cons (cons fn sig) siglist)))))
+ t)
+ ((looking-at "\\((\\|nil\\)")
+ (byte-compile-arglist-signature
+ (read (current-buffer))))
+ (t
+ 'err))
+ ;; alist of functions and arglist signatures.
+ siglist (cons (cons fn sig) siglist))))))
(dolist (e fnlist)
(setq arglist (nth 2 e)
type
@@ -319,9 +328,14 @@ Returns non-nil if any false statements are found."
(setq root (directory-file-name (file-relative-name root)))
(or (file-directory-p root)
(error "Directory `%s' not found" root))
- (let ((files (directory-files-recursively root "\\.el\\'")))
- (when files
- (apply #'check-declare-files files))))
+ (when-let* ((files (directory-files-recursively root "\\.el\\'"))
+ (files (mapcan (lambda (file)
+ ;; Filter out lock files.
+ (and (not (string-prefix-p
+ ".#" (file-name-nondirectory file)))
+ (list file)))
+ files)))
+ (apply #'check-declare-files files)))
(provide 'check-declare)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 80eaf93c3b7..c22dfb2eb26 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -556,7 +556,8 @@ the users will view as each check is completed."
"Display and update the status buffer for the current checkdoc mode.
CHECK is a list of four strings stating the current status of each
test; the nth string describes the status of the nth test."
- (let (temp-buffer-setup-hook)
+ (let (temp-buffer-setup-hook
+ (temp-buffer-show-hook #'special-mode))
(with-output-to-temp-buffer "*Checkdoc Status*"
(mapc #'princ
(list "Buffer comments and tags: " (nth 0 check)
@@ -1993,7 +1994,7 @@ from the comment."
(defun-depth (ppss-depth (syntax-ppss)))
(lst nil)
(ret nil)
- (oo (make-vector 3 0))) ;substitute obarray for `read'
+ (oo (obarray-make 3))) ;substitute obarray for `read'
(forward-char 1)
(forward-sexp 1)
(skip-chars-forward " \n\t")
@@ -2793,7 +2794,7 @@ function called to create the messages."
": " msg)))
(if (string= checkdoc-diagnostic-buffer "*warn*")
(warn (apply #'concat text))
- (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+ (with-current-buffer checkdoc-diagnostic-buffer
(let ((inhibit-read-only t)
(pt (point-max)))
(goto-char pt)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 9281cd9821e..437dea2d6a9 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -711,11 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class.
(require 'help-mode)
-;; FIXME: We could go crazy and add another entry so describe-symbol can be
-;; used with the slot names of CL structs (and/or EIEIO objects).
-(add-to-list 'describe-symbol-backends
- `(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s))))
-
(defconst cl--typedef-regexp
(concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
"cl-deftype" "deftype"))
@@ -725,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(add-to-list 'find-function-regexp-alist
'(define-type . cl--typedef-regexp)))
-(define-button-type 'cl-help-type
- :supertype 'help-function-def
- 'help-function #'cl-describe-type
- 'help-echo (purecopy "mouse-2, RET: describe this type"))
-
(define-button-type 'cl-type-definition
:supertype 'help-function-def
'help-echo (purecopy "mouse-2, RET: find type definition"))
@@ -744,7 +734,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(cl--find-class type))
;;;###autoload
-(defun cl-describe-type (type)
+(defun cl-describe-type (type &optional _buf _frame)
"Display the documentation for type TYPE (a symbol)."
(interactive
(let ((str (completing-read "Describe type: " obarray #'cl-find-class t)))
@@ -766,6 +756,15 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
;; Return the text we displayed.
(buffer-string)))))
+(defun cl--class-children (class)
+ (let ((children '()))
+ (mapatoms
+ (lambda (sym)
+ (let ((sym-class (cl--find-class sym)))
+ (and sym-class (memq class (cl--class-parents sym-class))
+ (push sym children)))))
+ children))
+
(defun cl--describe-class (type &optional class)
(unless class (setq class (cl--find-class type)))
(let ((location (find-lisp-object-file-name type 'define-type))
@@ -773,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(insert (symbol-name type)
(substitute-command-keys " is a type (of kind `"))
(help-insert-xref-button (symbol-name metatype)
- 'cl-help-type metatype)
+ 'help-type metatype)
(insert (substitute-command-keys "')"))
(when location
(insert (substitute-command-keys " in `"))
@@ -792,21 +791,19 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(setq cur (cl--class-name cur))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
- 'cl-help-type cur)
+ 'help-type cur)
(insert (substitute-command-keys (if pl "', " "'"))))
(insert ".\n")))
- ;; Children, if available. Ā”For EIEIO!
- (let ((ch (condition-case nil
- (cl-struct-slot-value metatype 'children class)
- (cl-struct-unknown-slot nil)))
+ ;; Children.
+ (let ((ch (cl--class-children class))
cur)
(when ch
(insert " Children ")
(while (setq cur (pop ch))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
- 'cl-help-type cur)
+ 'help-type cur)
(insert (substitute-command-keys (if ch "', " "'"))))
(insert ".\n")))
@@ -903,22 +900,25 @@ Outputs to the current buffer."
(cslots (condition-case nil
(cl-struct-slot-value metatype 'class-slots class)
(cl-struct-unknown-slot nil))))
- (insert (propertize "Instance Allocated Slots:\n\n"
- 'face 'bold))
- (let* ((has-doc nil)
- (slots-strings
- (mapcar
- (lambda (slot)
- (list (cl-prin1-to-string (cl--slot-descriptor-name slot))
- (cl-prin1-to-string (cl--slot-descriptor-type slot))
- (cl-prin1-to-string (cl--slot-descriptor-initform slot))
- (let ((doc (alist-get :documentation
- (cl--slot-descriptor-props slot))))
- (if (not doc) ""
- (setq has-doc t)
- (substitute-command-keys doc)))))
- slots)))
- (cl--print-table `("Name" "Type" "Default") slots-strings has-doc))
+ (if (and (null slots) (eq metatype 'built-in-class))
+ (insert "This is a built-in type.\n")
+
+ (insert (propertize "Instance Allocated Slots:\n\n"
+ 'face 'bold))
+ (let* ((has-doc nil)
+ (slots-strings
+ (mapcar
+ (lambda (slot)
+ (list (cl-prin1-to-string (cl--slot-descriptor-name slot))
+ (cl-prin1-to-string (cl--slot-descriptor-type slot))
+ (cl-prin1-to-string (cl--slot-descriptor-initform slot))
+ (let ((doc (alist-get :documentation
+ (cl--slot-descriptor-props slot))))
+ (if (not doc) ""
+ (setq has-doc t)
+ (substitute-command-keys doc)))))
+ slots)))
+ (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)))
(insert "\n")
(when (> (length cslots) 0)
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 48f5c06e390..8bda857afdd 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -672,7 +672,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
;; compiled. Otherwise the byte-compiler and all the code on
;; which it depends needs to be usable before cl-generic is loaded,
;; which imposes a significant burden on the bootstrap.
- (if (consp (lambda (x) (+ x 1)))
+ (if (not (compiled-function-p (lambda (x) (+ x 1))))
(lambda (exp) (eval exp t))
;; But do byte-compile the dispatchers once bootstrap is passed:
;; the performance difference is substantial (like a 5x speedup on
@@ -1140,12 +1140,8 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
- ;; Supposedly this is called from help-fns, so help-fns should be loaded at
- ;; this point.
- (declare-function help-fns-short-filename "help-fns" (filename))
(let ((generic (if (symbolp function) (cl--generic function))))
(when generic
- (require 'help-mode) ;Needed for `help-function-def' button!
(save-excursion
;; Ensure that we have two blank lines (but not more).
(unless (looking-back "\n\n" (- (point) 2))
@@ -1153,33 +1149,49 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(insert "This is a generic function.\n\n")
(insert (propertize "Implementations:\n\n" 'face 'bold))
;; Loop over fanciful generics
- (dolist (method (cl--generic-method-table generic))
- (pcase-let*
- ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)))
- ;; FIXME: Add hyperlinks for the types as well.
- (let ((print-quoted nil)
- (quals (if (length> qualifiers 0)
- (concat (substring qualifiers
- 0 (string-match " *\\'"
- qualifiers))
- "\n")
- "")))
- (insert (format "%s%S"
- quals
- (cons function
- (cl--generic-upcase-formal-args args)))))
- (let* ((met-name (cl--generic-load-hist-format
- function
- (cl--generic-method-qualifiers method)
- (cl--generic-method-specializers method)))
- (file (find-lisp-object-file-name met-name 'cl-defmethod)))
- (when file
- (insert (substitute-command-keys " in `"))
- (help-insert-xref-button (help-fns-short-filename file)
- 'help-function-def met-name file
- 'cl-defmethod)
- (insert (substitute-command-keys "'.\n"))))
- (insert "\n" (or doc "Undocumented") "\n\n")))))))
+ (cl--map-methods-documentation
+ function
+ (lambda (quals signature file doc)
+ (insert (format "%s%S%s\n\n%s\n\n"
+ quals signature
+ (if file (format-message " in `%s'." file) "")
+ (or doc "Undocumented")))))))))
+
+(defun cl--map-methods-documentation (funname metname-printer)
+ "Iterate on FUNNAME's methods documentation at point."
+ ;; Supposedly this is called from help-fns, so help-fns should be loaded at
+ ;; this point.
+ (require 'help-fns)
+ (declare-function help-fns-short-filename "help-fns" (filename))
+ (let ((generic (if (symbolp funname) (cl--generic funname))))
+ (when generic
+ (require 'help-mode) ;Needed for `help-function-def' button!
+ ;; Loop over fanciful generics
+ (dolist (method (cl--generic-method-table generic))
+ (pcase-let*
+ ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))
+ ;; FIXME: Add hyperlinks for the types as well.
+ (quals (if (length> qualifiers 0)
+ (concat (substring qualifiers
+ 0 (string-match " *\\'"
+ qualifiers))
+ "\n")
+ ""))
+ (met-name (cl--generic-load-hist-format
+ funname
+ (cl--generic-method-qualifiers method)
+ (cl--generic-method-specializers method)))
+ (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+ (funcall metname-printer
+ quals
+ (cons funname
+ (cl--generic-upcase-formal-args args))
+ (when file
+ (make-text-button (help-fns-short-filename file) nil
+ 'type 'help-function-def
+ 'help-args
+ (list met-name file 'cl-defmethod)))
+ doc))))))
(defun cl--generic-specializers-apply-to-type-p (specializers type)
"Return non-nil if a method with SPECIALIZERS applies to TYPE."
@@ -1318,62 +1330,30 @@ These match if the argument is `eql' to VAL."
(cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection)
(eql nil))
-;;; Support for cl-defstructs specializers.
-
-(defun cl--generic-struct-tag (name &rest _)
- ;; Use exactly the same code as for `typeof'.
- `(if ,name (type-of ,name) 'null))
+;;; Dispatch on "normal types".
-(defun cl--generic-struct-specializers (tag &rest _)
+(defun cl--generic-type-specializers (tag &rest _)
(and (symbolp tag)
- (let ((class (get tag 'cl--class)))
- (when (cl-typep class 'cl-structure-class)
+ (let ((class (cl--find-class tag)))
+ (when class
(cl--class-allparents class)))))
-(cl-generic-define-generalizer cl--generic-struct-generalizer
- 50 #'cl--generic-struct-tag
- #'cl--generic-struct-specializers)
-
-(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
- "Support for dispatch on types defined by `cl-defstruct'."
- (or
- (when (symbolp type)
- ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
- ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
- ;; take place without requiring cl-lib.
- (let ((class (cl--find-class type)))
- (and (cl-typep class 'cl-structure-class)
- (or (null (cl--struct-class-type class))
- (error "Can't dispatch on cl-struct %S: type is %S"
- type (cl--struct-class-type class)))
- (progn (cl-assert (null (cl--struct-class-named class))) t)
- (list cl--generic-struct-generalizer))))
- (cl-call-next-method)))
-
-(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
-
-;;; Dispatch on "system types".
-
(cl-generic-define-generalizer cl--generic-typeof-generalizer
- ;; FIXME: We could also change `type-of' to return `null' for nil.
- 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
- (lambda (tag &rest _)
- (and (symbolp tag) (assq tag cl--typeof-types))))
+ 10 (lambda (name &rest _) `(cl-type-of ,name))
+ #'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
- "Support for dispatch on builtin types.
-See the full list and their hierarchy in `cl--typeof-types'."
- ;; FIXME: Add support for other types accepted by `cl-typep' such
- ;; as `character', `face', `function', ...
+ "Support for dispatch on types.
+This currently works for built-in types and types built on top of records."
+ ;; FIXME: Add support for other "types" accepted by `cl-typep' such
+ ;; as `character', `face', `keyword', ...?
(or
- (and (memq type cl--all-builtin-types)
- (progn
- ;; FIXME: While this wrinkle in the semantics can be occasionally
- ;; problematic, this warning is more often annoying than helpful.
- ;;(if (memq type '(vector array sequence))
- ;; (message "`%S' also matches CL structs and EIEIO classes"
- ;; type))
- (list cl--generic-typeof-generalizer)))
+ (and (symbolp type)
+ (not (eq type t)) ;; Handled by the `t-generalizer'.
+ (let ((class (cl--find-class type)))
+ (memq (type-of class)
+ '(built-in-class cl-structure-class eieio--class)))
+ (list cl--generic-typeof-generalizer))
(cl-call-next-method)))
(cl--generic-prefill-dispatchers 0 integer)
@@ -1381,6 +1361,8 @@ See the full list and their hierarchy in `cl--typeof-types'."
(cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
(cl--generic-prefill-dispatchers 0 (eql 'x) integer)
+(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
+
;;; Dispatch on major mode.
;; Two parts:
@@ -1418,19 +1400,13 @@ Used internally for the (major-mode MODE) context specializers."
(defun cl--generic-oclosure-tag (name &rest _)
`(oclosure-type ,name))
-(defun cl-generic--oclosure-specializers (tag &rest _)
- (and (symbolp tag)
- (let ((class (cl--find-class tag)))
- (when (cl-typep class 'oclosure--class)
- (oclosure--class-allparents class)))))
-
(cl-generic-define-generalizer cl--generic-oclosure-generalizer
;; Give slightly higher priority than the struct specializer, so that
;; for a generic function with methods dispatching structs and on OClosures,
;; we first try `oclosure-type' before `type-of' since `type-of' will return
;; non-nil for an OClosure as well.
51 #'cl--generic-oclosure-tag
- #'cl-generic--oclosure-specializers)
+ #'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
"Support for dispatch on types defined by `oclosure-define'."
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 88447203a64..a84ef4a34b2 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2250,7 +2250,7 @@ Like `cl-flet' but the definitions can refer to previous ones.
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make local (recursive) function definitions.
-+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp])))
- `(and (pred (pcase--flip cl-typep ',type))
+ `(and (pred (cl-typep _ ',type))
,@(mapcar
(lambda (field)
(let* ((name (if (consp field) (car field) field))
(pat (if (consp field) (cadr field) field)))
`(app ,(if (eq (cl-struct-sequence-type type) 'list)
`(nth ,(cl-struct-slot-offset type name))
- `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+ `(aref _ ,(cl-struct-slot-offset type name)))
,pat)))
fields)))
@@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)."
"Extra special cases for `cl-typep' predicates."
(let* ((x1 pred1) (x2 pred2)
(t1
- (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
- (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (eq '_ (car-safe x1)) (setq x1 (cdr x1))
(null (cdr-safe x1)) (setq x1 (car x1))
(eq 'quote (car-safe x1)) (cadr x1)))
(t2
- (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
- (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (eq '_ (car-safe x2)) (setq x2 (cdr x2))
(null (cdr-safe x2)) (setq x2 (car x2))
(eq 'quote (car-safe x2)) (cadr x2))))
(or
@@ -3460,45 +3460,20 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym macroexpand-all-environment))))))
+;; Please keep it in sync with `comp-known-predicates'.
(pcase-dolist (`(,type . ,pred)
;; Mostly kept in alphabetical order.
- '((array . arrayp)
- (atom . atom)
- (base-char . characterp)
- (bignum . bignump)
- (boolean . booleanp)
- (bool-vector . bool-vector-p)
- (buffer . bufferp)
- (byte-code-function . byte-code-function-p)
- (character . natnump)
- (char-table . char-table-p)
- (command . commandp)
- (compiled-function . compiled-function-p)
- (hash-table . hash-table-p)
- (cons . consp)
- (fixnum . fixnump)
- (float . floatp)
- (frame . framep)
- (function . functionp)
- (integer . integerp)
- (keyword . keywordp)
+ ;; These aren't defined via `cl--define-built-in-type'.
+ '((base-char . characterp) ;Could be subtype of `fixnum'.
+ (character . natnump) ;Could be subtype of `fixnum'.
+ (command . commandp) ;Subtype of closure & subr.
+ (keyword . keywordp) ;Would need `keyword-with-pos`.
+ (natnum . natnump) ;Subtype of fixnum & bignum.
+ (real . numberp) ;Not clear where it would fit.
+ ;; This one is redundant, but we keep it to silence a
+ ;; warning during the early bootstrap when `cl-seq.el' gets
+ ;; loaded before `cl-preloaded.el' is defined.
(list . listp)
- (marker . markerp)
- (natnum . natnump)
- (number . numberp)
- (null . null)
- (overlay . overlayp)
- (process . processp)
- (real . numberp)
- (sequence . sequencep)
- (subr . subrp)
- (string . stringp)
- (symbol . symbolp)
- (vector . vectorp)
- (window . windowp)
- ;; FIXME: Do we really want to consider these types?
- (number-or-marker . number-or-marker-p)
- (integer-or-marker . integer-or-marker-p)
))
(put type 'cl-deftype-satisfies pred))
@@ -3818,7 +3793,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance."
(pcase-defmacro cl-type (type)
"Pcase pattern that matches objects of TYPE.
TYPE is a type descriptor as accepted by `cl-typep', which see."
- `(pred (pcase--flip cl-typep ',type)))
+ `(pred (cl-typep _ ',type)))
+
;; Local variables:
;; generated-autoload-file: "cl-loaddefs.el"
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 20e68555578..d23ad3972a9 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -50,51 +50,16 @@
(apply #'error string (append sargs args))
(signal 'cl-assertion-failed `(,form ,@sargs)))))
-(defconst cl--typeof-types
- ;; Hand made from the source code of `type-of'.
- '((integer number integer-or-marker number-or-marker atom)
- (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom)
- (cons list sequence)
- ;; Markers aren't `numberp', yet they are accepted wherever integers are
- ;; accepted, pretty much.
- (marker integer-or-marker number-or-marker atom)
- (overlay atom) (float number number-or-marker atom)
- (window-configuration atom) (process atom) (window atom)
- ;; FIXME: We'd want to put `function' here, but that's only true
- ;; for those `subr's which aren't special forms!
- (subr atom)
- ;; FIXME: We should probably reverse the order between
- ;; `compiled-function' and `byte-code-function' since arguably
- ;; `subr' is also "compiled functions" but not "byte code functions",
- ;; but it would require changing the value returned by `type-of' for
- ;; byte code objects, which risks breaking existing code, which doesn't
- ;; seem worth the trouble.
- (compiled-function byte-code-function function atom)
- (module-function function atom)
- (buffer atom) (char-table array sequence atom)
- (bool-vector array sequence atom)
- (frame atom) (hash-table atom) (terminal atom)
- (thread atom) (mutex atom) (condvar atom)
- (font-spec atom) (font-entity atom) (font-object atom)
- (vector array sequence atom)
- (user-ptr atom)
- (tree-sitter-parser atom)
- (tree-sitter-node atom)
- (tree-sitter-compiled-query atom)
- ;; Plus, really hand made:
- (null symbol list sequence atom))
- "Alist of supertypes.
-Each element has the form (TYPE . SUPERTYPES) where TYPE is one of
-the symbols returned by `type-of', and SUPERTYPES is the list of its
-supertypes from the most specific to least specific.")
-
-(defconst cl--all-builtin-types
- (delete-dups (copy-sequence (apply #'append cl--typeof-types))))
+(defun cl--builtin-type-p (name)
+ (if (not (fboundp 'built-in-class-p)) ;; Early bootstrap
+ nil
+ (let ((class (and (symbolp name) (get name 'cl--class))))
+ (and class (built-in-class-p class)))))
(defun cl--struct-name-p (name)
"Return t if NAME is a valid structure name for `cl-defstruct'."
(and name (symbolp name) (not (keywordp name))
- (not (memq name cl--all-builtin-types))))
+ (not (cl--builtin-type-p name))))
;; When we load this (compiled) file during pre-loading, the cl--struct-class
;; code below will need to access the `cl-struct' info, since it's considered
@@ -147,7 +112,7 @@ supertypes from the most specific to least specific.")
(defun cl--struct-register-child (parent tag)
;; Can't use (cl-typep parent 'cl-structure-class) at this stage
;; because `cl-structure-class' is defined later.
- (while (recordp parent)
+ (while (cl--struct-class-p parent)
(add-to-list (cl--struct-class-children-sym parent) tag)
;; Only register ourselves as a child of the leftmost parent since structs
;; can only have one parent.
@@ -162,9 +127,14 @@ supertypes from the most specific to least specific.")
(with-suppressed-warnings ((obsolete cl-old-struct-compat-mode))
(message "cl-old-struct-compat-mode is obsolete!")
(cl-old-struct-compat-mode 1)))
- (if (eq type 'record)
- ;; Defstruct using record objects.
- (setq type nil))
+ (when (eq type 'record)
+ ;; Defstruct using record objects.
+ (setq type nil)
+ ;; `cl-structure-class' and `cl-structure-object' are allowed to be
+ ;; defined without specifying the parent, because their parent
+ ;; doesn't exist yet when they're defined.
+ (cl-assert (or parent (memq name '(cl-structure-class
+ cl-structure-object)))))
(cl-assert (or type (not named)))
(if (boundp children-sym)
(add-to-list children-sym tag)
@@ -172,7 +142,9 @@ supertypes from the most specific to least specific.")
(and (null type) (eq (caar slots) 'cl-tag-slot)
;; Hide the tag slot from "standard" (i.e. non-`type'd) structs.
(setq slots (cdr slots)))
- (let* ((parent-class (when parent (cl--struct-get-class parent)))
+ (let* ((parent-class (if parent (cl--struct-get-class parent)
+ (cl--find-class (if (eq type 'list) 'cons
+ (or type 'record)))))
(n (length slots))
(index-table (make-hash-table :test 'eq :size n))
(vslots (let ((v (make-vector n nil))
@@ -195,7 +167,9 @@ supertypes from the most specific to least specific.")
name docstring
(unless (symbolp parent-class) (list parent-class))
type named vslots index-table children-sym tag print)))
- (unless (symbolp parent-class)
+ (cl-assert (or (not (symbolp parent-class))
+ (memq name '(cl-structure-class cl-structure-object))))
+ (when (cl--struct-class-p parent-class)
(let ((pslots (cl--struct-class-slots parent-class)))
(or (>= n (length pslots))
(let ((ok t))
@@ -286,7 +260,7 @@ supertypes from the most specific to least specific.")
(cl-defstruct (cl--class
(:constructor nil)
(:copier nil))
- "Type of descriptors for any kind of structure-like data."
+ "Abstract supertype of all type descriptors."
;; Intended to be shared between defstruct and defclass.
(name nil :type symbol) ;The type name.
(docstring nil :type string)
@@ -327,8 +301,170 @@ supertypes from the most specific to least specific.")
(merge-ordered-lists (mapcar #'cl--class-allparents
(cl--class-parents class)))))
-(eval-and-compile
- (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object)))))
+(cl-defstruct (built-in-class
+ (:include cl--class)
+ (:noinline t)
+ (:constructor nil)
+ (:constructor built-in-class--make (name docstring parents))
+ (:copier nil))
+ "Type descriptors for built-in types.
+The `slots' (and hence `index-table') are currently unused."
+ )
+
+(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots)
+ ;; `slots' is currently unused, but we could make it take
+ ;; a list of "slot like properties" together with the corresponding
+ ;; accessor, and then we could maybe even make `slot-value' work
+ ;; on some built-in types :-)
+ (declare (indent 2) (doc-string 3))
+ (unless (listp parents) (setq parents (list parents)))
+ (unless (or parents (eq name t))
+ (error "Missing parents for %S: %S" name parents))
+ (let ((predicate (intern-soft (format
+ (if (string-match "-" (symbol-name name))
+ "%s-p" "%sp")
+ name))))
+ (unless (fboundp predicate) (setq predicate nil))
+ (while (keywordp (car slots))
+ (let ((kw (pop slots)) (val (pop slots)))
+ (pcase kw
+ (:predicate (setq predicate val))
+ (_ (error "Unknown keyword arg: %S" kw)))))
+ `(progn
+ ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)
+ ;; (message "Missing predicate for: %S" name)
+ nil)
+ (put ',name 'cl--class
+ (built-in-class--make ',name ,docstring
+ (mapcar (lambda (type)
+ (let ((class (get type 'cl--class)))
+ (unless class
+ (error "Unknown type: %S" type))
+ class))
+ ',parents))))))
+
+;; FIXME: Our type DAG has various quirks:
+;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
+;; in the DAG.
+;; - An OClosure can be an interpreted function or a `byte-code-function',
+;; so the DAG of OClosure types is "orthogonal" to the distinction
+;; between interpreted and compiled functions.
+
+(defun cl-functionp (object)
+ "Return non-nil if OBJECT is a member of type `function'.
+This is like `functionp' except that it returns nil for all lists and symbols,
+regardless if `funcall' would accept to call them."
+ (memq (cl-type-of object)
+ '(primitive-function subr-native-elisp module-function
+ interpreted-function byte-code-function)))
+
+(cl--define-built-in-type t nil "Abstract supertype of everything.")
+(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells."
+ :predicate atom)
+
+(cl--define-built-in-type tree-sitter-compiled-query atom)
+(cl--define-built-in-type tree-sitter-node atom)
+(cl--define-built-in-type tree-sitter-parser atom)
+(when (fboundp 'user-ptrp)
+ (cl--define-built-in-type user-ptr atom nil
+ ;; FIXME: Shouldn't it be called `user-ptr-p'?
+ :predicate user-ptrp))
+(cl--define-built-in-type font-object atom)
+(cl--define-built-in-type font-entity atom)
+(cl--define-built-in-type font-spec atom)
+(cl--define-built-in-type condvar atom)
+(cl--define-built-in-type mutex atom)
+(cl--define-built-in-type thread atom)
+(cl--define-built-in-type terminal atom)
+(cl--define-built-in-type hash-table atom)
+(cl--define-built-in-type frame atom)
+(cl--define-built-in-type buffer atom)
+(cl--define-built-in-type window atom)
+(cl--define-built-in-type process atom)
+(cl--define-built-in-type finalizer atom)
+(cl--define-built-in-type window-configuration atom)
+(cl--define-built-in-type overlay atom)
+(cl--define-built-in-type number-or-marker atom
+ "Abstract supertype of both `number's and `marker's.")
+(cl--define-built-in-type symbol atom
+ "Type of symbols."
+ ;; Example of slots we could document. It would be desirable to
+ ;; have some way to extract this from the C code, or somehow keep it
+ ;; in sync (probably not for `cons' and `symbol' but for things like
+ ;; `font-entity').
+ (name symbol-name)
+ (value symbol-value)
+ (function symbol-function)
+ (plist symbol-plist))
+
+(cl--define-built-in-type obarray atom)
+(cl--define-built-in-type native-comp-unit atom)
+
+(cl--define-built-in-type sequence t "Abstract supertype of sequences.")
+(cl--define-built-in-type list sequence)
+(cl--define-built-in-type array (sequence atom) "Abstract supertype of arrays.")
+(cl--define-built-in-type number (number-or-marker)
+ "Abstract supertype of numbers.")
+(cl--define-built-in-type float (number))
+(cl--define-built-in-type integer-or-marker (number-or-marker)
+ "Abstract supertype of both `integer's and `marker's.")
+(cl--define-built-in-type integer (number integer-or-marker))
+(cl--define-built-in-type marker (integer-or-marker))
+(cl--define-built-in-type bignum (integer)
+ "Type of those integers too large to fit in a `fixnum'.")
+(cl--define-built-in-type fixnum (integer)
+ (format "Type of small (fixed-size) integers.
+The size depends on the Emacs version and compilation options.
+For this build of Emacs it's %dbit."
+ (1+ (logb (1+ most-positive-fixnum)))))
+(cl--define-built-in-type boolean (symbol)
+ "Type of the canonical boolean values, i.e. either nil or t.")
+(cl--define-built-in-type symbol-with-pos (symbol)
+ "Type of symbols augmented with source-position information.")
+(cl--define-built-in-type vector (array))
+(cl--define-built-in-type record (atom)
+ "Abstract type of objects with slots.")
+(cl--define-built-in-type bool-vector (array) "Type of bitvectors.")
+(cl--define-built-in-type char-table (array)
+ "Type of special arrays that are indexed by characters.")
+(cl--define-built-in-type string (array))
+(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'?
+ "Type of the nil value."
+ :predicate null)
+(cl--define-built-in-type cons (list)
+ "Type of cons cells."
+ ;; Example of slots we could document.
+ (car car) (cdr cdr))
+(cl--define-built-in-type function (atom)
+ "Abstract supertype of function values."
+ ;; FIXME: Historically, (cl-typep FOO 'function) called `functionp',
+ ;; so while `cl-functionp' would be the more correct predicate, it
+ ;; would breaks existing code :-(
+ ;; :predicate cl-functionp
+ )
+(cl--define-built-in-type compiled-function (function)
+ "Abstract type of functions that have been compiled.")
+(cl--define-built-in-type byte-code-function (compiled-function)
+ "Type of functions that have been byte-compiled.")
+(cl--define-built-in-type subr (atom)
+ "Abstract type of functions compiled to machine code.")
+(cl--define-built-in-type module-function (function)
+ "Type of functions provided via the module API.")
+(cl--define-built-in-type interpreted-function (function)
+ "Type of functions that have not been compiled.")
+(cl--define-built-in-type special-form (subr)
+ "Type of the core syntactic elements of the Emacs Lisp language.")
+(cl--define-built-in-type subr-native-elisp (subr compiled-function)
+ "Type of functions that have been compiled by the native compiler.")
+(cl--define-built-in-type primitive-function (subr compiled-function)
+ "Type of functions hand written in C.")
+
+(unless (cl--class-parents (cl--find-class 'cl-structure-object))
+ ;; When `cl-structure-object' is created, built-in classes didn't exist
+ ;; yet, so we couldn't put `record' as the parent.
+ ;; Fix it now to close the recursion.
+ (setf (cl--class-parents (cl--find-class 'cl-structure-object))
+ (list (cl--find-class 'record))))
;; Make sure functions defined with cl-defsubst can be inlined even in
;; packages which do not require CL. We don't put an autoload cookie
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index c35353ec3d0..5e5eee1da9e 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -444,7 +444,7 @@ primitives such as `prin1'.")
(defun cl-print--preprocess (object)
(let ((print-number-table (make-hash-table :test 'eq :rehash-size 2.0)))
- (if (fboundp 'print--preprocess)
+ (if (fboundp 'print--preprocess) ;Emacsā‰„26
;; Use the predefined C version if available.
(print--preprocess object) ;Fill print-number-table!
(let ((cl-print--number-index 0))
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
index 6ba9664ea5c..4edfe811586 100644
--- a/lisp/emacs-lisp/comp-common.el
+++ b/lisp/emacs-lisp/comp-common.el
@@ -119,7 +119,7 @@ Used to modify the compiler environment."
(function ((or integer marker) (or integer marker)) string))
(bufferp (function (t) boolean))
(byte-code-function-p (function (t) boolean))
- (capitalize (function (or integer string) (or integer string)))
+ (capitalize (function ((or integer string)) (or integer string)))
(car (function (list) t))
(car-less-than-car (function (list list) boolean))
(car-safe (function (t) t))
@@ -240,7 +240,8 @@ Used to modify the compiler environment."
(integer-or-marker-p (function (t) boolean))
(integerp (function (t) boolean))
(interactive-p (function () boolean))
- (intern-soft (function ((or string symbol) &optional vector) symbol))
+ (intern-soft (function ((or string symbol) &optional (or obarray vector))
+ symbol))
(invocation-directory (function () string))
(invocation-name (function () string))
(isnan (function (float) boolean))
@@ -309,7 +310,7 @@ Used to modify the compiler environment."
(numberp (function (t) boolean))
(one-window-p (function (&optional t t) boolean))
(overlayp (function (t) boolean))
- (parse-colon-path (function (string) cons))
+ (parse-colon-path (function (string) list))
(plist-get (function (list t &optional t) t))
(plist-member (function (list t &optional t) list))
(point (function () integer))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index c65af16b725..cbfb9540f03 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -38,13 +38,7 @@
(require 'cl-lib)
(require 'cl-extra) ;HACK: For `cl-find-class' when `cl-loaddefs' is missing.
-(defconst comp--typeof-builtin-types (mapcar (lambda (x)
- (append x '(t)))
- cl--typeof-types)
- ;; TODO can we just add t in `cl--typeof-types'?
- "Like `cl--typeof-types' but with t as common supertype.")
-
-(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr
+(cl-defstruct (comp-cstr (:constructor comp--type-to-cstr
(type &aux
(null (eq type 'null))
(integer (eq type 'integer))
@@ -55,7 +49,7 @@
'(nil)))
(range (when integer
'((- . +))))))
- (:constructor comp-value-to-cstr
+ (:constructor comp--value-to-cstr
(value &aux
(integer (integerp value))
(valset (unless integer
@@ -63,7 +57,7 @@
(range (when integer
`((,value . ,value))))
(typeset ())))
- (:constructor comp-irange-to-cstr
+ (:constructor comp--irange-to-cstr
(irange &aux
(range (list irange))
(typeset ())))
@@ -89,12 +83,7 @@ Integer values are handled in the `range' slot.")
(defun comp--cl-class-hierarchy (x)
"Given a class name `x' return its hierarchy."
- `(,@(cl--class-allparents (cl--struct-get-class x))
- ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types
- ;; which use :type and can thus be either `vector' or `cons' (the latter
- ;; isn't `atom').
- atom
- t))
+ (cl--class-allparents (cl--find-class x)))
(defun comp--all-classes ()
"Return all non built-in type names currently defined."
@@ -106,15 +95,14 @@ Integer values are handled in the `range' slot.")
res))
(defun comp--compute-typeof-types ()
- (append comp--typeof-builtin-types
- (mapcar #'comp--cl-class-hierarchy (comp--all-classes))))
+ (mapcar #'comp--cl-class-hierarchy (comp--all-classes)))
(defun comp--compute--pred-type-h ()
(cl-loop with h = (make-hash-table :test #'eq)
for class-name in (comp--all-classes)
for pred = (get class-name 'cl-deftype-satisfies)
when pred
- do (puthash pred class-name h)
+ do (puthash pred (comp--type-to-cstr class-name) h)
finally return h))
(cl-defstruct comp-cstr-ctxt
@@ -130,7 +118,7 @@ Integer values are handled in the `range' slot.")
;; TODO we should be able to just cons hash this.
(common-supertype-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
-`comp-common-supertype'.")
+`comp-ctxt-common-supertype-mem'.")
(subtype-p-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
`comp-cstr-ctxt-subtype-p-mem'.")
@@ -229,10 +217,10 @@ Return them as multiple value."
;; builds.
(defvar comp-ctxt nil)
-(defvar comp-cstr-one (comp-value-to-cstr 1)
+(defvar comp-cstr-one (comp--value-to-cstr 1)
"Represent the integer immediate one.")
-(defvar comp-cstr-t (comp-type-to-cstr t)
+(defvar comp-cstr-t (comp--type-to-cstr t)
"Represent the superclass t.")
@@ -249,6 +237,8 @@ Return them as multiple value."
t)
((and (not (symbolp x)) (symbolp y))
nil)
+ ((or (consp x) (consp y)
+ nil))
(t
(< (sxhash-equal x)
(sxhash-equal y)))))))
@@ -270,18 +260,10 @@ Return them as multiple value."
(symbol-name y)))
(defun comp--direct-supertypes (type)
- "Return the direct supertypes of TYPE."
- (let ((supers (comp-supertypes type)))
- (cl-assert (eq type (car supers)))
- (cl-loop
- with notdirect = nil
- with direct = nil
- for parent in (cdr supers)
- unless (memq parent notdirect)
- do (progn
- (push parent direct)
- (setq notdirect (append notdirect (comp-supertypes parent))))
- finally return direct)))
+ (when (symbolp type) ;; FIXME: Can this test ever fail?
+ (let* ((class (cl--find-class type))
+ (parents (if class (cl--class-parents class))))
+ (mapcar #'cl--class-name parents))))
(defsubst comp-subtype-p (type1 type2)
"Return t if TYPE1 is a subtype of TYPE2 or nil otherwise."
@@ -306,13 +288,10 @@ Return them as multiple value."
(apply #'append
(mapcar #'comp--direct-supertypes typeset)))
for subs = (comp--direct-subtypes sup)
- when (and (length> subs 1) ;;FIXME: Why?
- ;; Every subtype of `sup` is a subtype of
- ;; some element of `typeset`?
- ;; It's tempting to just check (member x typeset),
- ;; but think of the typeset (marker number),
- ;; where `sup' is `integer-or-marker' and `sub'
- ;; is `integer'.
+ when (and (length> subs 1) ;; If there's only one sub do
+ ;; nothing as we want to
+ ;; return the most specific
+ ;; type.
(cl-every (lambda (sub)
(cl-some (lambda (type)
(comp-subtype-p sub type))
@@ -353,23 +332,8 @@ Return them as multiple value."
(defun comp-supertypes (type)
"Return the ordered list of supertypes of TYPE."
- ;; FIXME: We should probably keep the results in
- ;; `comp-cstr-ctxt-typeof-types' (or maybe even precompute them
- ;; and maybe turn `comp-cstr-ctxt-typeof-types' into a hash-table).
- ;; Or maybe we shouldn't keep structs and defclasses in it,
- ;; and just use `cl--class-allparents' when needed (and refuse to
- ;; compute their direct subtypes since we can't know them).
- (cl-loop
- named loop
- with above
- for lane in (comp-cstr-ctxt-typeof-types comp-ctxt)
- do (let ((x (memq type lane)))
- (cond
- ((null x) nil)
- ((eq x lane) (cl-return-from loop x)) ;A base type: easy case.
- (t (setq above
- (if above (comp--intersection x above) x)))))
- finally return above))
+ (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt))
+ (error "Type %S missing from typeof-types!" type)))
(defun comp-union-typesets (&rest typesets)
"Union types present into TYPESETS."
@@ -608,7 +572,7 @@ All SRCS constraints must be homogeneously negated or non-negated."
;; We propagate only values those types are not already
;; into typeset.
when (cl-notany (lambda (x)
- (comp-subtype-p (type-of v) x))
+ (comp-subtype-p (cl-type-of v) x))
(comp-cstr-typeset dst))
collect v)))
@@ -697,7 +661,7 @@ DST is returned."
;; Verify disjoint condition between positive types and
;; negative types coming from values, in case give-up.
- (let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
+ (let ((neg-value-types (nconc (mapcar #'cl-type-of (valset neg))
(when (range neg)
'(integer)))))
(when (cl-some (lambda (x)
@@ -718,7 +682,7 @@ DST is returned."
((cl-some (lambda (x)
(cl-some (lambda (y)
(comp-subtype-p y x))
- (mapcar #'type-of (valset pos))))
+ (mapcar #'cl-type-of (valset pos))))
(typeset neg))
(give-up))
(t
@@ -1141,7 +1105,7 @@ DST is returned."
(cl-loop for v in (valset dst)
unless (symbolp v)
do (push v strip-values)
- (push (type-of v) strip-types))
+ (push (cl-type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))
@@ -1210,14 +1174,14 @@ FN non-nil indicates we are parsing a function lambda list."
('nil
(make-comp-cstr :typeset ()))
('fixnum
- (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
+ (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
('boolean
(comp-type-spec-to-cstr '(member t nil)))
('integer
- (comp-irange-to-cstr '(- . +)))
- ('null (comp-value-to-cstr nil))
+ (comp--irange-to-cstr '(- . +)))
+ ('null (comp--value-to-cstr nil))
((pred atom)
- (comp-type-to-cstr type-spec))
+ (comp--type-to-cstr type-spec))
(`(or . ,rest)
(apply #'comp-cstr-union-make
(mapcar #'comp-type-spec-to-cstr rest)))
@@ -1227,16 +1191,16 @@ FN non-nil indicates we are parsing a function lambda list."
(`(not ,cstr)
(comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
(`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
- (comp-irange-to-cstr `(,l . ,h)))
+ (comp--irange-to-cstr `(,l . ,h)))
(`(integer * ,(and (pred integerp) h))
- (comp-irange-to-cstr `(- . ,h)))
+ (comp--irange-to-cstr `(- . ,h)))
(`(integer ,(and (pred integerp) l) *)
- (comp-irange-to-cstr `(,l . +)))
+ (comp--irange-to-cstr `(,l . +)))
(`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p))
;; No float range support :/
- (comp-type-to-cstr 'float))
+ (comp--type-to-cstr 'float))
(`(member . ,rest)
- (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
+ (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest)))
(`(function ,args ,ret)
(make-comp-cstr-f
:args (mapcar (lambda (x)
diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el
index 5d1a193269d..5cc61579030 100644
--- a/lisp/emacs-lisp/comp-run.el
+++ b/lisp/emacs-lisp/comp-run.el
@@ -25,7 +25,7 @@
;; While the main native compiler is implemented in comp.el, when
;; commonly used as a jit compiler it is only loaded by Emacs sub
-;; processes performing async compilation. This files contains all
+;; processes performing async compilation. This file contains all
;; the code needed to drive async compilations and any Lisp code
;; needed at runtime to run native code.
@@ -72,11 +72,23 @@ Set this variable to nil to suppress warnings altogether, or to
the symbol `silent' to log warnings but not pop up the *Warnings*
buffer."
:type '(choice
- (const :tag "Do not report warnings" nil)
- (const :tag "Report and display warnings" t)
- (const :tag "Report but do not display warnings" silent))
+ (const :tag "Do not report warnings/errors" nil)
+ (const :tag "Report and display warnings/errors" t)
+ (const :tag "Report but do not display warnings/errors" silent))
:version "28.1")
+(defcustom native-comp-async-warnings-errors-kind 'important
+ "Which kind of warnings and errors to report from async native compilation.
+
+Setting this variable to `important' (the default) will report
+only important warnings and all errors.
+Setting this variable to `all' will report all warnings and
+errors."
+ :type '(choice
+ (const :tag "Report all warnings/errors" all)
+ (const :tag "Report important warnings and all errors" important))
+ :version "30.1")
+
(defcustom native-comp-always-compile nil
"Non-nil means unconditionally (re-)compile all files."
:type 'boolean
@@ -184,13 +196,21 @@ processes from `comp-async-compilations'"
(let ((warning-suppress-types
(if (eq native-comp-async-report-warnings-errors 'silent)
(cons '(comp) warning-suppress-types)
- warning-suppress-types)))
+ warning-suppress-types))
+ (regexp (if (eq native-comp-async-warnings-errors-kind 'all)
+ "^.*?\\(?:Error\\|Warning\\): .*$"
+ (rx bol
+ (*? nonl)
+ (or
+ (seq "Error: " (*? nonl))
+ (seq "Warning: the function ā€˜" (1+ (not "ā€™"))
+ "ā€™ is not known to be defined."))
+ eol))))
(with-current-buffer (process-buffer process)
(save-excursion
(accept-process-output process)
(goto-char (or comp-last-scanned-async-output (point-min)))
- (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$"
- nil t)
+ (while (re-search-forward regexp nil t)
(display-warning 'comp (match-string 0)))
(setq comp-last-scanned-async-output (point-max)))))
(accept-process-output process)))
@@ -213,8 +233,8 @@ display a message."
"`comp-files-queue' should be \".el\" files: %s"
source-file)
when (or native-comp-always-compile
- load ; Always compile when the compilation is
- ; commanded for late load.
+ load ; Always compile when the compilation is
+ ; commanded for late load.
;; Skip compilation if `comp-el-to-eln-filename' fails
;; to find a writable directory.
(with-demoted-errors "Async compilation :%S"
@@ -236,6 +256,7 @@ display a message."
load-path
backtrace-line-length
byte-compile-warnings
+ comp-sanitizer-emit
;; package-load-list
;; package-user-dir
;; package-directory-list
@@ -344,13 +365,15 @@ Return the trampoline if found or nil otherwise."
(when (memq subr-name comp-warn-primitives)
(warn "Redefining `%s' might break native compilation of trampolines."
subr-name))
- (unless (or (null native-comp-enable-subr-trampolines)
- (memq subr-name native-comp-never-optimize-functions)
- (gethash subr-name comp-installed-trampolines-h))
- (cl-assert (subr-primitive-p (symbol-function subr-name)))
- (when-let ((trampoline (or (comp-trampoline-search subr-name)
- (comp-trampoline-compile subr-name))))
- (comp--install-trampoline subr-name trampoline))))
+ (let ((subr (symbol-function subr-name)))
+ (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573)
+ (null native-comp-enable-subr-trampolines)
+ (memq subr-name native-comp-never-optimize-functions)
+ (gethash subr-name comp-installed-trampolines-h))
+ (cl-assert (subr-primitive-p subr))
+ (when-let ((trampoline (or (comp-trampoline-search subr-name)
+ (comp-trampoline-compile subr-name))))
+ (comp--install-trampoline subr-name trampoline)))))
;;;###autoload
(defun native--compile-async (files &optional recursively load selector)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 260bd2f1acb..2ec55ed98ee 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -43,7 +43,7 @@
(defvar native-comp-eln-load-path)
(defvar native-comp-enable-subr-trampolines)
-(declare-function comp--compile-ctxt-to-file "comp.c")
+(declare-function comp--compile-ctxt-to-file0 "comp.c")
(declare-function comp--init-ctxt "comp.c")
(declare-function comp--release-ctxt "comp.c")
(declare-function comp-el-to-eln-filename "comp.c")
@@ -68,7 +68,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug 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.
@@ -155,17 +155,19 @@ native compilation runs.")
"Current allocation class.
Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
-(defconst comp-passes '(comp-spill-lap
- comp-limplify
- comp-fwprop
- comp-call-optim
- comp-ipa-pure
- comp-add-cstrs
- comp-fwprop
- comp-tco
- comp-fwprop
- comp-remove-type-hints
- comp-final)
+(defconst comp-passes '(comp--spill-lap
+ comp--limplify
+ comp--fwprop
+ comp--call-optim
+ comp--ipa-pure
+ comp--add-cstrs
+ comp--fwprop
+ comp--tco
+ comp--fwprop
+ comp--remove-type-hints
+ comp--sanitizer
+ comp--compute-function-types
+ comp--final)
"Passes to be executed in order.")
(defvar comp-disabled-passes '()
@@ -187,42 +189,56 @@ Useful to hook into pass checkers.")
finally return h)
"Hash table function -> `comp-constraint'.")
+;; Keep it in sync with the `cl-deftype-satisfies' property set in
+;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the
+;; relation type <-> predicate is not bijective (bug#45576).
(defconst comp-known-predicates
- '((arrayp . array)
- (atom . atom)
- (characterp . fixnum)
- (booleanp . boolean)
- (bool-vector-p . bool-vector)
- (bufferp . buffer)
- (natnump . (integer 0 *))
- (char-table-p . char-table)
- (hash-table-p . hash-table)
- (consp . cons)
- (integerp . integer)
- (floatp . float)
- (functionp . (or function symbol))
- (integerp . integer)
- (keywordp . keyword)
- (listp . list)
- (numberp . number)
- (null . null)
- (numberp . number)
- (sequencep . sequence)
- (stringp . string)
- (symbolp . symbol)
- (vectorp . vector)
- (integer-or-marker-p . integer-or-marker))
- "Alist predicate -> matched type specifier.")
+ ;; FIXME: Auto-generate (most of) it from `cl-deftype-satifies'?
+ '((arrayp array)
+ (atom atom)
+ (bool-vector-p bool-vector)
+ (booleanp boolean)
+ (bufferp buffer)
+ (char-table-p char-table)
+ (characterp fixnum t)
+ (consp cons)
+ (floatp float)
+ (framep frame)
+ (functionp (or function symbol cons) (not function))
+ (hash-table-p hash-table)
+ (integer-or-marker-p integer-or-marker)
+ (integerp integer)
+ (keywordp symbol t)
+ (listp list)
+ (markerp marker)
+ (natnump (integer 0 *))
+ (null null)
+ (number-or-marker-p number-or-marker)
+ (numberp number)
+ (obarrayp obarray)
+ (overlayp overlay)
+ (processp process)
+ (sequencep sequence)
+ (stringp string)
+ (subrp subr)
+ (symbol-with-pos-p symbol-with-pos)
+ (symbolp symbol)
+ (vectorp vector)
+ (windowp window))
+ "(PREDICATE TYPE-IF-SATISFIED ?TYPE-IF-NOT-SATISFIED).")
(defconst comp-known-predicates-h
(cl-loop
with comp-ctxt = (make-comp-cstr-ctxt)
with h = (make-hash-table :test #'eq)
- for (pred . type-spec) in comp-known-predicates
- for cstr = (comp-type-spec-to-cstr type-spec)
- do (puthash pred cstr h)
+ for (pred . type-specs) in comp-known-predicates
+ for pos-cstr = (comp-type-spec-to-cstr (car type-specs))
+ for neg-cstr = (if (length> type-specs 1)
+ (comp-type-spec-to-cstr (cl-second type-specs))
+ (comp-cstr-negation-make pos-cstr))
+ do (puthash pred (cons pos-cstr neg-cstr) h)
finally return h)
- "Hash table function -> `comp-constraint'.")
+ "Hash table FUNCTION -> (POS-CSTR . NEG-CSTR).")
(defun comp--known-predicate-p (predicate)
"Return t if PREDICATE is known."
@@ -230,9 +246,14 @@ Useful to hook into pass checkers.")
(gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))
t))
-(defun comp--pred-to-cstr (predicate)
- "Given PREDICATE, return the corresponding constraint."
- (or (gethash predicate comp-known-predicates-h)
+(defun comp--pred-to-pos-cstr (predicate)
+ "Given PREDICATE, return the corresponding positive constraint."
+ (or (car-safe (gethash predicate comp-known-predicates-h))
+ (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
+
+(defun comp--pred-to-neg-cstr (predicate)
+ "Given PREDICATE, return the corresponding negative constraint."
+ (or (cdr-safe (gethash predicate comp-known-predicates-h))
(gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
(defconst comp-symbol-values-optimizable '(most-positive-fixnum
@@ -388,7 +409,7 @@ This is typically for top-level forms other than defun.")
(closed nil :type boolean
:documentation "t if closed.")
;; All the following are for SSA and CGF analysis.
- ;; Keep in sync with `comp-clean-ssa'!!
+ ;; Keep in sync with `comp--clean-ssa'!!
(in-edges () :type list
:documentation "List of incoming edges.")
(out-edges () :type list
@@ -416,7 +437,7 @@ into it.")
:documentation "Start block LAP address.")
(non-ret-insn nil :type list
:documentation "Insn known to perform a non local exit.
-`comp-fwprop' may identify and store here basic blocks performing
+`comp--fwprop' may identify and store here basic blocks performing
non local exits and mark it rewrite it later.")
(no-ret nil :type boolean
:documentation "t when the block is known to perform a
@@ -507,7 +528,7 @@ CFG is mutated by a pass.")
(lambda-list nil :type list
:documentation "Original lambda-list."))
-(cl-defstruct (comp-mvar (:constructor make--comp-mvar)
+(cl-defstruct (comp-mvar (:constructor make--comp-mvar0)
(:include comp-cstr))
"A meta-variable being a slot in the meta-stack."
(id nil :type (or null number)
@@ -516,6 +537,7 @@ CFG is mutated by a pass.")
:documentation "Slot number in the array if a number or
`scratch' for scratch slot."))
+;; In use by comp.c.
(defun comp-mvar-type-hint-match-p (mvar type-hint)
"Match MVAR against TYPE-HINT.
In use by the back-end."
@@ -569,10 +591,9 @@ In use by the back-end."
finally return t)
t))
-(defsubst comp--symbol-func-to-fun (symbol-funcion)
- "Given a function called SYMBOL-FUNCION return its `comp-func'."
- (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h
- comp-ctxt))
+(defsubst comp--symbol-func-to-fun (symbol-func)
+ "Given a function called SYMBOL-FUNC return its `comp-func'."
+ (gethash (gethash symbol-func (comp-ctxt-sym-to-c-name-h comp-ctxt))
(comp-ctxt-funcs-h comp-ctxt)))
(defun comp--function-pure-p (f)
@@ -637,7 +658,7 @@ VERBOSITY is a number between 0 and 3."
-(defmacro comp-loop-insn-in-block (basic-block &rest body)
+(defmacro comp--loop-insn-in-block (basic-block &rest body)
"Loop over all insns in BASIC-BLOCK executing BODY.
Inside BODY, `insn' and `insn-cell'can be used to read or set the
current instruction or its cell."
@@ -651,19 +672,19 @@ current instruction or its cell."
;;; spill-lap pass specific code.
-(defun comp-lex-byte-func-p (f)
+(defun comp--lex-byte-func-p (f)
"Return t if F is a lexically-scoped byte compiled function."
(and (byte-code-function-p f)
(fixnump (aref f 0))))
-(defun comp-spill-decl-spec (function-name spec)
+(defun comp--spill-decl-spec (function-name spec)
"Return the declared specifier SPEC for FUNCTION-NAME."
(plist-get (cdr (assq function-name byte-to-native-plist-environment))
spec))
-(defun comp-spill-speed (function-name)
+(defun comp--spill-speed (function-name)
"Return the speed for FUNCTION-NAME."
- (or (comp-spill-decl-spec function-name 'speed)
+ (or (comp--spill-decl-spec function-name 'speed)
(comp-ctxt-speed comp-ctxt)))
;; Autoloaded as might be used by `disassemble-internal'.
@@ -702,7 +723,7 @@ clashes."
;; pick the first one.
(concat prefix crypted "_" human-readable "_0"))))
-(defun comp-decrypt-arg-list (x function-name)
+(defun comp--decrypt-arg-list (x function-name)
"Decrypt argument list X for FUNCTION-NAME."
(unless (fixnump x)
(signal 'native-compiler-error-dyn-func (list function-name)))
@@ -717,21 +738,21 @@ clashes."
:nonrest nonrest
:rest rest))))
-(defsubst comp-byte-frame-size (byte-compiled-func)
+(defsubst comp--byte-frame-size (byte-compiled-func)
"Return the frame size to be allocated for BYTE-COMPILED-FUNC."
(aref byte-compiled-func 3))
-(defun comp-add-func-to-ctxt (func)
+(defun comp--add-func-to-ctxt (func)
"Add FUNC to the current compiler context."
(let ((name (comp-func-name func))
(c-name (comp-func-c-name func)))
(puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt))
(puthash c-name func (comp-ctxt-funcs-h comp-ctxt))))
-(cl-defgeneric comp-spill-lap-function (input)
+(cl-defgeneric comp--spill-lap-function (input)
"Byte-compile INPUT and spill lap for further stages.")
-(cl-defmethod comp-spill-lap-function ((function-name symbol))
+(cl-defmethod comp--spill-lap-function ((function-name symbol))
"Byte-compile FUNCTION-NAME, spilling data from the byte compiler."
(unless (comp-ctxt-output comp-ctxt)
(setf (comp-ctxt-output comp-ctxt)
@@ -747,9 +768,9 @@ clashes."
(list (make-byte-to-native-func-def :name function-name
:c-name c-name
:byte-func byte-code)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
-(cl-defmethod comp-spill-lap-function ((form list))
+(cl-defmethod comp--spill-lap-function ((form list))
"Byte-compile FORM, spilling data from the byte compiler."
(unless (memq (car-safe form) '(lambda closure))
(signal 'native-compiler-error
@@ -763,9 +784,9 @@ clashes."
(list (make-byte-to-native-func-def :name '--anonymous-lambda
:c-name c-name
:byte-func byte-code)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
-(defun comp-intern-func-in-ctxt (_ obj)
+(defun comp--intern-func-in-ctxt (_ obj)
"Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."
(when-let ((byte-func (byte-to-native-lambda-byte-func obj)))
(let* ((lap (byte-to-native-lambda-lap obj))
@@ -778,9 +799,9 @@ clashes."
(name (when top-l-form
(byte-to-native-func-def-name top-l-form)))
(c-name (comp-c-func-name (or name "anonymous-lambda") "F"))
- (func (if (comp-lex-byte-func-p byte-func)
+ (func (if (comp--lex-byte-func-p byte-func)
(make-comp-func-l
- :args (comp-decrypt-arg-list (aref byte-func 0)
+ :args (comp--decrypt-arg-list (aref byte-func 0)
name))
(make-comp-func-d :lambda-list (aref byte-func 0)))))
(setf (comp-func-name func) name
@@ -790,9 +811,9 @@ clashes."
(comp-func-command-modes func) (command-modes byte-func)
(comp-func-c-name func) c-name
(comp-func-lap func) lap
- (comp-func-frame-size func) (comp-byte-frame-size byte-func)
- (comp-func-speed func) (comp-spill-speed name)
- (comp-func-pure func) (comp-spill-decl-spec name 'pure))
+ (comp-func-frame-size func) (comp--byte-frame-size byte-func)
+ (comp-func-speed func) (comp--spill-speed name)
+ (comp-func-pure func) (comp--spill-decl-spec name 'pure))
;; Store the c-name to have it retrievable from
;; `comp-ctxt-top-level-forms'.
@@ -800,11 +821,11 @@ clashes."
(setf (byte-to-native-func-def-c-name top-l-form) c-name))
(unless name
(puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt)))
- (comp-add-func-to-ctxt func)
+ (comp--add-func-to-ctxt func)
(comp-log (format "Function %s:\n" name) 1)
(comp-log lap 1 t))))
-(cl-defmethod comp-spill-lap-function ((filename string))
+(cl-defmethod comp--spill-lap-function ((filename string))
"Byte-compile FILENAME, spilling data from the byte compiler."
(byte-compile-file filename)
(when (or (null byte-native-qualities)
@@ -829,7 +850,7 @@ clashes."
collect
(if (and (byte-to-native-func-def-p form)
(eq -1
- (comp-spill-speed (byte-to-native-func-def-name form))))
+ (comp--spill-speed (byte-to-native-func-def-name form))))
(let ((byte-code (byte-to-native-func-def-byte-func form)))
(remhash byte-code byte-to-native-lambdas-h)
(make-byte-to-native-top-level
@@ -837,11 +858,11 @@ clashes."
',(byte-to-native-func-def-name form)
,byte-code
nil)
- :lexical (comp-lex-byte-func-p byte-code)))
+ :lexical (comp--lex-byte-func-p byte-code)))
form)))
- (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))
-(defun comp-spill-lap (input)
+(defun comp--spill-lap (input)
"Byte-compile and spill the LAP representation for INPUT.
If INPUT is a symbol, it is the function-name to be compiled.
If INPUT is a string, it is the filename to be compiled."
@@ -849,7 +870,7 @@ If INPUT is a string, it is the filename to be compiled."
(byte-to-native-lambdas-h (make-hash-table :test #'eq))
(byte-to-native-top-level-forms ())
(byte-to-native-plist-environment ())
- (res (comp-spill-lap-function input)))
+ (res (comp--spill-lap-function input)))
(comp-cstr-ctxt-update-type-slots comp-ctxt)
res))
@@ -878,55 +899,55 @@ Points to the next slot to be filled.")
byte-switch byte-pushconditioncase)
"LAP end of basic blocks op codes.")
-(defun comp-lap-eob-p (inst)
+(defun comp--lap-eob-p (inst)
"Return t if INST closes the current basic blocks, nil otherwise."
(when (memq (car inst) comp-lap-eob-ops)
t))
-(defun comp-lap-fall-through-p (inst)
+(defun comp--lap-fall-through-p (inst)
"Return t if INST falls through, nil otherwise."
(when (not (memq (car inst) '(byte-goto byte-return)))
t))
-(defsubst comp-sp ()
+(defsubst comp--sp ()
"Current stack pointer."
(declare (gv-setter (lambda (val)
`(setf (comp-limplify-sp comp-pass) ,val))))
(comp-limplify-sp comp-pass))
-(defmacro comp-with-sp (sp &rest body)
+(defmacro comp--with-sp (sp &rest body)
"Execute BODY setting the stack pointer to SP.
Restore the original value afterwards."
(declare (debug (form body))
(indent defun))
(let ((sym (gensym)))
- `(let ((,sym (comp-sp)))
- (setf (comp-sp) ,sp)
+ `(let ((,sym (comp--sp)))
+ (setf (comp--sp) ,sp)
(progn ,@body)
- (setf (comp-sp) ,sym))))
+ (setf (comp--sp) ,sym))))
-(defsubst comp-slot-n (n)
+(defsubst comp--slot-n (n)
"Slot N into the meta-stack."
(comp-vec-aref (comp-limplify-frame comp-pass) n))
-(defsubst comp-slot ()
+(defsubst comp--slot ()
"Current slot into the meta-stack pointed by sp."
- (comp-slot-n (comp-sp)))
+ (comp--slot-n (comp--sp)))
-(defsubst comp-slot+1 ()
+(defsubst comp--slot+1 ()
"Slot into the meta-stack pointed by sp + 1."
- (comp-slot-n (1+ (comp-sp))))
+ (comp--slot-n (1+ (comp--sp))))
-(defsubst comp-label-to-addr (label)
+(defsubst comp--label-to-addr (label)
"Find the address of LABEL."
(or (gethash label (comp-limplify-label-to-addr comp-pass))
(signal 'native-ice (list "label not found" label))))
-(defsubst comp-mark-curr-bb-closed ()
+(defsubst comp--mark-curr-bb-closed ()
"Mark the current basic block as closed."
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t))
-(defun comp-bb-maybe-add (lap-addr &optional sp)
+(defun comp--bb-maybe-add (lap-addr &optional sp)
"If necessary create a pending basic block for LAP-ADDR with stack depth SP.
The basic block is returned regardless it was already declared or not."
(let ((bb (or (cl-loop ; See if the block was already limplified.
@@ -944,24 +965,24 @@ The basic block is returned regardless it was already declared or not."
(signal 'native-ice (list "incoherent stack pointers"
sp (comp-block-lap-sp bb))))
bb)
- (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym))
+ (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym))
(comp-limplify-pending-blocks comp-pass))))))
-(defsubst comp-call (func &rest args)
+(defsubst comp--call (func &rest args)
"Emit a call for function FUNC with ARGS."
`(call ,func ,@args))
-(defun comp-callref (func nargs stack-off)
+(defun comp--callref (func nargs stack-off)
"Emit a call using narg abi for FUNC.
NARGS is the number of arguments.
STACK-OFF is the index of the first slot frame involved."
`(callref ,func ,@(cl-loop repeat nargs
for sp from stack-off
- collect (comp-slot-n sp))))
+ collect (comp--slot-n sp))))
-(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg)
+(cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg)
"`comp-mvar' initializer."
- (let ((mvar (make--comp-mvar :slot slot)))
+ (let ((mvar (make--comp-mvar0 :slot slot)))
(when const-vld
(comp--add-const-to-relocs constant)
(setf (comp-cstr-imm mvar) constant))
@@ -971,49 +992,49 @@ STACK-OFF is the index of the first slot frame involved."
(setf (comp-mvar-neg mvar) t))
mvar))
-(defun comp-new-frame (size vsize &optional ssa)
+(defun comp--new-frame (size vsize &optional ssa)
"Return a clean frame of meta variables of size SIZE and VSIZE.
If SSA is non-nil, populate it with m-var in ssa form."
(cl-loop with v = (make-comp-vec :beg (- vsize) :end size)
for i from (- vsize) below size
for mvar = (if ssa
- (make-comp-ssa-mvar :slot i)
- (make-comp-mvar :slot i))
+ (make--comp--ssa-mvar :slot i)
+ (make--comp-mvar :slot i))
do (setf (comp-vec-aref v i) mvar)
finally return v))
-(defun comp-emit (insn)
+(defun comp--emit (insn)
"Emit INSN into basic block BB."
(let ((bb (comp-limplify-curr-block comp-pass)))
(cl-assert (not (comp-block-closed bb)))
(push insn (comp-block-insns bb))))
-(defun comp-emit-set-call (call)
+(defun comp--emit-set-call (call)
"Emit CALL assigning the result to the current slot frame.
If the callee function is known to have a return type, propagate it."
(cl-assert call)
- (comp-emit (list 'set (comp-slot) call)))
+ (comp--emit (list 'set (comp--slot) call)))
-(defun comp-copy-slot (src-n &optional dst-n)
+(defun comp--copy-slot (src-n &optional dst-n)
"Set slot number DST-N to slot number SRC-N as source.
If DST-N is specified, use it; otherwise assume it to be the current slot."
- (comp-with-sp (or dst-n (comp-sp))
- (let ((src-slot (comp-slot-n src-n)))
+ (comp--with-sp (or dst-n (comp--sp))
+ (let ((src-slot (comp--slot-n src-n)))
(cl-assert src-slot)
- (comp-emit `(set ,(comp-slot) ,src-slot)))))
+ (comp--emit `(set ,(comp--slot) ,src-slot)))))
-(defsubst comp-emit-annotation (str)
+(defsubst comp--emit-annotation (str)
"Emit annotation STR."
- (comp-emit `(comment ,str)))
+ (comp--emit `(comment ,str)))
-(defsubst comp-emit-setimm (val)
+(defsubst comp--emit-setimm (val)
"Set constant VAL to current slot."
(comp--add-const-to-relocs val)
;; Leave relocation index nil on purpose, will be fixed-up in final
;; by `comp-finalize-relocs'.
- (comp-emit `(setimm ,(comp-slot) ,val)))
+ (comp--emit `(setimm ,(comp--slot) ,val)))
-(defun comp-make-curr-block (block-name entry-sp &optional addr)
+(defun comp--make-curr-block (block-name entry-sp &optional addr)
"Create a basic block with BLOCK-NAME and set it as current block.
ENTRY-SP is the sp value when entering.
Add block to the current function and return it."
@@ -1025,104 +1046,104 @@ Add block to the current function and return it."
(puthash (comp-block-name bb) bb (comp-func-blocks comp-func))
bb))
-(defun comp-latch-make-fill (target)
+(defun comp--latch-make-fill (target)
"Create a latch pointing to TARGET and fill it.
Return the created latch."
- (let ((latch (make-comp-latch :name (comp-new-block-sym "latch")))
+ (let ((latch (make-comp-latch :name (comp--new-block-sym "latch")))
(curr-bb (comp-limplify-curr-block comp-pass)))
- ;; See `comp-make-curr-block'.
+ ;; See `comp--make-curr-block'.
(setf (comp-limplify-curr-block comp-pass) latch)
(when (< (comp-func-speed comp-func) 3)
;; At speed 3 the programmer is responsible to manually
;; place `comp-maybe-gc-or-quit'.
- (comp-emit '(call comp-maybe-gc-or-quit)))
- ;; See `comp-emit-uncond-jump'.
- (comp-emit `(jump ,(comp-block-name target)))
- (comp-mark-curr-bb-closed)
+ (comp--emit '(call comp-maybe-gc-or-quit)))
+ ;; See `comp--emit-uncond-jump'.
+ (comp--emit `(jump ,(comp-block-name target)))
+ (comp--mark-curr-bb-closed)
(puthash (comp-block-name latch) latch (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) curr-bb)
latch))
-(defun comp-emit-uncond-jump (lap-label)
+(defun comp--emit-uncond-jump (lap-label)
"Emit an unconditional branch to LAP-LABEL."
(cl-destructuring-bind (label-num . stack-depth) lap-label
(when stack-depth
- (cl-assert (= (1- stack-depth) (comp-sp))))
- (let* ((target-addr (comp-label-to-addr label-num))
- (target (comp-bb-maybe-add target-addr
- (comp-sp)))
+ (cl-assert (= (1- stack-depth) (comp--sp))))
+ (let* ((target-addr (comp--label-to-addr label-num))
+ (target (comp--bb-maybe-add target-addr
+ (comp--sp)))
(latch (when (< target-addr (comp-limplify-pc comp-pass))
- (comp-latch-make-fill target)))
+ (comp--latch-make-fill target)))
(eff-target-name (comp-block-name (or latch target))))
- (comp-emit `(jump ,eff-target-name))
- (comp-mark-curr-bb-closed))))
+ (comp--emit `(jump ,eff-target-name))
+ (comp--mark-curr-bb-closed))))
-(defun comp-emit-cond-jump (a b target-offset lap-label negated)
+(defun comp--emit-cond-jump (a b target-offset lap-label negated)
"Emit a conditional jump to LAP-LABEL when A and B satisfy EQ.
TARGET-OFFSET is the positive offset on the SP when branching to the target
block.
If NEGATED is non null, negate the tested condition.
Return value is the fall-through block name."
(cl-destructuring-bind (label-num . label-sp) lap-label
- (let* ((bb (comp-block-name (comp-bb-maybe-add
+ (let* ((bb (comp-block-name (comp--bb-maybe-add
(1+ (comp-limplify-pc comp-pass))
- (comp-sp)))) ; Fall through block.
- (target-sp (+ target-offset (comp-sp)))
- (target-addr (comp-label-to-addr label-num))
- (target (comp-bb-maybe-add target-addr target-sp))
+ (comp--sp)))) ; Fall through block.
+ (target-sp (+ target-offset (comp--sp)))
+ (target-addr (comp--label-to-addr label-num))
+ (target (comp--bb-maybe-add target-addr target-sp))
(latch (when (< target-addr (comp-limplify-pc comp-pass))
- (comp-latch-make-fill target)))
+ (comp--latch-make-fill target)))
(eff-target-name (comp-block-name (or latch target))))
(when label-sp
- (cl-assert (= (1- label-sp) (+ target-offset (comp-sp)))))
- (comp-emit (if negated
+ (cl-assert (= (1- label-sp) (+ target-offset (comp--sp)))))
+ (comp--emit (if negated
(list 'cond-jump a b bb eff-target-name)
(list 'cond-jump a b eff-target-name bb)))
- (comp-mark-curr-bb-closed)
+ (comp--mark-curr-bb-closed)
bb)))
-(defun comp-emit-handler (lap-label handler-type)
+(defun comp--emit-handler (lap-label handler-type)
"Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE."
(cl-destructuring-bind (label-num . label-sp) lap-label
- (cl-assert (= (- label-sp 2) (comp-sp)))
+ (cl-assert (= (- label-sp 2) (comp--sp)))
(setf (comp-func-has-non-local comp-func) t)
- (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
- (comp-sp)))
- (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num)
- (1+ (comp-sp))))
- (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym))))
- (comp-emit (list 'push-handler
+ (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp--sp)))
+ (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num)
+ (1+ (comp--sp))))
+ (pop-bb (make--comp-block-lap nil (comp--sp) (comp--new-block-sym))))
+ (comp--emit (list 'push-handler
handler-type
- (comp-slot+1)
+ (comp--slot+1)
(comp-block-name pop-bb)
(comp-block-name guarded-bb)))
- (comp-mark-curr-bb-closed)
+ (comp--mark-curr-bb-closed)
;; Emit the basic block to pop the handler if we got the non local.
(puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) pop-bb)
- (comp-emit `(fetch-handler ,(comp-slot+1)))
- (comp-emit `(jump ,(comp-block-name handler-bb)))
- (comp-mark-curr-bb-closed))))
+ (comp--emit `(fetch-handler ,(comp--slot+1)))
+ (comp--emit `(jump ,(comp-block-name handler-bb)))
+ (comp--mark-curr-bb-closed))))
-(defun comp-limplify-listn (n)
+(defun comp--limplify-listn (n)
"Limplify list N."
- (comp-with-sp (+ (comp-sp) n -1)
- (comp-emit-set-call (comp-call 'cons
- (comp-slot)
- (make-comp-mvar :constant nil))))
- (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp)
- do (comp-with-sp sp
- (comp-emit-set-call (comp-call 'cons
- (comp-slot)
- (comp-slot+1))))))
-
-(defun comp-new-block-sym (&optional postfix)
+ (comp--with-sp (+ (comp--sp) n -1)
+ (comp--emit-set-call (comp--call 'cons
+ (comp--slot)
+ (make--comp-mvar :constant nil))))
+ (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp)
+ do (comp--with-sp sp
+ (comp--emit-set-call (comp--call 'cons
+ (comp--slot)
+ (comp--slot+1))))))
+
+(defun comp--new-block-sym (&optional postfix)
"Return a unique symbol postfixing POSTFIX naming the next new basic block."
(intern (format (if postfix "bb_%s_%s" "bb_%s")
(funcall (comp-func-block-cnt-gen comp-func))
postfix)))
-(defun comp-fill-label-h ()
+(defun comp--fill-label-h ()
"Fill label-to-addr hash table for the current function."
(setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql))
(cl-loop for insn in (comp-func-lap comp-func)
@@ -1131,10 +1152,10 @@ Return value is the fall-through block name."
(`(TAG ,label . ,_)
(puthash label addr (comp-limplify-label-to-addr comp-pass))))))
-(defun comp-jump-table-optimizable (jmp-table)
+(defun comp--jump-table-optimizable (jmp-table)
"Return t if JMP-TABLE can be optimized out."
;; Identify LAP sequences like:
- ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24)
+ ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24)
;; (byte-switch)
;; (TAG 126 . 10)
(let ((targets (hash-table-values jmp-table)))
@@ -1143,13 +1164,13 @@ Return value is the fall-through block name."
(`(TAG ,target . ,_label-sp)
(= target (car targets)))))))
-(defun comp-emit-switch (var last-insn)
+(defun comp--emit-switch (var last-insn)
"Emit a Limple for a lap jump table given VAR and LAST-INSN."
;; FIXME this not efficient for big jump tables. We should have a second
;; strategy for this case.
(pcase last-insn
(`(setimm ,_ ,jmp-table)
- (unless (comp-jump-table-optimizable jmp-table)
+ (unless (comp--jump-table-optimizable jmp-table)
(cl-loop
for test being each hash-keys of jmp-table
using (hash-value target-label)
@@ -1157,27 +1178,27 @@ Return value is the fall-through block name."
with test-func = (hash-table-test jmp-table)
for n from 1
for last = (= n len)
- for m-test = (make-comp-mvar :constant test)
- for target-name = (comp-block-name (comp-bb-maybe-add
- (comp-label-to-addr target-label)
- (comp-sp)))
+ for m-test = (make--comp-mvar :constant test)
+ for target-name = (comp-block-name (comp--bb-maybe-add
+ (comp--label-to-addr target-label)
+ (comp--sp)))
for ff-bb = (if last
- (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
- (comp-sp))
+ (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp--sp))
(make--comp-block-lap nil
- (comp-sp)
- (comp-new-block-sym)))
+ (comp--sp)
+ (comp--new-block-sym)))
for ff-bb-name = (comp-block-name ff-bb)
if (eq test-func 'eq)
- do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name))
+ do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name))
else
;; Store the result of the comparison into the scratch slot before
;; emitting the conditional jump.
- do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
- (comp-call test-func var m-test)))
- (comp-emit (list 'cond-jump
- (make-comp-mvar :slot 'scratch)
- (make-comp-mvar :constant nil)
+ do (comp--emit (list 'set (make--comp-mvar :slot 'scratch)
+ (comp--call test-func var m-test)))
+ (comp--emit (list 'cond-jump
+ (make--comp-mvar :slot 'scratch)
+ (make--comp-mvar :constant nil)
ff-bb-name target-name))
unless last
;; All fall through are artificially created here except the last one.
@@ -1192,7 +1213,7 @@ SUBR-NAME is the name of function."
(or (gethash subr-name comp-subr-arities-h)
(func-arity subr-name)))
-(defun comp-emit-set-call-subr (subr-name sp-delta)
+(defun comp--emit-set-call-subr (subr-name sp-delta)
"Emit a call for SUBR-NAME.
SP-DELTA is the stack adjustment."
(let* ((nargs (1+ (- sp-delta)))
@@ -1203,39 +1224,39 @@ SP-DELTA is the stack adjustment."
(signal 'native-ice (list "subr contains unevalled args" subr-name)))
(if (eq maxarg 'many)
;; callref case.
- (comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
+ (comp--emit-set-call (comp--callref subr-name nargs (comp--sp)))
;; Normal call.
(unless (and (>= maxarg nargs) (<= minarg nargs))
(signal 'native-ice
(list "incoherent stack adjustment" nargs maxarg minarg)))
(let* ((subr-name subr-name)
(slots (cl-loop for i from 0 below maxarg
- collect (comp-slot-n (+ i (comp-sp))))))
- (comp-emit-set-call (apply #'comp-call (cons subr-name slots)))))))
+ collect (comp--slot-n (+ i (comp--sp))))))
+ (comp--emit-set-call (apply #'comp--call (cons subr-name slots)))))))
(eval-when-compile
- (defun comp-op-to-fun (x)
+ (defun comp--op-to-fun (x)
"Given the LAP op strip \"byte-\" to have the subr name."
(intern (string-replace "byte-" "" x)))
- (defun comp-body-eff (body op-name sp-delta)
+ (defun comp--body-eff (body op-name sp-delta)
"Given the original BODY, compute the effective one.
When BODY is `auto', guess function name from the LAP byte-code
name. Otherwise expect lname fnname."
(pcase (car body)
('auto
- `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta)))
+ `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta)))
((pred symbolp)
- `((comp-emit-set-call-subr ',(car body) ,sp-delta)))
+ `((comp--emit-set-call-subr ',(car body) ,sp-delta)))
(_ body))))
-(defmacro comp-op-case (&rest cases)
+(defmacro comp--op-case (&rest cases)
"Expand CASES into the corresponding `pcase' expansion.
This is responsible for generating the proper stack adjustment, when known,
and the annotation emission."
(declare (debug (body))
(indent defun))
- (declare-function comp-body-eff nil (body op-name sp-delta))
+ (declare-function comp--body-eff nil (body op-name sp-delta))
`(pcase op
,@(cl-loop for (op . body) in cases
for sp-delta = (gethash op comp-op-stack-info)
@@ -1244,55 +1265,55 @@ and the annotation emission."
collect `(',op
;; Log all LAP ops except the TAG one.
;; ,(unless (eq op 'TAG)
- ;; `(comp-emit-annotation
+ ;; `(comp--emit-annotation
;; ,(concat "LAP op " op-name)))
;; Emit the stack adjustment if present.
,(when (and sp-delta (not (eq 0 sp-delta)))
- `(cl-incf (comp-sp) ,sp-delta))
- ,@(comp-body-eff body op-name sp-delta))
+ `(cl-incf (comp--sp) ,sp-delta))
+ ,@(comp--body-eff body op-name sp-delta))
else
collect `(',op (signal 'native-ice
(list "unsupported LAP op" ',op-name))))
(_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op))))))
-(defun comp-limplify-lap-inst (insn)
+(defun comp--limplify-lap-inst (insn)
"Limplify LAP instruction INSN pushing it in the proper basic block."
(let ((op (car insn))
(arg (if (consp (cdr insn))
(cadr insn)
(cdr insn))))
- (comp-op-case
+ (comp--op-case
(TAG
(cl-destructuring-bind (_TAG label-num . label-sp) insn
;; Paranoid?
(when label-sp
(cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass))))
- (comp-emit-annotation (format "LAP TAG %d" label-num))))
+ (comp--emit-annotation (format "LAP TAG %d" label-num))))
(byte-stack-ref
- (comp-copy-slot (- (comp-sp) arg 1)))
+ (comp--copy-slot (- (comp--sp) arg 1)))
(byte-varref
- (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar
+ (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar
:constant arg))))
(byte-varset
- (comp-emit (comp-call 'set_internal
- (make-comp-mvar :constant arg)
- (comp-slot+1))))
+ (comp--emit (comp--call 'set_internal
+ (make--comp-mvar :constant arg)
+ (comp--slot+1))))
(byte-varbind ;; Verify
- (comp-emit (comp-call 'specbind
- (make-comp-mvar :constant arg)
- (comp-slot+1))))
+ (comp--emit (comp--call 'specbind
+ (make--comp-mvar :constant arg)
+ (comp--slot+1))))
(byte-call
- (cl-incf (comp-sp) (- arg))
- (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp))))
+ (cl-incf (comp--sp) (- arg))
+ (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp))))
(byte-unbind
- (comp-emit (comp-call 'helper_unbind_n
- (make-comp-mvar :constant arg))))
+ (comp--emit (comp--call 'helper_unbind_n
+ (make--comp-mvar :constant arg))))
(byte-pophandler
- (comp-emit '(pop-handler)))
+ (comp--emit '(pop-handler)))
(byte-pushconditioncase
- (comp-emit-handler (cddr insn) 'condition-case))
+ (comp--emit-handler (cddr insn) 'condition-case))
(byte-pushcatch
- (comp-emit-handler (cddr insn) 'catcher))
+ (comp--emit-handler (cddr insn) 'catcher))
(byte-nth auto)
(byte-symbolp auto)
(byte-consp auto)
@@ -1301,19 +1322,19 @@ and the annotation emission."
(byte-eq auto)
(byte-memq auto)
(byte-not
- (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp))
- (make-comp-mvar :constant nil))))
+ (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp))
+ (make--comp-mvar :constant nil))))
(byte-car auto)
(byte-cdr auto)
(byte-cons auto)
(byte-list1
- (comp-limplify-listn 1))
+ (comp--limplify-listn 1))
(byte-list2
- (comp-limplify-listn 2))
+ (comp--limplify-listn 2))
(byte-list3
- (comp-limplify-listn 3))
+ (comp--limplify-listn 3))
(byte-list4
- (comp-limplify-listn 4))
+ (comp--limplify-listn 4))
(byte-length auto)
(byte-aref auto)
(byte-aset auto)
@@ -1324,11 +1345,11 @@ and the annotation emission."
(byte-get auto)
(byte-substring auto)
(byte-concat2
- (comp-emit-set-call (comp-callref 'concat 2 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 2 (comp--sp))))
(byte-concat3
- (comp-emit-set-call (comp-callref 'concat 3 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 3 (comp--sp))))
(byte-concat4
- (comp-emit-set-call (comp-callref 'concat 4 (comp-sp))))
+ (comp--emit-set-call (comp--callref 'concat 4 (comp--sp))))
(byte-sub1 1-)
(byte-add1 1+)
(byte-eqlsign =)
@@ -1338,7 +1359,7 @@ and the annotation emission."
(byte-geq >=)
(byte-diff -)
(byte-negate
- (comp-emit-set-call (comp-call 'negate (comp-slot))))
+ (comp--emit-set-call (comp--call 'negate (comp--slot))))
(byte-plus +)
(byte-max auto)
(byte-min auto)
@@ -1353,9 +1374,9 @@ and the annotation emission."
(byte-preceding-char preceding-char)
(byte-current-column auto)
(byte-indent-to
- (comp-emit-set-call (comp-call 'indent-to
- (comp-slot)
- (make-comp-mvar :constant nil))))
+ (comp--emit-set-call (comp--call 'indent-to
+ (comp--slot)
+ (make--comp-mvar :constant nil))))
(byte-scan-buffer-OBSOLETE)
(byte-eolp auto)
(byte-eobp auto)
@@ -1364,7 +1385,7 @@ and the annotation emission."
(byte-current-buffer auto)
(byte-set-buffer auto)
(byte-save-current-buffer
- (comp-emit (comp-call 'record_unwind_current_buffer)))
+ (comp--emit (comp--call 'record_unwind_current_buffer)))
(byte-set-mark-OBSOLETE)
(byte-interactive-p-OBSOLETE)
(byte-forward-char auto)
@@ -1376,41 +1397,41 @@ and the annotation emission."
(byte-buffer-substring auto)
(byte-delete-region auto)
(byte-narrow-to-region
- (comp-emit-set-call (comp-call 'narrow-to-region
- (comp-slot)
- (comp-slot+1))))
+ (comp--emit-set-call (comp--call 'narrow-to-region
+ (comp--slot)
+ (comp--slot+1))))
(byte-widen
- (comp-emit-set-call (comp-call 'widen)))
+ (comp--emit-set-call (comp--call 'widen)))
(byte-end-of-line auto)
(byte-constant2) ; TODO
;; Branches.
(byte-goto
- (comp-emit-uncond-jump (cddr insn)))
+ (comp--emit-uncond-jump (cddr insn)))
(byte-goto-if-nil
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) nil))
(byte-goto-if-not-nil
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) t))
(byte-goto-if-nil-else-pop
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) nil))
(byte-goto-if-not-nil-else-pop
- (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) t))
(byte-return
- (comp-emit `(return ,(comp-slot+1))))
+ (comp--emit `(return ,(comp--slot+1))))
(byte-discard 'pass)
(byte-dup
- (comp-copy-slot (1- (comp-sp))))
+ (comp--copy-slot (1- (comp--sp))))
(byte-save-excursion
- (comp-emit (comp-call 'record_unwind_protect_excursion)))
+ (comp--emit (comp--call 'record_unwind_protect_excursion)))
(byte-save-window-excursion-OBSOLETE)
(byte-save-restriction
- (comp-emit (comp-call 'helper_save_restriction)))
+ (comp--emit (comp--call 'helper_save_restriction)))
(byte-catch) ;; Obsolete
(byte-unwind-protect
- (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1))))
+ (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1))))
(byte-condition-case) ;; Obsolete
(byte-temp-output-buffer-setup-OBSOLETE)
(byte-temp-output-buffer-show-OBSOLETE)
@@ -1437,61 +1458,61 @@ and the annotation emission."
(byte-numberp auto)
(byte-integerp auto)
(byte-listN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'list arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'list arg (comp--sp))))
(byte-concatN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'concat arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'concat arg (comp--sp))))
(byte-insertN
- (cl-incf (comp-sp) (- 1 arg))
- (comp-emit-set-call (comp-callref 'insert arg (comp-sp))))
+ (cl-incf (comp--sp) (- 1 arg))
+ (comp--emit-set-call (comp--callref 'insert arg (comp--sp))))
(byte-stack-set
- (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1)))
+ (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1)))
(byte-stack-set2 (cl-assert nil)) ;; TODO
(byte-discardN
- (cl-incf (comp-sp) (- arg)))
+ (cl-incf (comp--sp) (- arg)))
(byte-switch
;; Assume to follow the emission of a setimm.
- ;; This is checked into comp-emit-switch.
- (comp-emit-switch (comp-slot+1)
+ ;; This is checked into comp--emit-switch.
+ (comp--emit-switch (comp--slot+1)
(cl-first (comp-block-insns
(comp-limplify-curr-block comp-pass)))))
(byte-constant
- (comp-emit-setimm arg))
+ (comp--emit-setimm arg))
(byte-discardN-preserve-tos
- (cl-incf (comp-sp) (- arg))
- (comp-copy-slot (+ arg (comp-sp)))))))
+ (cl-incf (comp--sp) (- arg))
+ (comp--copy-slot (+ arg (comp--sp)))))))
-(defun comp-emit-narg-prologue (minarg nonrest rest)
+(defun comp--emit-narg-prologue (minarg nonrest rest)
"Emit the prologue for a narg function."
(cl-loop for i below minarg
- do (comp-emit `(set-args-to-local ,(comp-slot-n i)))
- (comp-emit '(inc-args)))
+ do (comp--emit `(set-args-to-local ,(comp--slot-n i)))
+ (comp--emit '(inc-args)))
(cl-loop for i from minarg below nonrest
for bb = (intern (format "entry_%s" i))
for fallback = (intern (format "entry_fallback_%s" i))
- do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb))
- (comp-make-curr-block bb (comp-sp))
- (comp-emit `(set-args-to-local ,(comp-slot-n i)))
- (comp-emit '(inc-args))
- finally (comp-emit '(jump entry_rest_args)))
+ do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb))
+ (comp--make-curr-block bb (comp--sp))
+ (comp--emit `(set-args-to-local ,(comp--slot-n i)))
+ (comp--emit '(inc-args))
+ finally (comp--emit '(jump entry_rest_args)))
(when (/= minarg nonrest)
(cl-loop for i from minarg below nonrest
for bb = (intern (format "entry_fallback_%s" i))
for next-bb = (if (= (1+ i) nonrest)
'entry_rest_args
(intern (format "entry_fallback_%s" (1+ i))))
- do (comp-with-sp i
- (comp-make-curr-block bb (comp-sp))
- (comp-emit-setimm nil)
- (comp-emit `(jump ,next-bb)))))
- (comp-make-curr-block 'entry_rest_args (comp-sp))
- (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest)))
- (setf (comp-sp) nonrest)
+ do (comp--with-sp i
+ (comp--make-curr-block bb (comp--sp))
+ (comp--emit-setimm nil)
+ (comp--emit `(jump ,next-bb)))))
+ (comp--make-curr-block 'entry_rest_args (comp--sp))
+ (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest)))
+ (setf (comp--sp) nonrest)
(when (and (> nonrest 8) (null rest))
- (cl-decf (comp-sp))))
+ (cl-decf (comp--sp))))
-(defun comp-limplify-finalize-function (func)
+(defun comp--limplify-finalize-function (func)
"Reverse insns into all basic blocks of FUNC."
(cl-loop for bb being the hash-value in (comp-func-blocks func)
do (setf (comp-block-insns bb)
@@ -1499,49 +1520,49 @@ and the annotation emission."
(comp--log-func func 2)
func)
-(cl-defgeneric comp-prepare-args-for-top-level (function)
+(cl-defgeneric comp--prepare-args-for-top-level (function)
"Given FUNCTION, return the two arguments for comp--register-...")
-(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l))
+(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l))
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
- (cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (cond
+ (cons (make--comp-mvar :constant (comp-args-base-min args))
+ (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))
+(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
- (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function)))
+ (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function)))
(let ((comp-curr-allocation-class 'd-default))
;; Lambda-lists must stay in the same relocation class of
;; the object referenced by code to respect uninterned
;; symbols.
- (make-comp-mvar :constant (comp-func-d-lambda-list function)))))
+ (make--comp-mvar :constant (comp-func-d-lambda-list function)))))
-(cl-defgeneric comp-emit-for-top-level (form for-late-load)
+(cl-defgeneric comp--emit-for-top-level (form for-late-load)
"Emit the Limple code for top level FORM.")
-(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def)
+(cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def)
for-late-load)
(let* ((name (byte-to-native-func-def-name form))
(c-name (byte-to-native-func-def-c-name form))
(f (gethash c-name (comp-ctxt-funcs-h comp-ctxt)))
- (args (comp-prepare-args-for-top-level f)))
+ (args (comp--prepare-args-for-top-level f)))
(cl-assert (and name f))
- (comp-emit
- `(set ,(make-comp-mvar :slot 1)
- ,(comp-call (if for-late-load
+ (comp--emit
+ `(set ,(make--comp-mvar :slot 1)
+ ,(comp--call (if for-late-load
'comp--late-register-subr
'comp--register-subr)
- (make-comp-mvar :constant name)
- (make-comp-mvar :constant c-name)
+ (make--comp-mvar :constant name)
+ (make--comp-mvar :constant c-name)
(car args)
(cdr args)
(setf (comp-func-type f)
- (make-comp-mvar :constant nil))
- (make-comp-mvar
+ (make--comp-mvar :constant nil))
+ (make--comp-mvar
:constant
(list
(let* ((h (comp-ctxt-function-docs comp-ctxt))
@@ -1552,40 +1573,40 @@ and the annotation emission."
(comp-func-command-modes f)))
;; This is the compilation unit it-self passed as
;; parameter.
- (make-comp-mvar :slot 0))))))
+ (make--comp-mvar :slot 0))))))
-(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)
+(cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level)
for-late-load)
(unless for-late-load
- (comp-emit
- (comp-call 'eval
+ (comp--emit
+ (comp--call 'eval
(let ((comp-curr-allocation-class 'd-impure))
- (make-comp-mvar :constant
+ (make--comp-mvar :constant
(byte-to-native-top-level-form form)))
- (make-comp-mvar :constant
+ (make--comp-mvar :constant
(byte-to-native-top-level-lexical form))))))
-(defun comp-emit-lambda-for-top-level (func)
+(defun comp--emit-lambda-for-top-level (func)
"Emit the creation of subrs for lambda FUNC.
These are stored in the reloc data array."
- (let ((args (comp-prepare-args-for-top-level func)))
+ (let ((args (comp--prepare-args-for-top-level func)))
(let ((comp-curr-allocation-class 'd-impure))
(comp--add-const-to-relocs (comp-func-byte-func func)))
- (comp-emit
- (comp-call 'comp--register-lambda
+ (comp--emit
+ (comp--call 'comp--register-lambda
;; mvar to be fixed-up when containers are
;; finalized.
(or (gethash (comp-func-byte-func func)
(comp-ctxt-lambda-fixups-h comp-ctxt))
(puthash (comp-func-byte-func func)
- (make-comp-mvar :constant nil)
+ (make--comp-mvar :constant nil)
(comp-ctxt-lambda-fixups-h comp-ctxt)))
- (make-comp-mvar :constant (comp-func-c-name func))
+ (make--comp-mvar :constant (comp-func-c-name func))
(car args)
(cdr args)
(setf (comp-func-type func)
- (make-comp-mvar :constant nil))
- (make-comp-mvar
+ (make--comp-mvar :constant nil))
+ (make--comp-mvar
:constant
(list
(let* ((h (comp-ctxt-function-docs comp-ctxt))
@@ -1596,9 +1617,9 @@ These are stored in the reloc data array."
(comp-func-command-modes func)))
;; This is the compilation unit it-self passed as
;; parameter.
- (make-comp-mvar :slot 0)))))
+ (make--comp-mvar :slot 0)))))
-(defun comp-limplify-top-level (for-late-load)
+(defun comp--limplify-top-level (for-late-load)
"Create a Limple function to modify the global environment at load.
When FOR-LATE-LOAD is non-nil, the emitted function modifies only
function definition.
@@ -1628,22 +1649,22 @@ into the C code forwarding the compilation unit."
(comp-func func)
(comp-pass (make-comp-limplify
:curr-block (make--comp-block-lap -1 0 'top-level)
- :frame (comp-new-frame 1 0))))
- (comp-make-curr-block 'entry (comp-sp))
- (comp-emit-annotation (if for-late-load
+ :frame (comp--new-frame 1 0))))
+ (comp--make-curr-block 'entry (comp--sp))
+ (comp--emit-annotation (if for-late-load
"Late top level"
"Top level"))
;; Assign the compilation unit incoming as parameter to the slot frame 0.
- (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0))
+ (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0))
(maphash (lambda (_ func)
- (comp-emit-lambda-for-top-level func))
+ (comp--emit-lambda-for-top-level func))
(comp-ctxt-byte-func-to-func-h comp-ctxt))
- (mapc (lambda (x) (comp-emit-for-top-level x for-late-load))
+ (mapc (lambda (x) (comp--emit-for-top-level x for-late-load))
(comp-ctxt-top-level-forms comp-ctxt))
- (comp-emit `(return ,(make-comp-mvar :slot 1)))
- (comp-limplify-finalize-function func)))
+ (comp--emit `(return ,(make--comp-mvar :slot 1)))
+ (comp--limplify-finalize-function func)))
-(defun comp-addr-to-bb-name (addr)
+(defun comp--addr-to-bb-name (addr)
"Search for a block starting at ADDR into pending or limplified blocks."
;; FIXME Actually we could have another hash for this.
(cl-flet ((pred (bb)
@@ -1655,7 +1676,7 @@ into the C code forwarding the compilation unit."
when (pred bb)
return (comp-block-name bb)))))
-(defun comp-limplify-block (bb)
+(defun comp--limplify-block (bb)
"Limplify basic-block BB and add it to the current function."
(setf (comp-limplify-curr-block comp-pass) bb
(comp-limplify-sp comp-pass) (comp-block-lap-sp bb)
@@ -1666,51 +1687,51 @@ into the C code forwarding the compilation unit."
(comp-func-lap comp-func))
for inst = (car inst-cell)
for next-inst = (car-safe (cdr inst-cell))
- do (comp-limplify-lap-inst inst)
+ do (comp--limplify-lap-inst inst)
(cl-incf (comp-limplify-pc comp-pass))
- when (comp-lap-fall-through-p inst)
+ when (comp--lap-fall-through-p inst)
do (pcase next-inst
(`(TAG ,_label . ,label-sp)
(when label-sp
- (cl-assert (= (1- label-sp) (comp-sp))))
+ (cl-assert (= (1- label-sp) (comp--sp))))
(let* ((stack-depth (if label-sp
(1- label-sp)
- (comp-sp)))
- (next-bb (comp-block-name (comp-bb-maybe-add
+ (comp--sp)))
+ (next-bb (comp-block-name (comp--bb-maybe-add
(comp-limplify-pc comp-pass)
stack-depth))))
(unless (comp-block-closed bb)
- (comp-emit `(jump ,next-bb))))
+ (comp--emit `(jump ,next-bb))))
(cl-return)))
- until (comp-lap-eob-p inst)))
+ until (comp--lap-eob-p inst)))
-(defun comp-limplify-function (func)
+(defun comp--limplify-function (func)
"Limplify a single function FUNC."
(let* ((frame-size (comp-func-frame-size func))
(comp-func func)
(comp-pass (make-comp-limplify
- :frame (comp-new-frame frame-size 0))))
- (comp-fill-label-h)
+ :frame (comp--new-frame frame-size 0))))
+ (comp--fill-label-h)
;; Prologue
- (comp-make-curr-block 'entry (comp-sp))
- (comp-emit-annotation (concat "Lisp function: "
+ (comp--make-curr-block 'entry (comp--sp))
+ (comp--emit-annotation (concat "Lisp function: "
(symbol-name (comp-func-name func))))
;; Dynamic functions have parameters bound by the trampoline.
(when (comp-func-l-p func)
(let ((args (comp-func-l-args func)))
(if (comp-args-p args)
(cl-loop for i below (comp-args-max args)
- do (cl-incf (comp-sp))
- (comp-emit `(set-par-to-local ,(comp-slot) ,i)))
- (comp-emit-narg-prologue (comp-args-base-min args)
+ do (cl-incf (comp--sp))
+ (comp--emit `(set-par-to-local ,(comp--slot) ,i)))
+ (comp--emit-narg-prologue (comp-args-base-min args)
(comp-nargs-nonrest args)
(comp-nargs-rest args)))))
- (comp-emit '(jump bb_0))
+ (comp--emit '(jump bb_0))
;; Body
- (comp-bb-maybe-add 0 (comp-sp))
+ (comp--bb-maybe-add 0 (comp--sp))
(cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass))
while next-bb
- do (comp-limplify-block next-bb))
+ do (comp--limplify-block next-bb))
;; Sanity check against block duplication.
(cl-loop with addr-h = (make-hash-table)
for bb being the hash-value in (comp-func-blocks func)
@@ -1719,15 +1740,15 @@ into the C code forwarding the compilation unit."
when addr
do (cl-assert (null (gethash addr addr-h)))
(puthash addr t addr-h))
- (comp-limplify-finalize-function func)))
+ (comp--limplify-finalize-function func)))
-(defun comp-limplify (_)
+(defun comp--limplify (_)
"Compute LIMPLE IR for forms in `comp-ctxt'."
- (maphash (lambda (_ f) (comp-limplify-function f))
+ (maphash (lambda (_ f) (comp--limplify-function f))
(comp-ctxt-funcs-h comp-ctxt))
- (comp-add-func-to-ctxt (comp-limplify-top-level nil))
+ (comp--add-func-to-ctxt (comp--limplify-top-level nil))
(when (comp-ctxt-with-late-load comp-ctxt)
- (comp-add-func-to-ctxt (comp-limplify-top-level t))))
+ (comp--add-func-to-ctxt (comp--limplify-top-level t))))
;;; add-cstrs pass specific code.
@@ -1751,22 +1772,22 @@ into the C code forwarding the compilation unit."
;; type specifier.
-(defsubst comp-mvar-used-p (mvar)
+(defsubst comp--mvar-used-p (mvar)
"Non-nil when MVAR is used as lhs in the current function."
(declare (gv-setter (lambda (val)
`(puthash ,mvar ,val comp-pass))))
(gethash mvar comp-pass))
-(defun comp-collect-mvars (form)
+(defun comp--collect-mvars (form)
"Add rhs m-var present in FORM into `comp-pass'."
(cl-loop for x in form
if (consp x)
- do (comp-collect-mvars x)
+ do (comp--collect-mvars x)
else
when (comp-mvar-p x)
- do (setf (comp-mvar-used-p x) t)))
+ do (setf (comp--mvar-used-p x) t)))
-(defun comp-collect-rhs ()
+(defun comp--collect-rhs ()
"Collect all lhs mvars into `comp-pass'."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
@@ -1774,11 +1795,13 @@ into the C code forwarding the compilation unit."
for insn in (comp-block-insns b)
for (op . args) = insn
if (comp--assign-op-p op)
- do (comp-collect-mvars (cdr args))
+ do (comp--collect-mvars (if (eq op 'setimm)
+ (cl-first args)
+ (cdr args)))
else
- do (comp-collect-mvars args))))
+ do (comp--collect-mvars args))))
-(defun comp-negate-arithm-cmp-fun (function)
+(defun comp--negate-arithm-cmp-fun (function)
"Negate FUNCTION.
Return nil if we don't want to emit constraints for its negation."
(cl-ecase function
@@ -1788,7 +1811,7 @@ Return nil if we don't want to emit constraints for its negation."
(>= '<)
(<= '>)))
-(defun comp-reverse-arithm-fun (function)
+(defun comp--reverse-arithm-fun (function)
"Reverse FUNCTION."
(cl-case function
(= '=)
@@ -1798,7 +1821,7 @@ Return nil if we don't want to emit constraints for its negation."
(<= '>=)
(t function)))
-(defun comp-emit-assume (kind lhs rhs bb negated)
+(defun comp--emit-assume (kind lhs rhs bb negated)
"Emit an assume of kind KIND for mvar LHS being RHS.
When NEGATED is non-nil, the assumption is negated.
The assume is emitted at the beginning of the block BB."
@@ -1808,41 +1831,41 @@ The assume is emitted at the beginning of the block BB."
((or 'and 'and-nhc)
(if (comp-mvar-p rhs)
(let ((tmp-mvar (if negated
- (make-comp-mvar :slot (comp-mvar-slot rhs))
+ (make--comp-mvar :slot (comp-mvar-slot rhs))
rhs)))
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs ,tmp-mvar))
(comp-block-insns bb))
(if negated
(push `(assume ,tmp-mvar (not ,rhs))
(comp-block-insns bb))))
;; If is only a constraint we can negate it directly.
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs ,(if negated
(comp-cstr-negation-make rhs)
rhs)))
(comp-block-insns bb))))
((pred comp--arithm-cmp-fun-p)
(when-let ((kind (if negated
- (comp-negate-arithm-cmp-fun kind)
+ (comp--negate-arithm-cmp-fun kind)
kind)))
- (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (push `(assume ,(make--comp-mvar :slot lhs-slot)
(,kind ,lhs
,(if-let* ((vld (comp-cstr-imm-vld-p rhs))
(val (comp-cstr-imm rhs))
(ok (and (integerp val)
(not (memq kind '(= !=))))))
val
- (make-comp-mvar :slot (comp-mvar-slot rhs)))))
+ (make--comp-mvar :slot (comp-mvar-slot rhs)))))
(comp-block-insns bb))))
(_ (cl-assert nil)))
(setf (comp-func-ssa-status comp-func) 'dirty)))
-(defun comp-maybe-add-vmvar (op cmp-res insns-seq)
+(defun comp--maybe-add-vmvar (op cmp-res insns-seq)
"If CMP-RES is clobbering OP emit a new constrained mvar and return it.
Return OP otherwise."
(if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res)))
- (new-mvar (make-comp-mvar
+ (new-mvar (make--comp-mvar
:slot
(- (cl-incf (comp-func-vframe-size comp-func))))))
(progn
@@ -1850,7 +1873,7 @@ Return OP otherwise."
new-mvar)
op))
-(defun comp-add-new-block-between (bb-symbol bb-a bb-b)
+(defun comp--add-new-block-between (bb-symbol bb-a bb-b)
"Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B."
(cl-loop
with new-bb = (make-comp-block-cstr :name bb-symbol
@@ -1873,7 +1896,7 @@ Return OP otherwise."
finally (cl-assert nil)))
;; Cheap substitute to a copy propagation pass...
-(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb)
+(defun comp--cond-cstrs-target-mvar (mvar exit-insn bb)
"Given MVAR, search in BB the original mvar MVAR got assigned from.
Keep on searching till EXIT-INSN is encountered."
(cl-flet ((targetp (x)
@@ -1890,7 +1913,7 @@ Keep on searching till EXIT-INSN is encountered."
(setf res rhs)))
finally (cl-assert nil))))
-(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym)
+(defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym)
"Return the appropriate basic block to add constraint assumptions into.
CURR-BB is the current basic block.
TARGET-BB-SYM is the symbol name of the target block."
@@ -1910,10 +1933,10 @@ TARGET-BB-SYM is the symbol name of the target block."
until (null (gethash new-name (comp-func-blocks comp-func)))
finally
;; Add it.
- (cl-return (comp-add-new-block-between new-name curr-bb target-bb))))))
+ (cl-return (comp--add-new-block-between new-name curr-bb target-bb))))))
-(defun comp-add-cond-cstrs-simple ()
- "`comp-add-cstrs' worker function for each selected function."
+(defun comp--add-cond-cstrs-simple ()
+ "`comp--add-cstrs' worker function for each selected function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
do
@@ -1929,26 +1952,26 @@ TARGET-BB-SYM is the symbol name of the target block."
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(nil t)
- when (comp-mvar-used-p tmp-mvar)
+ when (comp--mvar-used-p tmp-mvar)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and tmp-mvar obj2 block-target negated))
+ (comp--emit-assume 'and tmp-mvar obj2 block-target negated))
finally (cl-return-from in-the-basic-block)))
(`((cond-jump ,obj1 ,obj2 . ,blocks))
(cl-loop
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(nil t)
- when (comp-mvar-used-p obj1)
+ when (comp--mvar-used-p obj1)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and obj1 obj2 block-target negated))
+ (comp--emit-assume 'and obj1 obj2 block-target negated))
finally (cl-return-from in-the-basic-block)))))))
-(defun comp-add-cond-cstrs ()
- "`comp-add-cstrs' worker function for each selected function."
+(defun comp--add-cond-cstrs ()
+ "`comp--add-cstrs' worker function for each selected function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
do
@@ -1967,13 +1990,13 @@ TARGET-BB-SYM is the symbol name of the target block."
(set ,(and (pred comp-mvar-p) mvar-3)
(call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2)))
(cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2))
- (comp-emit-assume 'and mvar-tested
- (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))
- (comp-add-cond-cstrs-target-block b bb2)
+ (comp--emit-assume 'and mvar-tested
+ (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+ (comp--add-cond-cstrs-target-block b bb2)
nil)
- (comp-emit-assume 'and mvar-tested
- (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))
- (comp-add-cond-cstrs-target-block b bb1)
+ (comp--emit-assume 'and mvar-tested
+ (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+ (comp--add-cond-cstrs-target-block b bb1)
t))
(`((set ,(and (pred comp-mvar-p) cmp-res)
(,(pred comp--call-op-p)
@@ -1984,8 +2007,8 @@ TARGET-BB-SYM is the symbol name of the target block."
;; (comment ,_comment-str)
(cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
(cl-loop
- with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b)
- with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b)
+ with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq) b)
+ with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq) b)
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
for negated in '(t nil)
@@ -1994,61 +2017,51 @@ TARGET-BB-SYM is the symbol name of the target block."
(eql 'and-nhc)
(eq 'and)
(t fun))
- when (or (comp-mvar-used-p target-mvar1)
- (comp-mvar-used-p target-mvar2))
+ when (or (comp--mvar-used-p target-mvar1)
+ (comp--mvar-used-p target-mvar2))
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (when (comp-mvar-used-p target-mvar1)
- (comp-emit-assume kind target-mvar1
- (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq)
+ (when (comp--mvar-used-p target-mvar1)
+ (comp--emit-assume kind target-mvar1
+ (comp--maybe-add-vmvar op2 cmp-res prev-insns-seq)
block-target negated))
- (when (comp-mvar-used-p target-mvar2)
- (comp-emit-assume (comp-reverse-arithm-fun kind)
+ (when (comp--mvar-used-p target-mvar2)
+ (comp--emit-assume (comp--reverse-arithm-fun kind)
target-mvar2
- (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq)
+ (comp--maybe-add-vmvar op1 cmp-res prev-insns-seq)
block-target negated)))
finally (cl-return-from in-the-basic-block)))
(`((set ,(and (pred comp-mvar-p) cmp-res)
(,(pred comp--call-op-p)
,(and (pred comp--known-predicate-p) fun)
,op))
- ;; (comment ,_comment-str)
- (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
- (cl-loop
- with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
- with cstr = (comp--pred-to-cstr fun)
- for branch-target-cell on blocks
- for branch-target = (car branch-target-cell)
- for negated in '(t nil)
- when (comp-mvar-used-p target-mvar)
- do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
- (setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and target-mvar cstr block-target negated))
- finally (cl-return-from in-the-basic-block)))
- ;; Match predicate on the negated branch (unless).
- (`((set ,(and (pred comp-mvar-p) cmp-res)
- (,(pred comp--call-op-p)
- ,(and (pred comp--known-predicate-p) fun)
- ,op))
- (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p)))
- (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
+ . ,(or
+ ;; (comment ,_comment-str)
+ (and `((cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
+ (let negated-branch nil))
+ (and `((set ,neg-cmp-res
+ (call eq ,cmp-res ,(pred comp-cstr-null-p)))
+ (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
+ (let negated-branch t))))
(cl-loop
- with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
- with cstr = (comp--pred-to-cstr fun)
+ with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b)
for branch-target-cell on blocks
for branch-target = (car branch-target-cell)
- for negated in '(nil t)
- when (comp-mvar-used-p target-mvar)
+ for negated in (if negated-branch '(nil t) '(t nil))
+ when (comp--mvar-used-p target-mvar)
do
- (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (let ((block-target (comp--add-cond-cstrs-target-block
+ b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
- (comp-emit-assume 'and target-mvar cstr block-target negated))
+ (comp--emit-assume 'and target-mvar (if negated
+ (comp--pred-to-neg-cstr fun)
+ (comp--pred-to-pos-cstr fun))
+ block-target nil))
finally (cl-return-from in-the-basic-block))))
(setf prev-insns-seq insns-seq))))
-(defsubst comp-insert-insn (insn insn-cell)
+(defsubst comp--insert-insn (insn insn-cell)
"Insert INSN as second insn of INSN-CELL."
(let ((next-cell (cdr insn-cell))
(new-cell `(,insn)))
@@ -2056,15 +2069,15 @@ TARGET-BB-SYM is the symbol name of the target block."
(cdr new-cell) next-cell
(comp-func-ssa-status comp-func) 'dirty)))
-(defun comp-emit-call-cstr (mvar call-cell cstr)
+(defun comp--emit-call-cstr (mvar call-cell cstr)
"Emit a constraint CSTR for MVAR after CALL-CELL."
- (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar)))
+ (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar)))
;; Have new-mvar as LHS *and* RHS to ensure monotonicity and
;; fwprop convergence!!
(insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr))))
- (comp-insert-insn insn call-cell)))
+ (comp--insert-insn insn call-cell)))
-(defun comp-lambda-list-gen (lambda-list)
+(defun comp--lambda-list-gen (lambda-list)
"Return a generator to iterate over LAMBDA-LIST."
(lambda ()
(cl-case (car lambda-list)
@@ -2080,12 +2093,12 @@ TARGET-BB-SYM is the symbol name of the target block."
(car lambda-list)
(setf lambda-list (cdr lambda-list)))))))
-(defun comp-add-call-cstr ()
+(defun comp--add-call-cstr ()
"Add args assumptions for each function of which the type specifier is known."
(cl-loop
for bb being each hash-value of (comp-func-blocks comp-func)
do
- (comp-loop-insn-in-block bb
+ (comp--loop-insn-in-block bb
(when-let ((match
(pcase insn
(`(set ,lhs (,(pred comp--call-op-p) ,f . ,args))
@@ -2096,10 +2109,10 @@ TARGET-BB-SYM is the symbol name of the target block."
(cl-values f cstr-f nil args))))))
(cl-multiple-value-bind (f cstr-f lhs args) match
(cl-loop
- with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f))
+ with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f))
for arg in args
for cstr = (funcall gen)
- for target = (comp-cond-cstrs-target-mvar arg insn bb)
+ for target = (comp--cond-cstrs-target-mvar arg insn bb)
unless (comp-cstr-p cstr)
do (signal 'native-ice
(list "Incoherent type specifier for function" f))
@@ -2110,9 +2123,9 @@ TARGET-BB-SYM is the symbol name of the target block."
(or (null lhs)
(not (eql (comp-mvar-slot lhs)
(comp-mvar-slot target)))))
- do (comp-emit-call-cstr target insn-cell cstr)))))))
+ do (comp--emit-call-cstr target insn-cell cstr)))))))
-(defun comp-add-cstrs (_)
+(defun comp--add-cstrs (_)
"Rewrite conditional branches adding appropriate `assume' insns.
This is introducing and placing `assume' insns in use by fwprop
to propagate conditional branch test information on target basic
@@ -2126,10 +2139,10 @@ blocks."
(not (comp-func-has-non-local f)))
(let ((comp-func f)
(comp-pass (make-hash-table :test #'eq)))
- (comp-collect-rhs)
- (comp-add-cond-cstrs-simple)
- (comp-add-cond-cstrs)
- (comp-add-call-cstr)
+ (comp--collect-rhs)
+ (comp--add-cond-cstrs-simple)
+ (comp--add-cond-cstrs)
+ (comp--add-call-cstr)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2141,7 +2154,7 @@ blocks."
;; avoid optimizing-out functions and preventing their redefinition
;; being effective.
-(defun comp-collect-calls (f)
+(defun comp--collect-calls (f)
"Return a list with all the functions called by F."
(cl-loop
with h = (make-hash-table :test #'eq)
@@ -2161,17 +2174,17 @@ blocks."
(comp-ctxt-funcs-h comp-ctxt)))
f))))
-(defun comp-pure-infer-func (f)
+(defun comp--pure-infer-func (f)
"If all functions called by F are pure then F is pure too."
(when (and (cl-every (lambda (x)
(or (comp--function-pure-p x)
(eq x (comp-func-name f))))
- (comp-collect-calls f))
+ (comp--collect-calls f))
(not (eq (comp-func-pure f) t)))
(comp-log (format "%s inferred to be pure" (comp-func-name f)))
(setf (comp-func-pure f) t)))
-(defun comp-ipa-pure (_)
+(defun comp--ipa-pure (_)
"Infer function purity."
(cl-loop
with pure-n = 0
@@ -2184,7 +2197,7 @@ blocks."
when (and (>= (comp-func-speed f) 3)
(comp-func-l-p f)
(not (comp-func-pure f)))
- do (comp-pure-infer-func f)
+ do (comp--pure-infer-func f)
count (comp-func-pure f))))
finally (comp-log (format "ipa-pure iterated %d times" n))))
@@ -2198,13 +2211,13 @@ blocks."
;; this form is called 'minimal SSA form'.
;; This pass should be run every time basic blocks or m-var are shuffled.
-(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type)
- "Same as `make-comp-mvar' but set the `id' slot."
- (let ((mvar (apply #'make-comp-mvar rest)))
+(cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type)
+ "Same as `make--comp-mvar' but set the `id' slot."
+ (let ((mvar (apply #'make--comp-mvar rest)))
(setf (comp-mvar-id mvar) (sxhash-eq mvar))
mvar))
-(defun comp-clean-ssa (f)
+(defun comp--clean-ssa (f)
"Clean-up SSA for function F."
(setf (comp-func-edges-h f) (make-hash-table))
(cl-loop
@@ -2220,7 +2233,7 @@ blocks."
unless (eq 'phi (car insn))
collect insn))))
-(defun comp-compute-edges ()
+(defun comp--compute-edges ()
"Compute the basic block edges for the current function."
(cl-loop with blocks = (comp-func-blocks comp-func)
for bb being each hash-value of blocks
@@ -2256,7 +2269,7 @@ blocks."
(comp-block-in-edges (comp-edge-dst edge))))
(comp--log-edges comp-func)))
-(defun comp-collect-rev-post-order (basic-block)
+(defun comp--collect-rev-post-order (basic-block)
"Walk BASIC-BLOCK children and return their name in reversed post-order."
(let ((visited (make-hash-table))
(acc ()))
@@ -2271,7 +2284,7 @@ blocks."
(collect-rec basic-block)
acc)))
-(defun comp-compute-dominator-tree ()
+(defun comp--compute-dominator-tree ()
"Compute immediate dominators for each basic block in current function."
;; Originally based on: "A Simple, Fast Dominance Algorithm"
;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
@@ -2296,7 +2309,7 @@ blocks."
;; No point to go on if the only bb is 'entry'.
(bb0 (gethash 'bb_0 blocks)))
(cl-loop
- with rev-bb-list = (comp-collect-rev-post-order entry)
+ with rev-bb-list = (comp--collect-rev-post-order entry)
with changed = t
while changed
initially (progn
@@ -2323,7 +2336,7 @@ blocks."
new-idom)
changed t))))))
-(defun comp-compute-dominator-frontiers ()
+(defun comp--compute-dominator-frontiers ()
"Compute the dominator frontier for each basic block in `comp-func'."
;; Originally based on: "A Simple, Fast Dominance Algorithm"
;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
@@ -2338,7 +2351,7 @@ blocks."
(puthash b-name b (comp-block-df runner))
(setf runner (comp-block-idom runner))))))
-(defun comp-log-block-info ()
+(defun comp--log-block-info ()
"Log basic blocks info for the current function."
(maphash (lambda (name bb)
(let ((dom (comp-block-idom bb))
@@ -2351,7 +2364,7 @@ blocks."
3)))
(comp-func-blocks comp-func)))
-(defun comp-place-phis ()
+(defun comp--place-phis ()
"Place phi insns into the current function."
;; Originally based on: Static Single Assignment Book
;; Algorithm 3.1: Standard algorithm for inserting phi-functions
@@ -2392,7 +2405,7 @@ blocks."
(unless (cl-find y defs-v)
(push y w))))))))
-(defun comp-dom-tree-walker (bb pre-lambda post-lambda)
+(defun comp--dom-tree-walker (bb pre-lambda post-lambda)
"Dominator tree walker function starting from basic block BB.
PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(when pre-lambda
@@ -2402,18 +2415,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
for child = (comp-edge-dst ed)
when (eq bb (comp-block-idom child))
;; Current block is the immediate dominator then recur.
- do (comp-dom-tree-walker child pre-lambda post-lambda)))
+ do (comp--dom-tree-walker child pre-lambda post-lambda)))
(when post-lambda
(funcall post-lambda bb)))
-(cl-defstruct (comp-ssa (:copier nil))
+(cl-defstruct (comp--ssa (:copier nil))
"Support structure used while SSA renaming."
- (frame (comp-new-frame (comp-func-frame-size comp-func)
+ (frame (comp--new-frame (comp-func-frame-size comp-func)
(comp-func-vframe-size comp-func) t)
:type comp-vec
:documentation "`comp-vec' of m-vars."))
-(defun comp-ssa-rename-insn (insn frame)
+(defun comp--ssa-rename-insn (insn frame)
(cl-loop
for slot-n from (- (comp-func-vframe-size comp-func))
below (comp-func-frame-size comp-func)
@@ -2424,17 +2437,19 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(eql slot-n (comp-mvar-slot x))))
(new-lvalue ()
;; If is an assignment make a new mvar and put it as l-value.
- (let ((mvar (make-comp-ssa-mvar :slot slot-n)))
+ (let ((mvar (make--comp--ssa-mvar :slot slot-n)))
(setf (comp-vec-aref frame slot-n) mvar
(cadr insn) mvar))))
(pcase insn
+ (`(setimm ,(pred targetp) ,_imm)
+ (new-lvalue))
(`(,(pred comp--assign-op-p) ,(pred targetp) . ,_)
(let ((mvar (comp-vec-aref frame slot-n)))
(setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
(new-lvalue))
(`(fetch-handler . ,_)
;; Clobber all no matter what!
- (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
+ (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot slot-n)))
(`(phi ,n)
(when (equal n slot-n)
(new-lvalue)))
@@ -2442,7 +2457,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(let ((mvar (comp-vec-aref frame slot-n)))
(setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn)))))))))
-(defun comp-ssa-rename ()
+(defun comp--ssa-rename ()
"Entry point to rename into SSA within the current function."
(comp-log "Renaming\n" 2)
(let ((visited (make-hash-table)))
@@ -2450,7 +2465,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
(unless (gethash bb visited)
(puthash bb t visited)
(cl-loop for insn in (comp-block-insns bb)
- do (comp-ssa-rename-insn insn in-frame))
+ do (comp--ssa-rename-insn insn in-frame))
(setf (comp-block-final-frame bb)
(copy-sequence in-frame))
(when-let ((out-edges (comp-block-out-edges bb)))
@@ -2461,11 +2476,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
do (ssa-rename-rec child (comp-vec-copy in-frame)))))))
(ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
- (comp-new-frame (comp-func-frame-size comp-func)
+ (comp--new-frame (comp-func-frame-size comp-func)
(comp-func-vframe-size comp-func)
t)))))
-(defun comp-finalize-phis ()
+(defun comp--finalize-phis ()
"Fixup r-values into phis in all basic blocks."
(cl-flet ((finalize-phi (args b)
;; Concatenate into args all incoming m-vars for this phi.
@@ -2482,7 +2497,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
when (eq op 'phi)
do (finalize-phi args b)))))
-(defun comp-remove-unreachable-blocks ()
+(defun comp--remove-unreachable-blocks ()
"Remove unreachable basic blocks.
Return t when one or more block was removed, nil otherwise."
(cl-loop
@@ -2498,7 +2513,7 @@ Return t when one or more block was removed, nil otherwise."
ret t)
finally return ret))
-(defun comp-ssa ()
+(defun comp--ssa ()
"Port all functions into minimal SSA form."
(maphash (lambda (_ f)
(let* ((comp-func f)
@@ -2506,15 +2521,15 @@ Return t when one or more block was removed, nil otherwise."
(unless (eq ssa-status t)
(cl-loop
when (eq ssa-status 'dirty)
- do (comp-clean-ssa f)
- do (comp-compute-edges)
- (comp-compute-dominator-tree)
- until (null (comp-remove-unreachable-blocks)))
- (comp-compute-dominator-frontiers)
- (comp-log-block-info)
- (comp-place-phis)
- (comp-ssa-rename)
- (comp-finalize-phis)
+ do (comp--clean-ssa f)
+ do (comp--compute-edges)
+ (comp--compute-dominator-tree)
+ until (null (comp--remove-unreachable-blocks)))
+ (comp--compute-dominator-frontiers)
+ (comp--log-block-info)
+ (comp--place-phis)
+ (comp--ssa-rename)
+ (comp--finalize-phis)
(comp--log-func comp-func 3)
(setf (comp-func-ssa-status f) t))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2526,12 +2541,12 @@ Return t when one or more block was removed, nil otherwise."
;; This is also responsible for removing function calls to pure functions if
;; possible.
-(defconst comp-fwprop-max-insns-scan 4500
+(defconst comp--fwprop-max-insns-scan 4500
;; Chosen as ~ the greatest required value for full convergence
;; native compiling all Emacs code-base.
"Max number of scanned insn before giving-up.")
-(defun comp-copy-insn (insn)
+(defun comp--copy-insn-rec (insn)
"Deep copy INSN."
;; Adapted from `copy-tree'.
(if (consp insn)
@@ -2539,16 +2554,23 @@ Return t when one or more block was removed, nil otherwise."
(while (consp insn)
(let ((newcar (car insn)))
(if (or (consp (car insn)) (comp-mvar-p (car insn)))
- (setf newcar (comp-copy-insn (car insn))))
+ (setf newcar (comp--copy-insn (car insn))))
(push newcar result))
(setf insn (cdr insn)))
(nconc (nreverse result)
- (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn) (comp--copy-insn insn) insn)))
(if (comp-mvar-p insn)
(copy-comp-mvar insn)
insn)))
-(defmacro comp-apply-in-env (func &rest args)
+(defun comp--copy-insn (insn)
+ "Deep copy INSN."
+ (pcase insn
+ (`(setimm ,mvar ,imm)
+ `(setimm ,(copy-comp-mvar mvar) ,imm))
+ (_ (comp--copy-insn-rec insn))))
+
+(defmacro comp--apply-in-env (func &rest args)
"Apply FUNC to ARGS in the current compilation environment."
`(let ((env (cl-loop
for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt)
@@ -2564,7 +2586,7 @@ Return t when one or more block was removed, nil otherwise."
for (func-name . def) in env
do (setf (symbol-function func-name) def)))))
-(defun comp-fwprop-prologue ()
+(defun comp--fwprop-prologue ()
"Prologue for the propagate pass.
Here goes everything that can be done not iteratively (read once).
Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked?
@@ -2576,16 +2598,16 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or
(`(setimm ,lval ,v)
(setf (comp-cstr-imm lval) v))))))
-(defun comp-function-foldable-p (f args)
+(defun comp--function-foldable-p (f args)
"Given function F called with ARGS, return non-nil when optimizable."
(and (comp--function-pure-p f)
(cl-every #'comp-cstr-imm-vld-p args)))
-(defun comp-function-call-maybe-fold (insn f args)
+(defun comp--function-call-maybe-fold (insn f args)
"Given INSN, when F is pure if all ARGS are known, remove the function call.
Return non-nil if the function is folded successfully."
(cl-flet ((rewrite-insn-as-setimm (insn value)
- ;; See `comp-emit-setimm'.
+ ;; See `comp--emit-setimm'.
(comp--add-const-to-relocs value)
(setf (car insn) 'setimm
(cddr insn) `(,value))))
@@ -2597,7 +2619,7 @@ Return non-nil if the function is folded successfully."
comp-symbol-values-optimizable)))
(rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm
(car args))))))
- ((comp-function-foldable-p f args)
+ ((comp--function-foldable-p f args)
(ignore-errors
;; No point to complain here in case of error because we
;; should do basic block pruning in order to be sure that this
@@ -2608,14 +2630,14 @@ Return non-nil if the function is folded successfully."
;; and know to be pure.
(comp-func-byte-func f-in-ctxt)
f))
- (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args))))
+ (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args))))
(rewrite-insn-as-setimm insn value)))))))
-(defun comp-fwprop-call (insn lval f args)
+(defun comp--fwprop-call (insn lval f args)
"Propagate on a call INSN into LVAL.
F is the function being called with arguments ARGS.
Fold the call in case."
- (unless (comp-function-call-maybe-fold insn f args)
+ (unless (comp--function-call-maybe-fold insn f args)
(when (and (eq 'funcall f)
(comp-cstr-imm-vld-p (car args)))
(setf f (comp-cstr-imm (car args))
@@ -2636,16 +2658,16 @@ Fold the call in case."
(comp-type-spec-to-cstr
(comp-cstr-imm (car args)))))))))
-(defun comp-fwprop-insn (insn)
+(defun comp--fwprop-insn (insn)
"Propagate within INSN."
(pcase insn
(`(set ,lval ,rval)
(pcase rval
(`(,(or 'call 'callref) ,f . ,args)
- (comp-fwprop-call insn lval f args))
+ (comp--fwprop-call insn lval f args))
(`(,(or 'direct-call 'direct-callref) ,f . ,args)
(let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
- (comp-fwprop-call insn lval f args)))
+ (comp--fwprop-call insn lval f args)))
(_
(comp-cstr-shallow-copy lval rval))))
(`(assume ,lval ,(and (pred comp-mvar-p) rval))
@@ -2690,7 +2712,7 @@ Fold the call in case."
(rvals (mapcar #'car rest)))
(apply prop-fn lval rvals)))))
-(defun comp-fwprop* ()
+(defun comp--fwprop* ()
"Propagate for set* and phi operands.
Return t if something was changed."
(cl-loop named outer
@@ -2702,17 +2724,17 @@ Return t if something was changed."
for insn in (comp-block-insns b)
for orig-insn = (unless modified
;; Save consing after 1st change.
- (comp-copy-insn insn))
+ (comp--copy-insn insn))
do
- (comp-fwprop-insn insn)
+ (comp--fwprop-insn insn)
(cl-incf i)
when (and (null modified) (not (equal insn orig-insn)))
do (setf modified t))
- when (> i comp-fwprop-max-insns-scan)
+ when (> i comp--fwprop-max-insns-scan)
do (cl-return-from outer nil)
finally return modified))
-(defun comp-rewrite-non-locals ()
+(defun comp--rewrite-non-locals ()
"Make explicit in LIMPLE non-local exits if identified."
(cl-loop
for bb being each hash-value of (comp-func-blocks comp-func)
@@ -2729,26 +2751,26 @@ Return t if something was changed."
(cdr insn-seq) '((unreachable))
(comp-func-ssa-status comp-func) 'dirty))))
-(defun comp-fwprop (_)
+(defun comp--fwprop (_)
"Forward propagate types and consts within the lattice."
- (comp-ssa)
- (comp-dead-code)
+ (comp--ssa)
+ (comp--dead-code)
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
;; FIXME remove the following condition when tested.
(not (comp-func-has-non-local f)))
(let ((comp-func f))
- (comp-fwprop-prologue)
+ (comp--fwprop-prologue)
(cl-loop
for i from 1 to 100
- while (comp-fwprop*)
+ while (comp--fwprop*)
finally
(when (= i 100)
(display-warning
'comp
(format "fwprop pass jammed into %s?" (comp-func-name f))))
(comp-log (format "Propagation run %d times\n" i) 2))
- (comp-rewrite-non-locals)
+ (comp--rewrite-non-locals)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2768,7 +2790,7 @@ Return t if something was changed."
;; the full compilation unit.
;; For this reason this is triggered only at native-comp-speed == 3.
-(defun comp-func-in-unit (func)
+(defun comp--func-in-unit (func)
"Given FUNC return the `comp-fun' definition in the current context.
FUNCTION can be a function-name or byte compiled function."
(if (symbolp func)
@@ -2776,11 +2798,11 @@ FUNCTION can be a function-name or byte compiled function."
(cl-assert (byte-code-function-p func))
(gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt))))
-(defun comp-call-optim-form-call (callee args)
+(defun comp--call-optim-form-call (callee args)
(cl-flet ((fill-args (args total)
;; Fill missing args to reach TOTAL
(append args (cl-loop repeat (- total (length args))
- collect (make-comp-mvar :constant nil)))))
+ collect (make--comp-mvar :constant nil)))))
(when (and callee
(or (symbolp callee)
(gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt)))
@@ -2798,7 +2820,7 @@ FUNCTION can be a function-name or byte compiled function."
;; actually cheaper since it avoids the call to the
;; intermediate native trampoline (bug#67005).
(subrp (subrp f))
- (comp-func-callee (comp-func-in-unit callee)))
+ (comp-func-callee (comp--func-in-unit callee)))
(cond
((and subrp (not (subr-native-elisp-p f)))
;; Trampoline removal.
@@ -2833,30 +2855,30 @@ FUNCTION can be a function-name or byte compiled function."
((comp--type-hint-p callee)
`(call ,callee ,@args)))))))
-(defun comp-call-optim-func ()
+(defun comp--call-optim-func ()
"Perform the trampoline call optimization for the current function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(pcase insn
(`(set ,lval (callref funcall ,f . ,rest))
(when-let ((ok (comp-cstr-imm-vld-p f))
- (new-form (comp-call-optim-form-call
+ (new-form (comp--call-optim-form-call
(comp-cstr-imm f) rest)))
(setf insn `(set ,lval ,new-form))))
(`(callref funcall ,f . ,rest)
(when-let ((ok (comp-cstr-imm-vld-p f))
- (new-form (comp-call-optim-form-call
+ (new-form (comp--call-optim-form-call
(comp-cstr-imm f) rest)))
(setf insn new-form)))))))
-(defun comp-call-optim (_)
+(defun comp--call-optim (_)
"Try to optimize out funcall trampoline usage when possible."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
(comp-func-l-p f))
(let ((comp-func f))
- (comp-call-optim-func))))
+ (comp--call-optim-func))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2867,16 +2889,16 @@ FUNCTION can be a function-name or byte compiled function."
;;
;; This pass can be run as last optim.
-(defun comp-collect-mvar-ids (insn)
+(defun comp--collect-mvar-ids (insn)
"Collect the m-var unique identifiers into INSN."
(cl-loop for x in insn
if (consp x)
- append (comp-collect-mvar-ids x)
+ append (comp--collect-mvar-ids x)
else
when (comp-mvar-p x)
collect (comp-mvar-id x)))
-(defun comp-dead-assignments-func ()
+(defun comp--dead-assignments-func ()
"Clean-up dead assignments into current function.
Return the list of m-var ids nuked."
(let ((l-vals ())
@@ -2889,9 +2911,10 @@ Return the list of m-var ids nuked."
for (op arg0 . rest) = insn
if (comp--assign-op-p op)
do (push (comp-mvar-id arg0) l-vals)
- (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals))
+ (unless (eq op 'setimm)
+ (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)))
else
- do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals))))
+ do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals))))
;; Every l-value appearing that does not appear as r-value has no right to
;; exist and gets nuked.
(let ((nuke-list (cl-set-difference l-vals r-vals)))
@@ -2903,7 +2926,7 @@ Return the list of m-var ids nuked."
3)
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn
(when (and (comp--assign-op-p op)
(memq (comp-mvar-id arg0) nuke-list))
@@ -2914,7 +2937,7 @@ Return the list of m-var ids nuked."
insn))))))))
nuke-list)))
-(defun comp-dead-code ()
+(defun comp--dead-code ()
"Dead code elimination."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 2)
@@ -2923,7 +2946,7 @@ Return the list of m-var ids nuked."
(cl-loop
for comp-func = f
for i from 1
- while (comp-dead-assignments-func)
+ while (comp--dead-assignments-func)
finally (comp-log (format "dead code rm run %d times\n" i) 2)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2931,14 +2954,14 @@ Return the list of m-var ids nuked."
;;; Tail Call Optimization pass specific code.
-(defun comp-form-tco-call-seq (args)
+(defun comp--form-tco-call-seq (args)
"Generate a TCO sequence for ARGS."
`(,@(cl-loop for arg in args
for i from 0
- collect `(set ,(make-comp-mvar :slot i) ,arg))
+ collect `(set ,(make--comp-mvar :slot i) ,arg))
(jump bb_0)))
-(defun comp-tco-func ()
+(defun comp--tco-func ()
"Try to pattern match and perform TCO within the current function."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
@@ -2951,20 +2974,20 @@ Return the list of m-var ids nuked."
(return ,ret-val))
(when (and (string= func (comp-func-c-name comp-func))
(eq l-val ret-val))
- (let ((tco-seq (comp-form-tco-call-seq args)))
+ (let ((tco-seq (comp--form-tco-call-seq args)))
(setf (car insns-seq) (car tco-seq)
(cdr insns-seq) (cdr tco-seq)
(comp-func-ssa-status comp-func) 'dirty)
(cl-return-from in-the-basic-block))))))))
-(defun comp-tco (_)
+(defun comp--tco (_)
"Simple peephole pass performing self TCO."
(maphash (lambda (_ f)
(when (and (>= (comp-func-speed f) 3)
(comp-func-l-p f)
(not (comp-func-has-non-local f)))
(let ((comp-func f))
- (comp-tco-func)
+ (comp--tco-func)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
@@ -2974,54 +2997,88 @@ Return the list of m-var ids nuked."
;; This must run after all SSA prop not to have the type hint
;; information overwritten.
-(defun comp-remove-type-hints-func ()
+(defun comp--remove-type-hints-func ()
"Remove type hints from the current function.
These are substituted with a normal `set' op."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
- do (comp-loop-insn-in-block b
+ do (comp--loop-insn-in-block b
(pcase insn
(`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val))
(setf insn `(set ,l-val ,r-val)))))))
-(defun comp-remove-type-hints (_)
+(defun comp--remove-type-hints (_)
"Dead code elimination."
(maphash (lambda (_ f)
(when (>= (comp-func-speed f) 2)
(let ((comp-func f))
- (comp-remove-type-hints-func)
+ (comp--remove-type-hints-func)
(comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt)))
-;;; Final pass specific code.
+;;; Sanitizer pass specific code.
-(defun comp-args-to-lambda-list (args)
- "Return a lambda list for ARGS."
- (cl-loop
- with res
- repeat (comp-args-base-min args)
- do (push t res)
- finally
- (if (comp-args-p args)
- (cl-loop
- with n = (- (comp-args-max args) (comp-args-min args))
- initially (unless (zerop n)
- (push '&optional res))
- repeat n
- do (push t res))
+;; This pass aims to verify compile-time value-type predictions during
+;; execution of the code.
+;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before
+;; each conditional branch. 'helper_sanitizer_assert' will verify that
+;; the variable tested by the conditional branch is of the predicted
+;; value type, or signal an error otherwise.
+
+;;; Example:
+
+;; Assume we want to compile 'test.el' and test the function `foo'
+;; defined in it. Then:
+
+;; - Native-compile 'test.el' instrumenting it for sanitizer usage:
+;; (let ((comp-sanitizer-emit t))
+;; (load (native-compile "test.el")))
+
+;; - Run `foo' with the sanitizer active:
+;; (let ((comp-sanitizer-active t))
+;; (foo))
+
+(defvar comp-sanitizer-emit nil
+ "Gates the sanitizer pass.
+This is intended to be used only for development and verification of
+the native compiler.")
+
+(defun comp--sanitizer (_)
+ (when comp-sanitizer-emit
+ (cl-loop
+ for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
+ for comp-func = f
+ unless (comp-func-has-non-local comp-func)
+ do
(cl-loop
- with n = (- (comp-nargs-nonrest args) (comp-nargs-min args))
- initially (unless (zerop n)
- (push '&optional res))
- repeat n
- do (push t res)
- finally (when (comp-nargs-rest args)
- (push '&rest res)
- (push 't res))))
- (cl-return (reverse res))))
+ for b being each hash-value of (comp-func-blocks f)
+ do
+ (cl-loop
+ named in-the-basic-block
+ for insns-seq on (comp-block-insns b)
+ do (pcase insns-seq
+ (`((cond-jump ,(and (pred comp-mvar-p) mvar-tested)
+ ,(pred comp-mvar-p) ,_bb1 ,_bb2))
+ (let ((type (comp-cstr-to-type-spec mvar-tested))
+ (insn (car insns-seq)))
+ ;; No need to check if type is t.
+ (unless (eq type t)
+ (comp--add-const-to-relocs type)
+ (setcar
+ insns-seq
+ (comp--call 'helper_sanitizer_assert
+ mvar-tested
+ (make--comp-mvar :constant type)))
+ (setcdr insns-seq (list insn)))
+ ;; (setf (comp-func-ssa-status comp-func) 'dirty)
+ (cl-return-from in-the-basic-block))))))
+ do (comp--log-func comp-func 3))))
+
+
+;;; Function types pass specific code.
-(defun comp-compute-function-type (_ func)
+(defun comp--compute-function-type (_ func)
"Compute type specifier for `comp-func' FUNC.
Set it into the `type' slot."
(when (and (comp-func-l-p func)
@@ -3041,13 +3098,45 @@ Set it into the `type' slot."
(`(return ,mvar)
(push mvar res))))
finally return res)))
- (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func))
+ (type `(function ,(comp--args-to-lambda-list (comp-func-l-args func))
,(comp-cstr-to-type-spec res-mvar))))
(comp--add-const-to-relocs type)
;; Fix it up.
(setf (comp-cstr-imm (comp-func-type func)) type))))
-(defun comp-finalize-container (cont)
+(defun comp--compute-function-types (_)
+ "Compute and store the type specifier for all functions."
+ (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Final pass specific code.
+
+(defun comp--args-to-lambda-list (args)
+ "Return a lambda list for ARGS."
+ (cl-loop
+ with res
+ repeat (comp-args-base-min args)
+ do (push t res)
+ finally
+ (if (comp-args-p args)
+ (cl-loop
+ with n = (- (comp-args-max args) (comp-args-min args))
+ initially (unless (zerop n)
+ (push '&optional res))
+ repeat n
+ do (push t res))
+ (cl-loop
+ with n = (- (comp-nargs-nonrest args) (comp-nargs-min args))
+ initially (unless (zerop n)
+ (push '&optional res))
+ repeat n
+ do (push t res)
+ finally (when (comp-nargs-rest args)
+ (push '&rest res)
+ (push 't res))))
+ (cl-return (reverse res))))
+
+(defun comp--finalize-container (cont)
"Finalize data container CONT."
(setf (comp-data-container-l cont)
(cl-loop with h = (comp-data-container-idx cont)
@@ -3065,7 +3154,7 @@ Set it into the `type' slot."
'lambda-fixup
obj))))
-(defun comp-finalize-relocs ()
+(defun comp--finalize-relocs ()
"Finalize data containers for each relocation class.
Remove immediate duplicates within relocation classes.
Update all insn accordingly."
@@ -3081,7 +3170,7 @@ Update all insn accordingly."
(d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
(d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
;; We never want compiled lambdas ending up in pure space. A copy must
- ;; be already present in impure (see `comp-emit-lambda-for-top-level').
+ ;; be already present in impure (see `comp--emit-lambda-for-top-level').
(cl-loop for obj being each hash-keys of d-default-idx
when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
do (cl-assert (gethash obj d-impure-idx))
@@ -3097,7 +3186,7 @@ Update all insn accordingly."
do (remhash obj d-ephemeral-idx))
;; Fix-up indexes in each relocation class and fill corresponding
;; reloc lists.
- (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral))
+ (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral))
;; Make a vector from the function documentation hash table.
(cl-loop with h = (comp-ctxt-function-docs comp-ctxt)
with v = (make-vector (hash-table-count h) nil)
@@ -3121,11 +3210,11 @@ Update all insn accordingly."
(comp-mvar-range mvar) (list (cons idx idx)))
(puthash idx t reverse-h))))
-(defun comp-compile-ctxt-to-file (name)
+(defun comp--compile-ctxt-to-file (name)
"Compile as native code the current context naming it NAME.
Prepare every function for final compilation and drive the C back-end."
(let ((dir (file-name-directory name)))
- (comp-finalize-relocs)
+ (comp--finalize-relocs)
(maphash (lambda (_ f)
(comp--log-func f 1))
(comp-ctxt-funcs-h comp-ctxt))
@@ -3133,12 +3222,12 @@ Prepare every function for final compilation and drive the C back-end."
;; In case it's created in the meanwhile.
(ignore-error file-already-exists
(make-directory dir t)))
- (comp--compile-ctxt-to-file name)))
+ (comp--compile-ctxt-to-file0 name)))
-(defun comp-final1 ()
+(defun comp--final1 ()
(comp--init-ctxt)
(unwind-protect
- (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt))
+ (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt))
(comp--release-ctxt)))
(defvar comp-async-compilation nil
@@ -3147,17 +3236,16 @@ Prepare every function for final compilation and drive the C back-end."
(defvar comp-running-batch-compilation nil
"Non-nil when compilation is driven by any `batch-*-compile' function.")
-(defun comp-final (_)
+(defun comp--final (_)
"Final pass driving the C back-end for code emission."
- (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt))
(unless comp-dry-run
;; Always run the C side of the compilation as a sub-process
;; unless during bootstrap or async compilation (bug#45056). GCC
;; leaks memory but also interfere with the ability of Emacs to
;; detect when a sub-process completes (TODO understand why).
(if (or comp-running-batch-compilation comp-async-compilation)
- (comp-final1)
- ;; Call comp-final1 in a child process.
+ (comp--final1)
+ ;; Call comp--final1 in a child process.
(let* ((output (comp-ctxt-output comp-ctxt))
(print-escape-newlines t)
(print-length nil)
@@ -3179,7 +3267,7 @@ Prepare every function for final compilation and drive the C back-end."
load-path ',load-path)
,native-comp-async-env-modifier-form
(message "Compiling %s..." ',output)
- (comp-final1)))
+ (comp--final1)))
(temp-file (make-temp-file
(concat "emacs-int-comp-"
(file-name-base output) "-")
@@ -3223,7 +3311,7 @@ Prepare every function for final compilation and drive the C back-end."
;; Primitive function advice machinery
-(defun comp-make-lambda-list-from-subr (subr)
+(defun comp--make-lambda-list-from-subr (subr)
"Given SUBR return the equivalent lambda-list."
(pcase-let ((`(,min . ,max) (subr-arity subr))
(lambda-list '()))
@@ -3267,7 +3355,7 @@ Prepare every function for final compilation and drive the C back-end."
;;;###autoload
(defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME."
- (let* ((lambda-list (comp-make-lambda-list-from-subr
+ (let* ((lambda-list (comp--make-lambda-list-from-subr
(symbol-function subr-name)))
;; The synthesized trampoline must expose the exact same ABI of
;; the primitive we are replacing in the function reloc table.
@@ -3311,6 +3399,7 @@ filename (including FILE)."
do (ignore-error file-error
(comp-delete-or-replace-file f))))))
+;; In use by comp.c.
(defun comp-delete-or-replace-file (oldfile &optional newfile)
"Replace OLDFILE with NEWFILE.
When NEWFILE is nil just delete OLDFILE.
@@ -3399,16 +3488,18 @@ the deferred compilation mechanism."
(if (and comp-async-compilation
(not (eq (car err) 'native-compiler-error)))
(progn
- (message (if err-val
- "%s: Error: %s %s"
- "%s: Error %s")
+ (message "%s: Error %s"
function-or-file
- (get (car err) 'error-message)
- (car-safe err-val))
+ (error-message-string err))
(kill-emacs -1))
;; Otherwise re-signal it adding the compilation input.
+ ;; FIXME: We can't just insert arbitrary info in the
+ ;; error-data part of an error: the handler may expect
+ ;; specific data at specific positions!
(signal (car err) (if (consp err-val)
(cons function-or-file err-val)
+ ;; FIXME: `err-val' is supposed to be
+ ;; a list, so it can only be nil here!
(list function-or-file err-val)))))))
(if (stringp function-or-file)
data
@@ -3492,7 +3583,8 @@ last directory in `native-comp-eln-load-path')."
else
collect (byte-compile-file file))))
-(defun comp-write-bytecode-file (eln-file)
+;; In use by elisp-mode.el
+(defun comp--write-bytecode-file (eln-file)
"After native compilation write the bytecode file for ELN-FILE.
Make sure that eln file is younger than byte-compiled one and
return the filename of this last.
@@ -3529,7 +3621,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile."
(car (last native-comp-eln-load-path)))
(byte-to-native-output-buffer-file nil)
(eln-file (car (batch-native-compile))))
- (comp-write-bytecode-file eln-file)
+ (comp--write-bytecode-file eln-file)
(setq command-line-args-left (cdr command-line-args-left)))))
(defun native-compile-prune-cache ()
diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el
new file mode 100644
index 00000000000..f7037dc4101
--- /dev/null
+++ b/lisp/emacs-lisp/compat.el
@@ -0,0 +1,92 @@
+;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+
+;; Author: \
+;; Philip Kaludercic <philipk@posteo.net>, \
+;; Daniel Mendler <mail@daniel-mendler.de>
+;; Maintainer: \
+;; Daniel Mendler <mail@daniel-mendler.de>, \
+;; Compat Development <~pkal/compat-devel@lists.sr.ht>,
+;; emacs-devel@gnu.org
+;; URL: https://github.com/emacs-compat/compat
+;; Keywords: lisp, maint
+
+;; 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:
+
+;; The Compat package on ELPA provides forward-compatibility
+;; definitions for other packages. While mostly transparent, a
+;; minimal API is necessary whenever core definitions change calling
+;; conventions (e.g. `plist-get' can be invoked with a predicate from
+;; Emacs 29.1 onward). For core packages on ELPA to be able to take
+;; advantage of this functionality, the macros `compat-function' and
+;; `compat-call' have to be available in the core, usable even if
+;; users do not have the Compat package installed, which this file
+;; ensures.
+
+;; A basic introduction to Compat is given in the Info node `(elisp)
+;; Forwards Compatibility'. Further details on Compat are documented
+;; in the Info node `(compat) Top' (installed along with the Compat
+;; package) or read the same manual online:
+;; https://elpa.gnu.org/packages/doc/compat.html.
+
+;;; Code:
+
+(defmacro compat-function (fun)
+ "Return compatibility function symbol for FUN.
+This is a pseudo-compatibility stub for core packages on ELPA,
+that depend on the Compat package, whenever the user doesn't have
+the package installed on their current system."
+ `#',fun)
+
+(defmacro compat-call (fun &rest args)
+ "Call compatibility function or macro FUN with ARGS.
+This is a pseudo-compatibility stub for core packages on ELPA,
+that depend on the Compat package, whenever the user doesn't have
+the package installed on their current system."
+ (cons fun args))
+
+;;;; Clever trick to avoid installing Compat if not necessary
+
+;; The versioning scheme of the Compat package follows that of Emacs,
+;; to indicate the version of Emacs, that functionality is being
+;; provided for. For example, the Compat version number 29.2.3.9
+;; would attempt to provide compatibility definitions up to Emacs
+;; 29.2, while also designating that this is the third major release
+;; and ninth minor release of Compat, for the specific Emacs release.
+
+;; The package version of this file is specified programmatically,
+;; instead of giving a fixed version in the header of this file. This
+;; is done to ensure that the version of compat.el provided by Emacs
+;; always corresponds to the current version of Emacs. In addition to
+;; the major-minor version, a large "major release" makes sure that
+;; the built-in version of Compat is always preferred over an external
+;; installation. This means that if a package specifies a dependency
+;; on Compat which matches the current or an older version of Emacs
+;; that is being used, no additional dependencies have to be
+;; downloaded.
+;;
+;; Further details and background on this file can be found in the
+;; bug#66554 discussion.
+
+;;;###autoload (push (list 'compat
+;;;###autoload emacs-major-version
+;;;###autoload emacs-minor-version
+;;;###autoload 9999)
+;;;###autoload package--builtin-versions)
+
+(provide 'compat)
+;;; compat.el ends here
diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el
index f2eb8792bfa..8a0dddc2679 100644
--- a/lisp/emacs-lisp/debug-early.el
+++ b/lisp/emacs-lisp/debug-early.el
@@ -27,14 +27,17 @@
;; This file dumps a backtrace on stderr when an error is thrown. It
;; has no dependencies on any Lisp libraries and is thus used for
;; generating backtraces for bugs in the early parts of bootstrapping.
-;; It is also always used in batch model. It was introduced in Emacs
+;; It is also always used in batch mode. It was introduced in Emacs
;; 29, before which there was no backtrace available during early
;; bootstrap.
;;; Code:
+;; For bootstrap reasons, we cannot use any macros here since they're
+;; not defined yet.
+
(defalias 'debug-early-backtrace
- #'(lambda ()
+ #'(lambda (&optional base)
"Print a trace of Lisp function calls currently active.
The output stream used is the value of `standard-output'.
@@ -51,26 +54,39 @@ of the build process."
(require 'cl-print)
(error nil)))
#'cl-prin1
- #'prin1)))
+ #'prin1))
+ (first t))
(mapbacktrace
#'(lambda (evald func args _flags)
- (let ((args args))
- (if evald
+ (if first
+ ;; The first is the debug-early entry point itself.
+ (setq first nil)
+ (let ((args args))
+ (if evald
+ (progn
+ (princ " ")
+ (funcall prin1 func)
+ (princ "("))
(progn
- (princ " ")
- (funcall prin1 func)
- (princ "("))
- (progn
- (princ " (")
- (setq args (cons func args))))
- (if args
- (while (progn
- (funcall prin1 (car args))
- (setq args (cdr args)))
- (princ " ")))
- (princ ")\n")))))))
-
-(defalias 'debug-early
+ (princ " (")
+ (setq args (cons func args))))
+ (if args
+ (while (progn
+ (funcall prin1 (car args))
+ (setq args (cdr args)))
+ (princ " ")))
+ (princ ")\n"))))
+ base))))
+
+(defalias 'debug--early
+ #'(lambda (error base)
+ (princ "\nError: ")
+ (prin1 (car error)) ; The error symbol.
+ (princ " ")
+ (prin1 (cdr error)) ; The error data.
+ (debug-early-backtrace base)))
+
+(defalias 'debug-early ;Called from C.
#'(lambda (&rest args)
"Print an error message with a backtrace of active Lisp function calls.
The output stream used is the value of `standard-output'.
@@ -88,10 +104,31 @@ support the latter, except in batch mode which always uses
\(In versions of Emacs prior to Emacs 29, no backtrace was
available before `debug' was usable.)"
- (princ "\nError: ")
- (prin1 (car (car (cdr args)))) ; The error symbol.
- (princ " ")
- (prin1 (cdr (car (cdr args)))) ; The error data.
- (debug-early-backtrace)))
+ (debug--early (car (cdr args)) #'debug-early))) ; The error object.
+
+(defalias 'debug-early--handler ;Called from C.
+ #'(lambda (err)
+ (if backtrace-on-error-noninteractive
+ (debug--early err #'debug-early--handler))))
+
+(defalias 'debug-early--muted ;Called from C.
+ #'(lambda (err)
+ (save-current-buffer
+ (set-buffer (get-buffer-create "*Redisplay-trace*"))
+ (goto-char (point-max))
+ (if (bobp) nil
+ (let ((separator "\n\n\n\n"))
+ (save-excursion
+ ;; The C code tested `backtrace_yet', instead we
+ ;; keep a max of 10 backtraces.
+ (if (search-backward separator nil t 10)
+ (delete-region (point-min) (match-end 0))))
+ (insert separator)))
+ (insert "-- Caught at " (current-time-string) "\n")
+ (let ((standard-output (current-buffer)))
+ (debug--early err #'debug-early--muted))
+ (setq delayed-warnings-list
+ (cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*")
+ delayed-warnings-list)))))
;;; debug-early.el ends here.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 506b73f6fa2..ec947c1215d 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -153,6 +153,12 @@ where CAUSE can be:
(insert (debugger--buffer-state-content state)))
(goto-char (debugger--buffer-state-pos state)))
+(defvar debugger--last-error nil)
+
+(defun debugger--duplicate-p (args)
+ (pcase args
+ (`(error ,err . ,_) (and (consp err) (eq err debugger--last-error)))))
+
;;;###autoload
(setq debugger 'debug)
;;;###autoload
@@ -175,9 +181,14 @@ first will be printed into the backtrace buffer.
If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered."
(interactive)
- (if inhibit-redisplay
- ;; Don't really try to enter debugger within an eval from redisplay.
+ (if (or inhibit-redisplay
+ (debugger--duplicate-p args))
+ ;; Don't really try to enter debugger within an eval from redisplay
+ ;; or if we already popper into the debugger for this error,
+ ;; which can happen when we have several nested `handler-bind's that
+ ;; want to invoke the debugger.
debugger-value
+ (setq debugger--last-error nil)
(let ((non-interactive-frame
(or noninteractive ;FIXME: Presumably redundant.
;; If we're in the initial-frame (where `message' just
@@ -200,7 +211,7 @@ the debugger will not be entered."
(let (debugger-value
(debugger-previous-state
(if (get-buffer "*Backtrace*")
- (with-current-buffer (get-buffer "*Backtrace*")
+ (with-current-buffer "*Backtrace*"
(debugger--save-buffer-state))))
(debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
@@ -318,6 +329,12 @@ the debugger will not be entered."
(backtrace-mode))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
+ (when (eq 'error (car-safe debugger-args))
+ ;; Remember the error we just debugged, to avoid re-entering
+ ;; the debugger if some higher-up `handler-bind' invokes us
+ ;; again, oblivious that the error was already debugged from
+ ;; a more deeply nested `handler-bind'.
+ (setq debugger--last-error (nth 1 debugger-args)))
(setq debug-on-next-call debugger-step-after-exit)
debugger-value))))
@@ -651,7 +668,7 @@ Complete list of commands:
(princ (debugger-eval-expression exp))
(terpri))
- (with-current-buffer (get-buffer debugger-record-buffer)
+ (with-current-buffer debugger-record-buffer
(message "%s"
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 5c224362708..2423426dca0 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -211,10 +211,10 @@ See Info node `(elisp)Derived Modes' for more details.
(defvar ,hook nil)
(unless (get ',hook 'variable-documentation)
(put ',hook 'variable-documentation
- ,(format "Hook run after entering %s mode.
+ ,(format "Hook run after entering `%S'.
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
- name)))
+ child)))
(unless (boundp ',map)
(put ',map 'definition-name ',child))
(with-no-warnings (defvar ,map (make-sparse-keymap)))
@@ -365,137 +365,6 @@ which more-or-less shadow%s %s's corresponding table%s."
docstring))
-;;; OBSOLETE
-;; The functions below are only provided for backward compatibility with
-;; code byte-compiled with versions of derived.el prior to Emacs-21.
-
-(defsubst derived-mode-setup-function-name (mode)
- "Construct a setup-function name based on a MODE name."
- (declare (obsolete nil "28.1"))
- (intern (concat (symbol-name mode) "-setup")))
-
-
-;; Utility functions for defining a derived mode.
-
-;;;###autoload
-(defun derived-mode-init-mode-variables (mode)
- "Initialize variables for a new MODE.
-Right now, if they don't already exist, set up a blank keymap, an
-empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used."
-
- (if (boundp (derived-mode-map-name mode))
- t
- (eval `(defvar ,(derived-mode-map-name mode)
- (make-sparse-keymap)
- ,(format "Keymap for %s." mode)))
- (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-syntax-table-name mode))
- t
- (eval `(defvar ,(derived-mode-syntax-table-name mode)
- ;; Make a syntax table which doesn't specify anything
- ;; for any char. Valid data will be merged in by
- ;; derived-mode-merge-syntax-tables.
- (make-char-table 'syntax-table nil)
- ,(format "Syntax table for %s." mode)))
- (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-abbrev-table-name mode))
- t
- (eval `(defvar ,(derived-mode-abbrev-table-name mode)
- (progn
- (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil)
- (make-abbrev-table))
- ,(format "Abbrev table for %s." mode)))))
-
-;; Utility functions for running a derived mode.
-
-(defun derived-mode-set-keymap (mode)
- "Set the keymap of the new MODE, maybe merging with the parent."
- (let* ((map-name (derived-mode-map-name mode))
- (new-map (eval map-name))
- (old-map (current-local-map)))
- (and old-map
- (get map-name 'derived-mode-unmerged)
- (derived-mode-merge-keymaps old-map new-map))
- (put map-name 'derived-mode-unmerged nil)
- (use-local-map new-map)))
-
-(defun derived-mode-set-syntax-table (mode)
- "Set the syntax table of the new MODE, maybe merging with the parent."
- (let* ((table-name (derived-mode-syntax-table-name mode))
- (old-table (syntax-table))
- (new-table (eval table-name)))
- (if (get table-name 'derived-mode-unmerged)
- (derived-mode-merge-syntax-tables old-table new-table))
- (put table-name 'derived-mode-unmerged nil)
- (set-syntax-table new-table)))
-
-(defun derived-mode-set-abbrev-table (mode)
- "Set the abbrev table for MODE if it exists.
-Always merge its parent into it, since the merge is non-destructive."
- (let* ((table-name (derived-mode-abbrev-table-name mode))
- (old-table local-abbrev-table)
- (new-table (eval table-name)))
- (derived-mode-merge-abbrev-tables old-table new-table)
- (setq local-abbrev-table new-table)))
-
-(defun derived-mode-run-hooks (mode)
- "Run the mode hook for MODE."
- (let ((hooks-name (derived-mode-hook-name mode)))
- (if (boundp hooks-name)
- (run-hooks hooks-name))))
-
-;; Functions to merge maps and tables.
-
-(defun derived-mode-merge-keymaps (old new)
- "Merge an OLD keymap into a NEW one.
-The old keymap is set to be the last cdr of the new one, so that there will
-be automatic inheritance."
- ;; ?? Can this just use `set-keymap-parent'?
- (let ((tail new))
- ;; Scan the NEW map for prefix keys.
- (while (consp tail)
- (and (consp (car tail))
- (let* ((key (vector (car (car tail))))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew))))
- (and (vectorp (car tail))
- ;; Search a vector of ASCII char bindings for prefix keys.
- (let ((i (1- (length (car tail)))))
- (while (>= i 0)
- (let* ((key (vector i))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew)))
- (setq i (1- i)))))
- (setq tail (cdr tail))))
- (setcdr (nthcdr (1- (length new)) new) old))
-
-(defun derived-mode-merge-syntax-tables (old new)
- "Merge an OLD syntax table into a NEW one.
-Where the new table already has an entry, nothing is copied from the old one."
- (set-char-table-parent new old))
-
-;; Merge an old abbrev table into a new one.
-;; This function requires internal knowledge of how abbrev tables work,
-;; presuming that they are obarrays with the abbrev as the symbol, the expansion
-;; as the value of the symbol, and the hook as the function definition.
-(defun derived-mode-merge-abbrev-tables (old new)
- (if old
- (mapatoms
- (lambda (symbol)
- (or (intern-soft (symbol-name symbol) new)
- (define-abbrev new (symbol-name symbol)
- (symbol-value symbol) (symbol-function symbol))))
- old)))
-
(provide 'derived)
;;; derived.el ends here
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index a876e6b5744..850cc2085f7 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -54,7 +54,7 @@
(defun disassemble (object &optional buffer indent interactive-p)
"Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
-\(a lambda expression or a compiled-function object).
+\(a lambda expression or a byte-code-function object).
If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol."
(interactive
@@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol."
(save-excursion
(if (or interactive-p (null buffer))
(with-output-to-temp-buffer "*Disassemble*"
- (set-buffer "*Disassemble*")
+ (set-buffer standard-output)
(let ((lexical-binding lb))
(disassemble-internal object indent (not interactive-p))))
(set-buffer buffer)
@@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
(if (consp obj)
(setq bytes (car (cdr obj)) ;the byte code
constvec (car (cdr (cdr obj)))) ;constant vector
- ;; If it is lazy-loaded, load it now
- (fetch-bytecode obj)
(setq bytes (aref obj 1)
constvec (aref obj 2)))
(cl-assert (not (multibyte-string-p bytes)))
@@ -252,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
;; if the succeeding op is byte-switch, display the jump table
;; used
(cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch)
- (insert (format "<jump-table-%s (" (hash-table-test arg)))
- (let ((first-time t))
- (maphash #'(lambda (value tag)
- (if first-time
- (setq first-time nil)
- (insert " "))
- (insert (format "%s %s" value (cadr tag))))
- arg))
- (insert ")>"))
- ;; if the value of the constant is compiled code, then
- ;; recursively disassemble it.
- ((or (byte-code-function-p arg)
- (and (consp arg) (functionp arg)
- (assq 'byte-code arg))
+ (insert (format "<jump-table-%s (" (hash-table-test arg)))
+ (let ((first-time t))
+ (maphash #'(lambda (value tag)
+ (if first-time
+ (setq first-time nil)
+ (insert " "))
+ (insert (format "%s %s" value (cadr tag))))
+ arg))
+ (insert ")>"))
+ ;; if the value of the constant is compiled code, then
+ ;; recursively disassemble it.
+ ((or (byte-code-function-p arg)
(and (eq (car-safe arg) 'macro)
- (or (byte-code-function-p (cdr arg))
- (and (consp (cdr arg))
- (functionp (cdr arg))
- (assq 'byte-code (cdr arg))))))
+ (byte-code-function-p (cdr arg))))
(cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
- ((functionp arg)
- (insert "<compiled lambda>"))
(t (insert "<compiled macro>\n")))
(disassemble-internal
arg
@@ -287,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
(+ indent disassemble-recursive-indent)))
((eq (car-safe (car-safe arg)) 'byte-code)
(insert "(<byte code>...)\n")
- (mapc ;recurse on list of byte-code objects
+ (mapc ;Recurse on list of byte-code objects.
(lambda (obj)
(disassemble-1
obj
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 05b23a86fc0..4fa05008dd8 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -132,7 +132,7 @@ it is disabled.")
(string-replace "'" "\\='" (format "%S" getter)))))
(let ((start (point)))
(insert argdoc)
- (when (fboundp 'fill-region)
+ (when (fboundp 'fill-region) ;Don't break bootstrap!
(fill-region start (point) 'left t))))
;; Finally, insert the keymap.
(when (and (boundp keymap-sym)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a8a51502503..b27ffbca908 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -193,11 +193,15 @@ Use this with caution since it is not debugged."
(defcustom edebug-print-length 50
- "If non-nil, default value of `print-length' for printing results in Edebug."
- :type '(choice integer (const nil)))
+ "Maximum length of list to print before abbreviating, when in Edebug.
+If this is nil, use the value of `print-length' instead."
+ :type '(choice (integer :tag "A number")
+ (const :tag "Use `print-length'" nil)))
(defcustom edebug-print-level 50
- "If non-nil, default value of `print-level' for printing results in Edebug."
- :type '(choice integer (const nil)))
+ "Maximum depth of list nesting to print before abbreviating, when in Edebug.
+If nil, use the value of `print-level' instead."
+ :type '(choice (integer :tag "A number")
+ (const :tag "Use `print-level'" nil)))
(defcustom edebug-print-circle t
"If non-nil, default value of `print-circle' for printing results in Edebug."
:type 'boolean)
@@ -481,7 +485,7 @@ just FUNCTION is printed."
(edebug--eval-defun #'eval-defun edebug-it)))
;;;###autoload
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
+(defalias 'edebug-defun #'edebug-eval-top-level-form)
;;;###autoload
(defun edebug-eval-top-level-form ()
@@ -1225,10 +1229,12 @@ purpose by adding an entry to this alist, and setting
;; But the list will just be reversed.
,@(nreverse edebug-def-args))
'nil)
- ;; Make sure `forms' is not nil so we don't accidentally return
- ;; the magic keyword. Mark the closure so we don't throw away
- ;; unused vars (bug#59213).
- #'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
+ #'(lambda ()
+ ;; Mark the closure so we don't throw away unused vars (bug#59213).
+ :closure-dont-trim-context
+ ;; Make sure `forms' is not nil so we don't accidentally return
+ ;; the magic keyword.
+ ,@(or forms '(nil)))))
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
@@ -1266,55 +1272,48 @@ Does not unwrap inside vectors, records, structures, or hash tables."
(pcase sexp
(`(edebug-after ,_before-form ,_after-index ,form)
form)
- (`(lambda ,args (edebug-enter ',_sym ,_arglist
- (function (lambda nil . ,body))))
- `(lambda ,args ,@body))
- (`(closure ,env ,args (edebug-enter ',_sym ,_arglist
- (function (lambda nil . ,body))))
- `(closure ,env ,args ,@body))
- (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
+ (`(edebug-enter ',_sym ,_args
+ #'(lambda nil :closure-dont-trim-context . ,body))
(macroexp-progn body))
(_ sexp)))
+(defconst edebug--unwrap-cache
+ (make-hash-table :test 'eq :weakness 'key)
+ "Hash-table containing the results of unwrapping cons cells.
+These results are reused to avoid redundant work but also to avoid
+infinite loops when the code/environment contains a circular object.")
+
(defun edebug-unwrap* (sexp)
"Return the SEXP recursively unwrapped."
- (let ((ht (make-hash-table :test 'eq)))
- (edebug--unwrap1 sexp ht)))
-
-(defun edebug--unwrap1 (sexp hash-table)
- "Unwrap SEXP using HASH-TABLE of things already unwrapped.
-HASH-TABLE contains the results of unwrapping cons cells within
-SEXP, which are reused to avoid infinite loops when SEXP is or
-contains a circular object."
- (let ((new-sexp (edebug-unwrap sexp)))
- (while (not (eq sexp new-sexp))
- (setq sexp new-sexp
- new-sexp (edebug-unwrap sexp)))
- (if (consp new-sexp)
- (let ((result (gethash new-sexp hash-table nil)))
- (unless result
- (let ((remainder new-sexp)
- current)
- (setq result (cons nil nil)
- current result)
- (while
- (progn
- (puthash remainder current hash-table)
- (setf (car current)
- (edebug--unwrap1 (car remainder) hash-table))
- (setq remainder (cdr remainder))
- (cond
- ((atom remainder)
- (setf (cdr current)
- (edebug--unwrap1 remainder hash-table))
- nil)
- ((gethash remainder hash-table nil)
- (setf (cdr current) (gethash remainder hash-table nil))
- nil)
- (t (setq current
- (setf (cdr current) (cons nil nil)))))))))
- result)
- new-sexp)))
+ (while (not (eq sexp (setq sexp (edebug-unwrap sexp)))))
+ (cond
+ ((consp sexp)
+ (or (gethash sexp edebug--unwrap-cache nil)
+ (let ((remainder sexp)
+ (current (cons nil nil)))
+ (prog1 current
+ (while
+ (progn
+ (puthash remainder current edebug--unwrap-cache)
+ (setf (car current)
+ (edebug-unwrap* (car remainder)))
+ (setq remainder (cdr remainder))
+ (cond
+ ((atom remainder)
+ (setf (cdr current)
+ (edebug-unwrap* remainder))
+ nil)
+ ((gethash remainder edebug--unwrap-cache nil)
+ (setf (cdr current) (gethash remainder edebug--unwrap-cache nil))
+ nil)
+ (t (setq current
+ (setf (cdr current) (cons nil nil)))))))))))
+ ((byte-code-function-p sexp)
+ (apply #'make-byte-code
+ (aref sexp 0) (aref sexp 1)
+ (vconcat (mapcar #'edebug-unwrap* (aref sexp 2)))
+ (nthcdr 3 (append sexp ()))))
+ (t sexp)))
(defun edebug-defining-form (cursor form-begin form-end speclist)
@@ -1729,7 +1728,7 @@ contains a circular object."
(defun edebug-match-form (cursor)
(list (edebug-form cursor)))
-(defalias 'edebug-match-place 'edebug-match-form)
+(defalias 'edebug-match-place #'edebug-match-form)
;; Currently identical to edebug-match-form.
;; This is for common lisp setf-style place arguments.
@@ -2277,12 +2276,7 @@ only be active while Edebug is. It checks `debug-on-error' to see
whether it should call the debugger. When execution is resumed, the
error is signaled again."
(if (and (listp debug-on-error) (memq signal-name debug-on-error))
- (edebug 'error (cons signal-name signal-data)))
- ;; If we reach here without another non-local exit, then send signal again.
- ;; i.e. the signal is not continuable, yet.
- ;; Avoid infinite recursion.
- (let ((signal-hook-function nil))
- (signal signal-name signal-data)))
+ (edebug 'error (cons signal-name signal-data))))
;;; Entering Edebug
@@ -2326,6 +2320,12 @@ and run its entry function, and set up `edebug-before' and
(debug-on-error (or debug-on-error edebug-on-error))
(debug-on-quit edebug-on-quit))
(unwind-protect
+ ;; FIXME: We could replace this `signal-hook-function' with
+ ;; a cleaner `handler-bind' but then we wouldn't be able to
+ ;; install it here (i.e. once and for all when entering
+ ;; an Edebugged function), but instead it would have to
+ ;; be installed into a modified `edebug-after' which wraps
+ ;; the `handler-bind' around its argument(s). :-(
(let ((signal-hook-function #'edebug-signal))
(setq edebug-execution-mode (or edebug-next-execution-mode
edebug-initial-mode
@@ -3348,7 +3348,7 @@ With prefix argument, make it a temporary breakpoint."
(message "%s" msg)))
-(defalias 'edebug-step-through-mode 'edebug-step-mode)
+(defalias 'edebug-step-through-mode #'edebug-step-mode)
(defun edebug-step-mode ()
"Proceed to next stop point."
@@ -3836,12 +3836,12 @@ be installed in `emacs-lisp-mode-map'.")
;; Global GUD bindings for all emacs-lisp-mode buffers.
(unless edebug-inhibit-emacs-lisp-mode-bindings
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode)
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where)
;; The following isn't a GUD binding.
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode))
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode))
(defvar-keymap edebug-mode-map
:parent emacs-lisp-mode-map
@@ -4234,13 +4234,13 @@ Remove frames for Edebug's functions and the lambdas in
and after-index fields in both FRAMES and the returned list
of deinstrumented frames, for those frames where the source
code location is known."
- (let (skip-next-lambda def-name before-index after-index results
- (index (length frames)))
+ (let ((index (length frames))
+ skip-next-lambda def-name before-index after-index results)
(dolist (frame (reverse frames))
(let ((new-frame (copy-edebug--frame frame))
(fun (edebug--frame-fun frame))
(args (edebug--frame-args frame)))
- (cl-decf index)
+ (cl-decf index) ;; FIXME: Not used?
(pcase fun
('edebug-enter
(setq skip-next-lambda t
@@ -4250,38 +4250,46 @@ code location is known."
(nth 1 (nth 0 args))
(nth 0 args))
after-index (nth 1 args)))
- ((pred edebug--symbol-not-prefixed-p)
- (edebug--unwrap-frame new-frame)
- (edebug--add-source-info new-frame def-name before-index after-index)
- (edebug--add-source-info frame def-name before-index after-index)
- (push new-frame results)
- (setq before-index nil
- after-index nil))
- (`(,(or 'lambda 'closure) . ,_)
+ ;; Just skip all our own frames.
+ ((pred edebug--symbol-prefixed-p) nil)
+ (_
+ (when (and skip-next-lambda
+ (not (memq (car-safe fun) '(closure lambda))))
+ (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun))
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)
- (edebug--add-source-info frame def-name before-index after-index)
(edebug--add-source-info new-frame def-name before-index after-index)
+ (edebug--add-source-info frame def-name before-index after-index)
(push new-frame results))
- (setq before-index nil
+ (setq before-index nil
after-index nil
skip-next-lambda nil)))))
results))
-(defun edebug--symbol-not-prefixed-p (sym)
- "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
+(defun edebug--symbol-prefixed-p (sym)
+ "Return non-nil if SYM is a symbol prefixed by \"edebug-\"."
(and (symbolp sym)
- (not (string-prefix-p "edebug-" (symbol-name sym)))))
+ (string-prefix-p "edebug-" (symbol-name sym))))
(defun edebug--unwrap-frame (frame)
"Remove Edebug's instrumentation from FRAME.
Strip it from the function and any unevaluated arguments."
- (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
- (unless (edebug--frame-evald frame)
- (let (results)
- (dolist (arg (edebug--frame-args frame))
- (push (edebug-unwrap* arg) results))
- (setf (edebug--frame-args frame) (nreverse results)))))
+ (cl-callf edebug-unwrap* (edebug--frame-fun frame))
+ ;; We used to try to be careful to apply `edebug-unwrap' only to source
+ ;; expressions and not to values, so we did not apply unwrap to the arguments
+ ;; of the frame if they had already been evaluated.
+ ;; But this was not careful enough since `edebug-unwrap*' gleefully traverses
+ ;; its argument without paying attention to its syntactic structure so it
+ ;; also "mistakenly" descends into the values contained within the "source
+ ;; code". In practice this *very* rarely leads to undesired results.
+ ;; On the contrary, it's often useful to descend into values because they
+ ;; may contain interpreted closures and hence source code where we *do*
+ ;; want to apply `edebug-unwrap'.
+ ;; So based on this experience, we now also apply `edebug-unwrap*' to
+ ;; the already evaluated arguments.
+ ;;(unless (edebug--frame-evald frame)
+ (cl-callf (lambda (xs) (mapcar #'edebug-unwrap* xs))
+ (edebug--frame-args frame)))
(defun edebug--add-source-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 9c526f67204..cf8bd749f2a 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -191,7 +191,7 @@ Abstract classes cannot be instantiated."
;; We autoload this because it's used in `make-autoload'.
;;;###autoload
-(defun eieio-defclass-autoload (cname _superclasses filename doc)
+(defun eieio-defclass-autoload (cname superclasses filename doc)
"Create autoload symbols for the EIEIO class CNAME.
SUPERCLASSES are the superclasses that CNAME inherits from.
DOC is the docstring for CNAME.
@@ -199,15 +199,9 @@ This function creates a mock-class for CNAME and adds it into
SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor."
;; Assume we've already debugged inputs.
-
- ;; We used to store the list of superclasses in the `parent' slot (as a list
- ;; of class names). But now this slot holds a list of class objects, and
- ;; those parents may not exist yet, so the corresponding class objects may
- ;; simply not exist yet. So instead we just don't store the list of parents
- ;; here in eieio-defclass-autoload at all, since it seems that they're just
- ;; not needed before the class is actually loaded.
(let* ((oldc (cl--find-class cname))
- (newc (eieio--class-make cname)))
+ (newc (eieio--class-make cname))
+ (parents (mapcar #'cl-find-class superclasses)))
(if (eieio--class-p oldc)
nil ;; Do nothing if we already have this class.
@@ -218,6 +212,12 @@ It creates an autoload function for CNAME's constructor."
use '%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
+ (when (memq nil parents)
+ ;; If some parents aren't yet fully defined, just ignore them for now.
+ (setq parents (delq nil parents)))
+ (unless parents
+ (setq parents (list (cl--find-class 'eieio-default-superclass))))
+ (setf (cl--class-parents newc) parents)
(setf (cl--find-class cname) newc)
;; Create an autoload on top of our constructor function.
@@ -293,8 +293,7 @@ See `defclass' for more information."
;; reloading the file that does the `defclass', we don't
;; want to create a new class object.
(eieio--class-make cname)))
- (groups nil) ;; list of groups id'd from slots
- (clearparent nil))
+ (groups nil)) ;; list of groups id'd from slots
;; If this class already existed, and we are updating its structure,
;; make sure we keep the old child list. This can cause bugs, but
@@ -317,6 +316,9 @@ See `defclass' for more information."
(setf (eieio--class-children newc) children)
(remhash cname eieio-defclass-autoload-map))))
+ (unless (or superclasses (eq cname 'eieio-default-superclass))
+ (setq superclasses '(eieio-default-superclass)))
+
(if superclasses
(progn
(dolist (p superclasses)
@@ -336,16 +338,13 @@ See `defclass' for more information."
(push c (eieio--class-parents newc))))))
;; Reverse the list of our parents so that they are prioritized in
;; the same order as specified in the code.
- (cl-callf nreverse (eieio--class-parents newc)))
- ;; If there is nothing to loop over, then inherit from the
- ;; default superclass.
- (unless (eq cname 'eieio-default-superclass)
- ;; adopt the default parent here, but clear it later...
- (setq clearparent t)
- ;; save new child in parent
- (cl-pushnew cname (eieio--class-children eieio-default-superclass))
- ;; save parent in child
- (setf (eieio--class-parents newc) (list eieio-default-superclass))))
+ (cl-callf nreverse (eieio--class-parents newc))
+ ;; Before adding new slots, let's add all the methods and classes
+ ;; in from the parent class.
+ (eieio-copy-parents-into-subclass newc))
+
+ (cl-assert (eq cname 'eieio-default-superclass))
+ (setf (eieio--class-parents newc) (list (cl--find-class 'record))))
;; turn this into a usable self-pointing symbol; FIXME: Why?
(when eieio-backward-compatibility
@@ -376,10 +375,6 @@ See `defclass' for more information."
cname)
"25.1")))
- ;; Before adding new slots, let's add all the methods and classes
- ;; in from the parent class.
- (eieio-copy-parents-into-subclass newc)
-
;; Store the new class vector definition into the symbol. We need to
;; do this first so that we can call defmethod for the accessor.
;; The vector will be updated by the following while loop and will not
@@ -512,10 +507,6 @@ See `defclass' for more information."
;; Set up the options we have collected.
(setf (eieio--class-options newc) options)
- ;; if this is a superclass, clear out parent (which was set to the
- ;; default superclass eieio-default-superclass)
- (if clearparent (setf (eieio--class-parents newc) nil))
-
;; Create the cached default object.
(let ((cache (make-record newc
(+ (length (eieio--class-slots newc))
@@ -967,19 +958,13 @@ need be... May remove that later...)"
(cdr tuple)
nil)))
-(defsubst eieio--class/struct-parents (class)
- (or (eieio--class-parents class)
- `(,eieio-default-superclass)))
-
(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
- (let ((parents (eieio--class-parents class)))
+ (let ((parents (cl--class-parents class)))
(cons class
(merge-ordered-lists
(append
- (or
- (mapcar #'eieio--class-precedence-c3 parents)
- `((,eieio-default-superclass)))
+ (mapcar #'eieio--class-precedence-c3 parents)
(list parents))
(lambda (remaining-inputs)
(signal 'inconsistent-class-hierarchy
@@ -989,17 +974,15 @@ need be... May remove that later...)"
(defun eieio--class-precedence-dfs (class)
"Return all parents of CLASS in depth-first order."
- (let* ((parents (eieio--class-parents class))
+ (let* ((parents (cl--class-parents class))
(classes (copy-sequence
(apply #'append
(list class)
- (or
- (mapcar
- (lambda (parent)
- (cons parent
- (eieio--class-precedence-dfs parent)))
- parents)
- `((,eieio-default-superclass))))))
+ (mapcar
+ (lambda (parent)
+ (cons parent
+ (eieio--class-precedence-dfs parent)))
+ parents))))
(tail classes))
;; Remove duplicates.
(while tail
@@ -1012,13 +995,12 @@ need be... May remove that later...)"
(defun eieio--class-precedence-bfs (class)
"Return all parents of CLASS in breadth-first order."
(let* ((result)
- (queue (eieio--class/struct-parents class)))
+ (queue (cl--class-parents class)))
(while queue
(let ((head (pop queue)))
(unless (member head result)
(push head result)
- (unless (eq head eieio-default-superclass)
- (setq queue (append queue (eieio--class/struct-parents head)))))))
+ (setq queue (append queue (cl--class-parents head))))))
(cons class (nreverse result)))
)
@@ -1058,6 +1040,14 @@ method invocation orders of the involved classes."
;;;; General support to dispatch based on the type of the argument.
+;; FIXME: We could almost use the typeof-generalizer (i.e. the same as
+;; used for cl-structs), except that that generalizer doesn't support
+;; `:method-invocation-order' :-(
+
+(defun cl--generic-struct-tag (name &rest _)
+ ;; Use exactly the same code as for `typeof'.
+ `(cl-type-of ,name))
+
(cl-generic-define-generalizer eieio--generic-generalizer
;; Use the exact same tagcode as for cl-struct, so that methods
;; that dispatch on both kinds of objects get to share this
@@ -1066,8 +1056,7 @@ method invocation orders of the involved classes."
(lambda (tag &rest _)
(let ((class (cl--find-class tag)))
(and (eieio--class-p class)
- (mapcar #'eieio--class-name
- (eieio--class-precedence-list class))))))
+ (cl--class-allparents class)))))
(cl-defmethod cl-generic-generalizers :extra "class" (specializer)
"Support for dispatch on types defined by EIEIO's `defclass'."
@@ -1089,10 +1078,11 @@ method invocation orders of the involved classes."
;; Instead, we add a new "subclass" specializer.
(defun eieio--generic-subclass-specializers (tag &rest _)
- (when (eieio--class-p tag)
- (mapcar (lambda (class)
- `(subclass ,(eieio--class-name class)))
- (eieio--class-precedence-list tag))))
+ (when (cl--class-p tag)
+ (when (eieio--class-p tag)
+ (setq tag (eieio--full-class-object tag))) ;Autoload, if applicable.
+ (mapcar (lambda (class) `(subclass ,class))
+ (cl--class-allparents tag))))
(cl-generic-define-generalizer eieio--generic-subclass-generalizer
60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 893f8cd7e7f..bf6be1690e4 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -50,7 +50,7 @@ variable `eieio-default-superclass'."
(if (not root-class) (setq root-class 'eieio-default-superclass))
(cl-check-type root-class class)
(display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
- (with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
+ (with-current-buffer "*EIEIO OBJECT BROWSE*"
(erase-buffer)
(goto-char 0)
(eieio-browse-tree root-class "" "")
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index df85a64baf3..74f5e21db7d 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of
,@(mapcar (lambda (field)
(pcase-exhaustive field
(`(,name ,pat)
- `(app (pcase--flip eieio-oref ',name) ,pat))
+ `(app (eieio-oref _ ',name) ,pat))
((pred symbolp)
- `(app (pcase--flip eieio-oref ',field) ,field))))
+ `(app (eieio-oref _ ',field) ,field))))
fields)))
;;; Simple generators, and query functions. None of these would do
@@ -449,7 +449,12 @@ If EXTRA, include that in the string returned to represent the symbol."
(defun eieio-class-parents (class)
;; FIXME: What does "(overload of variable)" mean here?
"Return parent classes to CLASS. (overload of variable)."
- (eieio--class-parents (eieio--full-class-object class)))
+ ;; (declare (obsolete cl--class-parents "30.1"))
+ (let ((parents (eieio--class-parents (eieio--full-class-object class))))
+ (if (and (null (cdr parents))
+ (eq (car parents) (cl--find-class 'eieio-default-superclass)))
+ nil
+ parents)))
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
@@ -497,7 +502,7 @@ If EXTRA, include that in the string returned to represent the symbol."
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parents child))
+ (setq p (append p (cl--class-parents child))
child (pop p)))
(if child t))))
@@ -680,8 +685,7 @@ If SLOT is unbound, do nothing."
(defclass eieio-default-superclass nil
nil
"Default parent class for classes with no specified parent class.
-Its slots are automatically adopted by classes with no specified parents.
-This class is not stored in the `parent' slot of a class vector."
+Its slots are automatically adopted by classes with no specified parents."
:abstract t)
(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 06970d40e8a..24afd03fbe6 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash performance.")
(defvar eldoc-message-commands
;; Don't define as `defconst' since it would then go to (read-only) purespace.
- (make-vector eldoc-message-commands-table-size 0)
+ (obarray-make eldoc-message-commands-table-size)
"Commands after which it is appropriate to print in the echo area.
ElDoc does not try to print function arglists, etc., after just any command,
because some commands print their own messages in the echo area and these
@@ -191,7 +191,7 @@ It should receive the same arguments as `message'.")
When `eldoc-print-after-edit' is non-nil, ElDoc messages are only
printed after commands contained in this obarray."
- (let ((cmds (make-vector 31 0))
+ (let ((cmds (obarray-make 31))
(re (regexp-opt '("delete" "insert" "edit" "electric" "newline"))))
(mapatoms (lambda (s)
(and (commandp s)
@@ -312,9 +312,11 @@ Otherwise, it displays the message like `message' would."
(not (and (listp mode-line-format)
(assq 'eldoc-mode-line-string mode-line-format))))
(setq mode-line-format
- (list "" '(eldoc-mode-line-string
- (" " eldoc-mode-line-string " "))
- mode-line-format)))
+ (funcall
+ (if (listp mode-line-format) #'append #'list)
+ (list "" '(eldoc-mode-line-string
+ (" " eldoc-mode-line-string " ")))
+ mode-line-format)))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply #'format-message format-string args)))
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index a8bc4bdd1e0..27c169cc657 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'."
(insert-file-contents file)
(let ((buffer-file-name file)
(max-lisp-eval-depth (max 1000 max-lisp-eval-depth)))
+ (hack-local-variables)
(with-syntax-table emacs-lisp-mode-syntax-table
(mapc 'elint-top-form (elint-update-env)))))
(elint-set-mode-line)
diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 29114712f92..e77c8945dc3 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -39,16 +39,33 @@
(require 'newcomment)
(require 'pcase)
-(defconst ert-font-lock--assertion-re
+(defconst ert-font-lock--face-symbol-re
+ (rx (one-or-more (or alphanumeric "-" "_" ".")))
+ "A face symbol matching regex.")
+
+(defconst ert-font-lock--face-symbol-list-re
+ (rx "("
+ (* whitespace)
+ (one-or-more
+ (seq (regexp ert-font-lock--face-symbol-re)
+ (* whitespace)))
+ ")")
+ "A face symbol list matching regex.")
+
+(defconst ert-font-lock--assertion-line-re
(rx
- ;; column specifiers
+ ;; leading column assertion (arrow/caret)
(group (or "^" "<-"))
- (one-or-more " ")
+ (zero-or-more whitespace)
+ ;; possible to have many carets on an assertion line
+ (group (zero-or-more (seq "^" (zero-or-more whitespace))))
;; optional negation of the face specification
(group (optional "!"))
- ;; face symbol name
- (group (one-or-more (or alphanumeric "-" "_" "."))))
- "An ert-font-lock assertion regex.")
+ (zero-or-more whitespace)
+ ;; face symbol name or a list of symbols
+ (group (or (regexp ert-font-lock--face-symbol-re)
+ (regexp ert-font-lock--face-symbol-list-re))))
+ "An ert-font-lock assertion line regex.")
(defun ert-font-lock--validate-major-mode (mode)
"Validate if MODE is a valid major mode."
@@ -212,7 +229,7 @@ be used through `ert'.
(save-excursion
(beginning-of-line)
(skip-syntax-forward " ")
- (re-search-forward ert-font-lock--assertion-re
+ (re-search-forward ert-font-lock--assertion-line-re
(line-end-position) t 1)))
(defun ert-font-lock--goto-first-char ()
@@ -252,8 +269,8 @@ be used through `ert'.
(throw 'nextline t))
- ;; Collect the assertion
- (when (re-search-forward ert-font-lock--assertion-re
+ ;; Collect the first line assertion (caret or arrow)
+ (when (re-search-forward ert-font-lock--assertion-line-re
(line-end-position) t 1)
(unless (> linetocheck -1)
@@ -266,21 +283,38 @@ be used through `ert'.
(- (match-beginning 1) (line-beginning-position))
(ert-font-lock--get-first-char-column)))
;; negate the face?
- (negation (string-equal (match-string-no-properties 2) "!"))
+ (negation (string-equal (match-string-no-properties 3) "!"))
;; the face that is supposed to be in the position specified
- (face (match-string-no-properties 3)))
+ (face (read (match-string-no-properties 4))))
+ ;; Collect the first assertion on the line
(push (list :line-checked linetocheck
:line-assert curline
:column-checked column-checked
:face face
:negation negation)
- tests))))
+ tests)
+
+ ;; Collect all the other line carets (if present)
+ (goto-char (match-beginning 2))
+ (while (equal (following-char) ?^)
+ (setq column-checked (- (point) (line-beginning-position)))
+ (push (list :line-checked linetocheck
+ :line-assert curline
+ :column-checked column-checked
+ :face face
+ :negation negation)
+ tests)
+ (forward-char)
+ (skip-syntax-forward " ")))))
;; next line
(setq curline (1+ curline))
(forward-line 1))
+ (unless tests
+ (user-error "No test assertions found"))
+
(reverse tests)))
(defun ert-font-lock--point-at-line-and-column (line column)
@@ -307,21 +341,30 @@ The function is meant to be run from within an ERT test."
(let* ((line-checked (plist-get test :line-checked))
(line-assert (plist-get test :line-assert))
(column-checked (plist-get test :column-checked))
- (expected-face (intern (plist-get test :face)))
+ (expected-face (plist-get test :face))
(negation (plist-get test :negation))
(actual-face (get-text-property (ert-font-lock--point-at-line-and-column line-checked column-checked) 'face))
(line-str (ert-font-lock--get-line line-checked))
(line-assert-str (ert-font-lock--get-line line-assert)))
- (when (not (eq actual-face expected-face))
+ ;; normalize both expected and resulting face - these can be
+ ;; either symbols, nils or lists of symbols
+ (when (not (listp actual-face))
+ (setq actual-face (list actual-face)))
+ (when (not (listp expected-face))
+ (setq expected-face (list expected-face)))
+
+ ;; fail when lists are not 'equal and the assertion is *not negated*
+ (when (and (not negation) (not (equal actual-face expected-face)))
(ert-fail
(list (format "Expected face %S, got %S on line %d column %d"
expected-face actual-face line-checked column-checked)
:line line-str
:assert line-assert-str)))
- (when (and negation (eq actual-face expected-face))
+ ;; fail when lists are 'equal and the assertion is *negated*
+ (when (and negation (equal actual-face expected-face))
(ert-fail
(list (format "Did not expect face %S face on line %d, column %d"
actual-face line-checked column-checked)
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 05da0f1844e..cd60f9f457f 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -540,10 +540,10 @@ The same keyword arguments are supported as in
(when (and (featurep 'tramp) (getenv "EMACS_HYDRA_CI"))
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))
-;; If this defconst is used in a test file, `tramp' shall be loaded
+;; If this defvar is used in a test file, `tramp' shall be loaded
;; prior `ert-x'. There is no default value on w32 systems, which
;; could work out of the box.
-(defconst ert-remote-temporary-file-directory
+(defvar ert-remote-temporary-file-directory
(when (featurep 'tramp)
(cond
((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 353c1bd09d2..8ab57d2b238 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -278,14 +278,6 @@ DATA is displayed to the user and should state the reason for skipping."
(when ert--should-execution-observer
(funcall ert--should-execution-observer form-description)))
-;; See Bug#24402 for why this exists
-(defun ert--should-signal-hook (error-symbol data)
- "Stupid hack to stop `condition-case' from catching ert signals.
-It should only be stopped when ran from inside `ert--run-test-internal'."
- (when (and (not (symbolp debugger)) ; only run on anonymous debugger
- (memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error (cons error-symbol data))))
-
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
(and (symbolp thing)
@@ -324,8 +316,7 @@ It should only be stopped when ran from inside `ert--run-test-internal'."
(default-value (gensym "ert-form-evaluation-aborted-")))
`(let* ((,fn (function ,fn-name))
(,args (condition-case err
- (let ((signal-hook-function #'ert--should-signal-hook))
- (list ,@arg-forms))
+ (list ,@arg-forms)
(error (progn (setq ,fn #'signal)
(list (car err)
(cdr err)))))))
@@ -728,78 +719,68 @@ in front of the value of MESSAGE-FORM."
;; value and test execution should be terminated. Should not
;; return.
(exit-continuation (cl-assert nil))
- ;; The binding of `debugger' outside of the execution of the test.
- next-debugger
;; The binding of `ert-debug-on-error' that is in effect for the
;; execution of the current test. We store it to avoid being
;; affected by any new bindings the test itself may establish. (I
;; don't remember whether this feature is important.)
ert-debug-on-error)
-(defun ert--run-test-debugger (info args)
- "During a test run, `debugger' is bound to a closure that calls this function.
+(defun ert--run-test-debugger (info condition debugfun)
+ "Error handler used during the test run.
This function records failures and errors and either terminates
the test silently or calls the interactive debugger, as
appropriate.
-INFO is the ert--test-execution-info corresponding to this test
-run. ARGS are the arguments to `debugger'."
- (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args)
- args
- (cl-ecase first-debugger-arg
- ((lambda debug t exit nil)
- (apply (ert--test-execution-info-next-debugger info) args))
- (error
- (let* ((condition (car more-debugger-args))
- (type (cl-case (car condition)
- ((quit) 'quit)
- ((ert-test-skipped) 'skipped)
- (otherwise 'failed)))
- ;; We store the backtrace in the result object for
- ;; `ert-results-pop-to-backtrace-for-test-at-point'.
- ;; This means we have to limit `print-level' and
- ;; `print-length' when printing result objects. That
- ;; might not be worth while when we can also use
- ;; `ert-results-rerun-test-at-point-debugging-errors',
- ;; (i.e., when running interactively) but having the
- ;; backtrace ready for printing is important for batch
- ;; use.
- ;;
- ;; Grab the frames above the debugger.
- (backtrace (cdr (backtrace-get-frames debugger)))
- (infos (reverse ert--infos)))
- (setf (ert--test-execution-info-result info)
- (cl-ecase type
- (quit
- (make-ert-test-quit :condition condition
- :backtrace backtrace
- :infos infos))
- (skipped
- (make-ert-test-skipped :condition condition
- :backtrace backtrace
- :infos infos))
- (failed
- (make-ert-test-failed :condition condition
- :backtrace backtrace
- :infos infos))))
- ;; Work around Emacs's heuristic (in eval.c) for detecting
- ;; errors in the debugger.
- (cl-incf num-nonmacro-input-events)
- ;; FIXME: We should probably implement more fine-grained
- ;; control a la non-t `debug-on-error' here.
- (cond
- ((ert--test-execution-info-ert-debug-on-error info)
- (apply (ert--test-execution-info-next-debugger info) args))
- (t))
- (funcall (ert--test-execution-info-exit-continuation info)))))))
+INFO is the `ert--test-execution-info' corresponding to this test run.
+ERR is the error object."
+ (let* ((type (cl-case (car condition)
+ ((quit) 'quit)
+ ((ert-test-skipped) 'skipped)
+ (otherwise 'failed)))
+ ;; We store the backtrace in the result object for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+ ;; This means we have to limit `print-level' and
+ ;; `print-length' when printing result objects. That
+ ;; might not be worth while when we can also use
+ ;; `ert-results-rerun-test-at-point-debugging-errors',
+ ;; (i.e., when running interactively) but having the
+ ;; backtrace ready for printing is important for batch
+ ;; use.
+ ;;
+ ;; Grab the frames above ourselves.
+ (backtrace (cdr (backtrace-get-frames debugfun)))
+ (infos (reverse ert--infos)))
+ (setf (ert--test-execution-info-result info)
+ (cl-ecase type
+ (quit
+ (make-ert-test-quit :condition condition
+ :backtrace backtrace
+ :infos infos))
+ (skipped
+ (make-ert-test-skipped :condition condition
+ :backtrace backtrace
+ :infos infos))
+ (failed
+ (make-ert-test-failed :condition condition
+ :backtrace backtrace
+ :infos infos))))
+ ;; FIXME: We should probably implement more fine-grained
+ ;; control a la non-t `debug-on-error' here.
+ (cond
+ ((ert--test-execution-info-ert-debug-on-error info)
+ ;; The `debugfun' arg tells `debug' which backtrace frame starts
+ ;; the "entering the debugger" code so it can hide those frames
+ ;; from the backtrace.
+ (funcall debugger 'error condition :backtrace-base debugfun))
+ (t))
+ (funcall (ert--test-execution-info-exit-continuation info))))
(defun ert--run-test-internal (test-execution-info)
"Low-level function to run a test according to TEST-EXECUTION-INFO.
This mainly sets up debugger-related bindings."
- (setf (ert--test-execution-info-next-debugger test-execution-info) debugger
- (ert--test-execution-info-ert-debug-on-error test-execution-info)
+ (setf (ert--test-execution-info-ert-debug-on-error test-execution-info)
ert-debug-on-error)
(catch 'ert--pass
;; For now, each test gets its own temp buffer and its own
@@ -807,26 +788,14 @@ This mainly sets up debugger-related bindings."
;; too expensive, we can remove it.
(with-temp-buffer
(save-window-excursion
- ;; FIXME: Use `signal-hook-function' instead of `debugger' to
- ;; handle ert errors. Once that's done, remove
- ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for
- ;; details.
- (let ((lexical-binding t)
- (debugger (lambda (&rest args)
- (ert--run-test-debugger test-execution-info
- args)))
- (debug-on-error t)
- ;; Don't infloop if the error being called is erroring
- ;; out, and we have `debug-on-error' bound to nil inside
- ;; the test.
- (backtrace-on-error-noninteractive nil)
- (debug-on-quit t)
- ;; FIXME: Do we need to store the old binding of this
- ;; and consider it in `ert--run-test-debugger'?
- (debug-ignored-errors nil)
+ (let ((lexical-binding t) ;;FIXME: Why?
(ert--infos '()))
- (funcall (ert-test-body (ert--test-execution-info-test
- test-execution-info))))))
+ (letrec ((debugfun (lambda (err)
+ (ert--run-test-debugger test-execution-info
+ err debugfun))))
+ (handler-bind (((error quit) debugfun))
+ (funcall (ert-test-body (ert--test-execution-info-test
+ test-execution-info))))))))
(ert-pass))
(setf (ert--test-execution-info-result test-execution-info)
(make-ert-test-passed))
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 63f547ebeb8..411602ef166 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -60,6 +60,7 @@
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\
+transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\
menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
index a35a00ec1f3..f9591661688 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -164,7 +164,7 @@ If OBJECT is an icon, return the icon properties."
(defun icon-elements (name)
"Return the elements of icon NAME.
The elements are represented as a plist where the keys are
-`string', `face' and `display'. The `image' element is only
+`string', `face' and `image'. The `image' element is only
present if the icon is represented by an image."
(let ((string (icon-string name)))
(list 'face (get-text-property 0 'face string)
@@ -187,11 +187,13 @@ present if the icon is represented by an image."
merged)
(cl-defmethod icons--create ((_type (eql 'image)) icon keywords)
- (let ((file (if (file-name-absolute-p icon)
- icon
- (and (fboundp 'image-search-load-path)
- (image-search-load-path icon)))))
- (and (display-images-p)
+ (let* ((file (if (file-name-absolute-p icon)
+ icon
+ (and (fboundp 'image-search-load-path)
+ (image-search-load-path icon))))
+ (file-exists (and (stringp file) (file-readable-p file))))
+ (and file-exists
+ (display-images-p)
(fboundp 'image-supported-file-p)
(image-supported-file-p file)
(propertize
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index c774296084e..ddbd6fdc017 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -80,7 +80,9 @@
(error "inline-const-p can only be used within define-inline"))
(defmacro inline-const-val (_exp)
- "Return the value of EXP."
+ "Return the value of EXP.
+During inlining, if the value of EXP is not yet known, this aborts the
+inlining and makes us revert to a non-inlined function call."
(declare (debug t))
(error "inline-const-val can only be used within define-inline"))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1bb9c2fdc2e..3475d944337 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -343,7 +343,7 @@ This will generate compile-time constants from BINDINGS."
(lisp-vdefs '("defvar"))
(lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
"prog2" "lambda" "unwind-protect" "condition-case"
- "when" "unless" "with-output-to-string"
+ "when" "unless" "with-output-to-string" "handler-bind"
"ignore-errors" "dotimes" "dolist" "declare"))
(lisp-errs '("warn" "error" "signal"))
;; Elisp constructs. Now they are update dynamically
@@ -376,7 +376,7 @@ This will generate compile-time constants from BINDINGS."
(cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase"
"declaim" "destructuring-bind" "do" "do*"
"ecase" "etypecase" "eval-when" "flet" "flet*"
- "go" "handler-case" "handler-bind" "in-package" ;; "inline"
+ "go" "handler-case" "in-package" ;; "inline"
"labels" "letf" "locally" "loop"
"macrolet" "multiple-value-bind" "multiple-value-prog1"
"proclaim" "prog" "prog*" "progv"
@@ -1346,9 +1346,7 @@ Lisp function does not specify a special indentation."
(put 'catch 'lisp-indent-function 1)
(put 'condition-case 'lisp-indent-function 2)
(put 'handler-case 'lisp-indent-function 1) ;CL
-(put 'handler-bind 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
-(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
(put 'closure 'lisp-indent-function 2)
(defun indent-sexp (&optional endpos)
@@ -1421,14 +1419,15 @@ A prefix argument specifies pretty-printing."
;;;; Lisp paragraph filling commands.
-(defcustom emacs-lisp-docstring-fill-column 65
+(defcustom emacs-lisp-docstring-fill-column 72
"Value of `fill-column' to use when filling a docstring.
Any non-integer value means do not use a different value of
`fill-column' when filling docstrings."
:type '(choice (integer)
(const :tag "Use the current `fill-column'" t))
:safe (lambda (x) (or (eq x t) (integerp x)))
- :group 'lisp)
+ :group 'lisp
+ :version "30.1")
(defun lisp-fill-paragraph (&optional justify)
"Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 5f152d3b509..581053f6304 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -183,7 +183,9 @@ expression, in which case we want to handle forms differently."
(loaddefs-generate--shorten-autoload
`(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))))
- ((and expansion (memq car '(progn prog1)))
+ ;; Look inside `progn', and `eval-and-compile', since these
+ ;; are often used in the expansion of things like `pcase-defmacro'.
+ ((and expansion (memq car '(progn prog1 eval-and-compile)))
(let ((end (memq :autoload-end form)))
(when end ;Cut-off anything after the :autoload-end marker.
(setq form (copy-sequence form))
@@ -199,8 +201,7 @@ expression, in which case we want to handle forms differently."
define-globalized-minor-mode defun defmacro
easy-mmode-define-minor-mode define-minor-mode
define-inline cl-defun cl-defmacro cl-defgeneric
- cl-defstruct pcase-defmacro iter-defun cl-iter-defun
- transient-define-prefix))
+ cl-defstruct pcase-defmacro iter-defun cl-iter-defun))
(macrop car)
(setq expand (let ((load-true-file-name file)
(load-file-name file))
@@ -216,13 +217,17 @@ expression, in which case we want to handle forms differently."
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
cl-defun defun* cl-defmacro defmacro*
- define-overloadable-function))
+ define-overloadable-function
+ transient-define-prefix transient-define-suffix
+ transient-define-infix transient-define-argument))
(let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
(name (nth 1 form))
(args (pcase car
((or 'defun 'defmacro
'defun* 'defmacro* 'cl-defun 'cl-defmacro
- 'define-overloadable-function)
+ 'define-overloadable-function
+ 'transient-define-prefix 'transient-define-suffix
+ 'transient-define-infix 'transient-define-argument)
(nth 2 form))
('define-skeleton '(&optional str arg))
((or 'define-generic-mode 'define-derived-mode
@@ -244,7 +249,11 @@ expression, in which case we want to handle forms differently."
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
- define-minor-mode))
+ define-minor-mode
+ transient-define-prefix
+ transient-define-suffix
+ transient-define-infix
+ transient-define-argument))
t)
(and (eq (car-safe (car body)) 'interactive)
;; List of modes or just t.
@@ -378,6 +387,7 @@ don't include."
(let ((defs nil)
(load-name (loaddefs-generate--file-load-name file main-outfile))
(compute-prefixes t)
+ read-symbol-shorthands
local-outfile inhibit-autoloads)
(with-temp-buffer
(insert-file-contents file)
@@ -399,7 +409,22 @@ don't include."
(setq inhibit-autoloads (read (current-buffer)))))
(save-excursion
(when (re-search-forward "autoload-compute-prefixes: *" nil t)
- (setq compute-prefixes (read (current-buffer))))))
+ (setq compute-prefixes (read (current-buffer)))))
+ (save-excursion
+ ;; Since we're "open-coding", we have to repeat more
+ ;; complicated logic in `hack-local-variables'.
+ (when-let ((beg
+ (re-search-forward "read-symbol-shorthands: *" nil t)))
+ ;; `read-symbol-shorthands' alist ends with two parens.
+ (let* ((end (re-search-forward ")[;\n\s]*)"))
+ (commentless (replace-regexp-in-string
+ "\n\\s-*;+" ""
+ (buffer-substring beg end)))
+ (unsorted-shorthands (car (read-from-string commentless))))
+ (setq read-symbol-shorthands
+ (sort unsorted-shorthands
+ (lambda (sh1 sh2)
+ (> (length (car sh1)) (length (car sh2))))))))))
;; We always return the package version (even for pre-dumped
;; files).
@@ -473,27 +498,35 @@ don't include."
(when (and autoload-compute-prefixes
compute-prefixes)
- (when-let ((form (loaddefs-generate--compute-prefixes load-name)))
- ;; This output needs to always go in the main loaddefs.el,
- ;; regardless of `generated-autoload-file'.
- (push (list main-outfile file form) defs)))))
+ (with-demoted-errors "%S"
+ (when-let
+ ((form (loaddefs-generate--compute-prefixes load-name)))
+ ;; This output needs to always go in the main loaddefs.el,
+ ;; regardless of `generated-autoload-file'.
+ (push (list main-outfile file form) defs))))))
defs))
(defun loaddefs-generate--compute-prefixes (load-name)
(goto-char (point-min))
- (let ((prefs nil))
+ (let ((prefs nil)
+ (temp-obarray (obarray-make)))
;; Avoid (defvar <foo>) by requiring a trailing space.
(while (re-search-forward
"^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
- (let ((name (match-string-no-properties 2)))
- (when (save-excursion
- (goto-char (match-beginning 0))
- (or (bobp)
- (progn
- (forward-line -1)
- (not (looking-at ";;;###autoload")))))
- (push name prefs)))))
+ (let* ((name (match-string-no-properties 2))
+ ;; Consider `read-symbol-shorthands'.
+ (probe (let ((obarray temp-obarray))
+ (car (read-from-string name)))))
+ (when (symbolp probe)
+ (setq name (symbol-name probe))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ (or (bobp)
+ (progn
+ (forward-line -1)
+ (not (looking-at ";;;###autoload")))))
+ (push name prefs))))))
(loaddefs-generate--make-prefixes prefs load-name)))
(defun loaddefs-generate--rubric (file &optional type feature compile)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 0e4fd3ea521..b87b749dd76 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -42,14 +42,8 @@ condition-case handling a signaled error.")
(defmacro macroexp--with-extended-form-stack (expr &rest body)
"Evaluate BODY with EXPR pushed onto `byte-compile-form-stack'."
(declare (indent 1))
- ;; FIXME: We really should just be using a simple dynamic let-binding here,
- ;; but these explicit push and pop make the extended stack value visible
- ;; to error handlers. Remove that need for that!
- `(progn
- (push ,expr byte-compile-form-stack)
- (prog1
- (progn ,@body)
- (pop byte-compile-form-stack))))
+ `(let ((byte-compile-form-stack (cons ,expr byte-compile-form-stack)))
+ ,@body))
;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'.
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index ffbb29615da..d3d71a36ee4 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -608,18 +608,30 @@ This allows using default values for `map-elt', which can't be
done using `pcase--flip'.
KEY is the key sought in the map. DEFAULT is the default value."
+ ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA
+ ;; for earlier Emacsen.
+ (declare (obsolete _ "30.1"))
`(map-elt ,map ,key ,default))
(defun map--make-pcase-bindings (args)
"Return a list of pcase bindings from ARGS to the elements of a map."
- (mapcar (lambda (elt)
- (cond ((consp elt)
- `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
- ,(cadr elt)))
- ((keywordp elt)
- (let ((var (intern (substring (symbol-name elt) 1))))
- `(app (pcase--flip map-elt ,elt) ,var)))
- (t `(app (pcase--flip map-elt ',elt) ,elt))))
+ (mapcar (if (< emacs-major-version 30)
+ (lambda (elt)
+ (cond ((consp elt)
+ `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
+ ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (pcase--flip map-elt ,elt) ,var)))
+ (t `(app (pcase--flip map-elt ',elt) ,elt))))
+ (lambda (elt)
+ (cond ((consp elt)
+ `(app (map-elt _ ,(car elt) ,(caddr elt))
+ ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (map-elt _ ,elt) ,var)))
+ (t `(app (map-elt _ ',elt) ,elt)))))
args))
(defun map--make-pcase-patterns (args)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 0d45b4b95fa..5326c520601 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -189,7 +189,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
if
(cl-assert (eq 'interactive (car if)))
(let ((form (cadr if)))
- (if (macroexp-const-p form)
+ (if (macroexp-const-p form) ;Common case: a string.
if
;; The interactive is expected to be run in the static context
;; that the function captured.
@@ -539,6 +539,32 @@ Contrary to `remove-function', this also works when SYMBOL is a macro
or an autoload and it preserves `fboundp'.
Instead of the actual function to remove, FUNCTION can also be the `name'
of the piece of advice."
+ (interactive
+ (let* ((pred (lambda (sym) (advice--p (advice--symbol-function sym))))
+ (default (when-let* ((f (function-called-at-point))
+ ((funcall pred f)))
+ (symbol-name f)))
+ (prompt (format-prompt "Remove advice from function" default))
+ (symbol (intern (completing-read prompt obarray pred t nil nil default)))
+ advices)
+ (advice-mapc (lambda (f p)
+ (let ((k (or (alist-get 'name p) f)))
+ (push (cons
+ ;; "name" (string) and 'name (symbol) are
+ ;; considered different names so we use
+ ;; `prin1-to-string' even if the name is
+ ;; a string to distinguish between these
+ ;; two cases.
+ (prin1-to-string k)
+ ;; We use `k' here instead of `f' because
+ ;; the same advice can have multiple
+ ;; names.
+ k)
+ advices)))
+ symbol)
+ (list symbol (cdr (assoc-string
+ (completing-read "Advice to remove: " advices nil t)
+ advices)))))
(let ((f (symbol-function symbol)))
(remove-function (cond ;This is `advice--symbol-function' but as a "place".
((get symbol 'advice--pending)
@@ -559,8 +585,8 @@ of the piece of advice."
(defmacro define-advice (symbol args &rest body)
"Define an advice and add it to function named SYMBOL.
See `advice-add' and `add-function' for explanation on the
-arguments. Note if NAME is nil the advice is anonymous;
-otherwise it is named `SYMBOL@NAME'.
+arguments. If NAME is non-nil, the advice is named `SYMBOL@NAME'
+and installed with the name NAME; otherwise, the advice is anonymous.
\(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
(declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
@@ -571,7 +597,9 @@ otherwise it is named `SYMBOL@NAME'.
(lambda-list (nth 1 args))
(name (nth 2 args))
(depth (nth 3 args))
- (props (and depth `((depth . ,depth))))
+ (props (append
+ (and depth `((depth . ,depth)))
+ (and name `((name . ,name)))))
(advice (cond ((null name) `(lambda ,lambda-list ,@body))
((or (stringp name) (symbolp name))
(intern (format "%s@%s" symbol name)))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 26cd8594dfc..4da8e61aaa7 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -139,12 +139,15 @@
(:include cl--class)
(:copier nil))
"Metaclass for OClosure classes."
+ ;; The `allparents' slot is used for the predicate that checks if a given
+ ;; object is an OClosure of a particular type.
(allparents nil :read-only t :type (list-of symbol)))
(setf (cl--find-class 'oclosure)
(oclosure--class-make 'oclosure
- "The root parent of all OClosure classes"
- nil nil '(oclosure)))
+ "The root parent of all OClosure types"
+ nil (list (cl--find-class 'function))
+ '(oclosure)))
(defun oclosure--p (oclosure)
(not (not (oclosure-type oclosure))))
@@ -434,7 +437,7 @@ This has 2 uses:
- For compiled code, this is used as a marker which cconv uses to check that
immutable fields are indeed not mutated."
(if (byte-code-function-p oclosure)
- ;; Actually, this should never happen since the `cconv.el' should have
+ ;; Actually, this should never happen since `cconv.el' should have
;; optimized away the call to this function.
oclosure
;; For byte-coded functions, we store the type as a symbol in the docstring
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index db0cc515e46..ef056c7909b 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating
autoloads, generating a package description file (used to
identify a package as a VC package later on), building
documentation and marking the package as installed."
- (let ((pkg-spec (package-vc--desc->spec pkg-desc))
- missing)
+ (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
+ (lisp-dir (plist-get pkg-spec :lisp-dir))
+ (lisp-path (file-name-concat pkg-dir lisp-dir))
+ missing)
;; In case the package was installed directly from source, the
;; dependency list wasn't know beforehand, and they might have
@@ -519,7 +521,7 @@ documentation and marking the package as installed."
"\\|")
regexp-unmatchable))
(deps '()))
- (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (dolist (file (directory-files lisp-path t "\\.el\\'" t))
(unless (string-match-p ignored-files file)
(with-temp-buffer
(insert-file-contents file)
@@ -532,6 +534,7 @@ documentation and marking the package as installed."
(setq deps))))))
(dolist (dep deps)
(cl-callf version-to-list (cadr dep)))
+ (setf (package-desc-reqs pkg-desc) deps)
(setf missing (package-vc-install-dependencies (delete-dups deps)))
(setf missing (delq (assq (package-desc-name pkg-desc)
missing)
@@ -541,10 +544,8 @@ documentation and marking the package as installed."
(pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)))
;; Generate autoloads
(let* ((name (package-desc-name pkg-desc))
- (auto-name (format "%s-autoloads.el" name))
- (lisp-dir (plist-get pkg-spec :lisp-dir)))
- (package-generate-autoloads
- name (file-name-concat pkg-dir lisp-dir))
+ (auto-name (format "%s-autoloads.el" name)))
+ (package-generate-autoloads name lisp-path)
(when lisp-dir
(write-region
(with-temp-buffer
@@ -938,8 +939,8 @@ for the last released version of the package."
(interactive
(let* ((name (package-vc--read-package-name "Fetch package source: ")))
(list (cadr (assoc name package-archive-contents #'string=))
- (read-file-name "Clone into new or empty directory: " nil nil t nil
- (lambda (dir) (or (not (file-exists-p dir))
+ (read-directory-name "Clone into new or empty directory: " nil nil
+ (lambda (dir) (or (not (file-exists-p dir))
(directory-empty-p dir))))
(and current-prefix-arg :last-release))))
(package-vc--archives-initialize)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 80f746d7429..3428b2375d7 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2611,7 +2611,8 @@ This is meant to be used only in the case the byte-compiled files
are invalid due to changed byte-code, macros or the like."
(interactive)
(pcase-dolist (`(_ ,pkg-desc) package-alist)
- (package-recompile pkg-desc)))
+ (with-demoted-errors "Error while recompiling: %S"
+ (package-recompile pkg-desc))))
;;;###autoload
(defun package-autoremove ()
@@ -2805,8 +2806,7 @@ Helper function for `describe-package'."
(status (if desc (package-desc-status desc) "orphan"))
(incompatible-reason (package--incompatible-p desc))
(signed (if desc (package-desc-signed desc)))
- (maintainers (or (cdr (assoc :maintainers extras))
- (list (cdr (assoc :maintainer extras)))))
+ (maintainers (cdr (assoc :maintainer extras)))
(authors (cdr (assoc :authors extras)))
(news (and-let* (pkg-dir
((not built-in))
@@ -2942,7 +2942,7 @@ Helper function for `describe-package'."
(insert " "))
(insert "\n"))
(when maintainers
- (unless (proper-list-p maintainers)
+ (when (stringp (car maintainers))
(setq maintainers (list maintainers)))
(package--print-help-section
(if (cdr maintainers) "Maintainers" "Maintainer"))
@@ -4071,8 +4071,8 @@ invocations."
(defun package-menu--version-predicate (A B)
"Predicate to sort \"*Packages*\" buffer by the version column.
This is used for `tabulated-list-format' in `package-menu-mode'."
- (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0)))
- (vB (or (version-to-list (aref (cadr B) 1)) '(0))))
+ (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0)))
+ (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0))))
(if (version-list-= vA vB)
(package-menu--name-predicate A B)
(version-list-< vA vB))))
@@ -4700,18 +4700,23 @@ will be signaled in that case."
(let* ((name (package-desc-name pkg-desc))
(extras (package-desc-extras pkg-desc))
(maint (alist-get :maintainer extras)))
+ (unless (listp (cdr maint))
+ (setq maint (list maint)))
(cond
((and (null maint) (null no-error))
(user-error "Package `%s' has no explicit maintainer" name))
((and (not (progn
(require 'ietf-drums)
- (ietf-drums-parse-address (cdr maint))))
+ (ietf-drums-parse-address (cdar maint))))
(null no-error))
(user-error "Package `%s' has no maintainer address" name))
- ((not (null maint))
+ (t
(with-temp-buffer
- (package--print-email-button maint)
- (string-trim (substring-no-properties (buffer-string))))))))
+ (mapc #'package--print-email-button maint)
+ (replace-regexp-in-string
+ "\n" ", " (string-trim
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))))))
;;;###autoload
(defun package-report-bug (desc)
@@ -4721,17 +4726,19 @@ DESC must be a `package-desc' object."
package-menu-mode)
(let ((maint (package-maintainers desc))
(name (symbol-name (package-desc-name desc)))
+ (pkgdir (package-desc-dir desc))
vars)
- (dolist-with-progress-reporter (group custom-current-group-alist)
- "Scanning for modified user options..."
- (when (and (car group)
- (file-in-directory-p (car group) (package-desc-dir desc)))
- (dolist (ent (get (cdr group) 'custom-group))
- (when (and (custom-variable-p (car ent))
- (boundp (car ent))
- (not (eq (custom--standard-value (car ent))
- (default-toplevel-value (car ent)))))
- (push (car ent) vars)))))
+ (when pkgdir
+ (dolist-with-progress-reporter (group custom-current-group-alist)
+ "Scanning for modified user options..."
+ (when (and (car group)
+ (file-in-directory-p (car group) pkgdir))
+ (dolist (ent (get (cdr group) 'custom-group))
+ (when (and (custom-variable-p (car ent))
+ (boundp (car ent))
+ (not (eq (custom--standard-value (car ent))
+ (default-toplevel-value (car ent)))))
+ (push (car ent) vars))))))
(dlet ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report maint name vars))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 5ac4b289a80..23f1bac600c 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -42,6 +42,14 @@
;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
;; generate a lex-style DFA to decide whether to run E1 or E2.
+;; While the first version was written before I knew about Racket's `match'
+;; construct, the second version was significantly influenced by it,
+;; so a good presentation of the underlying ideas can be found at:
+;;
+;; Extensible Pattern Matching in an Extensible Language
+;; Sam Tobin-Hochstadt, 2010
+;; https://arxiv.org/abs/1106.2578
+
;;; Code:
(require 'macroexp)
@@ -123,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms:
call it with one argument
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
+ (F ARG1 .. _ .. ARGn)
+ call F, passing EXPVAL at the _ position.
FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
@@ -155,8 +165,12 @@ Emacs Lisp manual for more information and examples."
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
-(declare-function help-fns--signature "help-fns"
- (function doc real-def real-function buffer))
+(defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(")
+
+(with-eval-after-load 'find-func
+ (defvar find-function-regexp-alist)
+ (add-to-list 'find-function-regexp-alist
+ `(pcase-macro . pcase--find-macro-def-regexp)))
;; FIXME: Obviously, this will collide with nadvice's use of
;; function-documentation if we happen to advise `pcase'.
@@ -166,9 +180,10 @@ Emacs Lisp manual for more information and examples."
(defun pcase--make-docstring ()
(let* ((main (documentation (symbol-function 'pcase) 'raw))
(ud (help-split-fundoc main 'pcase)))
- ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
- ;; where cl-lib is anything using pcase-defmacro.
(require 'help-fns)
+ (declare-function help-fns-short-filename "help-fns" (filename))
+ (declare-function help-fns--signature "help-fns"
+ (function doc real-def real-function buffer))
(with-temp-buffer
(insert (or (cdr ud) main))
;; Presentation Note: For conceptual continuity, we guarantee
@@ -189,11 +204,20 @@ Emacs Lisp manual for more information and examples."
(let* ((pair (pop more))
(symbol (car pair))
(me (cdr pair))
- (doc (documentation me 'raw)))
+ (doc (documentation me 'raw))
+ (filename (find-lisp-object-file-name me 'defun)))
(insert "\n\n-- ")
(setq doc (help-fns--signature symbol doc me
(indirect-function me)
nil))
+ (when filename
+ (save-excursion
+ (forward-char -1)
+ (insert (format-message " in `"))
+ (help-insert-xref-button (help-fns-short-filename filename)
+ 'help-function-def symbol filename
+ 'pcase-macro)
+ (insert (format-message "'."))))
(insert "\n" (or doc "Not documented.")))))
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
@@ -261,8 +285,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the
EXP in each binding in BINDINGS can use the results of the destructuring
bindings that precede it in BINDINGS' order.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil."
(declare (indent 1)
(debug ((&rest (pcase-PAT &optional form)) body)))
@@ -283,8 +307,8 @@ All EXPs are evaluated first, and then used to perform destructuring
bindings by matching each EXP against its respective PATTERN. Then
BODY is evaluated with those bindings in effect.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil."
(declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
@@ -599,62 +623,84 @@ recording whether the var has been referenced by earlier parts of the match."
(defun pcase--and (match matches)
(if matches `(and ,match ,@matches) match))
-(defconst pcase-mutually-exclusive-predicates
- '((symbolp . integerp)
- (symbolp . numberp)
- (symbolp . consp)
- (symbolp . arrayp)
- (symbolp . vectorp)
- (symbolp . stringp)
- (symbolp . byte-code-function-p)
- (symbolp . compiled-function-p)
- (symbolp . recordp)
- (null . integerp)
- (null . numberp)
- (null . numberp)
- (null . consp)
- (null . arrayp)
- (null . vectorp)
- (null . stringp)
- (null . byte-code-function-p)
- (null . compiled-function-p)
- (null . recordp)
- (integerp . consp)
- (integerp . arrayp)
- (integerp . vectorp)
- (integerp . stringp)
- (integerp . byte-code-function-p)
- (integerp . compiled-function-p)
- (integerp . recordp)
- (numberp . consp)
- (numberp . arrayp)
- (numberp . vectorp)
- (numberp . stringp)
- (numberp . byte-code-function-p)
- (numberp . compiled-function-p)
- (numberp . recordp)
- (consp . arrayp)
- (consp . atom)
- (consp . vectorp)
- (consp . stringp)
- (consp . byte-code-function-p)
- (consp . compiled-function-p)
- (consp . recordp)
- (arrayp . byte-code-function-p)
- (arrayp . compiled-function-p)
- (vectorp . byte-code-function-p)
- (vectorp . compiled-function-p)
- (vectorp . recordp)
- (stringp . vectorp)
- (stringp . recordp)
- (stringp . byte-code-function-p)
- (stringp . compiled-function-p)))
-
+(defun pcase--subtype-bitsets ()
+ (let ((built-in-types ()))
+ (mapatoms (lambda (sym)
+ (let ((class (get sym 'cl--class)))
+ (when (and (built-in-class-p class)
+ (get sym 'cl-deftype-satisfies))
+ (push (list sym
+ (get sym 'cl-deftype-satisfies)
+ (cl--class-allparents class))
+ built-in-types)))))
+ ;; The "true" predicate for `function' type is `cl-functionp'.
+ (setcar (nthcdr 1 (assq 'function built-in-types)) 'cl-functionp)
+ ;; Sort the types from deepest in the hierarchy so all children
+ ;; are processed before their parent. It also gives lowest
+ ;; numbers to those types that are subtypes of the largest number
+ ;; of types, which minimize the need to use bignums.
+ (setq built-in-types (sort built-in-types
+ (lambda (x y)
+ (> (length (nth 2 x)) (length (nth 2 y))))))
+
+ (let ((bitsets (make-hash-table))
+ (i 1))
+ (dolist (x built-in-types)
+ ;; Don't dedicate any bit to those predicates which already
+ ;; have a bitset, since it means they're already represented
+ ;; by their subtypes.
+ (unless (and (nth 1 x) (gethash (nth 1 x) bitsets))
+ (dolist (parent (nth 2 x))
+ (let ((pred (nth 1 (assq parent built-in-types))))
+ (unless (or (eq parent t) (null pred))
+ (puthash pred (+ i (gethash pred bitsets 0))
+ bitsets))))
+ (setq i (+ i i))))
+
+ ;; Extra predicates that don't have matching types.
+ (dolist (pred-types '((functionp cl-functionp consp symbolp)
+ (keywordp symbolp)
+ (characterp fixnump)
+ (natnump integerp)
+ (facep symbolp stringp)
+ (plistp listp)
+ (cl-struct-p recordp)
+ ;; ;; FIXME: These aren't quite in the same
+ ;; ;; category since they'll signal errors.
+ (fboundp symbolp)
+ ))
+ (puthash (car pred-types)
+ (apply #'logior
+ (mapcar (lambda (pred)
+ (gethash pred bitsets))
+ (cdr pred-types)))
+ bitsets))
+ bitsets)))
+
+(defconst pcase--subtype-bitsets
+ (if (fboundp 'built-in-class-p)
+ (pcase--subtype-bitsets)
+ ;; Early bootstrap: we don't have the built-in classes yet, so just
+ ;; use an empty table for now.
+ (prog1 (make-hash-table)
+ ;; The empty table leads to significantly worse code, so upgrade
+ ;; to the real table as soon as possible (most importantly: before we
+ ;; start compiling code, and hence baking the result into files).
+ (with-eval-after-load 'cl-preloaded
+ (defconst pcase--subtype-bitsets (pcase--subtype-bitsets)))))
+ "Hash table mapping type predicates to their sets of types.
+The table maps each type predicate, such as `numberp' and `stringp',
+to the set of built-in types for which the predicate may return non-nil.
+The sets are represented as bitsets (integers) where each bit represents
+a specific leaf type. Which bit represents which type is unspecified.")
+
+;; Extra predicates
(defun pcase--mutually-exclusive-p (pred1 pred2)
- (or (member (cons pred1 pred2)
- pcase-mutually-exclusive-predicates)
- (member (cons pred2 pred1)
- pcase-mutually-exclusive-predicates)))
+ (let ((subtypes1 (gethash pred1 pcase--subtype-bitsets)))
+ (when subtypes1
+ (let ((subtypes2 (gethash pred2 pcase--subtype-bitsets)))
+ (when subtypes2
+ (zerop (logand subtypes1 subtypes2)))))))
(defun pcase--split-match (sym splitter match)
(cond
@@ -790,12 +836,13 @@ A and B can be one of:
((vectorp (cadr pat)) #'vectorp)
((compiled-function-p (cadr pat))
#'compiled-function-p))))
- (pcase--mutually-exclusive-p (cadr upat) otherpred))
+ (and otherpred
+ (pcase--mutually-exclusive-p (cadr upat) otherpred)))
'(:pcase--fail . nil))
- ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
+ ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c)))
;; try and preserve the info we get from that memq test.
- ((and (eq 'pcase--flip (car-safe (cadr upat)))
- (memq (cadr (cadr upat)) '(memq member memql))
+ ((and (memq (car-safe (cadr upat)) '(memq member memql))
+ (eq (cadr (cadr upat)) '_)
(eq 'quote (car-safe (nth 2 (cadr upat))))
(eq 'quote (car-safe pat)))
(let ((set (cadr (nth 2 (cadr upat)))))
@@ -843,7 +890,7 @@ A and B can be one of:
(defmacro pcase--flip (fun arg1 arg2)
"Helper function, used internally to avoid (funcall (lambda ...) ...)."
- (declare (debug (sexp body)))
+ (declare (debug (sexp body)) (obsolete _ "30.1"))
`(,fun ,arg2 ,arg1))
(defun pcase--funcall (fun arg vars)
@@ -864,9 +911,13 @@ A and B can be one of:
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
- (if (or (functionp fun) (not (consp fun)))
- `(funcall #',fun ,arg)
- `(,@fun ,arg)))))
+ (cond
+ ((or (functionp fun) (not (consp fun)))
+ `(funcall #',fun ,arg))
+ ((memq '_ fun)
+ (mapcar (lambda (x) (if (eq '_ x) arg x)) fun))
+ (t
+ `(,@fun ,arg))))))
(if (null env)
call
;; Let's not replace `vars' in `fun' since it's
@@ -927,7 +978,7 @@ Otherwise, it defers to REST which is a list of branches of the form
;; Yes, we can use `memql' (or `member')!
((> (length simples) 1)
(pcase--u1 (cons `(match ,var
- . (pred (pcase--flip ,mem-fun ',simples)))
+ . (pred (,mem-fun _ ',simples)))
(cdr matches))
code vars
(if (null others) rest
@@ -1074,12 +1125,13 @@ The predicate is the logical-AND of:
(declare (debug (pcase-QPAT)))
(cond
((eq (car-safe qpat) '\,) (cadr qpat))
+ ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat))
((vectorp qpat)
`(and (pred vectorp)
(app length ,(length qpat))
,@(let ((upats nil))
(dotimes (i (length qpat))
- (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i)))
+ (push `(app (aref _ ,i) ,(list '\` (aref qpat i)))
upats))
(nreverse upats))))
((consp qpat)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 1d722051406..d586fc59939 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point."
(interactive "r")
(if (null end) (pp--object beg #'pp-fill)
(goto-char beg)
- (let ((end (copy-marker end t))
- (newline (lambda ()
- (skip-chars-forward ")]}")
- (unless (save-excursion (skip-chars-forward " \t") (eolp))
- (insert "\n")
- (indent-according-to-mode)))))
+ (let* ((end (copy-marker end t))
+ (avoid-unbreakable
+ (lambda ()
+ (and (memq (char-before) '(?# ?s ?f))
+ (memq (char-after) '(?\[ ?\())
+ (looking-back "#[sf]?" (- (point) 2))
+ (goto-char (match-beginning 0)))))
+ (newline (lambda ()
+ (skip-chars-forward ")]}")
+ (unless (save-excursion (skip-chars-forward " \t") (eolp))
+ (funcall avoid-unbreakable)
+ (insert "\n")
+ (indent-according-to-mode)))))
(while (progn (forward-comment (point-max))
(< (point) end))
(let ((beg (point))
@@ -193,11 +200,18 @@ it inserts and pretty-prints that arg at point."
(and
(save-excursion
(goto-char beg)
- (if (save-excursion (skip-chars-backward " \t({[',")
- (bolp))
- ;; The sexp was already on its own line.
- nil
- (skip-chars-backward " \t")
+ ;; We skip backward over open parens because cutting
+ ;; the line right after an open paren does not help
+ ;; reduce the indentation depth.
+ ;; Similarly, we prefer to cut before a "." than after
+ ;; it because it reduces the indentation depth.
+ (while
+ (progn
+ (funcall avoid-unbreakable)
+ (not (zerop (skip-chars-backward " \t({[',.")))))
+ (if (bolp)
+ ;; The sexp already starts on its own line.
+ (progn (goto-char beg) nil)
(setq beg (copy-marker beg t))
(if paired (setq paired (copy-marker paired t)))
;; We could try to undo this insertion if it
@@ -346,6 +360,23 @@ after OUT-BUFFER-NAME."
(setq buffer-read-only nil)
(setq-local font-lock-verbose nil)))))
+(defun pp-insert-short-sexp (sexp &optional width)
+ "Insert a short description of SEXP in the current buffer.
+WIDTH is the maximum width to use for it and it defaults to the
+space available between point and the window margin."
+ (let ((printed (format "%S" sexp)))
+ (if (and (not (string-search "\n" printed))
+ (<= (string-width printed)
+ (or width (- (window-width) (current-column)))))
+ (insert printed)
+ (insert-text-button
+ "[Show]"
+ 'follow-link t
+ 'action (lambda (&rest _ignore)
+ ;; FIXME: Why "eval output"?
+ (pp-display-expression sexp "*Pp Eval Output*"))
+ 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
+
;;;###autoload
(defun pp-eval-expression (expression)
"Evaluate EXPRESSION and pretty-print its value.
@@ -430,23 +461,33 @@ the bounds of a region containing Lisp code to pretty-print."
(replace-match ""))
(insert-into-buffer obuf)))))
+(defvar pp--quoting-syntaxes
+ `((quote . "'")
+ (function . "#'")
+ (,backquote-backquote-symbol . "`")
+ (,backquote-unquote-symbol . ",")
+ (,backquote-splice-symbol . ",@")))
+
+(defun pp--quoted-or-unquoted-form-p (cons)
+ ;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X
+ (let ((head (car cons)))
+ (and (symbolp head)
+ (assq head pp--quoting-syntaxes)
+ (let ((rest (cdr cons)))
+ (and (consp rest) (null (cdr rest)))))))
+
(defun pp--insert-lisp (sexp)
(cl-case (type-of sexp)
(vector (pp--format-vector sexp))
(cons (cond
((consp (cdr sexp))
- (if (and (length= sexp 2)
- (memq (car sexp) '(quote function)))
- (cond
- ((symbolp (cadr sexp))
- (let ((print-quoted t))
- (prin1 sexp (current-buffer))))
- ((consp (cadr sexp))
- (insert (if (eq (car sexp) 'quote)
- "'" "#'"))
- (pp--format-list (cadr sexp)
- (set-marker (make-marker) (1- (point))))))
- (pp--format-list sexp)))
+ (let ((head (car sexp)))
+ (if-let (((null (cddr sexp)))
+ (syntax-entry (assq head pp--quoting-syntaxes)))
+ (progn
+ (insert (cdr syntax-entry))
+ (pp--insert-lisp (cadr sexp)))
+ (pp--format-list sexp))))
(t
(prin1 sexp (current-buffer)))))
;; Print some of the smaller integers as characters, perhaps?
@@ -458,6 +499,8 @@ the bounds of a region containing Lisp code to pretty-print."
(string
(let ((print-escape-newlines t))
(prin1 sexp (current-buffer))))
+ (symbol
+ (prin1 sexp (current-buffer)))
(otherwise (princ sexp (current-buffer)))))
(defun pp--format-vector (sexp)
@@ -468,15 +511,29 @@ the bounds of a region containing Lisp code to pretty-print."
(insert "]"))
(defun pp--format-list (sexp &optional start)
- (if (and (symbolp (car sexp))
- (not pp--inhibit-function-formatting)
- (not (keywordp (car sexp))))
+ (if (not (let ((head (car sexp)))
+ (or pp--inhibit-function-formatting
+ (not (symbolp head))
+ (keywordp head)
+ (let ((l sexp))
+ (catch 'not-funcall
+ (while l
+ (when (or
+ (atom l) ; SEXP is a dotted list
+ ;; Does SEXP have a form like (ELT... . ,X) ?
+ (pp--quoted-or-unquoted-form-p l))
+ (throw 'not-funcall t))
+ (setq l (cdr l)))
+ nil)))))
(pp--format-function sexp)
(insert "(")
(pp--insert start (pop sexp))
(while sexp
(if (consp sexp)
- (pp--insert " " (pop sexp))
+ (if (not (pp--quoted-or-unquoted-form-p sexp))
+ (pp--insert " " (pop sexp))
+ (pp--insert " . " sexp)
+ (setq sexp nil))
(pp--insert " . " sexp)
(setq sexp nil)))
(insert ")")))
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 0a47cca0231..c5307f70d08 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -825,7 +825,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(defun reb-restart-font-lock ()
"Restart `font-lock-mode' to fit current regexp format."
- (with-current-buffer (get-buffer reb-buffer)
+ (with-current-buffer reb-buffer
(let ((font-lock-is-on font-lock-mode))
(font-lock-mode -1)
(kill-local-variable 'font-lock-set-defaults)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4c6553972c2..a20cff16982 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -362,8 +362,7 @@ 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))
+ (if (listp sequence) 'list (type-of sequence))
(seq-subseq sequence 0 n)
(seq-subseq sequence (1+ n))))
@@ -619,12 +618,12 @@ SEQUENCE must be a sequence of numbers or markers."
(unless rest-marker
(pcase name
(`&rest
- (progn (push `(app (pcase--flip seq-drop ,index)
+ (progn (push `(app (seq-drop _ ,index)
,(seq--elt-safe args (1+ index)))
bindings)
(setq rest-marker t)))
(_
- (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+ (push `(app (seq--elt-safe _ ,index) ,name) bindings))))
(setq index (1+ index)))
bindings))
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 17cbf6b2d31..a1e49b50510 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -51,6 +51,17 @@
"Face used for a section.")
;;;###autoload
+(defun shortdoc--check (group functions)
+ (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval*
+ :result :result-string :eg-result :eg-result-string :doc)))
+ (dolist (f functions)
+ (when (consp f)
+ (dolist (x f)
+ (when (and (keywordp x) (not (memq x keywords)))
+ (error "Shortdoc %s function `%s': bad keyword `%s'"
+ group (car f) x)))))))
+
+;;;###autoload
(progn
(defvar shortdoc--groups nil)
@@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
`:no-eval*', `:result', `:result-string', `:eg-result' and
`:eg-result-string' properties."
(declare (indent defun))
+ (shortdoc--check group functions)
`(progn
(setq shortdoc--groups (delq (assq ',group shortdoc--groups)
shortdoc--groups))
@@ -572,10 +584,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
:result-string "#s(hash-table ...)")
(hash-table-count
:no-eval (hash-table-count table)
- :eg-result 15)
- (hash-table-size
- :no-eval (hash-table-size table)
- :eg-result 65))
+ :eg-result 15))
(define-short-documentation-group list
"Making Lists"
@@ -718,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
:eval (plist-get '(a 1 b 2 c 3) 'b))
(plist-put
:no-eval (setq plist (plist-put plist 'd 4))
- :eq-result (a 1 b 2 c 3 d 4))
+ :eg-result (a 1 b 2 c 3 d 4))
(plist-member
:eval (plist-member '(a 1 b 2 c 3) 'b))
"Data About Lists"
@@ -738,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
(intern
:eval (intern "abc"))
(intern-soft
+ :eval (intern-soft "list")
:eval (intern-soft "Phooey!"))
(make-symbol
:eval (make-symbol "abc"))
+ (gensym
+ :no-eval (gensym)
+ :eg-result g37)
"Comparing symbols"
(eq
:eval (eq 'abc 'abc)
@@ -751,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
:eval (equal 'abc 'abc))
"Name"
(symbol-name
- :eval (symbol-name 'abc)))
+ :eval (symbol-name 'abc))
+ "Obarrays"
+ (obarray-make
+ :eval (obarray-make))
+ (obarrayp
+ :eval (obarrayp (obarray-make))
+ :eval (obarrayp nil))
+ (unintern
+ :no-eval (unintern "abc" my-obarray)
+ :eg-result t)
+ (mapatoms
+ :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray))
+ (obarray-clear
+ :no-eval (obarray-clear my-obarray)))
(define-short-documentation-group comparison
"General-purpose"
@@ -1755,7 +1781,7 @@ With prefix numeric argument ARG, do it that many times."
(interactive)
(save-excursion
(goto-char (pos-bol))
- (when-let* ((re (rx bol "(" (group (+ (not (in " "))))))
+ (when-let* ((re (rx bol "(" (group (+ (not (in " )"))))))
(string
(and (or (looking-at re)
(re-search-backward re nil t))
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index 6348aaccf93..379fb0baec9 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -52,38 +52,26 @@
:version "28.1"
:group 'font-lock-faces)
-(defun shorthands--mismatch-from-end (str1 str2)
- "Tell index of first mismatch in STR1 and STR2, from end.
-The index is a valid 0-based index on STR1. Returns nil if STR1
-equals STR2. Return 0 if STR1 is a suffix of STR2."
- (cl-loop with l1 = (length str1) with l2 = (length str2)
- for i from 1
- for i1 = (- l1 i) for i2 = (- l2 i)
- while (eq (aref str1 i1) (aref str2 i2))
- if (zerop i2) return (if (zerop i1) nil i1)
- if (zerop i1) return 0
- finally (return i1)))
-
(defun shorthands-font-lock-shorthands (limit)
+ "Font lock until LIMIT considering `read-symbol-shorthands'."
(when read-symbol-shorthands
(while (re-search-forward
(concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>")
limit t)
(let* ((existing (get-text-property (match-beginning 1) 'face))
+ (print-name (match-string 1))
(probe (and (not (memq existing '(font-lock-comment-face
font-lock-string-face)))
- (intern-soft (match-string 1))))
- (sname (and probe (symbol-name probe)))
- (mismatch (and sname (shorthands--mismatch-from-end
- (match-string 1) sname)))
- (guess (and mismatch (1+ mismatch))))
- (when guess
- (when (and (< guess (1- (length (match-string 1))))
- ;; In bug#67390 we allow other separators
- (eq (char-syntax (aref (match-string 1) guess)) ?_))
- (setq guess (1+ guess)))
+ (intern-soft print-name)))
+ (symbol-name (and probe (symbol-name probe)))
+ (prefix (and symbol-name
+ (not (string-equal print-name symbol-name))
+ (car (assoc print-name
+ read-symbol-shorthands
+ #'string-prefix-p)))))
+ (when prefix
(add-face-text-property (match-beginning 1)
- (+ (match-beginning 1) guess)
+ (+ (match-beginning 1) (length prefix))
'elisp-shorthand-font-lock-face))))))
(font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 9884a2fc24b..c86e3f9c5df 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -139,6 +139,21 @@ If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(put 'tabulated-list-entries 'permanent-local t)
+(defvar-local tabulated-list-groups nil
+ "Groups displayed in the current Tabulated List buffer.
+This should be either a function, or a list.
+If a list, each element has the form (GROUP-NAME ENTRIES),
+where:
+
+ - GROUP-NAME is a group name as a string, which is displayed
+ at the top line of each group.
+
+ - ENTRIES is a list described in `tabulated-list-entries'.
+
+If `tabulated-list-groups' is a function, it is called with no
+arguments and must return a list of the above form.")
+(put 'tabulated-list-groups 'permanent-local t)
+
(defvar-local tabulated-list-padding 0
"Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
@@ -362,15 +377,17 @@ Do nothing if `tabulated-list--header-string' is nil."
(if tabulated-list--header-overlay
(move-overlay tabulated-list--header-overlay (point-min) (point))
(setq-local tabulated-list--header-overlay
- (make-overlay (point-min) (point))))
- (overlay-put tabulated-list--header-overlay
- 'face 'tabulated-list-fake-header))))
+ (make-overlay (point-min) (point)))
+ (overlay-put tabulated-list--header-overlay 'fake-header t)
+ (overlay-put tabulated-list--header-overlay
+ 'face 'tabulated-list-fake-header)))))
(defsubst tabulated-list-header-overlay-p (&optional pos)
"Return non-nil if there is a fake header.
Optional arg POS is a buffer position where to look for a fake header;
defaults to `point-min'."
- (overlays-at (or pos (point-min))))
+ (seq-find (lambda (o) (overlay-get o 'fake-header))
+ (overlays-at (or pos (point-min)))))
(defun tabulated-list-revert (&rest _ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
@@ -427,6 +444,9 @@ This sorts the `tabulated-list-entries' list if sorting is
specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
+If `tabulated-list-groups' is non-nil, each group of entries
+is printed and sorted separately.
+
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line.
@@ -437,6 +457,9 @@ be removed from entries that haven't changed (see
`tabulated-list-put-tag'). Don't use this immediately after
changing `tabulated-list-sort-key'."
(let ((inhibit-read-only t)
+ (groups (if (functionp tabulated-list-groups)
+ (funcall tabulated-list-groups)
+ tabulated-list-groups))
(entries (if (functionp tabulated-list-entries)
(funcall tabulated-list-entries)
tabulated-list-entries))
@@ -447,7 +470,14 @@ changing `tabulated-list-sort-key'."
(setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when sorter
- (setq entries (sort entries sorter)))
+ (if groups
+ (setq groups
+ (mapcar (lambda (group)
+ (cons (car group) (sort (cdr group) sorter)))
+ groups))
+ (setq entries (sort entries sorter))))
+ (unless (functionp tabulated-list-groups)
+ (setq tabulated-list-groups groups))
(unless (functionp tabulated-list-entries)
(setq tabulated-list-entries entries))
;; Without a sorter, we have no way to just update.
@@ -459,6 +489,25 @@ changing `tabulated-list-sort-key'."
(unless tabulated-list-use-header-line
(tabulated-list-print-fake-header)))
;; Finally, print the resulting list.
+ (if groups
+ (dolist (group groups)
+ (insert (car group) ?\n)
+ (when-let ((saved-pt-new (tabulated-list-print-entries
+ (cdr group) sorter update entry-id)))
+ (setq saved-pt saved-pt-new)))
+ (setq saved-pt (tabulated-list-print-entries
+ entries sorter update entry-id)))
+ (when update
+ (delete-region (point) (point-max)))
+ (set-buffer-modified-p nil)
+ ;; If REMEMBER-POS was specified, move to the "old" location.
+ (if saved-pt
+ (progn (goto-char saved-pt)
+ (move-to-column saved-col))
+ (goto-char (point-min)))))
+
+(defun tabulated-list-print-entries (entries sorter update entry-id)
+ (let (saved-pt)
(while entries
(let* ((elt (car entries))
(tabulated-list--near-rows
@@ -495,14 +544,7 @@ changing `tabulated-list-sort-key'."
(forward-line 1)
(delete-region old (point))))))
(setq entries (cdr entries)))
- (when update
- (delete-region (point) (point-max)))
- (set-buffer-modified-p nil)
- ;; If REMEMBER-POS was specified, move to the "old" location.
- (if saved-pt
- (progn (goto-char saved-pt)
- (move-to-column saved-col))
- (goto-char (point-min)))))
+ saved-pt))
(defun tabulated-list-print-entry (id cols)
"Insert a Tabulated List entry at point.
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 2c8b913ec33..1ed1528c6d5 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -156,44 +156,43 @@
(defun trace-values (&rest values)
"Helper function to get internal values.
You can call this function to add internal values in the trace buffer."
- (unless inhibit-trace
- (with-current-buffer (get-buffer-create trace-buffer)
- (goto-char (point-max))
- (insert
- (trace-entry-message
- 'trace-values trace-level values "")))))
+ (trace--entry-message
+ 'trace-values trace-level values (lambda () "")))
-(defun trace-entry-message (function level args context)
+(defun trace--entry-message (function level args context)
"Generate a string that describes that FUNCTION has been entered.
-LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
-and CONTEXT is a string describing the dynamic context (e.g. values of
-some global variables)."
- (let ((print-circle t)
- (print-escape-newlines t))
- (format "%s%s%d -> %s%s\n"
- (mapconcat #'char-to-string (make-string (max 0 (1- level)) ?|) " ")
- (if (> level 1) " " "")
- level
- ;; FIXME: Make it so we can click the function name to jump to its
- ;; definition and/or untrace it.
- (cl-prin1-to-string (cons function args))
- context)))
-
-(defun trace-exit-message (function level value context)
+LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION."
+ (unless inhibit-trace
+ (trace--insert
+ (let ((ctx (funcall context))
+ (print-circle t)
+ (print-escape-newlines t))
+ (format "%s%s%d -> %s%s\n"
+ (mapconcat #'char-to-string
+ (make-string (max 0 (1- level)) ?|) " ")
+ (if (> level 1) " " "")
+ level
+ ;; FIXME: Make it so we can click the function name to
+ ;; jump to its definition and/or untrace it.
+ (cl-prin1-to-string (cons function args))
+ ctx)))))
+
+(defun trace--exit-message (function level value context)
"Generate a string that describes that FUNCTION has exited.
-LEVEL is the trace level, VALUE value returned by FUNCTION,
-and CONTEXT is a string describing the dynamic context (e.g. values of
-some global variables)."
- (let ((print-circle t)
- (print-escape-newlines t))
- (format "%s%s%d <- %s: %s%s\n"
- (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
- (if (> level 1) " " "")
- level
- function
- ;; Do this so we'll see strings:
- (cl-prin1-to-string value)
- context)))
+LEVEL is the trace level, VALUE value returned by FUNCTION."
+ (unless inhibit-trace
+ (trace--insert
+ (let ((ctx (funcall context))
+ (print-circle t)
+ (print-escape-newlines t))
+ (format "%s%s%d <- %s: %s%s\n"
+ (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+ (if (> level 1) " " "")
+ level
+ function
+ ;; Do this so we'll see strings:
+ (cl-prin1-to-string value)
+ ctx)))))
(defvar trace--timer nil)
@@ -208,43 +207,40 @@ some global variables)."
(setq trace--timer nil)
(display-buffer buf nil 0))))))
+(defun trace--insert (msg)
+ (if noninteractive
+ (message "%s" (if (eq ?\n (aref msg (1- (length msg))))
+ (substring msg 0 -1) msg))
+ (with-current-buffer trace-buffer
+ (setq-local window-point-insertion-type t)
+ (goto-char (point-max))
+ (let ((deactivate-mark nil)) ;Protect deactivate-mark.
+ (insert msg)))))
(defun trace-make-advice (function buffer background context)
"Build the piece of advice to be added to trace FUNCTION.
FUNCTION is the name of the traced function.
BUFFER is the buffer where the trace should be printed.
BACKGROUND if nil means to display BUFFER.
-CONTEXT if non-nil should be a function that returns extra info that should
-be printed along with the arguments in the trace."
+CONTEXT should be a function that returns extra text that should
+be printed after the arguments in the trace."
(lambda (body &rest args)
(let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create buffer))
- (deactivate-mark nil) ;Protect deactivate-mark.
- (ctx (funcall context)))
+ (trace-buffer (get-buffer-create buffer)))
+ ;; Insert a separator from previous trace output:
(unless inhibit-trace
- (with-current-buffer trace-buffer
- (setq-local window-point-insertion-type t)
- (unless background (trace--display-buffer trace-buffer))
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- function trace-level args ctx))))
+ (unless background (trace--display-buffer trace-buffer))
+ (if (= trace-level 1) (trace--insert trace-separator)))
+ (trace--entry-message
+ function trace-level args context)
(let ((result))
(unwind-protect
(setq result (list (apply body args)))
- (unless inhibit-trace
- (let ((ctx (funcall context)))
- (with-current-buffer trace-buffer
- (unless background (trace--display-buffer trace-buffer))
- (goto-char (point-max))
- (insert
- (trace-exit-message
- function
- trace-level
- (if result (car result) '\!non-local\ exit\!)
- ctx))))))
+ (trace--exit-message
+ function
+ trace-level
+ (if result (car result) '\!non-local\ exit\!)
+ context))
(car result)))))
(defun trace-function-internal (function buffer background context)
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 02020552e7f..d8e5136c666 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -283,8 +283,16 @@ If it can't be found, return nil and don't move point."
(goto-char (prop-match-beginning match))
(end-of-line)))
-(defun vtable-update-object (table object old-object)
- "Replace OLD-OBJECT in TABLE with OBJECT."
+(defun vtable-update-object (table object &optional old-object)
+ "Update OBJECT's representation in TABLE.
+If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it.
+In either case, if the existing object is not found in the table (being
+compared with `equal'), signal an error. Note a limitation: if TABLE's
+buffer is not in a visible window, or if its window has changed width
+since it was updated, updating the TABLE is not possible, and an error
+is signaled."
+ (unless old-object
+ (setq old-object object))
(let* ((objects (vtable-objects table))
(inhibit-read-only t))
;; First replace the object in the object storage.
@@ -300,26 +308,31 @@ If it can't be found, return nil and don't move point."
(error "Can't find the old object"))
(setcar (cdr objects) object))
;; Then update the cache...
- (let* ((line-number (seq-position old-object (car (vtable--cache table))))
- (line (elt (car (vtable--cache table)) line-number)))
- (unless line
- (error "Can't find cached object"))
- (setcar line object)
- (setcdr line (vtable--compute-cached-line table object))
- ;; ... and redisplay the line in question.
- (save-excursion
- (vtable-goto-object old-object)
- (let ((keymap (get-text-property (point) 'keymap))
- (start (point)))
- (delete-line)
- (vtable--insert-line table line line-number
- (nth 1 (vtable--cache table))
- (vtable--spacer table))
- (add-text-properties start (point) (list 'keymap keymap
- 'vtable table))))
- ;; We may have inserted a non-numerical value into a previously
- ;; all-numerical table, so recompute.
- (vtable--recompute-numerical table (cdr line)))))
+ ;; FIXME: If the table's buffer has no visible window, or if its
+ ;; width has changed since the table was updated, the cache key will
+ ;; not match and the object can't be updated. (Bug #69837).
+ (if-let ((line-number (seq-position (car (vtable--cache table)) old-object
+ (lambda (a b)
+ (equal (car a) b))))
+ (line (elt (car (vtable--cache table)) line-number)))
+ (progn
+ (setcar line object)
+ (setcdr line (vtable--compute-cached-line table object))
+ ;; ... and redisplay the line in question.
+ (save-excursion
+ (vtable-goto-object old-object)
+ (let ((keymap (get-text-property (point) 'keymap))
+ (start (point)))
+ (delete-line)
+ (vtable--insert-line table line line-number
+ (nth 1 (vtable--cache table))
+ (vtable--spacer table))
+ (add-text-properties start (point) (list 'keymap keymap
+ 'vtable table))))
+ ;; We may have inserted a non-numerical value into a previously
+ ;; all-numerical table, so recompute.
+ (vtable--recompute-numerical table (cdr line)))
+ (error "Can't find cached object in vtable"))))
(defun vtable-remove-object (table object)
"Remove OBJECT from TABLE.
@@ -741,7 +754,7 @@ If NEXT, do the next column."
(seq-do-indexed
(lambda (elem index)
(when (and (vtable-column--numerical (elt columns index))
- (not (numberp elem)))
+ (not (numberp (car elem))))
(setq recompute t)))
line)
(when recompute
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 9c42f38dc45..192eb99a570 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -4637,7 +4637,7 @@ sensitive for VI-style look-and-feel."
(insert (substitute-command-keys "
Please specify your level of familiarity with the venomous VI PERil
\(and the VI Plan for Emacs Rescue).
-You can change it at any time by typing `\\[viper-set-expert-level]'
+You can change it at any time by typing \\[viper-set-expert-level]
1 -- BEGINNER: Almost all Emacs features are suppressed.
Feels almost like straight Vi. File name completion and
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 30750951887..9f724551239 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -257,11 +257,11 @@ that deletes a file.")
(defvar viper-expert-level (if (boundp 'viper-expert-level) viper-expert-level 0)
"User's expert level.
-The minor mode viper-vi-diehard-minor-mode is in effect when
-viper-expert-level is 1 or 2 or when viper-want-emacs-keys-in-vi is t.
-The minor mode viper-insert-diehard-minor-mode is in effect when
-viper-expert-level is 1 or 2 or if viper-want-emacs-keys-in-insert is t.
-Use `\\[viper-set-expert-level]' to change this.")
+The minor mode `viper-vi-diehard-minor-mode' is in effect when
+`viper-expert-level' is 1 or 2 or when `viper-want-emacs-keys-in-vi' is t.
+The minor mode `viper-insert-diehard-minor-mode' is in effect when
+`viper-expert-level' is 1 or 2 or if `viper-want-emacs-keys-in-insert' is t.
+Use \\[viper-set-expert-level] to change this.")
;; Max expert level supported by Viper. This is NOT a user option.
;; It is here to make it hard for the user from resetting it.
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 83fcdf89375..287292a24dc 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -388,7 +388,6 @@ widget."
idl-mode
perl-mode
- cperl-mode
javascript-mode
tcl-mode
python-mode
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index c3c11bb0b0b..13840da0bd9 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public keys."
(repeat :tag "Random pool"
(string :tag "Keyserver address"))
(const "keyring.debian.org")
- (const "keys.gnupg.net")
(const "keyserver.ubuntu.com")
(const "pgp.mit.edu")
- (const "pool.sks-keyservers.net")
- (const "zimmermann.mayfirst.org")
(string :tag "Custom keyserver"))
:version "28.1")
diff --git a/lisp/epa.el b/lisp/epa.el
index 53da3bf6cce..c29df18bb58 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -73,6 +73,17 @@ The command `epa-mail-encrypt' uses this."
:group 'epa
:version "24.4")
+(defcustom epa-keys-select-method 'buffer
+ "Method used to select keys in `epa-select-keys'.
+If the value is \\='buffer, the default, keys are selected via a
+pop-up buffer. If the value is \\='minibuffer, keys are selected
+via the minibuffer instead, using `completing-read-multiple'.
+Any other value is treated as \\='buffer."
+ :type '(choice (const :tag "Read keys from a pop-up buffer" buffer)
+ (const :tag "Read keys from minibuffer" minibuffer))
+ :group 'epa
+ :version "30.1")
+
;;; Faces
(defgroup epa-faces nil
@@ -450,6 +461,25 @@ q trust status questionable. - trust status unspecified.
(epa--marked-keys))
(kill-buffer epa-keys-buffer)))))
+(defun epa--select-keys-in-minibuffer (prompt keys)
+ (let* ((prompt (pcase-let ((`(,first ,second ,third)
+ (string-split prompt "\\."))
+ (hint "(separated by comma)"))
+ (if third
+ (format "%s %s. %s: " first hint second)
+ (format "%s %s: " first hint))))
+ (keys-alist
+ (seq-map
+ (lambda (key)
+ (cons (substring-no-properties
+ (epa--button-key-text key))
+ key))
+ keys))
+ (selected-keys (completing-read-multiple prompt keys-alist)))
+ (seq-map
+ (lambda (key) (cdr (assoc key keys-alist)))
+ selected-keys)))
+
;;;###autoload
(defun epa-select-keys (context prompt &optional names secret)
"Display a user's keyring and ask him to select keys.
@@ -459,7 +489,9 @@ NAMES is a list of strings to be matched with keys. If it is nil, all
the keys are listed.
If SECRET is non-nil, list secret keys instead of public keys."
(let ((keys (epg-list-keys context names secret)))
- (epa--select-keys prompt keys)))
+ (pcase epa-keys-select-method
+ ('minibuffer (epa--select-keys-in-minibuffer prompt keys))
+ (_ (epa--select-keys prompt keys)))))
;;;; Key Details
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4162df00595..9fc8a4d29f4 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -158,7 +158,6 @@
(declare-function erc-parse-user "erc" (string))
(declare-function erc-process-away "erc" (proc away-p))
(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host))
-(declare-function erc-query-buffer-p "erc" (&optional buffer))
(declare-function erc-remove-channel-member "erc" (channel nick))
(declare-function erc-remove-channel-users "erc" nil)
(declare-function erc-remove-user "erc" (nick))
@@ -254,6 +253,11 @@ Entries are of the form:
or
(PARAMETER) if no value is provided.
+where PARAMETER is a string and VALUE is a string or nil. For
+compatibility, a raw parameter of the form \"FOO=\" becomes
+(\"FOO\" . \"\") even though it's equivalent to the preferred
+canonical form \"FOO\" and its lisp representation (\"FOO\").
+
Some examples of possible parameters sent by servers:
CHANMODES=b,k,l,imnpst - list of supported channel modes
CHANNELLEN=50 - maximum length of channel names
@@ -273,7 +277,8 @@ WALLCHOPS - supports sending messages to all operators in a channel")
(defvar-local erc--isupport-params nil
"Hash map of \"ISUPPORT\" params.
Keys are symbols. Values are lists of zero or more strings with hex
-escapes removed.")
+escapes removed. ERC normalizes incoming parameters of the form
+\"FOO=\" to (FOO).")
;;; Server and connection state
@@ -433,7 +438,11 @@ and optionally alter the attempts tally."
(defcustom erc-split-line-length 440
"The maximum length of a single message.
-If a message exceeds this size, it is broken into multiple ones.
+ERC normally splits chat input submitted at its prompt into
+multiple messages when the initial size exceeds this value in
+bytes. Modules can tell ERC to forgo splitting entirely by
+setting this to zero locally or, preferably, by binding it around
+a remapped `erc-send-current-line' command.
IRC allows for lines up to 512 bytes. Two of them are CR LF.
And a typical message looks like this:
@@ -596,7 +605,8 @@ escape hatch for inhibiting their transmission.")
(if (= (car cmp) (point-min))
(goto-char (nth 1 cmp))
(goto-char (car cmp)))))
- (cl-assert (/= (point-min) (point)))
+ (when (= (point-min) (point))
+ (goto-char (point-max)))
(push (buffer-substring-no-properties (point-min) (point)) out)
(delete-region (point-min) (point)))
(or (nreverse out) (list "")))
@@ -1469,10 +1479,12 @@ for decoding."
(let ((args (erc-response.command-args parsed-response))
(decode-target nil)
(decoded-args ()))
+ ;; FIXME this should stop after the first match.
(dolist (arg args nil)
(when (string-match "^[#&].*" arg)
(setq decode-target arg)))
(when (stringp decode-target)
+ ;; FIXME `decode-target' should be passed as TARGET.
(setq decode-target (erc-decode-string-from-target decode-target nil)))
(setf (erc-response.unparsed parsed-response)
(erc-decode-string-from-target
@@ -2145,10 +2157,6 @@ Then display the welcome message."
;;
;; > The server SHOULD send "X", not "X="; this is the normalized form.
;;
- ;; Note: for now, assume the server will only send non-empty values,
- ;; possibly with printable ASCII escapes. Though in practice, the
- ;; only two escapes we're likely to see are backslash and space,
- ;; meaning the pattern is too liberal.
(let (case-fold-search)
(mapcar
(lambda (v)
@@ -2159,7 +2167,9 @@ Then display the welcome message."
(string-match "[\\]x[0-9A-F][0-9A-F]" v start))
(setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
c (string-to-number m 16))
- (if (<= ?\ c ?~)
+ ;; In practice, this range is too liberal. The only
+ ;; escapes we're likely to see are ?\\, ?=, and ?\s.
+ (if (<= ?\s c ?~)
(setq v (concat (substring v 0 (match-beginning 0))
(string c)
(substring v (match-end 0)))
@@ -2184,8 +2194,9 @@ primitive value."
(or erc-server-parameters
(erc-with-server-buffer
erc-server-parameters)))))
- (if (cdr v)
- (erc--parse-isupport-value (cdr v))
+ (if-let ((val (cdr v))
+ ((not (string-empty-p val))))
+ (erc--parse-isupport-value val)
'--empty--)))))
(pcase value
('--empty-- (unless single (list key)))
@@ -2196,7 +2207,9 @@ primitive value."
;; While it's better to depend on interfaces than specific types,
;; using `cl-struct-slot-value' or similar to extract a known slot at
;; runtime would incur a small "ducktyping" tax, which should probably
-;; be avoided when running dozens of times per incoming message.
+;; be avoided when running hundreds of times per incoming message.
+;; Instead of separate keys per data type, we could increment a
+;; counter whenever a new 005 arrives.
(defmacro erc--with-isupport-data (param var &rest body)
"Return structured data stored in VAR for \"ISUPPORT\" PARAM.
Expect VAR's value to be an instance of `erc--isupport-data'. If
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 27406a76f59..4b4930e5bff 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -443,7 +443,7 @@ of the channel. However, don't bother creating an actual
Instead, just spoof an `erc-server-user' and stash it during
\"PRIVMSG\" handling via `erc--cmem-from-nick-function' and
retrieve it during buttonizing via
-`erc-button--fallback-user-function'."
+`erc-button--fallback-cmem-function'."
:interactive nil
(if erc-button--phantom-users-mode
(progn
@@ -528,7 +528,8 @@ that `erc-button-add-button' adds, except for the face."
'(erc-callback nil
erc-data nil
mouse-face nil
- keymap nil)))
+ keymap nil))
+ (erc--restore-important-text-props '(mouse-face)))
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
"Create a button between FROM and TO with callback FUN and data DATA.
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index b8ba0673355..8388efe062c 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -37,6 +37,7 @@
(defvar erc-session-server)
(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc--init-cusr-fallback-status "erc" (v h o a q))
(declare-function erc-get-buffer "erc" (target &optional proc))
(declare-function erc-server-buffer "erc" nil)
(declare-function widget-apply-action "wid-edit" (widget &optional event))
@@ -49,15 +50,30 @@
(declare-function widget-type "wid-edit" (widget))
(cl-defstruct erc-input
- string insertp sendp)
+ "Object shared among members of `erc-pre-send-functions'.
+Any use outside of the hook is not supported."
+ ( string "" :type string
+ :documentation "String to send and, without `substxt', insert.
+ERC treats separate lines as separate messages.")
+ ( insertp nil :type boolean
+ :documentation "Whether to insert outgoing message.
+When nil, ERC still sends `string'.")
+ ( sendp nil :type boolean
+ :documentation "Whether to send and (for compat reasons) insert.
+To insert without sending, define a (slash) command.")
+ ( substxt nil :type (or function string null)
+ :documentation "Alternate string to insert without splitting.
+The function form is for internal use.")
+ ( refoldp nil :type boolean
+ :documentation "Whether to resplit a possibly overlong `string'.
+ERC only refolds `string', never `substxt'."))
(cl-defstruct (erc--input-split (:include erc-input
- (string :read-only)
+ (string "" :read-only t)
(insertp erc-insert-this)
(sendp (with-suppressed-warnings
((obsolete erc-send-this))
erc-send-this))))
- (refoldp nil :type boolean)
(lines nil :type (list-of string))
(abortp nil :type (list-of symbol))
(cmdp nil :type boolean))
@@ -76,11 +92,11 @@
make-erc-channel-user
( &key voice halfop op admin owner
last-message-time
- &aux (status (+ (if voice 1 0)
- (if halfop 2 0)
- (if op 4 0)
- (if admin 8 0)
- (if owner 16 0)))))
+ &aux (status
+ (if (or voice halfop op admin owner)
+ (erc--init-cusr-fallback-status
+ voice halfop op admin owner)
+ 0))))
:named)
"Object containing channel-specific data for a single user."
;; voice halfop op admin owner
@@ -140,9 +156,12 @@ For use with the macro `erc--with-isupport-data'."
(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data))
"Server-local data for recognized membership-status prefixes.
Derived from the advertised \"PREFIX\" ISUPPORT parameter."
- (letters "qaohv" :type string)
- (statuses "~&@%+" :type string)
- (alist nil :type (list-of cons)))
+ ( letters "vhoaq" :type string
+ :documentation "Status letters ranked lowest to highest.")
+ ( statuses "+%@&~" :type string
+ :documentation "Status prefixes ranked lowest to highest.")
+ ( alist nil :type (list-of cons)
+ :documentation "Alist of letters-prefix pairs."))
(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
"Server-local \"CHANMODES\" data."
@@ -152,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter."
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
- "Return preferred SYMBOL for `erc--modules'."
+ "Return preferred SYMBOL for `erc--module'."
(while-let ((canonical (get symbol 'erc--module))
((not (eq canonical symbol))))
(setq symbol canonical))
@@ -333,6 +352,7 @@ instead of a `set' state, which precludes any actual saving."
(read (current-buffer))))
(defmacro erc--find-feature (name alias)
+ ;; Don't use this outside of the file that defines NAME.
`(pcase (erc--find-group ',name ,(and alias (list 'quote alias)))
('erc (and-let* ((file (or (macroexp-file-name) buffer-file-name)))
(intern (file-name-base file))))
@@ -350,8 +370,12 @@ See Info node `(elisp) Defining Minor Modes' for more.")
(defmacro define-erc-module (name alias doc enable-body disable-body
&optional local-p)
"Define a new minor mode using ERC conventions.
-Symbol NAME is the name of the module.
-Symbol ALIAS is the alias to use, or nil.
+Expect NAME to be the module's name and ALIAS, when non-nil, to
+be a retired name used only for compatibility purposes. In new
+code, assume NAME is the same symbol users should specify when
+customizing `erc-modules' (see info node `(erc) Module Loading'
+for more on naming).
+
DOC is the documentation string to use for the minor mode.
ENABLE-BODY is a list of expressions used to enable the mode.
DISABLE-BODY is a list of expressions used to disable the mode.
@@ -382,7 +406,10 @@ Example:
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
(enable (intern (format "erc-%s-enable" (downcase sn))))
- (disable (intern (format "erc-%s-disable" (downcase sn)))))
+ (disable (intern (format "erc-%s-disable" (downcase sn))))
+ (nmodule (erc--normalize-module-symbol name))
+ (amod (and alias (intern (format "erc-%s-mode"
+ (downcase (symbol-name alias)))))))
`(progn
(define-minor-mode
,mode
@@ -399,13 +426,9 @@ if ARG is omitted or nil.
(if ,mode (,enable) (,disable))))
,(erc--assemble-toggle local-p name enable mode t enable-body)
,(erc--assemble-toggle local-p name disable mode nil disable-body)
- ,@(and-let* ((alias)
- ((not (eq name alias)))
- (aname (intern (format "erc-%s-mode"
- (downcase (symbol-name alias))))))
- `((defalias ',aname #',mode)
- (put ',aname 'erc-module ',(erc--normalize-module-symbol name))))
- (put ',mode 'erc-module ',(erc--normalize-module-symbol name))
+ ,@(and amod `((defalias ',amod #',mode)
+ (put ',amod 'erc-module ',nmodule)))
+ (put ',mode 'erc-module ',nmodule)
;; For find-function and find-variable.
(put ',mode 'definition-name ',name)
(put ',enable 'definition-name ',name)
@@ -462,10 +485,9 @@ If no server buffer exists, return nil."
,@body)))))
(defmacro erc-with-all-buffers-of-server (process pred &rest forms)
- "Execute FORMS in all buffers which have same process as this server.
-FORMS will be evaluated in all buffers having the process PROCESS and
-where PRED matches or in all buffers of the server process if PRED is
-nil."
+ "Evaluate FORMS in all buffers of PROCESS in which PRED returns non-nil.
+When PROCESS is nil, do so in all ERC buffers. When PRED is nil,
+run FORMS unconditionally."
(declare (indent 2) (debug (form form body)))
(macroexp-let2 nil pred pred
`(erc-buffer-filter (lambda ()
@@ -554,9 +576,21 @@ See `erc-define-message-format-catalog' for the meaning of
ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in
tests/lisp/erc/erc-tests.el for a convenience command to convert
a literal string into a sequence of `propertize' forms, which are
-much easier to review and edit."
+much easier to review and edit. When ENTRIES begins with a
+sequence of keyword-value pairs remove them and consider their
+evaluated values before processing the alist proper.
+
+Currently, the only recognized keyword is `:parent', which tells
+ERC to search recursively for a given template key using the
+keyword's associated value, another catalog symbol, if not found
+in catalog NAME."
(declare (indent 1))
(let (out)
+ (while (keywordp (car entries))
+ (push (pcase-exhaustive (pop entries)
+ (:parent `(put ',name 'erc--base-format-catalog
+ ,(pop entries))))
+ out))
(dolist (e entries (cons 'progn (nreverse out)))
(push `(defvar ,(intern (format "erc-message-%s-%s" name (car e)))
,(cdr e)
@@ -575,9 +609,14 @@ symbol, and FORMAT evaluates to a format string compatible with
`format-spec'. Expect modules that only define a handful of
entries to do so manually, instead of using this macro, so that
the resulting variables will end up with more useful doc strings."
- (declare (indent 1))
+ (declare (indent 1)
+ (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form))))
`(erc--define-catalog ,language ,entries))
+(define-inline erc--strpos (char string)
+ "Return position of CHAR in STRING or nil if not found."
+ (inline-quote (string-search (string ,char) ,string)))
+
(defmacro erc--doarray (spec &rest body)
"Map over ARRAY, running BODY with VAR bound to iteration element.
Behave more or less like `seq-doseq', but tailor operations for
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index dede833a93d..b5b8fbaf8ab 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -31,51 +31,11 @@
;;; Code:
-(require 'compat nil 'noerror)
+(require 'compat)
(eval-when-compile (require 'cl-lib))
-;; Except for the "erc-" namespacing, these two definitions should be
-;; continuously updated to match the latest upstream ones verbatim.
-;; Although they're pretty simple, it's likely not worth checking for
-;; and possibly deferring to the non-prefixed versions.
-;;
-;; BEGIN Compat macros
-
-;;;; Macros for extended compatibility function calls
-
-(defmacro erc-compat-function (fun)
- "Return compatibility function symbol for FUN.
-
-If the Emacs version provides a sufficiently recent version of
-FUN, the symbol FUN is returned itself. Otherwise the macro
-returns the symbol of a compatibility function which supports the
-behavior and calling convention of the current stable Emacs
-version. For example Compat 29.1 will provide compatibility
-functions which implement the behavior and calling convention of
-Emacs 29.1.
-
-See also `compat-call' to directly call compatibility functions."
- (let ((compat (intern (format "compat--%s" fun))))
- `#',(if (fboundp compat) compat fun)))
-
-(defmacro erc-compat-call (fun &rest args)
- "Call compatibility function or macro FUN with ARGS.
-
-A good example function is `plist-get' which was extended with an
-additional predicate argument in Emacs 29.1. The compatibility
-function, which supports this additional argument, can be
-obtained via (compat-function plist-get) and called
-via (compat-call plist-get plist prop predicate). It is not
-possible to directly call (plist-get plist prop predicate) on
-Emacs older than 29.1, since the original `plist-get' function
-does not yet support the predicate argument. Note that the
-Compat library never overrides existing functions.
-
-See also `compat-function' to lookup compatibility functions."
- (let ((compat (intern (format "compat--%s" fun))))
- `(,(if (fboundp compat) compat fun) ,@args)))
-
-;; END Compat macros
+(define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1")
+(define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1")
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -102,7 +62,7 @@ See `erc-encoding-coding-alist'."
(defun erc-set-write-file-functions (new-val)
(declare (obsolete nil "28.1"))
- (set (make-local-variable 'write-file-functions) new-val))
+ (setq-local write-file-functions new-val))
(defvar erc-emacs-build-time
(if (or (stringp emacs-build-time) (not emacs-build-time))
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 522973a0156..b8e16df755b 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -619,7 +619,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner."
(buffer-live-p (get-buffer (plist-get elt :file)))
(plist-member elt :size))
(let ((byte-count (with-current-buffer
- (get-buffer (plist-get elt :file))
+ (plist-get elt :file)
(+ (buffer-size) 0.0
erc-dcc-byte-count))))
(format " (%d%%)"
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 2e905097f97..9bb89fbfc81 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -54,6 +54,9 @@
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+(declare-function haiku-notifications-notify "haikuselect.c")
+(declare-function android-notifications-notify "androidselect.c")
+
(defun erc-notifications-notify (nick msg &optional privp)
"Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs.
This will replace the last notification sent with this function."
@@ -64,14 +67,19 @@ This will replace the last notification sent with this function."
(let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
(title (format "%s in %s" (xml-escape-string nick t) channel))
(body (xml-escape-string (erc-controls-strip msg) t)))
- (notifications-notify :bus erc-notifications-bus
- :title title
- :body body
- :replaces-id erc-notifications-last-notification
- :app-icon erc-notifications-icon
- :actions '("default" "Switch to buffer")
- :on-action (lambda (&rest _)
- (pop-to-buffer channel)))))))
+ (funcall (cond ((featurep 'android)
+ #'android-notifications-notify)
+ ((featurep 'haiku)
+ #'haiku-notifications-notify)
+ (t #'notifications-notify))
+ :bus erc-notifications-bus
+ :title title
+ :body body
+ :replaces-id erc-notifications-last-notification
+ :app-icon erc-notifications-icon
+ :actions '("default" "Switch to buffer")
+ :on-action (lambda (&rest _)
+ (pop-to-buffer channel)))))))
(defun erc-notifications-PRIVMSG (_proc parsed)
(let ((nick (car (erc-parse-user (erc-response.sender parsed))))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index b91ce007087..aa12b807fbc 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -44,11 +44,7 @@
(define-erc-module fill nil
"Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
-the channel buffers are filled."
- ;; FIXME ensure a consistent ordering relative to hook members from
- ;; other modules. Ideally, this module's processing should happen
- ;; after "morphological" modifications to a message's text but
- ;; before superficial decorations.
+channel buffers are filled. See also `erc-fill-wrap-mode'."
((add-hook 'erc-insert-modify-hook #'erc-fill 60)
(add-hook 'erc-send-modify-hook #'erc-fill 60))
((remove-hook 'erc-insert-modify-hook #'erc-fill)
@@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
(defvar erc-button-mode)
+(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
+(defvar erc--fill-wrap-scrolltobottom-exempt-p nil)
+
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(when erc-legacy-invisible-bounds-p
@@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
+ (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p
+ (memq 'scrolltobottom erc-modules))
+ (push 'scrolltobottom missing-deps)
+ (erc-scrolltobottom-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
@@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
+
This module displays nicks overhanging leftward to a common
-offset, as determined by the option `erc-fill-static-center'.
-And it \"wraps\" messages at a common margin width, as determined
-by the option `erc-fill-wrap-margin-width'. To use it, either
-include `fill-wrap' in `erc-modules' or set `erc-fill-function'
-to `erc-fill-wrap'. Most users will want to enable the
-`scrolltobottom' module as well.
-
-During sessions in which this module is active, use
-\\[erc-fill-wrap-nudge] to adjust the width of the indent and the
-stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for
-cycling between logical- and screen-line oriented command
-movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix
-alignment problems after running certain commands, like
-`text-scale-adjust'. Also see related stylistic options
-`erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'.
-\(Hint: in narrow windows, where is space tight, try setting
-`erc-fill-static-center' to 1. And if you also use the option
-`erc-fill-wrap-merge-indicator', set that to value-menu item
-\"Leading MIDDLE DOT sans gap\" or one of the various
-\"trailing\" items.)
+offset, as determined by the option `erc-fill-static-center'. It
+also \"wraps\" messages at a common width, as determined by the
+option `erc-fill-wrap-margin-width'. To use it, either include
+`fill-wrap' in `erc-modules' or set `erc-fill-function' to
+`erc-fill-wrap'.
+
+Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of
+the indent and the stamp margin. And For cycling between
+logical- and screen-line oriented command movement, see
+\\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use
+\\[erc-fill-wrap-refill-buffer] to fix alignment problems after
+running certain commands, like `text-scale-adjust'. Also see
+related stylistic options `erc-fill-wrap-merge', and
+`erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try
+setting `erc-fill-static-center' to 1, and if you use
+`erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans
+gap\" or one of the \"trailing\" items from the Customize menu.)
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
@@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter', which
strips trailing stamps from logged messages and instead prepends
them to every line.
-As a so-called \"local\" module, `fill-wrap' depends on the
-global modules `fill', `stamp', and `button'; it activates them
-as needed when initializing. Please note that enabling and
-disabling this module by invoking one of its minor-mode toggles
-is not recommended."
+A so-called \"local\" module, `fill-wrap' depends on the global
+modules `fill', `stamp', `button', and `scrolltobottom'. It
+activates them as needed when initializing and leaves them
+enabled when shutting down. To opt out of `scrolltobottom'
+specifically, disable its minor mode, `erc-scrolltobottom-mode',
+via `erc-fill-wrap-mode-hook'."
((erc-fill--wrap-ensure-dependencies)
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
@@ -832,7 +834,7 @@ decorations applied by third-party modules."
(line (count-screen-lines (window-start) (window-point))))
(when (zerop arg)
(setq arg 1))
- (erc-compat-call
+ (compat-call
set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (key '(?= ?- ?0))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index c5ab25bea98..fe44c3bdfcb 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -83,7 +83,7 @@ be experimental. It currently only works with Emacs 28+."
(when (and erc-scrolltobottom-all (< emacs-major-version 28))
(erc-button--display-error-notice-with-keys
"Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.")
- (setopt erc-scrolltobottom-all nil))
+ (setq erc-scrolltobottom-all nil))
(unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup))
(if erc-scrolltobottom-all
(progn
@@ -331,14 +331,15 @@ buffer than the window's start."
(defvar-local erc--keep-place-indicator-overlay nil
"Overlay for `erc-keep-place-indicator-mode'.")
-(defun erc--keep-place-indicator-on-window-buffer-change (window)
+(defun erc--keep-place-indicator-on-window-buffer-change (_)
"Maybe sync `erc--keep-place-indicator-overlay'.
Do so only when switching to a new buffer in the same window if
the replaced buffer is no longer visible in another window and
its `window-start' at the time of switching is strictly greater
than the indicator's position."
(when-let ((erc-keep-place-indicator-follow)
- ((eq window (selected-window)))
+ (window (selected-window))
+ ((not (eq window (active-minibuffer-window))))
(old-buffer (window-old-buffer window))
((buffer-live-p old-buffer))
((not (eq old-buffer (current-buffer))))
@@ -352,67 +353,70 @@ than the indicator's position."
(with-current-buffer old-buffer
(erc-keep-place-move old-start))))
-(defun erc--keep-place-indicator-setup ()
- "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'."
- (require 'fringe)
- (erc--restore-initialize-priors erc-keep-place-indicator-mode
- erc--keep-place-indicator-overlay (make-overlay 0 0))
- (add-hook 'erc-keep-place-mode-hook
- #'erc--keep-place-indicator-on-global-module nil t)
- (add-hook 'window-buffer-change-functions
- #'erc--keep-place-indicator-on-window-buffer-change 40 t)
- (when-let* (((memq erc-keep-place-indicator-style '(t arrow)))
- (ov-property (if (zerop (fringe-columns 'left))
- 'after-string
- 'before-string))
- (display (if (zerop (fringe-columns 'left))
- `((margin left-margin) ,overlay-arrow-string)
- '(left-fringe right-triangle
- erc-keep-place-indicator-arrow)))
- (bef (propertize " " 'display display)))
- (overlay-put erc--keep-place-indicator-overlay ov-property bef))
- (when (memq erc-keep-place-indicator-style '(t face))
- (overlay-put erc--keep-place-indicator-overlay 'face
- 'erc-keep-place-indicator-line)))
-
;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies)
+;;;###autoload(autoload 'erc-keep-place-indicator-mode "erc-goodies" nil t)
(define-erc-module keep-place-indicator nil
"Buffer-local `keep-place' with fringe arrow and/or highlighted face.
Play nice with global module `keep-place' but don't depend on it.
Expect that users may want different combinations of `keep-place'
-and `keep-place-indicator' in different buffers. Unlike global
-`keep-place', when `switch-to-buffer-preserve-window-point' is
-enabled, don't forcibly sync point in all windows where buffer
-has previously been shown because that defeats the purpose of
-having a placeholder."
+and `keep-place-indicator' in different buffers."
((cond (erc-keep-place-mode)
((memq 'keep-place erc-modules)
(erc-keep-place-mode +1))
;; Enable a local version of `keep-place-mode'.
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
+ (require 'fringe)
+ (add-hook 'window-buffer-change-functions
+ #'erc--keep-place-indicator-on-window-buffer-change 40)
+ (add-hook 'erc-keep-place-mode-hook
+ #'erc--keep-place-indicator-on-global-module 40)
(if (pcase erc-keep-place-indicator-buffer-type
('target erc--target)
('server (not erc--target))
('t t))
- (erc--keep-place-indicator-setup)
+ (progn
+ (erc--restore-initialize-priors erc-keep-place-indicator-mode
+ erc--keep-place-indicator-overlay (make-overlay 0 0))
+ (when-let (((memq erc-keep-place-indicator-style '(t arrow)))
+ (ov-property (if (zerop (fringe-columns 'left))
+ 'after-string
+ 'before-string))
+ (display (if (zerop (fringe-columns 'left))
+ `((margin left-margin) ,overlay-arrow-string)
+ '(left-fringe right-triangle
+ erc-keep-place-indicator-arrow)))
+ (bef (propertize " " 'display display)))
+ (overlay-put erc--keep-place-indicator-overlay ov-property bef))
+ (when (memq erc-keep-place-indicator-style '(t face))
+ (overlay-put erc--keep-place-indicator-overlay 'face
+ 'erc-keep-place-indicator-line)))
(erc-keep-place-indicator-mode -1)))
((when erc--keep-place-indicator-overlay
(delete-overlay erc--keep-place-indicator-overlay))
- (remove-hook 'window-buffer-change-functions
- #'erc--keep-place-indicator-on-window-buffer-change t)
+ (let ((buffer (current-buffer)))
+ ;; Remove global hooks unless others exist with mode enabled.
+ (unless (erc-buffer-filter (lambda ()
+ (and (not (eq buffer (current-buffer)))
+ erc-keep-place-indicator-mode)))
+ (remove-hook 'erc-keep-place-mode-hook
+ #'erc--keep-place-indicator-on-global-module)
+ (remove-hook 'window-buffer-change-functions
+ #'erc--keep-place-indicator-on-window-buffer-change)))
+ (when (local-variable-p 'erc-insert-pre-hook)
+ (remove-hook 'erc-insert-pre-hook #'erc-keep-place t))
(remove-hook 'erc-keep-place-mode-hook
#'erc--keep-place-indicator-on-global-module t)
- (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(kill-local-variable 'erc--keep-place-indicator-overlay))
'local)
(defun erc--keep-place-indicator-on-global-module ()
- "Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'.
-That is, ensure the local module can survive a user toggling the
-global one."
- (if erc-keep-place-mode
- (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
- (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
+ "Ensure `keep-place-indicator' survives toggling `erc-keep-place-mode'.
+Do this by simulating `keep-place' in all buffers where
+`keep-place-indicator' is enabled."
+ (erc-with-all-buffers-of-server nil (lambda () erc-keep-place-indicator-mode)
+ (if erc-keep-place-mode
+ (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
+ (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))))
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.
@@ -579,15 +583,18 @@ Do nothing if the variable `erc-command-indicator' is nil."
"Insert `erc-input' STATE's message if it's an echoed command."
(cl-assert erc-command-indicator-mode)
(when (erc--input-split-cmdp state)
- (setf (erc--input-split-insertp state) #'erc--command-indicator-display)
+ (setf (erc--input-split-insertp state) t
+ (erc--input-split-substxt state) #'erc--command-indicator-display)
(erc-send-distinguish-noncommands state)))
;; This function used to be called `erc-display-command'. It was
;; neutered in ERC 5.3.x (Emacs 24.5), commented out in 5.4, removed
;; in 5.5, and restored in 5.6.
-(defun erc--command-indicator-display (line)
+(defun erc--command-indicator-display (line &rest rest)
"Insert command LINE as echoed input resembling that of REPLs and shells."
(when erc-insert-this
+ (when rest
+ (setq line (string-join (cons line rest) "\n")))
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
@@ -618,6 +625,48 @@ Do nothing if the variable `erc-command-indicator' is nil."
erc--msg-props))))
(erc--refresh-prompt))))
+;;;###autoload
+(defun erc-load-irc-script-lines (lines &optional force noexpand)
+ "Process a list of LINES as prompt input submissions.
+If optional NOEXPAND is non-nil, do not expand script-specific
+substitution sequences via `erc-process-script-line' and instead
+process LINES as literal prompt input. With FORCE, bypass flood
+protection."
+ ;; The various erc-cmd-CMDs were designed to return non-nil when
+ ;; their command line should be echoed. But at some point, these
+ ;; handlers began displaying their own output, which naturally
+ ;; appeared *above* the echoed command. This tries to intercept
+ ;; these insertions, deferring them until the command has returned
+ ;; and its command line has been printed.
+ (cl-assert (eq 'erc-mode major-mode))
+ (let ((args (and erc-script-args
+ (if (string-match "^ " erc-script-args)
+ (substring erc-script-args 1)
+ erc-script-args))))
+ (with-silent-modifications
+ (dolist (line lines)
+ (erc-log (concat "erc-load-script: CMD: " line))
+ (unless (string-match (rx bot (* (syntax whitespace)) eot) line)
+ (unless noexpand
+ (setq line (erc-process-script-line line args)))
+ (let ((erc--current-line-input-split (erc--make-input-split line))
+ calls insertp)
+ (add-function :around (local 'erc--send-message-nested-function)
+ (lambda (&rest args) (push args calls))
+ '((name . erc-script-lines-fn) (depth . -80)))
+ (add-function :around (local 'erc--send-action-function)
+ (lambda (&rest args) (push args calls))
+ '((name . erc-script-lines-fn) (depth . -80)))
+ (setq insertp
+ (unwind-protect (erc-process-input-line line force)
+ (remove-function (local 'erc--send-action-function)
+ 'erc-script-lines-fn)
+ (remove-function (local 'erc--send-message-nested-function)
+ 'erc-script-lines-fn)))
+ (when (and insertp erc-script-echo)
+ (erc--command-indicator-display line)
+ (dolist (call calls)
+ (apply (car call) (cdr call))))))))))
;;; IRC control character processing.
(defgroup erc-control-characters nil
@@ -654,13 +703,11 @@ The value `erc-interpret-controls-p' must also be t for this to work."
:group 'erc-faces)
(defface erc-inverse-face
- '((t :foreground "White" :background "Black"))
+ '((t :inverse-video t))
"ERC inverse face."
:group 'erc-faces)
-(defface erc-spoiler-face
- '((((background light)) :foreground "DimGray" :background "DimGray")
- (((background dark)) :foreground "LightGray" :background "LightGray"))
+(defface erc-spoiler-face '((t :inherit default))
"ERC spoiler face."
:group 'erc-faces)
@@ -668,6 +715,8 @@ The value `erc-interpret-controls-p' must also be t for this to work."
"ERC underline face."
:group 'erc-faces)
+;; FIXME rename these to something like `erc-control-color-N-fg',
+;; and deprecate the old names via `define-obsolete-face-alias'.
(defface fg:erc-color-face0 '((t :foreground "White"))
"ERC face."
:group 'erc-faces)
@@ -797,7 +846,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
(intern (concat "bg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :background (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) '(default)))))
+ (t (erc-log (format " Wrong color: %s" n)) nil))))
(defun erc-get-fg-color-face (n)
"Fetches the right face for foreground color N (0-15)."
@@ -813,12 +862,12 @@ The value `erc-interpret-controls-p' must also be t for this to work."
(intern (concat "fg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :foreground (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) '(default)))))
+ (t (erc-log (format " Wrong color: %s" n)) nil))))
;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
(define-erc-module irccontrols nil
"This mode enables the interpretation of IRC control chars."
- ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight)
+ ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight -50)
(add-hook 'erc-send-modify-hook #'erc-controls-highlight)
(erc--modify-local-map t "C-c C-c" #'erc-toggle-interpret-controls))
((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight)
@@ -868,7 +917,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(setq s (replace-match "" nil nil s 1))
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
- (setq bg bg-color))
+ (when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")
@@ -929,7 +978,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(replace-match "" nil nil nil 1)
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
- (setq bg bg-color))
+ (when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")
@@ -961,13 +1010,16 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend properties
to a region in the current buffer."
- (if (and fg bg (equal fg bg))
- (progn
- (setq fg 'erc-spoiler-face
- bg nil)
- (put-text-property from to 'mouse-face 'erc-inverse-face str))
- (when fg (setq fg (erc-get-fg-color-face fg)))
- (when bg (setq bg (erc-get-bg-color-face bg))))
+ (when (and fg bg (equal fg bg) (not (equal fg "99")))
+ (add-text-properties from to '( mouse-face erc-spoiler-face
+ cursor-face erc-spoiler-face)
+ str)
+ (erc--reserve-important-text-props from to
+ '( mouse-face erc-spoiler-face
+ cursor-face erc-spoiler-face)
+ str))
+ (when fg (setq fg (erc-get-fg-color-face fg)))
+ (when bg (setq bg (erc-get-bg-color-face bg)))
(font-lock-prepend-text-property
from
to
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 99c3c0563d0..1b26afa1164 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1123,10 +1123,27 @@ TARGET to be an `erc--target' object."
(lambda ()
(when (and erc--target (eq (erc--target-symbol erc--target)
(erc--target-symbol target)))
- (let ((oursp (if (erc--target-channel-local-p target)
- (equal announced erc-server-announced-name)
- (erc-networks--id-equal-p identity erc-networks--id))))
- (funcall (if oursp on-dupe on-collision))))))))
+ ;; When a server sends administrative queries immediately
+ ;; after connection registration and before the session has a
+ ;; net-id, the buffer remains orphaned until reassociated
+ ;; here retroactively.
+ (unless erc-networks--id
+ (let ((id (erc-with-server-buffer erc-networks--id))
+ (server-buffer (process-buffer erc-server-process)))
+ (apply #'erc-button--display-error-notice-with-keys
+ server-buffer
+ (concat "Missing network session (ID) for %S. "
+ (if id "Using `%S' from %S." "Ignoring."))
+ (current-buffer)
+ (and id (list (erc-networks--id-symbol
+ (setq erc-networks--id id))
+ server-buffer)))))
+ (when erc-networks--id
+ (let ((oursp (if (erc--target-channel-local-p target)
+ (equal announced erc-server-announced-name)
+ (erc-networks--id-equal-p identity
+ erc-networks--id))))
+ (funcall (if oursp on-dupe on-collision)))))))))
(defconst erc-networks--qualified-sep "@"
"Separator used for naming a target buffer.")
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 52ebdc83e5e..05cbaf3872f 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -58,7 +58,9 @@ add this string to nicks completed."
;;;###autoload(put 'Completion 'erc--module 'completion)
;;;###autoload(put 'pcomplete 'erc--module 'completion)
+;;;###autoload(put 'completion 'erc--feature 'erc-pcomplete)
;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t)
+(put 'completion 'erc-group 'erc-pcomplete)
(define-erc-module pcomplete Completion
"In ERC Completion mode, the TAB key does completion whenever possible."
((add-hook 'erc-mode-hook #'pcomplete-erc-setup)
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 5fcea056e3e..a81a3869436 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -545,6 +545,30 @@ The INDENT level is ignored."
(speedbar-set-mode-line-format))))
(defvar erc-speedbar--shutting-down-p nil)
+(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.")
+
+(defvar-local erc-speedbar--last-ran nil
+ "When non-nil, a lisp timestamp updated when the speedbar timer runs.")
+
+(defun erc-speedbar--run-timer-on-post-insert ()
+ "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'."
+ (when speedbar-buffer
+ (with-current-buffer speedbar-buffer
+ (when-let
+ ((dframe-timer)
+ ((erc--check-msg-prop 'erc--cmd 'PRIVMSG))
+ (interval erc-speedbar--force-update-interval-secs)
+ ((or (null erc-speedbar--last-ran)
+ (time-less-p erc-speedbar--last-ran
+ (time-subtract (current-time) interval)))))
+ (run-at-time 0 nil #'dframe-timer-fn)))))
+
+(defun erc-speedbar--reset-last-ran-on-timer ()
+ "Reset `erc-speedbar--last-ran'."
+ (when speedbar-buffer
+ (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29
+ (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer)
+ (current-time)))))
;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t)
(define-erc-module nickbar nil
@@ -559,6 +583,8 @@ raising of frames or the stealing of input focus. If you witness
such a thing and can reproduce it, please file a bug report with
\\[erc-bug]."
((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+ (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert)
+ (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer)
(erc-speedbar--ensure)
(unless (or erc--updating-modules-p
(and-let* ((speedbar-buffer)
@@ -569,6 +595,8 @@ such a thing and can reproduce it, please file a bug report with
(with-current-buffer buf
(erc-speedbar--ensure 'force)))))
((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+ (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert)
+ (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer)
(when erc-track-mode
(setq erc-track--switch-fallback-blockers
(remove '(derived-mode . speedbar-mode)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 558afd19427..bcb9b4aafef 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -184,7 +184,7 @@ from entering them and instead jump over them."
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40)
(unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup)))
- ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
+ ((remove-hook 'erc-mode-hook #'erc-stamp--setup)
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
@@ -198,6 +198,7 @@ from entering them and instead jump over them."
"Escape hatch for omitting stamps when first char is invisible.")
(defun erc-stamp--recover-on-reconnect ()
+ "Attempt to restore \"last-inserted\" snapshots from prior session."
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
erc-timestamp-last-inserted-left
@@ -622,6 +623,7 @@ printed just after each line's text (no alignment)."
((guard erc-stamp--display-margin-mode)
(let ((s (propertize (substring-no-properties string)
'invisible erc-stamp--invisible-property)))
+ (insert " ")
(put-text-property 0 (length string) 'display
`((margin right-margin) ,s)
string)))
@@ -722,9 +724,6 @@ inserted is a date stamp."
'hash-table))
(erc-timestamp-last-inserted-left rendered)
erc-timestamp-format erc-away-timestamp-format)
- ;; FIXME delete once convinced adjustment correct.
- (cl-assert (string= rendered
- (erc-stamp--format-date-stamp aligned)))
(erc-add-timestamp))
(setq erc-timestamp-last-inserted-left rendered)))))
@@ -827,11 +826,16 @@ left-sided stamps and date stamps inserted by this function."
;; perform day alignments via this function only when needed.
(defun erc-stamp--time-as-day (current-time)
"Discard hour, minute, and second info from timestamp CURRENT-TIME."
+ (defvar current-time-list) ; <=28
(let* ((current-time-list) ; flag
(decoded (decode-time current-time erc-stamp--tz)))
(setf (decoded-time-second decoded) 0
(decoded-time-minute decoded) 0
- (decoded-time-hour decoded) 0)
+ (decoded-time-hour decoded) 0
+ (decoded-time-dst decoded) -1
+ (decoded-time-weekday decoded) nil
+ (decoded-time-zone decoded)
+ (and erc-stamp--tz (car (current-time-zone nil erc-stamp--tz))))
(encode-time decoded))) ; may return an integer
(defun erc-format-timestamp (time format)
@@ -854,12 +858,20 @@ Return the empty string if FORMAT is nil."
(defvar-local erc-stamp--csf-props-updated-p nil)
-;; This function is used to munge `buffer-invisibility-spec' to an
-;; appropriate value. Currently, it only handles timestamps, thus its
-;; location. If you add other features which affect invisibility,
-;; please modify this function and move it to a more appropriate
-;; location.
-(defun erc-munge-invisibility-spec ()
+(define-obsolete-function-alias 'erc-munge-invisibility-spec
+ #'erc-stamp--manage-local-options-state "30.1"
+ "Perform setup and teardown of `stamp'-owned options.
+
+Note that this function's role in practice has long defied its
+stated mandate as claimed in a now deleted comment, which
+envisioned it as evolving into a central toggle for modifying
+`buffer-invisibility-spec' on behalf of options and features
+ERC-wide.")
+(defun erc-stamp--manage-local-options-state ()
+ "Perform local setup and teardown for `stamp'-owned options.
+For `erc-timestamp-intangible', toggle `cursor-intangible-mode'.
+For `erc-echo-timestamps', integrate with `cursor-sensor-mode'.
+For `erc-hide-timestamps, modify `buffer-invisibility-spec'."
(if erc-timestamp-intangible
(cursor-intangible-mode +1) ; idempotent
(when (bound-and-true-p cursor-intangible-mode)
@@ -869,10 +881,12 @@ Return the empty string if FORMAT is nil."
(unless erc-stamp--permanent-cursor-sensor-functions
(dolist (hook '(erc-insert-post-hook erc-send-post-hook))
(add-hook hook #'erc-stamp--add-csf-on-post-modify nil t))
- (erc--restore-initialize-priors erc-stamp-mode
- erc-stamp--csf-props-updated-p nil)
+ (setq erc-stamp--csf-props-updated-p
+ (alist-get 'erc-stamp--csf-props-updated-p
+ (or erc--server-reconnecting erc--target-priors)))
(unless erc-stamp--csf-props-updated-p
(setq erc-stamp--csf-props-updated-p t)
+ ;; Spoof `erc--ts' as being non-nil.
(let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table)))
(with-silent-modifications
(erc--traverse-inserted
@@ -902,9 +916,9 @@ Return the empty string if FORMAT is nil."
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
- (erc-munge-invisibility-spec)
+ (erc-stamp--manage-local-options-state)
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
- (erc-munge-invisibility-spec))
+ (erc-stamp--manage-local-options-state))
;; Undo local mods from `erc-insert-timestamp-left-and-right'.
(erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left'
(kill-local-variable 'erc-stamp--last-stamp)
@@ -916,7 +930,7 @@ Return the empty string if FORMAT is nil."
"Hide timestamp information from display."
(interactive)
(setq erc-hide-timestamps t)
- (erc-munge-invisibility-spec))
+ (erc-stamp--manage-local-options-state))
(defun erc-show-timestamps ()
"Show timestamp information on display.
@@ -924,7 +938,7 @@ This function only works if `erc-timestamp-format' was previously
set, and timestamping is already active."
(interactive)
(setq erc-hide-timestamps nil)
- (erc-munge-invisibility-spec))
+ (erc-stamp--manage-local-options-state))
(defun erc-toggle-timestamps ()
"Hide or show timestamps in ERC buffers.
@@ -938,7 +952,7 @@ enabled when the message was inserted."
(setq erc-hide-timestamps t))
(mapc (lambda (buffer)
(with-current-buffer buffer
- (erc-munge-invisibility-spec)))
+ (erc-stamp--manage-local-options-state)))
(erc-buffer-list)))
(defvar-local erc-stamp--last-stamp nil)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 7e5ed165fb9..04ee76a9349 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -924,7 +924,7 @@ and expected types. This function should return a face or nil.")
Expect RANKS to be a list of faces and both NORMALS and the car
of NEW-FACES to be hash tables mapping faces to non-nil values.
Assume the latter's makeup and that of RANKS to resemble
-`erc-track-face-normal-list' and `erc-track-faces-priority-list'.
+`erc-track-faces-normal-list' and `erc-track-faces-priority-list'.
If NEW-FACES has a cdr, expect it to be its car's contents
ordered from most recently seen (later in the buffer) to
earliest. In general, act like `erc-track-select-mode-line-face'
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0565440f357..0750463a4e7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -13,7 +13,7 @@
;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
;; Version: 5.6-git
-;; Package-Requires: ((emacs "27.1") (compat "29.1.4.3"))
+;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4"))
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
@@ -135,6 +135,13 @@ concerning buffers."
"Running scripts at startup and with /LOAD."
:group 'erc)
+;; Add `custom-loads' features for group symbols missing from a
+;; supported Emacs version, possibly because they belong to a new ERC
+;; library. These groups all share their library's feature name.
+;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29
+;;;###autoload erc-imenu erc-nicks)) ; 30
+;;;###autoload (custom-add-load symbol symbol))
+
(defvar erc-message-parsed) ; only known to this file
(defvar erc--msg-props nil
@@ -386,6 +393,16 @@ If nil, only \"> \" will be shown."
(const "PART")
(const "QUIT")
(const "MODE")
+ (const :tag "Away notices (RPL_AWAY 301)" "301")
+ (const :tag "Self back notice (REP_UNAWAY 305)" "305")
+ (const :tag "Self away notice (REP_NOWAWAY 306)" "306")
+ (const :tag "Channel modes on join (RPL_CHANNELMODEIS 324)" "324")
+ (const :tag "Channel creation time (RPL_CREATIONTIME 329)" "329")
+ (const :tag "Channel no-topic on join (RPL_NOTOPIC 331)" "331")
+ (const :tag "Channel topic on join (RPL_TOPIC 332)" "332")
+ (const :tag "Topic author and time on join (RPL_TOPICWHOTIME 333)" "333")
+ (const :tag "Invitation success notice (RPL_INVITING 341)" "341")
+ (const :tag "Channel member names (353 RPL_NAMEREPLY)" "353")
(repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
(defcustom erc-hide-list nil
@@ -598,28 +615,52 @@ Removes all users in the current channel. This is called by
erc-channel-users)
(clrhash erc-channel-users)))
-(defmacro erc--define-channel-user-status-compat-getter (name n)
+(defmacro erc--define-channel-user-status-compat-getter (name c d)
"Define a gv getter for historical `erc-channel-user' status slot NAME.
-Expect NAME to be a string and N to be its associated power-of-2
-\"enumerated flag\" integer."
+Expect NAME to be a string, C to be its traditionally associated
+letter, and D to be its fallback power-of-2 integer for non-ERC
+buffers."
`(defun ,(intern (concat "erc-channel-user-" name)) (u)
,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'."
name)
(declare (gv-setter (lambda (v)
(macroexp-let2 nil v v
- (,'\`(let ((val (erc-channel-user-status ,',u)))
+ (,'\`(let ((val (erc-channel-user-status ,',u))
+ (n (or (erc--get-prefix-flag ,c) ,d)))
(setf (erc-channel-user-status ,',u)
(if ,',v
- (logior val ,n)
- (logand val ,(lognot n))))
+ (logior val n)
+ (logand val (lognot n))))
,',v))))))
- (= ,n (logand ,n (erc-channel-user-status u)))))
-
-(erc--define-channel-user-status-compat-getter "voice" 1)
-(erc--define-channel-user-status-compat-getter "halfop" 2)
-(erc--define-channel-user-status-compat-getter "op" 4)
-(erc--define-channel-user-status-compat-getter "admin" 8)
-(erc--define-channel-user-status-compat-getter "owner" 16)
+ (let ((n (or (erc--get-prefix-flag ,c) ,d)))
+ (= n (logand n (erc-channel-user-status u))))))
+
+(erc--define-channel-user-status-compat-getter "voice" ?v 1)
+(erc--define-channel-user-status-compat-getter "halfop" ?h 2)
+(erc--define-channel-user-status-compat-getter "op" ?o 4)
+(erc--define-channel-user-status-compat-getter "admin" ?a 8)
+(erc--define-channel-user-status-compat-getter "owner" ?q 16)
+
+;; This is a generalized version of the compat-oriented getters above.
+(defun erc--cusr-status-p (nick-or-cusr letter)
+ "Return non-nil if NICK-OR-CUSR has channel membership status LETTER."
+ (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
+ (cdr (erc-get-channel-member nick-or-cusr))))
+ (n (erc--get-prefix-flag letter)))
+ (= n (logand n (erc-channel-user-status cusr)))))
+
+(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp)
+ "Add or remove membership status associated with LETTER for NICK-OR-CUSR.
+With RESETP, clear the user's status info completely. If ENABLEP
+is non-nil, add the status value associated with LETTER."
+ (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
+ (cdr (erc-get-channel-member nick-or-cusr))))
+ (n (erc--get-prefix-flag letter)))
+ (cl-callf (lambda (v)
+ (if resetp
+ (if enablep n 0)
+ (if enablep (logior v n) (logand v (lognot n)))))
+ (erc-channel-user-status cusr))))
(defun erc-channel-user-owner-p (nick)
"Return non-nil if NICK is an owner of the current channel."
@@ -1211,30 +1252,30 @@ anyway."
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
(defcustom erc-pre-send-functions nil
- "Special hook run to possibly alter the string that is sent.
-The functions are called with one argument, an `erc-input' struct,
-and should alter that struct.
-
-The struct has three slots:
+ "Special hook to possibly alter the string to send and insert.
+ERC calls the member functions with one argument, an `erc-input'
+struct instance to modify as needed.
- `string': The current input string.
- `insertp': Whether the string should be inserted into the erc buffer.
- `sendp': Whether the string should be sent to the irc server.
-
-And one \"phony\" slot only accessible by hook members at runtime:
+The struct has five slots:
- `refoldp': Whether the string should be re-split per protocol limits.
+ `string': String to send, originally from prompt input.
+ `insertp': Whether a string should be inserted in the buffer.
+ `sendp': Whether `string' should be sent to the IRC server.
+ `substxt': String to display (but not send) instead of `string'.
+ `refoldp': Whether to re-split `string' per protocol limits.
This hook runs after protocol line splitting has taken place, so
-the value of `string' is originally \"pre-filled\". If you need
-ERC to refill the entire payload before sending it, set the phony
-`refoldp' slot to a non-nil value. Note that this refilling is
-only a convenience, and modules with special needs, such as
-preserving \"preformatted\" text or encoding for subprotocol
-\"tunneling\", should handle splitting manually."
- :group 'erc
- :type 'hook
- :version "27.1")
+the value of `string' comes \"pre-split\" according to the option
+`erc-split-line-length'. If you need ERC to refill the entire
+payload before sending it, set the `refoldp' slot to a non-nil
+value. Note that this refilling is only a convenience, and
+modules with special needs, such as preserving \"preformatted\"
+text or encoding for subprotocol \"tunneling\", should handle
+splitting manually and possibly also specify replacement text to
+display via the `substxt' slot."
+ :package-version '(ERC . "5.3")
+ :group 'erc-hooks
+ :type 'hook)
(define-obsolete-variable-alias 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
@@ -1278,8 +1319,8 @@ of `erc-insert-this' is t.
ERC runs this hook with the buffer narrowed to the bounds of the
inserted message plus a trailing newline. Built-in modules place
-their hook members at depths between 20 and 80, with those from
-the stamp module always running last. Use the functions
+their hook members in two depth ranges: the first between -80 and
+-20 and the second between 20 and 80. Use the functions
`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
@@ -1497,7 +1538,7 @@ Bound to local variables from an existing (logical) session's
buffer during local-module setup and `erc-mode-hook' activation.")
(defmacro erc--restore-initialize-priors (mode &rest vars)
- "Restore local VARS for MODE from a previous session."
+ "Restore local VARS for local minor MODE from a previous session."
(declare (indent 1))
(let ((priors (make-symbol "priors"))
(initp (make-symbol "initp"))
@@ -1507,6 +1548,8 @@ buffer during local-module setup and `erc-mode-hook' activation.")
(push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms))
`(let* ((,priors (or erc--server-reconnecting erc--target-priors))
(,initp (and ,priors (alist-get ',mode ,priors))))
+ (unless (local-variable-if-set-p ',mode)
+ (error "Not a local minor mode var: %s" ',mode))
(setq ,@(mapcan #'identity (nreverse forms))))))
(defun erc--target-from-string (string)
@@ -1620,11 +1663,7 @@ If BUFFER is nil, the current buffer is used."
(defun erc-query-buffer-p (&optional buffer)
"Return non-nil if BUFFER is an ERC query buffer.
If BUFFER is nil, the current buffer is used."
- (with-current-buffer (or buffer (current-buffer))
- (let ((target (erc-target)))
- (and (eq major-mode 'erc-mode)
- target
- (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
+ (not (erc-channel-p (or buffer (current-buffer)))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
@@ -1691,7 +1730,7 @@ Defaults to the server buffer."
(defconst erc-default-server "irc.libera.chat"
"IRC server to use if it cannot be detected otherwise.")
-(defconst erc-default-port 6667
+(defvar erc-default-port 6667
"IRC port to use if it cannot be detected otherwise.")
(defconst erc-default-port-tls 6697
@@ -1839,18 +1878,20 @@ buries those."
:group 'erc-buffers
:type 'boolean)
-(defun erc-channel-p (channel)
- "Return non-nil if CHANNEL seems to be an IRC channel name."
- (cond ((stringp channel)
- (memq (aref channel 0)
- (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single)))
- (append types nil)
- '(?# ?& ?+ ?!))))
- ((and-let* (((bufferp channel))
- ((buffer-live-p channel))
- (target (buffer-local-value 'erc--target channel)))
- (erc-channel-p (erc--target-string target))))
- (t nil)))
+(defvar erc--fallback-channel-prefixes "#&"
+ "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.")
+
+(defun erc-channel-p (target)
+ "Return non-nil if TARGET is a valid channel name or a channel buffer."
+ (cond ((stringp target)
+ (and-let*
+ (((not (string-empty-p target)))
+ (value (let ((entry (erc--get-isupport-entry 'CHANTYPES)))
+ (if entry (cadr entry) erc--fallback-channel-prefixes)))
+ ((erc--strpos (aref target 0) value)))))
+ ((and-let* (((buffer-live-p target))
+ (target (buffer-local-value 'erc--target target))
+ ((erc--target-channel-p target)))))))
;; For the sake of compatibility, a historical quirk concerning this
;; option, when nil, has been preserved: all buffers are suffixed with
@@ -2149,13 +2190,17 @@ buffer rather than a server buffer.")
(cl-pushnew mod (if (get mod 'erc--module) built-in third-party)))
`(,@(sort built-in #'string-lessp) ,@(nreverse third-party))))
+;;;###autoload(custom-autoload 'erc-modules "erc")
+
(defcustom erc-modules '( autojoin button completion fill imenu irccontrols
list match menu move-to-prompt netsplit
networks readonly ring stamp track)
- "A list of modules which ERC should enable.
-If you set the value of this without using `customize' remember to call
-\(erc-update-modules) after you change it. When using `customize', modules
-removed from the list will be disabled."
+ "Modules to enable while connecting.
+When modifying this option in lisp code, use a Custom-friendly
+facilitator, like `setopt', or call `erc-update-modules'
+afterward. This ensures a consistent ordering and disables
+removed modules. It also gives packages access to the hook
+`erc-before-connect'."
:get (lambda (sym)
;; replace outdated names with their newer equivalents
(erc-migrate-modules (symbol-value sym)))
@@ -2439,29 +2484,22 @@ nil."
(cl-assert (= (point) (point-max)))))
(defun erc-open (&optional server port nick full-name
- connect passwd tgt-list channel process
+ connect passwd _tgt-list channel process
client-certificate user id)
- "Connect to SERVER on PORT as NICK with USER and FULL-NAME.
-
-If CONNECT is non-nil, connect to the server. Otherwise assume
-already connected and just create a separate buffer for the new
-target given by CHANNEL, meaning these parameters are mutually
-exclusive. Note that CHANNEL may also be a query; its name has
-been retained for historical reasons.
-
-Use PASSWD as user password on the server. If TGT-LIST is
-non-nil, use it to initialize `erc-default-recipients'.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the file name of the private key corresponding
-to a client certificate and the second element is the file name
-of the client certificate itself to use when connecting over TLS,
-or t, which means that `auth-source' will be queried for the
-private key and the certificate.
-
-When non-nil, ID should be a symbol for identifying the connection.
-
-Returns the buffer for the given server or channel."
+ "Return a new or reinitialized server or target buffer.
+If CONNECT is non-nil, connect to SERVER and return its new or
+reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs
+to an active session, and return a new or refurbished target buffer for
+CHANNEL, which may also be a query target (the parameter name remains
+for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and
+PASSWD to `erc-determine-parameters' for preserving as session-local
+variables. Do something similar for CLIENT-CERTIFICATE and ID, which
+should be as described by `erc-tls'.
+
+Note that ERC ignores TGT-LIST and initializes `erc-default-recipients'
+with CHANNEL as its only member. Note also that this function has the
+side effect of setting the current buffer to the one it returns. Use
+`with-current-buffer' or `save-excursion' to nullify this effect."
(let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer))
@@ -2498,7 +2536,7 @@ Returns the buffer for the given server or channel."
;; connection parameters
(setq erc-server-process process)
;; stack of default recipients
- (setq erc-default-recipients tgt-list)
+ (when channel (setq erc-default-recipients (list channel)))
(when target
(setq erc--target target
erc-network (erc-network)))
@@ -2637,8 +2675,11 @@ typically the same as that reported by `erc-current-nick'."
;;;###autoload
(defun erc-select-read-args ()
- "Prompt the user for values of nick, server, port, and password.
-With prefix arg, also prompt for user and full name."
+ "Prompt for connection parameters and return them in a plist.
+By default, collect `:server', `:port', `:nickname', and
+`:password'. With a non-nil prefix argument, also prompt for
+`:user' and `:full-name'. Also return various environmental
+properties needed by entry-point commands, like `erc-tls'."
(let* ((input (let ((d (erc-compute-server)))
(if erc--prompt-for-server-function
(funcall erc--prompt-for-server-function)
@@ -2692,7 +2733,7 @@ With prefix arg, also prompt for user and full name."
(setq passwd nil))
`( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user))
,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full))
- ,@(and env `(&interactive-env ,env)))))
+ ,@(and env `(--interactive-env-- ,env)))))
(defmacro erc--with-entrypoint-environment (env &rest body)
"Run BODY with bindings from ENV alist."
@@ -2721,30 +2762,41 @@ With prefix arg, also prompt for user and full name."
(full-name (erc-compute-full-name))
id
;; Used by interactive form
- ((&interactive-env --interactive-env--)))
- "ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC.
-
-It allows selecting connection parameters, and then starts ERC.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- id
-
-That is, if called with
+ ((--interactive-env-- --interactive-env--)))
+ "Connect to an Internet Relay Chat SERVER on a non-TLS PORT.
+Use NICK and USER, when non-nil, to inform the IRC commands of
+the same name, possibly factoring in a non-nil FULL-NAME as well.
+When PASSWORD is non-nil, also send an opening server password
+via the \"PASS\" command. Interactively, prompt for SERVER,
+PORT, NICK, and PASSWORD, along with USER and FULL-NAME when
+given a prefix argument. Non-interactively, expect the rarely
+needed ID parameter, when non-nil, to be a symbol or a string for
+naming the server buffer and identifying the connection
+unequivocally. Once connected, return the server buffer. (See
+Info node `(erc) Connecting' for details about all mentioned
+parameters.)
+
+Together with `erc-tls', this command serves as the main entry
+point for ERC, the powerful, modular, and extensible IRC client.
+Non-interactively, both commands accept the following keyword
+arguments, with their defaults supplied by the indicated
+\"compute\" functions:
+
+ :server `erc-compute-server'
+ :port `erc-compute-port'
+ :nick `erc-compute-nick'
+ :user `erc-compute-user'
+ :password N/A
+ :full-name `erc-compute-full-name'
+ :id' N/A
+
+For example, when called in the following manner
(erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of the other parameters.
-
-See `erc-tls' for the meaning of ID.
+ERC assigns SERVER and FULL-NAME the associated keyword values
+and defers to `erc-compute-port', `erc-compute-user', and
+`erc-compute-nick' for those respective parameters.
\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)"
(interactive (let ((erc--display-context `((erc-interactive-display . erc)
@@ -2770,51 +2822,26 @@ See `erc-tls' for the meaning of ID.
client-certificate
id
;; Used by interactive form
- ((&interactive-env --interactive-env--)))
- "ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC over TLS.
-
-It allows selecting connection parameters, and then starts ERC
-over TLS.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- client-certificate
- id
-
-That is, if called with
-
- (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of their respective parameters.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the certificate key file name, and the second
-element is the certificate file name itself, or t, which means
-that `auth-source' will be queried for the key and the
-certificate. Authenticating using a TLS client certificate is
-also referred to as \"CertFP\" (Certificate Fingerprint)
-authentication by various IRC networks.
-
-Example usage:
+ ((--interactive-env-- --interactive-env--)))
+ "Connect to an IRC server over a TLS-encrypted connection.
+Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along
+with USER and FULL-NAME when given a prefix argument.
+Non-interactively, also accept a CLIENT-CERTIFICATE, which should
+be a list containing the file name of the certificate's key
+followed by that of the certificate itself. Alternatively,
+accept a value of t instead of a list, to tell ERC to query
+`auth-source' for the certificate's details.
+
+Example client certificate (CertFP) usage:
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
\\='(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))
-When present, ID should be a symbol or a string to use for naming
-the server buffer and identifying the connection unequivocally.
-See Info node `(erc) Network Identifier' for details. Like
-CLIENT-CERTIFICATE, this parameter cannot be specified
-interactively.
+See the alternative entry-point command `erc' as well as Info
+node `(erc) Connecting' for a fuller description of the various
+parameters, like ID.
\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)"
(interactive
@@ -3505,6 +3532,40 @@ repeatedly with VAL set to each of VAL's members."
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--reserve-important-text-props (beg end plist &optional object)
+ "Record text-property pairs in PLIST as important between BEG and END.
+Also mark the message being inserted as containing these important props
+so modules performing destructive modifications can later restore them.
+Expect to run in a narrowed buffer at message-insertion time."
+ (when erc--msg-props
+ (let ((existing (erc--check-msg-prop 'erc--important-prop-names)))
+ (puthash 'erc--important-prop-names (cl-union existing (map-keys plist))
+ erc--msg-props)))
+ (erc--merge-prop beg end 'erc--important-props plist object))
+
+(defun erc--restore-important-text-props (props &optional beg end)
+ "Restore PROPS where recorded in the accessible portion of the buffer.
+Expect to run in a narrowed buffer at message-insertion time. Limit the
+effect to the region between buffer positions BEG and END, when non-nil.
+
+Callers should be aware that this function fails if the property
+`erc--important-props' has an empty value almost anywhere along the
+affected region. Use the function `erc--remove-from-prop-value-list' to
+ensure that props with empty values are excised completely."
+ (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names))
+ (present (seq-intersection props registered))
+ (b (or beg (point-min)))
+ (e (or end (point-max))))
+ (while-let
+ (((setq b (text-property-not-all b e 'erc--important-props nil)))
+ (val (get-text-property b 'erc--important-props))
+ (q (next-single-property-change b 'erc--important-props nil e)))
+ (while-let ((k (pop val))
+ (v (pop val)))
+ (when (memq k present)
+ (put-text-property b q k v)))
+ (setq b q))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
@@ -3806,14 +3867,14 @@ TYPE, when non-nil, to be a symbol handled by
string MSG). Expect BUFFER to be among the sort accepted by the
function `erc-display-line'.
-Expect BUFFER to be a live `erc-mode' buffer, a list of such
-buffers, or the symbols `all' or `active'. If `all', insert
-STRING in all buffers for the current session. If `active',
-defer to the function `erc-active-buffer', which may return the
-session's server buffer if the previously active buffer has been
-killed. If BUFFER is nil or a network process, pretend it's set
-to the appropriate server buffer. Otherwise, use the current
-buffer.
+When non-nil, expect BUFFER to be a live `erc-mode' buffer, a
+list of such buffers, or the symbols `all' or `active'. If
+`all', insert STRING in all buffers for the current session. If
+`active', defer to the function `erc-active-buffer', which may
+return the session's server buffer if the previously active
+buffer has been killed. If BUFFER is nil or a network process,
+pretend it's set to the appropriate server buffer. Otherwise,
+use the current buffer.
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
@@ -3826,11 +3887,10 @@ being (erc-error-face erc-notice-face) throughout MSG when
`erc-notice-highlight-type' is left at its default, `all'.
As of ERC 5.6, assume third-party code will use this function
-instead of lower-level ones, like `erc-insert-line', when needing
-ERC to process arbitrary informative messages as if they'd been
-sent from a server. That is, guarantee \"local\" messages, for
-which PARSED is typically nil, will be subject to buttonizing,
-filling, and other effects."
+instead of lower-level ones, like `erc-insert-line', to insert
+arbitrary informative messages as if sent by the server. That
+is, tell modules to treat a \"local\" message for which PARSED is
+nil like any other server-sent message."
(let* ((erc--msg-props
(or erc--msg-props
(let ((table (make-hash-table))
@@ -3912,6 +3972,10 @@ for other purposes.")
(defun erc-send-input-line (target line &optional force)
"Send LINE to TARGET."
+ (when-let ((target)
+ (cmem (erc-get-channel-member (erc-current-nick))))
+ (setf (erc-channel-user-last-message-time (cdr cmem))
+ (erc-compat--current-lisp-time)))
(when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n"))
(setq line " \n"))
(erc-message "PRIVMSG" (concat target " " line) force))
@@ -3940,17 +4004,19 @@ erc-cmd-FOO, this returns a string /FOO."
command-name)))
(defun erc-process-input-line (line &optional force no-command)
- "Translate LINE to an RFC1459 command and send it based.
-Returns non-nil if the command is actually sent to the server, and nil
-otherwise.
-
-If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>',
-it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't
-start with /<COMMAND>) then it is sent as a message.
-
-An optional FORCE argument forces sending the line when flood
-protection is in effect. The optional NO-COMMAND argument prohibits
-this function from interpreting the line as a command."
+ "Dispatch a slash-command or chat-input handler from user-input LINE.
+If simplistic validation fails, print an error and return nil.
+Otherwise, defer to an appropriate handler. For \"slash\" commands,
+like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil
+if LINE is fit for echoing as a command line when executing scripts.
+For normal chat input, expect a handler to return non-nil if a message
+was successfully processed as an outgoing \"PRIVMSG\". If LINE is a
+slash command, and ERC can't find a corresponding handler of the form
+`erc-cmd-<COMMAND>', pass LINE to `erc-cmd-default', treating it as a
+catch-all handler. Otherwise, for normal chat input, pass LINE and the
+boolean argument FORCE to `erc-send-input-line-function'. With a
+non-nil NO-COMMAND, always treat LINE as normal chat input rather than a
+slash command."
(let ((command-list (erc-extract-command-from-line line)))
(if (and command-list
(not no-command))
@@ -4016,16 +4082,42 @@ this function from interpreting the line as a command."
;; Input commands handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun erc-cmd-AMSG (line)
- "Send LINE to all channels of the current server that you are on."
- (interactive "sSend to all channels you're on: ")
- (setq line (erc-trim-string line))
+(defun erc--connected-and-joined-p ()
+ (and (erc--current-buffer-joined-p)
+ erc-server-connected))
+
+(defun erc-cmd-GMSG (line)
+ "Send LINE to all channels on all networks you are on."
+ (setq line (string-remove-prefix " " line))
(erc-with-all-buffers-of-server nil
- (lambda ()
- (erc-channel-p (erc-default-target)))
+ #'erc--connected-and-joined-p
+ (erc-send-message line)))
+(put 'erc-cmd-GMSG 'do-not-parse-args t)
+
+(defun erc-cmd-AMSG (line)
+ "Send LINE to all channels of the current network.
+Interactively, prompt for the line of text to send."
+ (interactive "sSend to all channels on this network: ")
+ (setq line (string-remove-prefix " " line))
+ (erc-with-all-buffers-of-server erc-server-process
+ #'erc--connected-and-joined-p
(erc-send-message line)))
(put 'erc-cmd-AMSG 'do-not-parse-args t)
+(defun erc-cmd-GME (line)
+ "Send LINE as an action to all channels on all networks you are on."
+ (erc-with-all-buffers-of-server nil
+ #'erc--connected-and-joined-p
+ (erc-cmd-ME line)))
+(put 'erc-cmd-GME 'do-not-parse-args t)
+
+(defun erc-cmd-AME (line)
+ "Send LINE as an action to all channels on the current network."
+ (erc-with-all-buffers-of-server erc-server-process
+ #'erc--connected-and-joined-p
+ (erc-cmd-ME line)))
+(put 'erc-cmd-AME 'do-not-parse-args t)
+
(defun erc-cmd-SAY (line)
"Send LINE to the current query or channel as a message, not a command.
@@ -6153,17 +6245,15 @@ return a possibly empty string."
(catch 'done
(pcase-dolist (`(,letter . ,pfx)
(erc--parsed-prefix-alist pfx-obj))
- (pcase letter
- ((and ?q (guard (erc-channel-user-owner nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "owner")))
- ((and ?a (guard (erc-channel-user-admin nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "admin")))
- ((and ?o (guard (erc-channel-user-op nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "operator")))
- ((and ?h (guard (erc-channel-user-halfop nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "half-op")))
- ((and ?v (guard (erc-channel-user-voice nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "voice")))))
+ (when (erc--cusr-status-p nick-or-cusr letter)
+ (throw 'done
+ (pcase letter
+ (?q (propertize (string pfx) 'help-echo "owner"))
+ (?a (propertize (string pfx) 'help-echo "admin"))
+ (?o (propertize (string pfx) 'help-echo "operator"))
+ (?h (propertize (string pfx) 'help-echo "half-op"))
+ (?v (propertize (string pfx) 'help-echo "voice"))
+ (_ (string pfx))))))
"")))
(t
(cond ((erc-channel-user-owner nick-or-cusr)
@@ -6775,12 +6865,52 @@ parameter advertised by the current server, with the original
ordering intact. If no such parameter has yet arrived, return a
stand-in from the fallback value \"(qaohv)~&@%+\"."
(erc--with-isupport-data PREFIX erc--parsed-prefix
- (let ((alist (nreverse (erc-parse-prefix))))
+ (let ((alist (erc-parse-prefix)))
(make-erc--parsed-prefix
:key key
:letters (apply #'string (map-keys alist))
:statuses (apply #'string (map-values alist))
- :alist alist))))
+ :alist (nreverse alist)))))
+
+(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p)
+ "Return numeric rank for CHAR or nil if unknown.
+For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h,
+and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a
+`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to
+be a prefix instead."
+ (and-let* ((obj (or parsed-prefix (erc--parsed-prefix)))
+ (pos (erc--strpos char (if from-prefix-p
+ (erc--parsed-prefix-statuses obj)
+ (erc--parsed-prefix-letters obj)))))
+ (ash 1 pos)))
+
+(defun erc--init-cusr-fallback-status (voice halfop op admin owner)
+ "Return channel-membership based on traditional status semantics.
+Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into
+an internal numeric value suitable for the `status' slot of a new
+`erc-channel-user' object."
+ (let ((pfx (erc--parsed-prefix)))
+ (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0)
+ (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0)
+ (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0)
+ (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0)
+ (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0))))
+
+(defun erc--compute-cusr-fallback-status (current v h o a q)
+ "Return current channel membership after toggling V H O A Q as requested.
+Assume `erc--parsed-prefix' is non-nil in the current buffer.
+Expect status switches V, H, O, A, Q, when non-nil, to be the
+symbol `on' or `off'. Return an internal numeric value suitable
+for the `status' slot of an `erc-channel-user' object."
+ (let (on off)
+ (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off)))
+ (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off)))
+ (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off)))
+ (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off)))
+ (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off)))
+ (when on (setq current (apply #'logior current on)))
+ (when off (setq current (apply #'logand current (mapcar #'lognot off)))))
+ current)
(defcustom erc-channel-members-changed-hook nil
"This hook is called every time the variable `channel-members' changes.
@@ -6788,48 +6918,40 @@ The buffer where the change happened is current while this hook is called."
:group 'erc-hooks
:type 'hook)
-(defun erc-channel-receive-names (names-string)
- "This function is for internal use only.
+(defun erc--partition-prefixed-names (name)
+ "From NAME, return a list of (STATUS NICK LOGIN HOST).
+Expect NAME to be a prefixed name, like @bob."
+ (unless (string-empty-p name)
+ (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p))
+ (nick (if status (substring name 1) name)))
+ (unless (string-empty-p nick)
+ (list status nick nil nil)))))
-Update `erc-channel-users' according to NAMES-STRING.
-NAMES-STRING is a string listing some of the names on the
-channel."
- (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix)))
- (voice-ch (cdr (assq ?v prefix)))
- (op-ch (cdr (assq ?o prefix)))
- (hop-ch (cdr (assq ?h prefix)))
- (adm-ch (cdr (assq ?a prefix)))
- (own-ch (cdr (assq ?q prefix)))
- (names (delete "" (split-string names-string)))
- name op voice halfop admin owner)
- (let ((erc-channel-members-changed-hook nil))
- (dolist (item names)
- (let ((updatep t)
- (ch (aref item 0)))
- (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off)
- (if (rassq ch prefix)
- (if (= (length item) 1)
- (setq updatep nil)
- (setq name (substring item 1))
- (setf (pcase ch
- ((pred (eq voice-ch)) voice)
- ((pred (eq hop-ch)) halfop)
- ((pred (eq op-ch)) op)
- ((pred (eq adm-ch)) admin)
- ((pred (eq own-ch)) owner)
- (_ (message "Unknown prefix char `%S'" ch) voice))
- 'on)))
- (when updatep
+(defun erc-channel-receive-names (names-string)
+ "Update `erc-channel-members' from NAMES-STRING.
+Expect NAMES-STRING to resemble the trailing argument of a 353
+RPL_NAMREPLY. Call internal handlers for parsing individual
+names, whose expected composition may differ depending on enabled
+extensions."
+ (let ((names (delete "" (split-string names-string)))
+ (erc-channel-members-changed-hook nil))
+ (dolist (name names)
+ (when-let ((args (erc--partition-prefixed-names name)))
+ (pcase-let* ((`(,status ,nick ,login ,host) args)
+ (cmem (erc-get-channel-user nick)))
+ (progn
;; If we didn't issue the NAMES request (consider two clients
;; talking to an IRC proxy), `erc-channel-begin-receiving-names'
;; will not have been called, so we have to do it here.
(unless erc-channel-new-member-names
(erc-channel-begin-receiving-names))
- (puthash (erc-downcase name) t
- erc-channel-new-member-names)
- (erc-update-current-channel-member
- name name t voice halfop op admin owner)))))
- (run-hooks 'erc-channel-members-changed-hook)))
+ (puthash (erc-downcase nick) t erc-channel-new-member-names)
+ (if cmem
+ (erc--update-current-channel-member cmem status nil
+ nick host login)
+ (erc--create-current-channel-member nick status nil
+ nick host login)))))))
+ (run-hooks 'erc-channel-members-changed-hook))
(defun erc-update-user-nick (nick &optional new-nick
host login full-name info)
@@ -6881,17 +7003,85 @@ which USER is a member, and t is returned."
(run-hooks 'erc-channel-members-changed-hook))))))
changed))
+(defun erc--create-current-channel-member
+ (nick status timep &optional new-nick host login full-name info)
+ "Add an `erc-channel-member' entry for NICK.
+Create a new `erc-server-users' entry if necessary, and ensure
+`erc-channel-members-changed-hook' runs exactly once, regardless.
+Pass STATUS to the `erc-channel-user' constructor. With TIMEP,
+assume NICK has just spoken, and initialize `last-message-time'.
+Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to
+`erc-update-user' if a server user exists and otherwise to the
+`erc-server-user' constructor."
+ (cl-assert (null (erc-get-channel-member nick)))
+ (let* ((user-changed-p nil)
+ (down (erc-downcase nick))
+ (user (gethash down (erc-with-server-buffer erc-server-users))))
+ (if user
+ (progn
+ (cl-pushnew (current-buffer) (erc-server-user-buffers user))
+ ;; Update *after* ^ so hook has chance to run.
+ (setf user-changed-p (erc-update-user user new-nick host login
+ full-name info)))
+ (erc-add-server-user nick
+ (setq user (make-erc-server-user
+ :nickname (or new-nick nick)
+ :host host
+ :full-name full-name
+ :login login
+ :info nil
+ :buffers (list (current-buffer))))))
+ (let ((cusr (erc-channel-user--make
+ :status (or status 0)
+ :last-message-time (and timep
+ (erc-compat--current-lisp-time)))))
+ (puthash down (cons user cusr) erc-channel-users))
+ ;; An existing `cusr' was changed or a new one was added, and
+ ;; `user' was not updated, though possibly just created (since
+ ;; `erc-update-user' runs this same hook in all a user's buffers).
+ (unless user-changed-p
+ (run-hooks 'erc-channel-members-changed-hook))
+ t))
+
+(defun erc--update-current-channel-member (cmem status timep &rest user-args)
+ "Update existing `erc-channel-member' entry.
+Set the `status' slot of the entry's `erc-channel-user' side to
+STATUS and, with TIMEP, update its `last-message-time'. When
+actual changes are made, run `erc-channel-members-changed-hook',
+and return non-nil."
+ (cl-assert cmem)
+ (let ((cusr (cdr cmem))
+ (user (car cmem))
+ cusr-changed-p user-changed-p)
+ (when (and status (/= status (erc-channel-user-status cusr)))
+ (setf (erc-channel-user-status cusr) status
+ cusr-changed-p t))
+ (when timep
+ (setf (erc-channel-user-last-message-time cusr)
+ (erc-compat--current-lisp-time)))
+ ;; Ensure `erc-channel-members-changed-hook' runs on change.
+ (cl-assert (memq (current-buffer) (erc-server-user-buffers user)))
+ (setq user-changed-p (apply #'erc-update-user user user-args))
+ ;; An existing `cusr' was changed or a new one was added, and
+ ;; `user' was not updated, though possibly just created (since
+ ;; `erc-update-user' runs this same hook in all a user's buffers).
+ (when (and cusr-changed-p (null user-changed-p))
+ (run-hooks 'erc-channel-members-changed-hook))
+ (erc-log (format "update-member: user = %S, cusr = %S" user cusr))
+ (or cusr-changed-p user-changed-p)))
+
(defun erc-update-current-channel-member
- (nick new-nick &optional addp voice halfop op admin owner host login full-name info
- update-message-time)
+ (nick new-nick &optional addp voice halfop op admin owner host login
+ full-name info update-message-time)
"Update or create entry for NICK in current `erc-channel-members' table.
-With ADDP, ensure an entry exists. If one already does, call
-`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME,
-INFO, and NEW-NICK. Expect any non-nil membership status
-switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the
-symbol `on' or `off' when needing to influence a new or existing
-`erc-channel-user' object's `status' slot. Likewise, when
-UPDATE-MESSAGE-TIME is non-nil, update or initialize the
+With ADDP, ensure an entry exists. When an entry does exist or
+when ADDP is non-nil and an `erc-server-users' entry already
+exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN,
+FULL-NAME, and INFO. Expect any non-nil membership
+status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be
+the symbol `on' or `off' when needing to influence a new or
+existing `erc-channel-user' object's `status' slot. Likewise,
+when UPDATE-MESSAGE-TIME is non-nil, update or initialize the
`last-message-time' slot to the current-time. If changes occur,
including creation, run `erc-channel-members-changed-hook'.
Return non-nil when meaningful changes, including creation, have
@@ -6901,62 +7091,26 @@ Without ADDP, do nothing unless a `erc-channel-members' entry
exists. When it doesn't, assume the sender is a non-joined
entity, like the server itself or a historical speaker, or assume
the prior buffer for the channel was killed without parting."
- (let* (cusr-changed-p
- user-changed-p
- (cmem (erc-get-channel-member nick))
- (cusr (cdr cmem))
- (down (erc-downcase nick))
- (user (or (car cmem)
- (gethash down (erc-with-server-buffer erc-server-users)))))
- (if cusr
- (progn
- (erc-log (format "update-member: user = %S, cusr = %S" user cusr))
- (when-let (((or voice halfop op admin owner))
- (existing (erc-channel-user-status cusr)))
- (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on)))
- (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on)))
- (when op (setf (erc-channel-user-op cusr) (eq op 'on)))
- (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on)))
- (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on)))
- (setq cusr-changed-p (= existing (erc-channel-user-status cusr))))
- (when update-message-time
- (setf (erc-channel-user-last-message-time cusr) (current-time)))
- ;; Assume `user' exists and its `buffers' slot contains the
- ;; current buffer so that `erc-channel-members-changed-hook'
- ;; will run if changes are made.
- (setq user-changed-p
- (erc-update-user user new-nick
- host login full-name info)))
- (when addp
- (if (null user)
- (progn
- (setq user (make-erc-server-user
- :nickname nick
- :host host
- :full-name full-name
- :login login
- :info info
- :buffers (list (current-buffer))))
- (erc-add-server-user nick user))
- (setf (erc-server-user-buffers user)
- (cons (current-buffer)
- (erc-server-user-buffers user))))
- (setq cusr (make-erc-channel-user
- :voice (and voice (eq voice 'on))
- :halfop (and halfop (eq halfop 'on))
- :op (and op (eq op 'on))
- :admin (and admin (eq admin 'on))
- :owner (and owner (eq owner 'on))
- :last-message-time (if update-message-time
- (current-time))))
- (puthash down (cons user cusr) erc-channel-users)
- (setq cusr-changed-p t)))
- ;; An existing `cusr' was changed or a new one was added, and
- ;; `user' was not updated, though possibly just created (since
- ;; `erc-update-user' runs this same hook in all a user's buffers).
- (when (and cusr-changed-p (null user-changed-p))
- (run-hooks 'erc-channel-members-changed-hook))
- (or cusr-changed-p user-changed-p)))
+(let* ((cmem (erc-get-channel-member nick))
+ (status (and (or voice halfop op admin owner)
+ (if cmem
+ (erc--compute-cusr-fallback-status
+ (erc-channel-user-status (cdr cmem))
+ voice halfop op admin owner)
+ (erc--init-cusr-fallback-status
+ (and voice (eq voice 'on))
+ (and halfop (eq halfop 'on))
+ (and op (eq op 'on))
+ (and admin (eq admin 'on))
+ (and owner (eq owner 'on)))))))
+ (if cmem
+ (erc--update-current-channel-member cmem status update-message-time
+ new-nick host login
+ full-name info)
+ (when addp
+ (erc--create-current-channel-member nick status update-message-time
+ new-nick host login
+ full-name info)))))
(defun erc-update-channel-member (channel nick new-nick
&optional add voice halfop op admin owner host login
@@ -7146,16 +7300,6 @@ person who changed the modes."
;; nick modes - ignored at this point
(t nil))))
-(defun erc--update-membership-prefix (nick letter state)
- "Update status prefixes for NICK in current channel buffer.
-Expect LETTER to be a status char and STATE to be a boolean."
- (erc-update-current-channel-member nick nil nil
- (and (= letter ?v) state)
- (and (= letter ?h) state)
- (and (= letter ?o) state)
- (and (= letter ?a) state)
- (and (= letter ?q) state)))
-
(defvar-local erc--channel-modes nil
"When non-nil, a hash table of current channel modes.
Keys are characters. Values are either a string, for types A-C,
@@ -7201,7 +7345,7 @@ complement relevant letters in STRING."
(cond ((= ?+ c) (setq +p t))
((= ?- c) (setq +p nil))
((and status-letters (string-search (string c) status-letters))
- (erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
+ (erc--cusr-change-status (pop args) c +p))
((and-let* ((group (or (aref table c) (and fallbackp ?d))))
(erc--handle-channel-mode group c +p
(and (/= group ?d)
@@ -7523,6 +7667,12 @@ See associated unit test for precise behavior."
(match-string 2 string)
(match-string 3 string))))
+(defun erc--shuffle-nuh-nickward (nick login host)
+ "Interpret results of `erc--parse-nuh', promoting loners to nicks."
+ (cond (nick (cl-assert (null login)) (list nick login host))
+ ((and (null login) host) (list host nil nil))
+ ((and login (null host)) (list login nil nil))))
+
(defun erc-extract-nick (string)
"Return the nick corresponding to a user specification STRING.
@@ -7821,26 +7971,10 @@ When all lines are empty, remove all but the first."
"Partition non-command input into lines of protocol-compliant length."
;; Prior to ERC 5.6, line splitting used to be predicated on
;; `erc-flood-protect' being non-nil.
- (unless (erc--input-split-cmdp state)
+ (unless (or (zerop erc-split-line-length) (erc--input-split-cmdp state))
(setf (erc--input-split-lines state)
(mapcan #'erc--split-line (erc--input-split-lines state)))))
-(defun erc--input-ensure-hook-context ()
- (unless (erc--input-split-p erc--current-line-input-split)
- (error "Invoked outside of `erc-pre-send-functions'")))
-
-(defun erc-input-refoldp (_)
- "Impersonate accessor for phony `erc-input' `refoldp' slot.
-This function only works inside `erc-pre-send-functions' members."
- (declare (gv-setter (lambda (v)
- `(progn
- (erc--input-ensure-hook-context)
- (setf (erc--input-split-refoldp
- erc--current-line-input-split)
- ,v)))))
- (erc--input-ensure-hook-context)
- (erc--input-split-refoldp erc--current-line-input-split))
-
(defun erc--run-send-hooks (lines-obj)
"Run send-related hooks that operate on the entire prompt input.
Sequester some of the back and forth involved in honoring old
@@ -7858,12 +7992,17 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object."
(state (progn
;; This may change `str' and `erc-*-this'.
(run-hook-with-args 'erc-send-pre-hook str)
- (make-erc-input :string str
- :insertp erc-insert-this
- :sendp erc-send-this))))
+ (make-erc-input
+ :string str
+ :insertp erc-insert-this
+ :sendp erc-send-this
+ :substxt (erc--input-split-substxt lines-obj)
+ :refoldp (erc--input-split-refoldp lines-obj)))))
(run-hook-with-args 'erc-pre-send-functions state)
(setf (erc--input-split-sendp lines-obj) (erc-input-sendp state)
(erc--input-split-insertp lines-obj) (erc-input-insertp state)
+ (erc--input-split-substxt lines-obj) (erc-input-substxt state)
+ (erc--input-split-refoldp lines-obj) (erc-input-refoldp state)
;; See note in test of same name re trailing newlines.
(erc--input-split-lines lines-obj)
(let ((lines (split-string (erc-input-string state)
@@ -7878,17 +8017,22 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object."
(user-error "Multiline command detected" ))
lines-obj)
-(cl-defmethod erc--send-input-lines (lines-obj)
+(defun erc--send-input-lines (lines-obj)
"Send lines in `erc--input-split-lines' object LINES-OBJ."
(when (erc--input-split-sendp lines-obj)
- (dolist (line (erc--input-split-lines lines-obj))
- (when (erc--input-split-insertp lines-obj)
- (if (functionp (erc--input-split-insertp lines-obj))
- (funcall (erc--input-split-insertp lines-obj) line)
- (erc-display-msg line)))
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect)
- (not (erc--input-split-cmdp lines-obj))))))
+ (let ((insertp (erc--input-split-insertp lines-obj))
+ (substxt (erc--input-split-substxt lines-obj)))
+ (when (and insertp substxt)
+ (setq insertp nil)
+ (if (functionp substxt)
+ (apply substxt (erc--input-split-lines lines-obj))
+ (erc-display-msg substxt)))
+ (dolist (line (erc--input-split-lines lines-obj))
+ (when insertp
+ (erc-display-msg line))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect)
+ (not (erc--input-split-cmdp lines-obj)))))))
(defun erc-send-input (input &optional skip-ws-chk)
"Treat INPUT as typed in by the user.
@@ -7972,9 +8116,18 @@ as outgoing chat messages and echoed slash commands."
(when (fboundp cmd) cmd)))
(defun erc-extract-command-from-line (line)
- "Extract command and args from the input LINE.
-If no command was given, return nil. If command matches, return a
-list of the form: (command args) where both elements are strings."
+ "Extract a \"slash command\" and its args from a prompt-input LINE.
+If LINE doesn't start with a slash command, return nil. If it
+does, meaning the pattern `erc-command-regexp' matches, return a
+list of the form (COMMAND ARGS), where COMMAND is either a symbol
+for a known handler function or `erc-cmd-default' if unknown.
+When COMMAND has the symbol property `do-not-parse-args', return
+a string in place of ARGS: that is, either LINE itself, when LINE
+consists of only whitespace, or LINE stripped of any trailing
+whitespace, including a final newline. When COMMAND lacks the
+symbol property `do-not-parse-args', return a possibly empty list
+of non-whitespace tokens. Do not perform any shell-style parsing
+of quoted or escaped substrings."
(when (string-match erc-command-regexp line)
(let* ((cmd (erc-command-symbol (match-string 1 line)))
;; note: return is nil, we apply this simply for side effects
@@ -8045,7 +8198,6 @@ See also `erc-downcase'."
(defun erc--current-buffer-joined-p ()
"Return non-nil if the current buffer is a channel and is joined."
- (cl-assert erc--target)
(and (erc--target-channel-p erc--target)
(erc--target-channel-joined-p erc--target)
t))
@@ -8362,7 +8514,8 @@ and so on."
((string-match "^%[Ss]$" esc) server)
((string-match "^%[Nn]$" esc) nick)
((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
- (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
+ (t (erc-log (format "Bad escape sequence in %s: %S\n"
+ 'erc-process-script-line esc))
(message "BUG IN ERC: esc=%S" esc)
"")))
(setq line tail)
@@ -8381,37 +8534,6 @@ and so on."
(buffer-string))))
(erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
-(defun erc-load-irc-script-lines (lines &optional force noexpand)
- "Load IRC script LINES (a list of strings).
-
-If optional NOEXPAND is non-nil, do not expand script-specific
-sequences, process the lines verbatim. Use this for multiline
-user input."
- (let* ((cb (current-buffer))
- (s "")
- (sp (or (and (bound-and-true-p erc-command-indicator-mode)
- (fboundp 'erc-command-indicator)
- (erc-command-indicator))
- (erc-prompt)))
- (args (and (boundp 'erc-script-args) erc-script-args)))
- (if (and args (string-match "^ " args))
- (setq args (substring args 1)))
- ;; prepare the prompt string for echo
- (erc-put-text-property 0 (length sp)
- 'font-lock-face 'erc-command-indicator-face sp)
- (while lines
- (setq s (car lines))
- (erc-log (concat "erc-load-script: CMD: " s))
- (unless (string-match "^\\s-*$" s)
- (let ((line (if noexpand s (erc-process-script-line s args))))
- (if (and (erc-process-input-line line force)
- erc-script-echo)
- (progn
- (erc-put-text-property 0 (length line)
- 'font-lock-face 'erc-input-face line)
- (erc-display-line (concat sp line) cb)))))
- (setq lines (cdr lines)))))
-
;; authentication
(defun erc--unfun (maybe-fn)
@@ -9319,6 +9441,12 @@ if yet untried."
(unless catalog (setq catalog erc-current-message-catalog))
(symbol-value
(or (erc--make-message-variable-name catalog key 'softp)
+ (let ((parent catalog)
+ last)
+ (while (and (setq parent (get parent 'erc--base-format-catalog))
+ (not (setq last (erc--make-message-variable-name
+ parent key 'softp)))))
+ last)
(let ((default (default-toplevel-value 'erc-current-message-catalog)))
(or (and (not (eq default catalog))
(erc--make-message-variable-name default key 'softp))
@@ -9395,6 +9523,7 @@ guarantee that the input method functions properly for the
purpose of typing within the ERC prompt."
(when (and (eq major-mode 'erc-mode)
(fboundp 'set-text-conversion-style))
+ (defvar text-conversion-style) ; avoid free variable warning on <=29
(if (>= (point) (erc-beg-of-input-line))
(unless (eq text-conversion-style 'action)
(set-text-conversion-style 'action))
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 8f68a750bd7..6ec53ef9412 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -160,6 +160,18 @@ or `eshell-printn' for display."
:preserve-args
:usage "[-S] [mode]")
(cond
+ (args
+ (let* ((mask (car args))
+ (modes
+ (if (stringp mask)
+ (if (string-match (rx bos (+ (any "0-7")) eos) mask)
+ (- #o777 (string-to-number mask 8))
+ (file-modes-symbolic-to-number
+ mask (default-file-modes)))
+ (- #o777 mask))))
+ (set-default-file-modes modes)
+ (eshell-print
+ "Warning: umask changed for all new files created by Emacs.\n")))
(symbolic-p
(let ((mode (default-file-modes)))
(eshell-printn
@@ -173,17 +185,9 @@ or `eshell-printn' for display."
(concat (and (= (logand mode 1) 1) "r")
(and (= (logand mode 2) 2) "w")
(and (= (logand mode 4) 4) "x"))))))
- ((not args)
- (eshell-printn (format "%03o" (logand (lognot (default-file-modes))
- #o777))))
(t
- (when (stringp (car args))
- (if (string-match "^[0-7]+$" (car args))
- (setcar args (string-to-number (car args) 8))
- (error "Setting umask symbolically is not yet implemented")))
- (set-default-file-modes (- #o777 (car args)))
- (eshell-print
- "Warning: umask changed for all new files created by Emacs.\n")))
+ (eshell-printn (format "%03o" (logand (lognot (default-file-modes))
+ #o777)))))
nil))
(put 'eshell/umask 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index cf90a8bb230..07063afc286 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -262,6 +262,7 @@ Thus, this does not include the current directory.")
(defun eshell-parse-user-reference ()
"An argument beginning with ~ is a filename to be expanded."
(when (and (not eshell-current-argument)
+ (not eshell-current-quoted)
(eq (char-after) ?~))
;; Apply this modifier fairly early so it happens before things
;; like glob expansion.
@@ -316,7 +317,7 @@ Thus, this does not include the current directory.")
(`(boundaries . ,suffix)
`(boundaries 0 . ,(string-search "/" suffix))))))))))
-(defun eshell/pwd (&rest _args)
+(defun eshell/pwd ()
"Change output from `pwd' to be cleaner."
(let* ((path default-directory)
(len (length path)))
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index b0c3e6e7a11..7fc6958a00f 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -190,6 +190,12 @@ interpretation."
'(("**/" . recurse)
("***/" . recurse-symlink)))
+(defsubst eshell-glob-chars-regexp ()
+ "Return the lazily-created value for `eshell-glob-chars-regexp'."
+ (or eshell-glob-chars-regexp
+ (setq-local eshell-glob-chars-regexp
+ (format "[%s]+" (apply 'string eshell-glob-chars-list)))))
+
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:
@@ -210,11 +216,8 @@ set to true, then these characters will match themselves in the
resulting regular expression."
(let ((matched-in-pattern 0) ; How much of PATTERN handled
regexp)
- (while (string-match
- (or eshell-glob-chars-regexp
- (setq-local eshell-glob-chars-regexp
- (format "[%s]+" (apply 'string eshell-glob-chars-list))))
- pattern matched-in-pattern)
+ (while (string-match (eshell-glob-chars-regexp)
+ pattern matched-in-pattern)
(let* ((op-begin (match-beginning 0))
(op-char (aref pattern op-begin)))
(setq regexp
@@ -239,6 +242,10 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
+(defun eshell-glob-p (pattern)
+ "Return non-nil if PATTERN has any special glob characters."
+ (string-match (eshell-glob-chars-regexp) pattern))
+
(defun eshell-glob-convert-1 (glob &optional last)
"Convert a GLOB matching a single element of a file name to regexps.
If LAST is non-nil, this glob is the last element of a file name.
@@ -291,14 +298,13 @@ The result is a list of three elements:
symlinks.
3. A boolean indicating whether to match directories only."
- (let ((globs (eshell-split-path glob))
- (isdir (eq (aref glob (1- (length glob))) ?/))
+ (let ((globs (eshell-split-filename glob))
+ (isdir (string-suffix-p "/" glob))
start-dir result last-saw-recursion)
(if (and (cdr globs)
(file-name-absolute-p (car globs)))
- (setq start-dir (car globs)
- globs (cdr globs))
- (setq start-dir "."))
+ (setq start-dir (pop globs))
+ (setq start-dir (file-name-as-directory ".")))
(while globs
(if-let ((recurse (cdr (assoc (car globs)
eshell-glob-recursive-alist))))
@@ -306,11 +312,15 @@ The result is a list of three elements:
(setcar result recurse)
(push recurse result)
(setq last-saw-recursion t))
- (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
- result)
+ (if (or result (eshell-glob-p (car globs)))
+ (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
+ result)
+ ;; We haven't seen a glob yet, so instead append to the start
+ ;; directory.
+ (setq start-dir (file-name-concat start-dir (car globs))))
(setq last-saw-recursion nil))
(setq globs (cdr globs)))
- (list (file-name-as-directory start-dir)
+ (list start-dir
(nreverse result)
isdir)))
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index 90f9c6cf78d..efb37225651 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -121,12 +121,11 @@ Uses the system sudo through Tramp's sudo method."
:usage "[(-u | --user) USER] (-s | --shell) | COMMAND
Execute a COMMAND as the superuser or another USER.")
(let ((dir (eshell--method-wrap-directory default-directory "sudo" user)))
- (if shell
- (throw 'eshell-replace-command
- (eshell-parse-command "cd" (list dir)))
- (throw 'eshell-external
- (let ((default-directory dir))
- (eshell-named-command (car args) (cdr args))))))))
+ (throw 'eshell-replace-command
+ (if shell
+ (eshell-parse-command "cd" (list dir))
+ `(let ((default-directory ,dir))
+ (eshell-named-command ',(car args) ',(cdr args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
@@ -144,12 +143,11 @@ Uses the system doas through Tramp's doas method."
:usage "[(-u | --user) USER] (-s | --shell) | COMMAND
Execute a COMMAND as the superuser or another USER.")
(let ((dir (eshell--method-wrap-directory default-directory "doas" user)))
- (if shell
- (throw 'eshell-replace-command
- (eshell-parse-command "cd" (list dir)))
- (throw 'eshell-external
- (let ((default-directory dir))
- (eshell-named-command (car args) (cdr args))))))))
+ (throw 'eshell-replace-command
+ (if shell
+ (eshell-parse-command "cd" (list dir))
+ `(let ((default-directory ,dir))
+ (eshell-named-command ',(car args) ',(cdr args))))))))
(put 'eshell/doas 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 75afaf1c104..751f13cc715 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -166,9 +166,9 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t))
(setq-local eshell-complex-commands
- (append '("grep" "egrep" "fgrep" "agrep" "rgrep"
- "glimpse" "locate" "cat" "time" "cp" "mv"
- "make" "du" "diff")
+ (append '("compile" "grep" "egrep" "fgrep" "agrep"
+ "rgrep" "glimpse" "locate" "cat" "time" "cp"
+ "mv" "make" "du" "diff")
eshell-complex-commands)))
(defalias 'eshell/date 'current-time-string)
@@ -590,7 +590,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
:external "cp"
:show-usage
:usage "[OPTION]... SOURCE DEST
- or: cp [OPTION]... SOURCE... DIRECTORY
+ or: cp [OPTION]... SOURCE... DIRECTORY
Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
(if archive
(setq preserve t no-dereference t em-recursive t))
@@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
:preserve-args
:external "ln"
:show-usage
- :usage "[OPTION]... TARGET [LINK_NAME]
- or: ln [OPTION]... TARGET... DIRECTORY
-Create a link to the specified TARGET with optional LINK_NAME. If there is
-more than one TARGET, the last argument must be a directory; create links
-in DIRECTORY to each TARGET. Create hard links by default, symbolic links
+ :usage "[OPTION]... TARGET LINK_NAME
+ or: ln [OPTION]... TARGET... DIRECTORY
+Create a link to the specified TARGET with LINK_NAME. If there is more
+than one TARGET, the last argument must be a directory; create links in
+DIRECTORY to each TARGET. Create hard links by default, symbolic links
with `--symbolic'. When creating hard links, each TARGET must exist.")
(let ((no-dereference t))
(eshell-mvcpln-template "ln" "linking"
@@ -741,7 +741,7 @@ Fallback to standard make when called synchronously."
(eshell-compile "make" args
;; Use plain output unless we're executing in the
;; background.
- (not eshell-current-subjob-p)))
+ (unless eshell-current-subjob-p 'plain)))
(put 'eshell/make 'eshell-no-numeric-conversions t)
@@ -789,7 +789,7 @@ available..."
(ignore-errors
(occur (car args))))
(if (get-buffer "*Occur*")
- (with-current-buffer (get-buffer "*Occur*")
+ (with-current-buffer "*Occur*"
(setq string (buffer-string))
(kill-buffer (current-buffer)))))
(if string (insert string))
@@ -940,7 +940,7 @@ external command."
"display data only this many levels of data")
(?h "human-readable" 1024 human-readable
"print sizes in human readable format")
- (?H "is" 1000 human-readable
+ (?H "si" 1000 human-readable
"likewise, but use powers of 1000 not 1024")
(?k "kilobytes" 1024 block-size
"like --block-size 1024")
@@ -1018,7 +1018,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
(eshell-stringify-list
(flatten-tree (cdr time-args))))))))
-(defun eshell/whoami (&rest _args)
+(defun eshell/whoami ()
"Make \"whoami\" Tramp aware."
(eshell-user-login-name))
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 1880cc03885..78cf28d785a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if non-nil,
allows values to be converted to numbers where appropriate.
ARGS should be a list of lists of arguments, such as that
-produced by `eshell-prepare-slice'. \"Adjacent\" values of
+produced by `eshell-prepare-splice'. \"Adjacent\" values of
consecutive arguments will be passed to `eshell-concat'. For
example, if ARGS is
@@ -440,6 +440,7 @@ Point is left at the end of the arguments."
(defsubst eshell-looking-at-backslash-return (pos)
"Test whether a backslash-return sequence occurs at POS."
+ (declare (obsolete nil "30.1"))
(and (eq (char-after pos) ?\\)
(or (= (1+ pos) (point-max))
(and (eq (char-after (1+ pos)) ?\n)
@@ -464,8 +465,8 @@ backslash is ignored and the character after is returned. If the
backslash is in a quoted string, the backslash and the character
after are both returned."
(when (eq (char-after) ?\\)
- (when (eshell-looking-at-backslash-return (point))
- (throw 'eshell-incomplete "\\"))
+ (when (= (1+ (point)) (point-max))
+ (throw 'eshell-incomplete "\\"))
(forward-char 2) ; Move one char past the backslash.
(let ((special-chars (if eshell-current-quoted
eshell-special-chars-inside-quoting
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 2746800ea78..30494bafb48 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -934,48 +934,52 @@ This yields the SUBCOMMANDs when found in forms like
(dolist (elem haystack)
(cond
((eq (car-safe elem) 'eshell-as-subcommand)
- (iter-yield (cdr elem)))
+ (iter-yield (cadr elem)))
((listp elem)
(iter-yield-from (eshell--find-subcommands elem))))))
-(defun eshell--invoke-command-directly (command)
+(defun eshell--invoke-command-directly-p (command)
"Determine whether the given COMMAND can be invoked directly.
COMMAND should be a non-top-level Eshell command in parsed form.
A command can be invoked directly if all of the following are true:
* The command is of the form
- \"(eshell-trap-errors (eshell-named-command NAME ARGS))\",
- where ARGS is optional.
+ (eshell-with-copied-handles
+ (eshell-trap-errors (eshell-named-command NAME [ARGS])) _).
* NAME is a string referring to an alias function and isn't a
complex command (see `eshell-complex-commands').
* Any subcommands in ARGS can also be invoked directly."
- (when (and (eq (car command) 'eshell-trap-errors)
- (eq (car (cadr command)) 'eshell-named-command))
- (let ((name (cadr (cadr command)))
- (args (cdr-safe (nth 2 (cadr command)))))
- (and name (stringp name)
- (not (member name eshell-complex-commands))
- (catch 'simple
- (dolist (pred eshell-complex-commands t)
- (when (and (functionp pred)
- (funcall pred name))
- (throw 'simple nil))))
- (eshell-find-alias-function name)
- (catch 'indirect-subcommand
- (iter-do (subcommand (eshell--find-subcommands args))
- (unless (eshell--invoke-command-directly subcommand)
- (throw 'indirect-subcommand nil)))
- t)))))
-
-(defun eshell-invoke-directly (command)
+ (pcase command
+ (`(eshell-with-copied-handles
+ (eshell-trap-errors (eshell-named-command ,name . ,args))
+ ,_)
+ (and name (stringp name)
+ (not (member name eshell-complex-commands))
+ (catch 'simple
+ (dolist (pred eshell-complex-commands t)
+ (when (and (functionp pred)
+ (funcall pred name))
+ (throw 'simple nil))))
+ (eshell-find-alias-function name)
+ (catch 'indirect-subcommand
+ (iter-do (subcommand (eshell--find-subcommands (car args)))
+ (unless (eshell--invoke-command-directly-p subcommand)
+ (throw 'indirect-subcommand nil)))
+ t)))))
+
+(defun eshell-invoke-directly-p (command)
"Determine whether the given COMMAND can be invoked directly.
COMMAND should be a top-level Eshell command in parsed form, as
produced by `eshell-parse-command'."
- (let ((base (cadr (nth 2 (nth 2 (cadr command))))))
- (eshell--invoke-command-directly base)))
+ (pcase command
+ (`(eshell-commands (progn ,_ (unwind-protect (progn ,base) . ,_)))
+ (eshell--invoke-command-directly-p base))))
+
+(define-obsolete-function-alias 'eshell-invoke-directly
+ 'eshell-invoke-directly-p "30.1")
(defun eshell-eval-argument (argument)
"Evaluate a single Eshell ARGUMENT and return the result."
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index dc2b93e574b..44861c222b8 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -253,10 +253,10 @@ An external command simply means external to Emacs."
"Add a set of paths to PATH."
(eshell-eval-using-options
"addpath" args
- '((?b "begin" nil prepend "add path element at beginning")
+ '((?b "begin" nil prepend "add to beginning of $PATH")
(?h "help" nil nil "display this usage message")
- :usage "[-b] PATH
-Adds the given PATH to $PATH.")
+ :usage "[-b] DIR...
+Adds the given DIR to $PATH.")
(let ((path (eshell-get-path t)))
(if args
(progn
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 21e3f00086f..b15f99a0359 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -290,7 +290,7 @@ non-interactive sessions, such as when using `eshell-command'.")
"C-e" #'eshell-show-maximum-output
"C-f" #'eshell-forward-argument
"C-m" #'eshell-copy-old-input
- "C-o" #'eshell-kill-output
+ "C-o" #'eshell-delete-output
"C-r" #'eshell-show-output
"C-t" #'eshell-truncate-buffer
"C-u" #'eshell-kill-input
@@ -619,14 +619,14 @@ If NO-NEWLINE is non-nil, the input is sent without an implied final
newline."
(interactive "P")
;; Note that the input string does not include its terminal newline.
- (let ((proc-running-p (and (eshell-head-process)
- (not queue-p)))
- (inhibit-modification-hooks t))
- (unless (and proc-running-p
+ (let* ((proc-running-p (eshell-head-process))
+ (send-to-process-p (and proc-running-p (not queue-p)))
+ (inhibit-modification-hooks t))
+ (unless (and send-to-process-p
(not (eq (process-status
(eshell-head-process))
'run)))
- (if (or proc-running-p
+ (if (or send-to-process-p
(>= (point) eshell-last-output-end))
(goto-char (point-max))
(let ((copy (eshell-get-old-input use-region)))
@@ -634,7 +634,7 @@ newline."
(insert-and-inherit copy)))
(unless (or no-newline
(and eshell-send-direct-to-subprocesses
- proc-running-p))
+ send-to-process-p))
(insert-before-markers-and-inherit ?\n))
;; Delete and reinsert input. This seems like a no-op, except
;; for the resulting entries in the undo list: undoing this
@@ -644,7 +644,7 @@ newline."
(inhibit-read-only t))
(delete-region eshell-last-output-end (point))
(insert text))
- (if proc-running-p
+ (if send-to-process-p
(progn
(eshell-update-markers eshell-last-output-end)
(if (or eshell-send-direct-to-subprocesses
@@ -673,7 +673,8 @@ newline."
(run-hooks 'eshell-input-filter-functions)
(and (catch 'eshell-terminal
(ignore
- (if (eshell-invoke-directly cmd)
+ (if (and (not proc-running-p)
+ (eshell-invoke-directly-p cmd))
(eval cmd)
(eshell-eval-command cmd input))))
(eshell-life-is-too-much)))))
@@ -831,15 +832,23 @@ This function should be in the list `eshell-output-filter-functions'."
eshell-last-output-start
eshell-last-output-end))
-(defun eshell-kill-output ()
- "Kill all output from interpreter since last input.
-Does not delete the prompt."
- (interactive)
+(defun eshell-delete-output (&optional kill)
+ "Delete all output from interpreter since last input.
+If KILL is non-nil (interactively, the prefix), save the killed text in
+the kill ring.
+
+This command does not delete the prompt."
+ (interactive "P")
(save-excursion
(goto-char (eshell-beginning-of-output))
(insert "*** output flushed ***\n")
+ (when kill
+ (copy-region-as-kill (point) (eshell-end-of-output)))
(delete-region (point) (eshell-end-of-output))))
+(define-obsolete-function-alias 'eshell-kill-output
+ #'eshell-delete-output "30.1")
+
(defun eshell-show-output (&optional arg)
"Display start of this batch of interpreter output at top of window.
Sets mark to the value of point when this command is run.
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index d01e3569d57..e6f5fc9629a 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -100,29 +100,37 @@ the new process for its value.
Lastly, any remaining arguments will be available in the locally
let-bound variable `args'."
(declare (debug (form form sexp body)))
- `(let* ((temp-args
- ,(if (memq ':preserve-args (cadr options))
- (list 'copy-tree macro-args)
- (list 'eshell-stringify-list
- (list 'flatten-tree macro-args))))
- (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args))
- ,@(delete-dups
- (delq nil (mapcar (lambda (opt)
- (and (listp opt) (nth 3 opt)
- `(,(nth 3 opt) (pop processed-args))))
- ;; `options' is of the form (quote OPTS).
- (cadr options))))
- (args processed-args))
- ;; Silence unused lexical variable warning if body does not use `args'.
- (ignore args)
- ,@body-forms))
+ (let ((option-syms (eshell--get-option-symbols
+ ;; `options' is of the form (quote OPTS).
+ (cadr options))))
+ `(let* ((temp-args
+ ,(if (memq ':preserve-args (cadr options))
+ (list 'copy-tree macro-args)
+ (list 'eshell-stringify-list
+ (list 'flatten-tree macro-args))))
+ (args (eshell--do-opts ,name temp-args ,macro-args
+ ,options ',option-syms))
+ ;; Bind all the option variables. When done, `args' will
+ ;; contain any remaining positional arguments.
+ ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms))
+ ;; Silence unused lexical variable warning if body does not use `args'.
+ (ignore args)
+ ,@body-forms)))
;;; Internal Functions:
;; Documented part of the interface; see eshell-eval-using-options.
(defvar eshell--args)
-(defun eshell--do-opts (name options args orig-args)
+(defun eshell--get-option-symbols (options)
+ "Get a list of symbols for the specified OPTIONS.
+OPTIONS is a list of command-line options from
+`eshell-eval-using-options' (which see)."
+ (delete-dups
+ (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt)))
+ options))))
+
+(defun eshell--do-opts (name args orig-args options option-syms)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(require 'esh-ext)
@@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere."
(if (and (= (length args) 0)
(memq ':show-usage options))
(eshell-show-usage name options)
- (setq args (eshell--process-args name args options))
+ (setq args (eshell--process-args name args options
+ option-syms))
nil))))
(when usage-msg
(user-error "%s" usage-msg))))))
@@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized."
"%s: unrecognized option --%s")
name (car switch)))))))
-(defun eshell--process-args (name args options)
- "Process the given ARGS using OPTIONS."
- (let* ((seen ())
- (opt-vals (delq nil (mapcar (lambda (opt)
- (when (listp opt)
- (let ((sym (nth 3 opt)))
- (when (and sym (not (memq sym seen)))
- (push sym seen)
- (list sym)))))
- options)))
+(defun eshell--process-args (name args options option-syms)
+ "Process the given ARGS for the command NAME using OPTIONS.
+OPTION-SYMS is a list of symbols that will hold the processed arguments.
+
+Return a list of values corresponding to each element in OPTION-SYMS,
+followed by any additional positional arguments."
+ (let* ((opt-vals (mapcar #'list option-syms))
(ai 0) arg
(eshell--args args)
(pos-argument-found nil))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 2bb0043bddb..35c81f6a4b2 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -193,7 +193,7 @@ This is like `process-live-p', but additionally checks whether
(defalias 'eshell/wait #'eshell-wait-for-process)
-(defun eshell/jobs (&rest _args)
+(defun eshell/jobs ()
"List processes, if there are any."
(and (fboundp 'process-list)
(process-list)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index f0acfecb701..129134814e3 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -447,29 +447,34 @@ Prepend remote identification of `default-directory', if any."
(parse-colon-path path-env))
(parse-colon-path path-env))))
-(defun eshell-split-path (path)
- "Split a path into multiple subparts."
- (let ((len (length path))
- (i 0) (li 0)
- parts)
- (if (and (eshell-under-windows-p)
- (> len 2)
- (eq (aref path 0) ?/)
- (eq (aref path 1) ?/))
- (setq i 2))
- (while (< i len)
- (if (and (eq (aref path i) ?/)
- (not (get-text-property i 'escaped path)))
- (setq parts (cons (if (= li i) "/"
- (substring path li (1+ i))) parts)
- li (1+ i)))
- (setq i (1+ i)))
- (if (< li i)
- (setq parts (cons (substring path li i) parts)))
- (if (and (eshell-under-windows-p)
- (string-match "\\`[A-Za-z]:\\'" (car (last parts))))
- (setcar (last parts) (concat (car (last parts)) "/")))
- (nreverse parts)))
+(defun eshell-split-filename (filename)
+ "Split a FILENAME into a list of file/directory components."
+ (let* ((remote (file-remote-p filename))
+ (filename (file-local-name filename))
+ (len (length filename))
+ (index 0) (curr-start 0)
+ parts)
+ (when (and (eshell-under-windows-p)
+ (string-prefix-p "//" filename))
+ (setq index 2))
+ (while (< index len)
+ (when (and (eq (aref filename index) ?/)
+ (not (get-text-property index 'escaped filename)))
+ (push (if (= curr-start index) "/"
+ (substring filename curr-start (1+ index)))
+ parts)
+ (setq curr-start (1+ index)))
+ (setq index (1+ index)))
+ (when (< curr-start len)
+ (push (substring filename curr-start) parts))
+ (setq parts (nreverse parts))
+ (when (and (eshell-under-windows-p)
+ (string-match "\\`[A-Za-z]:\\'" (car parts)))
+ (setcar parts (concat (car parts) "/")))
+ (if remote (cons remote parts) parts)))
+
+(define-obsolete-function-alias 'eshell-split-path
+ 'eshell-split-filename "30.1")
(defun eshell-to-flat-string (value)
"Make value a string. If separated by newlines change them to spaces."
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index ae0b18cd13a..02b5c785625 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -255,6 +255,20 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses."
(defvar-keymap eshell-var-mode-map
"C-c M-v" #'eshell-insert-envvar)
+;;; Internal Variables:
+
+(defvar eshell-in-local-scope-p nil
+ "Non-nil if the current command has a local variable scope.
+This is set to t in `eshell-local-variable-bindings' (which see).")
+
+(defvar eshell-local-variable-bindings
+ '((eshell-in-local-scope-p t)
+ (process-environment (eshell-copy-environment))
+ (eshell-variable-aliases-list eshell-variable-aliases-list)
+ (eshell-path-env-list eshell-path-env-list)
+ (comint-pager comint-pager))
+ "A list of `let' bindings for local variable (and subcommand) environments.")
+
;;; Functions:
(define-minor-mode eshell-var-mode
@@ -271,12 +285,10 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses."
(setq-local process-environment (eshell-copy-environment)))
(make-local-variable 'comint-pager)
(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)
- (comint-pager comint-pager))
- eshell-subcommand-bindings))
+ (append eshell-local-variable-bindings
+ eshell-subcommand-bindings))
+ (setq-local eshell-complex-commands
+ (append '("env") eshell-complex-commands))
(setq-local eshell-special-chars-inside-quoting
(append eshell-special-chars-inside-quoting '(?$)))
@@ -294,32 +306,36 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses."
(add-hook 'pcomplete-try-first-hook
#'eshell-complete-variable-assignment nil t)))
-(defun eshell-handle-local-variables ()
- "Allow for the syntax `VAR=val <command> <args>'."
- ;; Eshell handles local variable settings (e.g. 'CFLAGS=-O2 make')
- ;; by making the whole command into a subcommand, and calling
- ;; `eshell-set-variable' immediately before the command is invoked.
- ;; This means that 'FOO=x cd bar' won't work exactly as expected,
- ;; but that is by no means a typical use of local environment
- ;; variables.
+(defun eshell-parse-local-variables (args)
+ "Parse a list of ARGS, looking for variable assignments.
+Variable assignments are of the form \"VAR=value\". If ARGS
+begins with any such assignments, throw `eshell-replace-command'
+with a form that will temporarily set those variables.
+Otherwise, return nil."
+ ;; Handle local variable settings by let-binding the entries in
+ ;; `eshell-local-variable-bindings' and calling `eshell-set-variable'
+ ;; for each variable before the command is invoked.
(let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'")
- (command eshell-last-command-name)
- (args eshell-last-arguments))
- (when (and (stringp command) (string-match setvar command))
+ (head (car args))
+ (rest (cdr args)))
+ (when (and (stringp head) (string-match setvar head))
(throw 'eshell-replace-command
- `(eshell-as-subcommand
- (progn
- ,@(let (locals)
- (while (and (stringp command)
- (string-match setvar command))
- (push `(eshell-set-variable
- ,(match-string 1 command)
- ,(match-string 2 command))
- locals)
- (setq command (pop args)))
- (nreverse locals))
- (eshell-named-command ,command ,(list 'quote args)))
- )))))
+ `(let ,eshell-local-variable-bindings
+ ,@(let (locals)
+ (while (and (stringp head)
+ (string-match setvar head))
+ (push `(eshell-set-variable
+ ,(match-string 1 head)
+ ,(match-string 2 head))
+ locals)
+ (setq head (pop rest)))
+ (nreverse locals))
+ (eshell-named-command ,head ',rest))))))
+
+(defun eshell-handle-local-variables ()
+ "Allow for the syntax `VAR=val <command> <args>'."
+ (eshell-parse-local-variables (cons eshell-last-command-name
+ eshell-last-arguments)))
(defun eshell-interpolate-variable ()
"Parse a variable interpolation.
@@ -409,19 +425,22 @@ the values of nil for each."
obarray #'boundp))
(pcomplete-here))))
-;; FIXME the real "env" command does more than this, it runs a program
-;; in a modified environment.
(defun eshell/env (&rest args)
"Implementation of `env' in Lisp."
- (eshell-init-print-buffer)
(eshell-eval-using-options
"env" args
- '((?h "help" nil nil "show this usage screen")
+ '(;; FIXME: Support more "env" options, like "--unset".
+ (?h "help" nil nil "show this usage screen")
:external "env"
- :usage "<no arguments>")
- (dolist (setting (sort (eshell-environment-variables) 'string-lessp))
- (eshell-buffered-print setting "\n"))
- (eshell-flush)))
+ :parse-leading-options-only
+ :usage "[NAME=VALUE]... [COMMAND]...")
+ (if args
+ (or (eshell-parse-local-variables args)
+ (eshell-named-command (car args) (cdr args)))
+ (eshell-init-print-buffer)
+ (dolist (setting (sort (eshell-environment-variables) 'string-lessp))
+ (eshell-buffered-print setting "\n"))
+ (eshell-flush))))
(defun eshell-insert-envvar (envvar-name)
"Insert ENVVAR-NAME into the current buffer at point."
@@ -709,7 +728,7 @@ to a Lisp variable)."
((functionp target)
(funcall target nil value))
((null target)
- (unless eshell-in-subcommand-p
+ (unless eshell-in-local-scope-p
(error "Variable `%s' is not settable" (eshell-stringify name)))
(push `(,name ,(lambda () value) t t)
eshell-variable-aliases-list)
diff --git a/lisp/faces.el b/lisp/faces.el
index d5120f42b92..c3a54a08a3d 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'."
If FACE is a face-alias, get the documentation for the target face."
(let ((alias (get face 'face-alias)))
(if alias
- (let ((doc (get alias 'face-documentation)))
+ (let ((doc (documentation-property alias 'face-documentation)))
(format "%s is an alias for the face `%s'.%s" face alias
(if doc (format "\n%s" doc)
"")))
- (get face 'face-documentation))))
+ (documentation-property face 'face-documentation))))
(defun set-face-documentation (face string)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 3492dcbf17a..b2b681b7c44 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1065,6 +1065,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
;; (La)TeX: don't allow braces
(latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
(tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
+ ;; XML: don't allow angle brackets
+ (xml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
+ (nxml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
)
"Alist of (MODE CHARS BEG END), where MODE is a symbol.
This is possibly a major-mode name, or one of the symbols
@@ -1098,12 +1101,12 @@ Suppose the cursor is somewhere that might be near end of file,
the guessing would position point before punctuation (like comma)
after the file extension:
- C:\temp\file.log, which contain ....
+ C:\\temp\\file.log, which contain ....
=============================== (before)
---------------- (after)
- C:\temp\file.log on Windows or /tmp/file.log on Unix
+ C:\\temp\\file.log on Windows or /tmp/file.log on Unix
=============================== (before)
---------------- (after)
diff --git a/lisp/files-x.el b/lisp/files-x.el
index fccb2fa4a9f..f70be5f7ff3 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -929,19 +929,23 @@ earlier in the `setq-connection-local'. The return value of the
;;;###autoload
(defmacro connection-local-p (variable &optional application)
"Non-nil if VARIABLE has a connection-local binding in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used."
(declare (debug (symbolp &optional form)))
(unless (symbolp variable)
(signal 'wrong-type-argument (list 'symbolp variable)))
- `(let (connection-local-variables-alist file-local-variables-alist)
- (hack-connection-local-variables
- (connection-local-criteria-for-default-directory ,application))
- (and (assq ',variable connection-local-variables-alist) t)))
+ `(let ((criteria
+ (connection-local-criteria-for-default-directory ,application))
+ connection-local-variables-alist file-local-variables-alist)
+ (when criteria
+ (hack-connection-local-variables criteria)
+ (and (assq ',variable connection-local-variables-alist) t))))
;;;###autoload
(defmacro connection-local-value (variable &optional application)
"Return connection-local VARIABLE for APPLICATION in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used.
If VARIABLE does not have a connection-local binding, the return
@@ -949,12 +953,15 @@ value is the default binding of the variable."
(declare (debug (symbolp &optional form)))
(unless (symbolp variable)
(signal 'wrong-type-argument (list 'symbolp variable)))
- `(let (connection-local-variables-alist file-local-variables-alist)
- (hack-connection-local-variables
- (connection-local-criteria-for-default-directory ,application))
- (if-let ((result (assq ',variable connection-local-variables-alist)))
- (cdr result)
- ,variable)))
+ `(let ((criteria
+ (connection-local-criteria-for-default-directory ,application))
+ connection-local-variables-alist file-local-variables-alist)
+ (if (not criteria)
+ ,variable
+ (hack-connection-local-variables criteria)
+ (if-let ((result (assq ',variable connection-local-variables-alist)))
+ (cdr result)
+ ,variable))))
;;;###autoload
(defun path-separator ()
diff --git a/lisp/files.el b/lisp/files.el
index 8b4e4394e5a..20d63d33fef 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -698,6 +698,14 @@ Also see the `permanently-enabled-local-variables' and
Some modes may wish to set this to nil to prevent directory-local
settings being applied, but still respect file-local ones.")
+(defvar-local untrusted-content nil
+ "Non-nil means that current buffer originated from an untrusted source.
+Email clients and some other modes may set this non-nil to mark the
+buffer contents as untrusted.
+
+This variable might be subject to change without notice.")
+(put 'untrusted-content 'permanent-local t)
+
;; This is an odd variable IMO.
;; You might wonder why it is needed, when we could just do:
;; (setq-local enable-local-variables nil)
@@ -2747,6 +2755,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes.
Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
+ ;; The above is sufficiently like turning on read-only-mode, so run
+ ;; the mode hook here by hand.
+ (if buffer-read-only
+ (run-hooks 'read-only-mode-hook))
(if noninteractive
nil
(let* (not-serious
@@ -3059,7 +3071,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.docbook\\'" . sgml-mode)
("\\.com\\'" . dcl-mode)
("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
- ("/\\.\\(authinfo\\|netrc\\)\\'" . authinfo-mode)
+ ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode)
;; Windows candidates may be opened case sensitively on Unix
("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
("\\.la\\'" . conf-unix-mode)
@@ -3270,7 +3282,16 @@ and `inhibit-local-variables-suffixes'. If
;; Optional group 1: env(1) invocation.
"\\("
"[^ \t\n]*/bin/env[ \t]*"
- "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?"
+ ;; Within group 1: possible -S/--split-string and environment
+ ;; adjustments.
+ "\\(?:"
+ ;; -S/--split-string
+ "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)"
+ ;; More env arguments.
+ "\\(?:-[^ \t\n]+[ \t]+\\)*"
+ ;; Interpreter environment modifications.
+ "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*"
+ "\\)?"
"\\)?"
;; Group 2: interpreter.
"\\([^ \t\n]+\\)"))
@@ -3400,7 +3421,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'.
+It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'.
If `enable-local-variables' is nil, or if the file name matches
`inhibit-local-variables-regexps', this function does not check
@@ -3412,7 +3433,7 @@ set the major mode only if that would change it. In other words
we don't actually set it to the same mode the buffer already has."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let ((try-locals (not (inhibit-local-variables-p)))
- end done mode modes)
+ end modes)
;; Once we drop the deprecated feature where mode: is also allowed to
;; specify minor-modes (ie, there can be more than one "mode:"), we can
;; remove this section and just let (hack-local-variables t) handle it.
@@ -3443,100 +3464,96 @@ we don't actually set it to the same mode the buffer already has."
(push (intern (concat (downcase (buffer-substring (point) end))
"-mode"))
modes))))
- ;; If we found modes to use, invoke them now, outside the save-excursion.
- (if modes
- (catch 'nop
- (dolist (mode (nreverse modes))
- (if (not (functionp mode))
- (message "Ignoring unknown mode `%s'" mode)
- (setq done t)
- (or (set-auto-mode-0 mode keep-mode-if-same)
- ;; continuing would call minor modes again, toggling them off
- (throw 'nop nil))))))
- ;; Check for auto-mode-alist entry in dir-locals.
- (unless done
- (with-demoted-errors "Directory-local variables error: %s"
- ;; Note this is a no-op if enable-local-variables is nil.
- (let* ((mode-alist (cdr (hack-dir-local--get-variables
- (lambda (key) (eq key 'auto-mode-alist))))))
- (setq done (set-auto-mode--apply-alist mode-alist
- keep-mode-if-same t)))))
- (and (not done)
- (setq mode (hack-local-variables t (not try-locals)))
- (not (memq mode modes)) ; already tried and failed
- (if (not (functionp mode))
- (message "Ignoring unknown mode `%s'" mode)
- (setq done t)
- (set-auto-mode-0 mode keep-mode-if-same)))
- ;; If we didn't, look for an interpreter specified in the first line.
- ;; As a special case, allow for things like "#!/bin/env perl", which
- ;; finds the interpreter anywhere in $PATH.
- (and (not done)
- (setq mode (save-excursion
- (goto-char (point-min))
- (if (looking-at auto-mode-interpreter-regexp)
- (match-string 2))))
- ;; Map interpreter name to a mode, signaling we're done at the
- ;; same time.
- (setq done (assoc-default
- (file-name-nondirectory mode)
- (mapcar (lambda (e)
- (cons
- (format "\\`%s\\'" (car e))
- (cdr e)))
- interpreter-mode-alist)
- #'string-match-p))
- ;; If we found an interpreter mode to use, invoke it now.
- (set-auto-mode-0 done keep-mode-if-same))
- ;; Next try matching the buffer beginning against magic-mode-alist.
- (unless done
- (if (setq done (save-excursion
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region (point-min)
- (min (point-max)
- (+ (point-min) magic-mode-regexp-match-limit)))
- (assoc-default
- nil magic-mode-alist
- (lambda (re _dummy)
- (cond
- ((functionp re)
- (funcall re))
- ((stringp re)
- (let ((case-fold-search nil))
- (looking-at re)))
- (t
- (error
- "Problem in magic-mode-alist with element %s"
- re))))))))
- (set-auto-mode-0 done keep-mode-if-same)))
- ;; Next compare the filename against the entries in auto-mode-alist.
- (unless done
- (setq done (set-auto-mode--apply-alist auto-mode-alist
- keep-mode-if-same nil)))
- ;; Next try matching the buffer beginning against magic-fallback-mode-alist.
- (unless done
- (if (setq done (save-excursion
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region (point-min)
- (min (point-max)
- (+ (point-min) magic-mode-regexp-match-limit)))
- (assoc-default nil magic-fallback-mode-alist
- (lambda (re _dummy)
- (cond
- ((functionp re)
- (funcall re))
- ((stringp re)
- (let ((case-fold-search nil))
- (looking-at re)))
- (t
- (error
- "Problem with magic-fallback-mode-alist element: %s"
- re))))))))
- (set-auto-mode-0 done keep-mode-if-same)))
- (unless done
- (set-buffer-major-mode (current-buffer)))))
+ (or
+ ;; If we found modes to use, invoke them now, outside the save-excursion.
+ ;; Presume `modes' holds a major mode followed by minor modes.
+ (let ((done ()))
+ (dolist (mode (nreverse modes))
+ (if (eq done :keep)
+ ;; `keep-mode-if-same' is set and the (major) mode
+ ;; was already set. Refrain from calling the following
+ ;; minor modes since they have already been set.
+ ;; It was especially important in the past when calling
+ ;; minor modes without an arg would toggle them, but it's
+ ;; still preferable to avoid re-enabling them,
+ nil
+ (let ((res (set-auto-mode-0 mode keep-mode-if-same)))
+ (setq done (or res done)))))
+ done)
+ ;; Check for auto-mode-alist entry in dir-locals.
+ (with-demoted-errors "Directory-local variables error: %s"
+ ;; Note this is a no-op if enable-local-variables is nil.
+ (let* ((mode-alist (cdr (hack-dir-local--get-variables
+ (lambda (key) (eq key 'auto-mode-alist))))))
+ (set-auto-mode--apply-alist mode-alist keep-mode-if-same t)))
+ (let ((mode (hack-local-variables t (not try-locals))))
+ (unless (memq mode modes) ; already tried and failed
+ (set-auto-mode-0 mode keep-mode-if-same)))
+ ;; If we didn't, look for an interpreter specified in the first line.
+ ;; As a special case, allow for things like "#!/bin/env perl", which
+ ;; finds the interpreter anywhere in $PATH.
+ (when-let
+ ((interp (save-excursion
+ (goto-char (point-min))
+ (if (looking-at auto-mode-interpreter-regexp)
+ (match-string 2))))
+ ;; Map interpreter name to a mode, signaling we're done at the
+ ;; same time.
+ (mode (assoc-default
+ (file-name-nondirectory interp)
+ (mapcar (lambda (e)
+ (cons
+ (format "\\`%s\\'" (car e))
+ (cdr e)))
+ interpreter-mode-alist)
+ #'string-match-p)))
+ ;; If we found an interpreter mode to use, invoke it now.
+ (set-auto-mode-0 mode keep-mode-if-same))
+ ;; Next try matching the buffer beginning against magic-mode-alist.
+ (let ((mode (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point-min)
+ (min (point-max)
+ (+ (point-min) magic-mode-regexp-match-limit)))
+ (assoc-default
+ nil magic-mode-alist
+ (lambda (re _dummy)
+ (cond
+ ((functionp re)
+ (funcall re))
+ ((stringp re)
+ (let ((case-fold-search nil))
+ (looking-at re)))
+ (t
+ (error
+ "Problem in magic-mode-alist with element %s"
+ re)))))))))
+ (set-auto-mode-0 mode keep-mode-if-same))
+ ;; Next compare the filename against the entries in auto-mode-alist.
+ (set-auto-mode--apply-alist auto-mode-alist
+ keep-mode-if-same nil)
+ ;; Next try matching the buffer beginning against magic-fallback-mode-alist.
+ (let ((mode (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point-min)
+ (min (point-max)
+ (+ (point-min) magic-mode-regexp-match-limit)))
+ (assoc-default nil magic-fallback-mode-alist
+ (lambda (re _dummy)
+ (cond
+ ((functionp re)
+ (funcall re))
+ ((stringp re)
+ (let ((case-fold-search nil))
+ (looking-at re)))
+ (t
+ (error
+ "Problem with magic-fallback-mode-alist element: %s"
+ re)))))))))
+ (set-auto-mode-0 mode keep-mode-if-same))
+ (set-buffer-major-mode (current-buffer)))))
(defvar-local set-auto-mode--last nil
"Remember the mode we have set via `set-auto-mode-0'.")
@@ -3546,9 +3563,22 @@ we don't actually set it to the same mode the buffer already has."
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."
+FUNCTION instead.
+FUNCTION can be nil to hide other entries (either in this var or in
+`major-mode-remap-defaults') and means that we should call MODE."
:type '(alist (symbol) (function)))
+(defvar major-mode-remap-defaults nil
+ "Alist mapping file-specified mode to actual mode.
+This works like `major-mode-remap-alist' except it has lower priority
+and it is meant to be modified by packages rather than users.")
+
+(defun major-mode-remap (mode)
+ "Return the function to use to enable MODE."
+ (or (cdr (or (assq mode major-mode-remap-alist)
+ (assq mode major-mode-remap-defaults)))
+ mode))
+
;; 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
@@ -3557,18 +3587,29 @@ FUNCTION instead."
"Apply MODE and return it.
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
- (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 (alist-get mode major-mode-remap-alist mode))
- (unless (eq mode major-mode)
- (setq set-auto-mode--last (cons mode major-mode)))
- mode)))
+same, do nothing and return `:keep'.
+Return nil if MODE could not be applied."
+ (when mode
+ (if (and keep-mode-if-same
+ (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)))))
+ :keep
+ (let ((modefun (major-mode-remap mode)))
+ (if (not (functionp modefun))
+ (progn
+ (message "Ignoring unknown mode `%s'%s" mode
+ (if (eq mode modefun) ""
+ (format " (remapped to `%S')" modefun)))
+ nil)
+ (funcall modefun)
+ (unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill.
+ ;; `modefun' is something like a minor mode.
+ (local-variable-p 'set-auto-mode--last))
+ (setq set-auto-mode--last (cons mode major-mode)))
+ mode)))))
(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
"Regexp of lines to skip when looking for file-local settings.
@@ -3754,7 +3795,8 @@ function is allowed to change the contents of this alist.
This hook is called only if there is at least one file-local
variable to set.")
-(defvar permanently-enabled-local-variables '(lexical-binding)
+(defvar permanently-enabled-local-variables
+ '(lexical-binding read-symbol-shorthands)
"A list of file-local variables that are always enabled.
This overrides any `enable-local-variables' setting.")
@@ -4174,8 +4216,9 @@ major-mode."
(not (string-match
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
- ;; Allow several mode: elements.
- (push (intern (concat val2 "-mode")) result))
+ (let ((mode (intern (concat val2 "-mode"))))
+ (when (fboundp (major-mode-remap mode))
+ (setq result mode))))
(cond ((eq var 'coding))
((eq var 'lexical-binding)
(unless hack-local-variables--warned-lexical
@@ -4190,6 +4233,13 @@ major-mode."
;; to use 'thisbuf's name in the
;; warning message.
(or (buffer-file-name thisbuf) ""))))))
+ ((eq var 'read-symbol-shorthands)
+ ;; Sort automatically by shorthand length
+ ;; in descending order.
+ (setq val (sort val
+ (lambda (sh1 sh2) (> (length (car sh1))
+ (length (car sh2))))))
+ (push (cons 'read-symbol-shorthands val) result))
((and (eq var 'mode) handle-mode))
(t
(ignore-errors
@@ -4199,10 +4249,7 @@ major-mode."
val)
result))))))
(forward-line 1)))))))
- (if (eq handle-mode t)
- ;; Return the final mode: setting that's defined.
- (car (seq-filter #'fboundp result))
- result)))
+ result))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
@@ -4331,10 +4378,8 @@ already the major mode."
(pcase var
('mode
(let ((mode (intern (concat (downcase (symbol-name val))
- "-mode"))))
- (unless (eq (indirect-function mode)
- (indirect-function major-mode))
- (funcall mode))))
+ "-mode"))))
+ (set-auto-mode-0 mode t)))
('eval
(pcase val
(`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
@@ -4414,6 +4459,12 @@ to see whether it should be considered."
(funcall predicate key)
(or (not key)
(derived-mode-p key)))
+ ;; If KEY is an extra parent it may remain not loaded
+ ;; (hence with some of its mode-specific vars missing their
+ ;; `safe-local-variable' property), leading to spurious
+ ;; prompts about unsafe vars (bug#68246).
+ (if (and (symbolp key) (autoloadp (indirect-function key)))
+ (ignore-errors (autoload-do-load (indirect-function key))))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 7332687d46d..68133ba2255 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -161,18 +161,9 @@ COND-FN takes one argument: the current element."
(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
-(defun filesets-select-command (cmd-list)
- "Select one command from CMD-LIST -- a string with space separated names."
- (let ((this (shell-command-to-string
- (format "which --skip-alias %s 2> %s | head -n 1"
- cmd-list null-device))))
- (if (equal this "")
- nil
- (file-name-nondirectory (substring this 0 (- (length this) 1))))))
-
(defun filesets-which-command (cmd)
"Call \"which CMD\"."
- (shell-command-to-string (format "which %s" cmd)))
+ (shell-command-to-string (format "which %s" (shell-quote-argument cmd))))
(defun filesets-which-command-p (cmd)
"Call \"which CMD\" and return non-nil if the command was found."
@@ -286,7 +277,7 @@ See `easy-menu-add-item' for documentation."
)
(defcustom filesets-menu-in-menu nil
- "Use that instead of `current-menubar' as the menu to change.
+ "Use that instead of `current-global-map' as the menu to change.
See `easy-menu-add-item' for documentation."
:set #'filesets-set-default
:type 'sexp)
@@ -547,16 +538,6 @@ the filename."
(defcustom filesets-external-viewers
(let
- ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
- ;; (filesets-select-command "ggv gv")))
- ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
- ;; (filesets-select-command "xpdf acroread")))
- ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
- ;; (filesets-select-command "xdvi tkdvi")))
- ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
- ;; (filesets-select-command "antiword")))
- ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
- ;; (filesets-select-command "gqview ee display"))))
((ps-cmd "ggv")
(pdf-cmd "xpdf")
(dvi-cmd "xdvi")
@@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil."
(t
(error "Filesets: %s does not exist" dir))))
-(defun filesets-quote (txt)
- "Return TXT in quotes."
- (concat "\"" txt "\""))
-
(defun filesets-get-selection ()
"Get the text between mark and point -- i.e. the selection or region."
(let ((m (mark))
@@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-quoted-selection ()
"Return the currently selected text in quotes."
- (filesets-quote (filesets-get-selection)))
+ (shell-quote-argument (filesets-get-selection)))
(defun filesets-get-shortcut (n)
"Create menu shortcuts based on number N."
@@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(if fmt
(mapconcat
(lambda (this)
- (if (stringp this) (format this file)
- (format "%S" (if (functionp this)
- (funcall this)
- this))))
+ (if (stringp this)
+ (format this (shell-quote-argument file))
+ (shell-quote-argument (if (functionp this)
+ (funcall this)
+ this))))
fmt "")
- (format "%S" file))))
+ (shell-quote-argument file))))
(output
(cond
((and (functionp vwr) co-flag)
@@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
(funcall vwr file)
nil)
(co-flag
- (shell-command-to-string (format "%s %s" vwr args)))
+ (shell-command-to-string (format "%s %s" vwr args)))
(t
(shell-command (format "%s %s&" vwr args))
nil))))
@@ -1767,7 +1745,7 @@ If no fileset name is provided, prompt for NAME."
(add-to-list 'filesets-data (list name '(:files)))
(message
(substitute-command-keys
- "Fileset %s created. Call `\\[filesets-save-config]' to save.")
+ "Fileset %s created. Call \\[filesets-save-config] to save.")
name)
(car filesets-data))))))
(if entry
@@ -2483,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and build the menu."
(setq filesets-menu-use-cached-flag t)))
(filesets-build-menu)))
+;;; obsolete
+
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
(error "%s" (mapconcat #'identity args " ")))
+(define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1")
+
(provide 'filesets)
;;; filesets.el ends here
diff --git a/lisp/follow.el b/lisp/follow.el
index 316c85b1629..874e546bd6d 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -413,8 +413,8 @@ being able to use 144 or 216 lines instead of the normal 72... (your
mileage may vary).
To split one large window into two side-by-side windows, the commands
-`\\[split-window-right]' or \
-`\\[follow-delete-other-windows-and-split]' can be used.
+\\[split-window-right] or \
+\\[follow-delete-other-windows-and-split] can be used.
Only windows displayed in the same frame follow each other.
@@ -874,6 +874,7 @@ from the bottom."
(when (< dest win-s)
(setq follow-internal-force-redisplay t))))))
+(put 'follow-recenter 'isearch-scroll t)
(defun follow-redraw ()
"Arrange windows displaying the same buffer in successor order.
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index cf34017b994..73f9fccd793 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -38,7 +38,7 @@ For instance:
(?l . \"ls\")))
Each %-spec may contain optional flag, width, and precision
-modifiers, as follows:
+specifiers, as follows:
%<flags><width><precision>character
@@ -51,7 +51,7 @@ The following flags are allowed:
* ^: Convert to upper case.
* _: Convert to lower case.
-The width and truncation modifiers behave like the corresponding
+The width and precision specifiers behave like the corresponding
ones in `format' when applied to %s.
For example, \"%<010b\" means \"substitute into the output the
@@ -145,7 +145,7 @@ is returned, where each format spec is its own element."
"Return STR formatted according to FLAGS, WIDTH, and TRUNC.
FLAGS is a list of keywords as returned by
`format-spec--parse-flags'. WIDTH and TRUNC are either nil or
-string widths corresponding to `format-spec' modifiers."
+string widths corresponding to `format-spec' specifiers."
(let (diff str-width)
;; Truncate original string first, like `format' does.
(when trunc
diff --git a/lisp/forms.el b/lisp/forms.el
index e38fa7ae873..3a3160a0c8b 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -343,7 +343,7 @@ suitable for forms processing.")
(defvar forms-write-file-filter nil
"The name of a function that is called before writing the data file.
-This can be used to undo the effects of `form-read-file-hook'.")
+This can be used to undo the effects of `forms-read-file-filter'.")
(defvar forms-new-record-filter nil
"The name of a function that is called when a new record is created.")
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index b4ae0225943..373bfad92dd 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1491,6 +1491,7 @@ like an INI file. You can add this hook to `find-file-hook'."
"cd9660"
"cfs"
"cgroup"
+ "cgroup2"
"cifs"
"coda"
"coherent"
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 3ee93031119..0928b179787 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -2910,13 +2910,9 @@ The following commands are available:
(car func)
(gnus-byte-compile `(lambda () ,func)))))
-(defun gnus-agent-true ()
- "Return t."
- t)
+(defalias 'gnus-agent-true #'always)
-(defun gnus-agent-false ()
- "Return nil."
- nil)
+(defalias 'gnus-agent-false #'ignore)
(defun gnus-category-make-function-1 (predicate)
"Make a function from PREDICATE."
@@ -2924,8 +2920,9 @@ The following commands are available:
;; Functions are just returned as is.
((or (symbolp predicate)
(functionp predicate))
- `(,(or (cdr (assq predicate gnus-category-predicate-alist))
- predicate)))
+ (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist))
+ predicate)))
+ (if (symbolp fun) `(,fun) `(funcall ',fun))))
;; More complex predicate.
((consp predicate)
`(,(cond
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c3c5eab7d89..9f313108089 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -694,7 +694,7 @@ used as possible file names."
(defcustom gnus-page-delimiter "^\^L"
"Regexp describing what to use as article page delimiters.
-The default value is \"^\^L\", which is a form linefeed at the
+The default value is \"^\\^L\", which is a form linefeed at the
beginning of a line."
:type 'regexp
:group 'gnus-article-various)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 04abdfc0d1b..3fde9baa0fe 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1122,31 +1122,17 @@ Returns nil if there is no such line before LIMIT, t otherwise."
When enabled, it automatically turns on `font-lock-mode'."
:lighter ""
(when (derived-mode-p 'message-mode)
- ;; FIXME: Use font-lock-add-keywords!
- (let ((defaults (car font-lock-defaults))
- default) ;; keywords
- (while defaults
- (setq default (if (consp defaults)
- (pop defaults)
- (prog1
- defaults
- (setq defaults nil))))
- (if gnus-message-citation-mode
- ;; `gnus-message-citation-keywords' should be the last
- ;; elements of the keywords because the others are unlikely
- ;; to have the OVERRIDE flags -- XEmacs applies a keyword
- ;; having no OVERRIDE flag to matched text even if it has
- ;; already other faces, while Emacs doesn't.
- (set (make-local-variable default)
- (append (default-value default)
- gnus-message-citation-keywords))
- (kill-local-variable default))))
- ;; Force `font-lock-set-defaults' to update `font-lock-keywords'.
- (setq font-lock-set-defaults nil)
- (font-lock-set-defaults)
- (if font-lock-mode
- (font-lock-flush)
- (gnus-message-citation-mode (font-lock-mode 1)))))
+ (if (not font-lock-mode)
+ (gnus-message-citation-mode (font-lock-mode 1))
+ (if gnus-message-citation-mode
+ ;; `gnus-message-citation-keywords' should be the last
+ ;; elements of the keywords because the others are unlikely
+ ;; to have the OVERRIDE flags -- XEmacs applies a keyword
+ ;; having no OVERRIDE flag to matched text even if it has
+ ;; already other faces, while Emacs doesn't.
+ (font-lock-add-keywords nil gnus-message-citation-keywords t)
+ (font-lock-remove-keywords nil gnus-message-citation-keywords))
+ (font-lock-flush))))
(defun turn-on-gnus-message-citation-mode ()
"Turn on `gnus-message-citation-mode'."
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 48c1aef968b..f33c5f7f2e5 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -111,6 +111,12 @@ See `mail-user-agent' for more information."
(autoload 'gnus-completing-read "gnus-util")
+(defcustom gnus-dired-attach-at-end t
+ "Non-nil means that files should be attached at the end of a buffer."
+ :group 'mail ;; dired?
+ :version "30.1"
+ :type 'boolean)
+
;; Method to attach files to a mail composition.
(defun gnus-dired-attach (files-to-attach)
"Attach dired's marked files to a gnus message composition.
@@ -161,7 +167,8 @@ filenames."
;; set buffer to destination buffer, and attach files
(set-buffer destination)
- (goto-char (point-max)) ;attach at end of buffer
+ (when gnus-dired-attach-at-end
+ (goto-char (point-max))) ;attach at end of buffer
(while files-to-attach
(mml-attach-file (car files-to-attach)
(or (mm-default-file-type (car files-to-attach))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9664d603019..71bfaa639fa 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1064,11 +1064,11 @@ When FORCE, rebuild the tool bar."
All normal editing commands are switched off.
\\<gnus-group-mode-map>
The group buffer lists (some of) the groups available. For instance,
-`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
+\\[gnus-group-list-groups] will list all subscribed groups with unread articles, while \\[gnus-group-list-zombies]
lists all zombie groups.
-Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
-to a group not displayed, type `\\[gnus-group-toggle-subscription]'.
+Groups that are displayed can be entered with \\[gnus-group-read-group]. To subscribe
+to a group not displayed, type \\[gnus-group-toggle-subscription].
For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
@@ -4638,7 +4638,7 @@ and the second element is the address."
"Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
(let ((buffer (gnus-summary-buffer-name group)))
(if (gnus-buffer-live-p buffer)
- (with-current-buffer (get-buffer buffer)
+ (with-current-buffer buffer
(gnus-summary-add-mark article mark))
(gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
(list article)))))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index fdf97e1aabd..b18ede58fbf 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1189,12 +1189,12 @@ Uses the process/prefix convention.
The reply will include all From/Cc headers from the original
messages as the To/Cc headers.
-If prefix argument YANK is non-nil, the original article(s) will
+If prefix argument YANK is non-nil, the original article will
be yanked automatically."
(interactive (list (and current-prefix-arg
(gnus-summary-work-articles 1)))
gnus-summary-mode)
- (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+ (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg)))
(defun gnus-summary-very-wide-reply-with-original (n)
"Start composing a very wide reply mail a set of messages.
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index f34f5ea0e26..e4c3d2c0381 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -75,35 +75,55 @@ not get notifications."
(when group-article
(let ((group (cadr group-article))
(article (nth 2 group-article)))
- (cond ((string= key "read")
+ (cond ((or (equal key "read")
+ (equal key "default"))
(gnus-fetch-group group (list article))
(select-frame-set-input-focus (selected-frame)))
- ((string= key "mark-read")
+ ((equal key "mark-read")
(gnus-update-read-articles
group
(delq article (gnus-list-of-unread-articles group)))
;; gnus-group-refresh-group
- (gnus-group-update-group group)))))))
+ (gnus-group-update-group group))))))
+ ;; Notifications are removed unless otherwise specified once they (or
+ ;; an action of theirs) are selected
+ (assoc-delete-all id gnus-notifications-id-to-msg))
+
+(defun gnus-notifications-close (id _reason)
+ "Remove ID from the alist of notification identifiers to messages.
+REASON is ignored."
+ (assoc-delete-all id gnus-notifications-id-to-msg))
(defun gnus-notifications-notify (from subject photo-file)
"Send a notification about a new mail.
Return a notification id if any, or t on success."
- (if (fboundp 'notifications-notify)
+ (if (featurep 'android)
(gnus-funcall-no-warning
- 'notifications-notify
+ 'android-notifications-notify
:title from
:body subject
:actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
- :app-icon (gnus-funcall-no-warning
- 'image-search-load-path "gnus/gnus.png")
- :image-path photo-file
- :app-name "Gnus"
- :category "email.arrived"
+ :on-close 'gnus-notifications-close
+ :group "Email arrivals"
:timeout gnus-notifications-timeout)
- (message "New message from %s: %s" from subject)
- ;; Don't return an id
- t))
+ (if (fboundp 'notifications-notify)
+ (gnus-funcall-no-warning
+ 'notifications-notify
+ :title from
+ :body subject
+ :actions '("read" "Read" "mark-read" "Mark As Read")
+ :on-action 'gnus-notifications-action
+ :on-close 'gnus-notifications-close
+ :app-icon (gnus-funcall-no-warning
+ 'image-search-load-path "gnus/gnus.png")
+ :image-path photo-file
+ :app-name "Gnus"
+ :category "email.arrived"
+ :timeout gnus-notifications-timeout)
+ (message "New message from %s: %s" from subject)
+ ;; Don't return an id
+ t)))
(declare-function gravatar-retrieve-synchronously "gravatar.el"
(mail-address))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index bd19e7d7cd7..479b7496cf1 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
(t "permanent"))
header
(if (< score 0) "lower" "raise"))
- (if (numberp match)
- (int-to-string match)
- match))))
+ (cond ((numberp match) (int-to-string match))
+ ((string= header "date")
+ (int-to-string
+ (-
+ (/ (car (time-convert (current-time) 1)) 86400)
+ (/ (car (time-convert (gnus-date-get-time match) 1))
+ 86400))))
+ (t match)))))
;; If this is an integer comparison, we transform from string to int.
(if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index f337278994c..05ad4303b5c 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2285,14 +2285,16 @@ If FORCE is non-nil, the .newsrc file is read."
;; doesn't change with each release) and the
;; function that must be applied to convert the
;; previous version into the current version.
- '(("September Gnus v0.1" nil
- gnus-convert-old-ticks)
- ("Oort Gnus v0.08" "legacy-gnus-agent"
- gnus-agent-convert-to-compressed-agentview)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unlist-expire-days)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unhook-expire-days)))
+ '(;;These all date back to 2004 or earlier!
+ ;; ("September Gnus v0.1" nil
+ ;; gnus-convert-old-ticks)
+ ;; ("Oort Gnus v0.08" "legacy-gnus-agent"
+ ;; gnus-agent-convert-to-compressed-agentview)
+ ;; ("Gnus v5.10.7" "legacy-gnus-agent"
+ ;; gnus-agent-unlist-expire-days)
+ ;; ("Gnus v5.10.7" "legacy-gnus-agent"
+ ;; gnus-agent-unhook-expire-days)
+ ))
#'car-less-than-car)))
;; Skip converters older than the file version
(while (and converters (>= fcv (caar converters)))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index fd67e46a401..dc66e1375ab 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3062,17 +3062,17 @@ the summary mode hooks are run.")
"Major mode for reading articles.
\\<gnus-summary-mode-map>
Each line in this buffer represents one article. To read an
-article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards
-and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
+article, you can, for instance, type \\[gnus-summary-next-page]. To move forwards
+and backwards while displaying articles, type \\[gnus-summary-next-unread-article] and \\[gnus-summary-prev-unread-article],
respectively.
You can also post articles and send mail from this buffer. To
-follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
-of an article, type `\\[gnus-summary-reply]'.
+follow up an article, type \\[gnus-summary-followup]. To mail a reply to the author
+of an article, type \\[gnus-summary-reply].
There are approximately one gazillion commands you can execute in
this buffer; read the Info manual for more
-information (`\\[gnus-info-find-node]').
+information (\\[gnus-info-find-node]).
The following commands are available:
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b5aa0b02d34..0b0a9bbfc1d 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1113,8 +1113,7 @@ sure of changing the value of `foo'."
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
-(defun gnus-not-ignore (&rest _args)
- t)
+(defalias 'gnus-not-ignore #'always)
(defvar gnus-directory-sep-char-regexp "/"
"The regexp of directory separator character.
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 99833e4eeca..dab66b60205 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -309,12 +309,31 @@ be set in `.emacs' instead."
:group 'gnus-start
:type 'boolean)
+(defcustom gnus-mode-line-logo
+ '((:type svg :file "gnus-pointer.svg" :ascent center)
+ (:type xpm :file "gnus-pointer.xpm" :ascent center)
+ (:type xbm :file "gnus-pointer.xbm" :ascent center))
+ "Image spec for the Gnus logo to be displayed in mode-line.
+
+If non-nil, it should be a list of image specifications to be passed
+as the first argument to `find-image', which see. Then, if the display
+is capable of showing images, the Gnus logo will be displayed as part of
+the buffer-identification in the mode-line of Gnus-buffers.
+
+If nil, there will be no Gnus logo in the mode-line."
+ :group 'gnus-visual
+ :type '(choice
+ (repeat :tag "List of Gnus logo image specifications" (plist))
+ (const :tag "Don't display Gnus logo" nil))
+ :version "30.1")
+
(defun gnus-mode-line-buffer-identification (line)
(let* ((str (car-safe line))
(str (if (stringp str)
(car (propertized-buffer-identification str))
str)))
- (if (or (not (fboundp 'find-image))
+ (if (or (not gnus-mode-line-logo)
+ (not (fboundp 'find-image))
(not (display-graphic-p))
(not (stringp str))
(not (string-match "^Gnus:" str)))
@@ -325,14 +344,7 @@ be set in `.emacs' instead."
(add-text-properties
0 5
(list 'display
- (find-image
- '((:type svg :file "gnus-pointer.svg"
- :ascent center)
- (:type xpm :file "gnus-pointer.xpm"
- :ascent center)
- (:type xbm :file "gnus-pointer.xbm"
- :ascent center))
- t)
+ (find-image gnus-mode-line-logo t)
'help-echo (if gnus-emacs-version
(format
"This is %s, %s."
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
deleted file mode 100644
index d4f08c72de8..00000000000
--- a/lisp/gnus/legacy-gnus-agent.el
+++ /dev/null
@@ -1,260 +0,0 @@
-;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
-
-;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
-;; Keywords: news
-
-;; 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:
-
-;; Conversion functions for the Agent.
-
-;;; Code:
-(require 'gnus-start)
-(require 'gnus-util)
-(require 'gnus-range)
-(require 'gnus-agent)
-
-;; Oort Gnus v0.08 - This release updated agent to no longer use
-;; history file and to support a compressed alist.
-
-(defvar gnus-agent-compressed-agentview-search-only nil)
-
-(defun gnus-agent-convert-to-compressed-agentview (converting-to)
- "Iterates over all agentview files to ensure that they have been
-converted to the compressed format."
-
- (let ((search-in (list gnus-agent-directory))
- here
- members
- member
- converted-something)
- (while (setq here (pop search-in))
- (setq members (directory-files here t))
- (while (setq member (pop members))
- (cond ((string-match "/\\.\\.?$" member)
- nil)
- ((file-directory-p member)
- (push member search-in))
- ((equal (file-name-nondirectory member) ".agentview")
- (setq converted-something
- (or (gnus-agent-convert-agentview member)
- converted-something))))))
-
- (if converted-something
- (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
-
-(defun gnus-agent-convert-to-compressed-agentview-prompt ()
- (catch 'found-file-to-convert
- (let ((gnus-agent-compressed-agentview-search-only t))
- (gnus-agent-convert-to-compressed-agentview nil))))
-
-(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
-
-(defun gnus-agent-convert-agentview (file)
- "Load FILE and do a `read' there."
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let ((inhibit-quit t)
- (alist (read (current-buffer)))
- (version (condition-case nil (read (current-buffer))
- (end-of-file 0)))
- changed-version
- history-file)
-
- (cond
- ((= version 0)
- (let (entry
- (gnus-command-method nil))
- (mm-disable-multibyte) ;; everything is binary
- (erase-buffer)
- (insert "\n")
- (let ((file (concat (file-name-directory file) "/history")))
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)
- (setq history-file file)))
-
- (goto-char (point-min))
- (while (not (eobp))
- (if (and (looking-at
- "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
- (string= (gnus-agent-article-name ".agentview" (match-string 2))
- file)
- (setq entry (assoc (string-to-number (match-string 3)) alist)))
- (setcdr entry (string-to-number (match-string 1))))
- (forward-line 1))
- (setq changed-version t)))
- ((= version 1)
- (setq changed-version t)))
-
- (when changed-version
- (when gnus-agent-compressed-agentview-search-only
- (throw 'found-file-to-convert t))
-
- (erase-buffer)
- (let (article-id day-of-download comp-list compressed)
- (while alist
- (setq article-id (caar alist)
- day-of-download (cdar alist)
- comp-list (assq day-of-download compressed)
- alist (cdr alist))
- (if comp-list
- (setcdr comp-list (cons article-id (cdr comp-list)))
- (push (list day-of-download article-id) compressed)))
- (setq alist compressed)
- (while alist
- (setq comp-list (pop alist))
- (setcdr comp-list
- (gnus-compress-sequence (nreverse (cdr comp-list)))))
- (princ compressed (current-buffer)))
- (insert "\n2\n")
- (write-file file)
- (when history-file
- (delete-file history-file))
- t))))
-
-;; End of Oort Gnus v0.08 updates
-
-;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
-;; from previous versions. Therefore, the previous
-;; hacks to handle a gnus-agent-expire-days that
-;; specifies a list of values can be removed.
-
-(defun gnus-agent-unlist-expire-days (converting-to)
- (when (listp gnus-agent-expire-days)
- (let (buffer)
- (unwind-protect
- (save-window-excursion
- (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
- (set-buffer buffer)
- (erase-buffer)
- (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ")
- (gnus-pp gnus-agent-expire-days)
-
- (insert
- (format-message
- "\nIn order to use version `%s' of gnus, you will need to set\n"
- converting-to))
- (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
- (insert "expiration days to individual groups, you must instead set the\n")
- (insert (format-message
- "`agent-days-until-old' group and/or topic parameter.\n"))
- (insert "\n")
- (insert "If you would like, gnus can iterate over every group comparing its name to the\n")
- (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n")
- (insert (format-message
- "gnus finds a match, it will update that group's `agent-days-until-old' group\n"))
- (insert "parameter to the value associated with the regular expression.\n")
- (insert "\n")
- (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
- (insert "ERROR as soon as this function completes. The reason is that you must\n")
- (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
- (insert "to set it to an integer before gnus can be used.\n")
- (insert "\n")
- (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
- (insert "execute past this function.\n")
- (insert "\n")
- (insert "Should gnus use gnus-agent-expire-days to assign\n")
- (insert "agent-days-until-old parameters to individual groups? (Y/N)")
-
- (switch-to-buffer buffer)
- (beep)
- (beep)
-
- (let ((echo-keystrokes 0)
- c)
- (while (progn (setq c (read-char-exclusive))
- (cond ((or (eq c ?y) (eq c ?Y))
- (save-excursion
- (let ((groups (gnus-group-listed-groups)))
- (while groups
- (let* ((group (pop groups))
- (days gnus-agent-expire-days)
- (day (catch 'found
- (while days
- (when (eq 0 (string-match
- (caar days)
- group))
- (throw 'found (cadr (car days))))
- (setq days (cdr days)))
- nil)))
- (when day
- (gnus-group-set-parameter group 'agent-days-until-old
- day))))))
- nil
- )
- ((or (eq c ?n) (eq c ?N))
- nil)
- (t
- t))))))
- (kill-buffer buffer))
- (error "Change gnus-agent-expire-days to an integer for gnus to start"))))
-
-;; The gnus-agent-unlist-expire-days has its own conversion prompt.
-;; Therefore, hide the default prompt.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
-
-(defun gnus-agent-unhook-expire-days (_converting-to)
- "Remove every lambda from `gnus-group-prepare-hook' that mention the
-symbol `gnus-agent-do-once' in their definition. This should NOT be
-necessary as gnus-agent.el no longer adds them. However, it is
-possible that the hook was persistently saved."
- (let ((h t)) ; Iterate from bgn of hook.
- (while h
- (let ((func (progn (when (eq h t)
- ;; Init h to list of functions.
- (setq h (cond ((listp gnus-group-prepare-hook)
- gnus-group-prepare-hook)
- ((boundp 'gnus-group-prepare-hook)
- (list gnus-group-prepare-hook)))))
- (pop h))))
-
- (when (cond ((byte-code-function-p func)
- ;; Search def. of compiled function for
- ;; gnus-agent-do-once string.
- (let* (definition
- print-level
- print-length
- (standard-output
- (lambda (char)
- (setq definition (cons char definition)))))
- (princ func) ; Populates definition with reversed list
- ; of characters.
- (let* ((i (length definition))
- (s (make-string i 0)))
- (while definition
- (aset s (setq i (1- i)) (pop definition)))
-
- (string-match "\\bgnus-agent-do-once\\b" s))))
- ((listp func)
- (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda.
- ))
-
- (remove-hook 'gnus-group-prepare-hook func)
- ;; I don't what remove-hook is going to actually do to the
- ;; hook list so start over from the beginning.
- (setq h t))))))
-
-;; gnus-agent-unhook-expire-days is safe in that it does not modify
-;; the .newsrc.eld file.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
-
-(provide 'legacy-gnus-agent)
-
-;;; legacy-gnus-agent.el ends here
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 3a7192092af..109b6c17c2c 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -502,6 +502,7 @@ If MODE is not set, try to find mode automatically."
(setq coding-system (mm-find-buffer-file-coding-system)))
(setq text (buffer-string))))
(with-temp-buffer
+ (setq untrusted-content t)
(insert (cond ((eq charset 'gnus-decoded)
(with-current-buffer (mm-handle-buffer handle)
(buffer-string)))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 97821894b48..ea679759f3e 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments."
(nnheader-skeleton-replace from to t))
(defun nnheader-strip-cr ()
- "Strip all \r's from the current buffer."
+ "Strip all \\r's from the current buffer."
(nnheader-skeleton-replace "\r"))
(define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1")
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index ca21408f6c3..a291893e9a2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -741,18 +741,28 @@ the C sources, too."
(defun help-fns--parent-mode (function)
;; If this is a derived mode, link to the parent.
- (let ((parent-mode (and (symbolp function)
- ;; FIXME: Should we mention other parent modes?
- (get function
- 'derived-mode-parent))))
+ (when (symbolp function)
+ (let ((parent-mode (get function 'derived-mode-parent))
+ (extra-parents (get function 'derived-mode-extra-parents)))
(when parent-mode
(insert (substitute-quotes " Parent mode: `"))
(let ((beg (point)))
- (insert (format "%s" parent-mode))
+ (insert (format "%S" parent-mode))
(make-text-button beg (point)
'type 'help-function
'help-args (list parent-mode)))
- (insert (substitute-quotes "'.\n")))))
+ (insert (substitute-quotes "'.\n")))
+ (when extra-parents
+ (insert (format " Extra parent mode%s:" (if (cdr extra-parents) "s" "")))
+ (dolist (parent extra-parents)
+ (insert (substitute-quotes " `"))
+ (let ((beg (point)))
+ (insert (format "%S" parent))
+ (make-text-button beg (point)
+ 'type 'help-function
+ 'help-args (list parent)))
+ (insert (substitute-quotes "'")))
+ (insert ".\n")))))
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
@@ -1051,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(concat
"an autoloaded " (if (commandp def)
"interactive "))
- (if (commandp def) "an interactive " "a "))))
-
- ;; Print what kind of function-like object FUNCTION is.
- (princ (cond ((or (stringp def) (vectorp def))
+ (if (commandp def) "an interactive " "a ")))
+ ;; Print what kind of function-like object FUNCTION is.
+ (description
+ (cond ((or (stringp def) (vectorp def))
"a keyboard macro")
((and (symbolp function)
(get function 'reader-construct))
@@ -1063,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; aliases before functions.
(aliased
(format-message "an alias for `%s'" real-def))
- ((subr-native-elisp-p def)
- (concat beg "native-compiled Lisp function"))
- ((subrp def)
- (concat beg (if (eq 'unevalled (cdr (subr-arity def)))
- "special form"
- "built-in function")))
((autoloadp def)
(format "an autoloaded %s"
(cond
@@ -1082,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; need to check macros before functions.
(macrop function))
(concat beg "Lisp macro"))
- ((byte-code-function-p def)
- (concat beg "byte-compiled Lisp function"))
- ((module-function-p def)
- (concat beg "module function"))
- ((memq (car-safe def) '(lambda closure))
- (concat beg "Lisp function"))
+ ((atom def)
+ (let ((type (or (oclosure-type def) (cl-type-of def))))
+ (concat beg (format "%s"
+ (make-text-button
+ (symbol-name type) nil
+ 'type 'help-type
+ 'help-args (list type))))))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
@@ -1097,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
elts nil))
(setq elts (cdr-safe elts)))
(concat beg (if is-full "keymap" "sparse keymap"))))
- (t "")))
+ (t ""))))
+ (with-current-buffer standard-output
+ (insert description))
(if (and aliased (not (fboundp real-def)))
(princ ",\nwhich is not defined.")
@@ -1789,9 +1796,8 @@ If FRAME is omitted or nil, use the selected frame."
alias)
""))))
(insert "\nDocumentation:\n"
- (substitute-command-keys
- (or (face-documentation face)
- "Not documented as a face."))
+ (or (face-documentation face)
+ "Not documented as a face.")
"\n\n"))
(with-current-buffer standard-output
(save-excursion
@@ -2124,6 +2130,12 @@ keymap value."
(when used-gentemp
(makunbound keymap))))
+(defcustom describe-mode-outline t
+ "Non-nil enables outlines in the output buffer of `describe-mode'."
+ :type 'boolean
+ :group 'help
+ :version "30.1")
+
;;;###autoload
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
@@ -2136,7 +2148,10 @@ variable \(listed in `minor-mode-alist') must also be a function
whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
+documentation for the major and minor modes of that buffer.
+
+When `describe-mode-outline' is non-nil, Outline minor mode
+is enabled in the Help buffer."
(interactive "@")
(unless buffer
(setq buffer (current-buffer)))
@@ -2150,13 +2165,20 @@ documentation for the major and minor modes of that buffer."
(with-current-buffer (help-buffer)
;; Add the local minor modes at the start.
(when local-minors
- (insert (format "Minor mode%s enabled in this buffer:"
- (if (length> local-minors 1)
- "s" "")))
+ (unless describe-mode-outline
+ (insert (format "Minor mode%s enabled in this buffer:"
+ (if (length> local-minors 1)
+ "s" ""))))
(describe-mode--minor-modes local-minors))
;; Document the major mode.
(let ((major (buffer-local-value 'major-mode buffer)))
+ (when describe-mode-outline
+ (goto-char (point-min))
+ (put-text-property
+ (point) (progn (insert (format "Major mode %S" major)) (point))
+ 'outline-level 1)
+ (insert "\n\n"))
(insert "The major mode is "
(buttonize
(propertize (format-mode-line
@@ -2180,36 +2202,56 @@ documentation for the major and minor modes of that buffer."
;; Insert the global minor modes after the major mode.
(when global-minor-modes
- (insert (format "Global minor mode%s enabled:"
- (if (length> global-minor-modes 1)
- "s" "")))
- (describe-mode--minor-modes global-minor-modes)
- (when (re-search-forward "^\f")
- (beginning-of-line)
- (ensure-empty-lines 1)))
+ (unless describe-mode-outline
+ (insert (format "Global minor mode%s enabled:"
+ (if (length> global-minor-modes 1)
+ "s" ""))))
+ (describe-mode--minor-modes global-minor-modes t)
+ (unless describe-mode-outline
+ (when (re-search-forward "^\f")
+ (beginning-of-line)
+ (ensure-empty-lines 1))))
+
+ (when describe-mode-outline
+ (setq-local outline-search-function #'outline-search-level)
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'insert)
+ (outline-minor-mode 1))
+
;; For the sake of IELM and maybe others
nil)))))
-(defun describe-mode--minor-modes (modes)
+(defun describe-mode--minor-modes (modes &optional global)
(dolist (mode (seq-sort #'string< modes))
(let ((pretty-minor-mode
(capitalize
(replace-regexp-in-string
"\\(\\(-minor\\)?-mode\\)?\\'" ""
(symbol-name mode)))))
- (insert
- " "
- (buttonize
- pretty-minor-mode
- (lambda (mode)
- (goto-char (point-min))
- (text-property-search-forward
- 'help-minor-mode mode t)
- (beginning-of-line))
- mode))
+ (if (not describe-mode-outline)
+ (insert
+ " "
+ (buttonize
+ pretty-minor-mode
+ (lambda (mode)
+ (goto-char (point-min))
+ (text-property-search-forward
+ 'help-minor-mode mode t)
+ (beginning-of-line))
+ mode))
+ (goto-char (point-max))
+ (put-text-property
+ (point) (progn (insert (if global "Global" "Local")
+ (format " minor mode %S" mode))
+ (point))
+ 'outline-level 1)
+ (insert "\n\n"))
(save-excursion
- (goto-char (point-max))
- (insert "\n\n\f\n")
+ (unless describe-mode-outline
+ (goto-char (point-max))
+ (insert "\n\n\f\n"))
;; Document the minor modes fully.
(insert (buttonize
(propertize pretty-minor-mode 'help-minor-mode mode)
@@ -2223,11 +2265,14 @@ documentation for the major and minor modes of that buffer."
(format "indicator%s"
indicator)))))
(insert (or (help-split-fundoc (documentation mode) nil 'doc)
- "No docstring")))))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-paragraph 1)
- (ensure-empty-lines 1))
+ "No docstring"))
+ (when describe-mode-outline
+ (insert "\n\n")))))
+ (unless describe-mode-outline
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-paragraph 1)
+ (ensure-empty-lines 1)))
(defun help-fns--list-local-commands ()
(let ((functions nil))
@@ -2400,6 +2445,81 @@ one of them returns non-nil."
(setq buffer-undo-list nil)
(texinfo-mode)))
+(defconst help-fns--function-numbers
+ (make-hash-table :test 'equal :weakness 'value))
+(defconst help-fns--function-names (make-hash-table :weakness 'key))
+
+(defun help-fns--display-function (function)
+ (cond
+ ((subr-primitive-p function)
+ (describe-function function))
+ ((and (compiled-function-p function)
+ (not (and (fboundp 'kmacro-p) (kmacro-p function))))
+ (disassemble function))
+ (t
+ ;; FIXME: Use cl-print!
+ (pp-display-expression function "*Help Source*" (consp function)))))
+
+;;;###autoload
+(defun help-fns-function-name (function)
+ "Return a short buttonized string representing FUNCTION.
+The string is propertized with a button; clicking on that
+provides further details about FUNCTION.
+FUNCTION can be a function, a built-in, a keyboard macro,
+or a compile function.
+This function is intended to be used to display various
+callable symbols in buffers in a way that allows the user
+to find out more details about the symbols."
+ ;; FIXME: For kmacros, should we print the key-sequence?
+ (cond
+ ((symbolp function)
+ (let ((name (if (eq (intern-soft (symbol-name function)) function)
+ (symbol-name function)
+ (concat "#:" (symbol-name function)))))
+ (if (not (fboundp function))
+ name
+ (make-text-button name nil
+ 'type 'help-function
+ 'help-args (list function)))))
+ ((gethash function help-fns--function-names))
+ ((subrp function)
+ (let ((name (subr-name function)))
+ ;; FIXME: For native-elisp-functions, should we use `help-function'
+ ;; or `disassemble'?
+ (format "#<%s %s>"
+ (cl-type-of function)
+ (make-text-button name nil
+ 'type 'help-function
+ ;; Let's hope the subr hasn't been redefined!
+ 'help-args (list (intern name))))))
+ (t
+ (let ((type (or (oclosure-type function)
+ (if (consp function)
+ (car function) (cl-type-of function))))
+ (hash (sxhash-eq function))
+ ;; Use 3 digits minimum.
+ (mask #xfff)
+ name)
+ (while
+ (let* ((hex (format (concat "%0"
+ (number-to-string (1+ (/ (logb mask) 4)))
+ "X")
+ (logand mask hash)))
+ ;; FIXME: For kmacros, we don't want to `disassemble'!
+ (button (buttonize
+ hex #'help-fns--display-function function
+ ;; FIXME: Shouldn't `buttonize' add
+ ;; the "mouse-2, RET:" prefix?
+ "mouse-2, RET: Display the function's body")))
+ (setq name (format "#<%s %s>" type button))
+ (and (< mask (abs hash)) ; We can add more digits.
+ (gethash name help-fns--function-numbers)))
+ ;; Add a digit.
+ (setq mask (+ (ash mask 4) #x0f)))
+ (puthash name function help-fns--function-numbers)
+ (puthash function name help-fns--function-names)
+ name))))
+
(provide 'help-fns)
;;; help-fns.el ends here
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index cea8b379ec0..8a16e85a329 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -92,141 +92,146 @@ and then returns."
`(defun ,fname ()
"Help command."
(interactive)
- (let ((line-prompt
- (substitute-command-keys ,help-line))
- (help-buffer-under-preparation t))
- (when three-step-help
- (message "%s" line-prompt))
- (let* ((help-screen ,help-text)
- ;; We bind overriding-local-map for very small
- ;; sections, *excluding* where we switch buffers
- ;; and where we execute the chosen help command.
- (local-map (make-sparse-keymap))
- (new-minor-mode-map-alist minor-mode-map-alist)
- (prev-frame (selected-frame))
- config new-frame key char)
- (when (string-match "%THIS-KEY%" help-screen)
- (setq help-screen
- (replace-match (help--key-description-fontified
- (substring (this-command-keys) 0 -1))
- t t help-screen)))
- (unwind-protect
- (let ((minor-mode-map-alist nil))
- (setcdr local-map ,helped-map)
- (define-key local-map [t] 'undefined)
- ;; Make the scroll bar keep working normally.
- (define-key local-map [vertical-scroll-bar]
- (lookup-key global-map [vertical-scroll-bar]))
- (if three-step-help
- (progn
- (setq key (let ((overriding-local-map local-map))
- (read-key-sequence nil)))
- ;; Make the HELP key translate to C-h.
- (if (lookup-key function-key-map key)
- (setq key (lookup-key function-key-map key)))
- (setq char (aref key 0)))
- (setq char ??))
- (when (or (eq char ??) (eq char help-char)
- (memq char help-event-list))
- (setq config (current-window-configuration))
- (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t)
- (and (fboundp 'make-frame)
- (not (eq (window-frame)
- prev-frame))
- (setq new-frame (window-frame)
- config nil))
- (setq buffer-read-only nil)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (substitute-command-keys help-screen)))
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- (help-mode)
- (variable-pitch-mode)
- (setq new-minor-mode-map-alist minor-mode-map-alist))
- (goto-char (point-min))
- (while (or (memq char (append help-event-list
- (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s
- deletechar backspace vertical-scroll-bar
- 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 end))
- (scroll-up))
- ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home))
- (equal key "\M-v"))
- (scroll-down))
- ((memq char '(down))
- (scroll-up 1))
- ((memq char '(up))
- (scroll-down 1)))
- (error nil))
- (let ((cursor-in-echo-area t)
- (overriding-local-map local-map))
- (frame-toggle-on-screen-keyboard (selected-frame) nil)
- (setq key (read-key-sequence
- (format "Type one of listed options%s: "
- (if (pos-visible-in-window-p
- (point-max))
- ""
- (concat ", or "
- (help--key-description-fontified (kbd "<PageDown>"))
- "/"
- (help--key-description-fontified (kbd "<PageUp>"))
- "/"
- (help--key-description-fontified (kbd "SPC"))
- "/"
- (help--key-description-fontified (kbd "DEL"))
- " to scroll")))
- nil nil nil nil
- ;; Disable ``text conversion''. OS
- ;; input methods might otherwise chose
- ;; to insert user input directly into
- ;; a buffer.
- t)
- char (aref key 0)))
-
- ;; If this is a scroll bar command, just run it.
- (when (eq char 'vertical-scroll-bar)
- (command-execute (lookup-key local-map key) nil key))))
- ;; We don't need the prompt any more.
- (message "")
- ;; Mouse clicks are not part of the help feature,
- ;; so reexecute them in the standard environment.
- (if (listp char)
- (setq unread-command-events
- (cons char unread-command-events)
- config nil)
- (let ((defn (lookup-key local-map key)))
- (if defn
- (progn
- (when config
- (set-window-configuration config)
- (setq config nil))
- ;; Temporarily rebind `minor-mode-map-alist'
- ;; to `new-minor-mode-map-alist' (Bug#10454).
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- ;; `defn' must make sure that its frame is
- ;; selected, so we won't iconify it below.
- (call-interactively defn))
- (when new-frame
- ;; Do not iconify the selected frame.
- (unless (eq new-frame (selected-frame))
- (iconify-frame new-frame))
- (setq new-frame nil)))
- (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
- (iconify-frame new-frame))
- (setq minor-mode-map-alist new-minor-mode-map-alist))))))
+ (help--help-screen ,help-line ,help-text ,helped-map ,buffer-name)))
+
+
+;;;###autoload
+(defun help--help-screen (help-line help-text helped-map buffer-name)
+ (let ((line-prompt
+ (substitute-command-keys help-line))
+ (help-buffer-under-preparation t))
+ (when three-step-help
+ (message "%s" line-prompt))
+ (let* ((help-screen help-text)
+ ;; We bind overriding-local-map for very small
+ ;; sections, *excluding* where we switch buffers
+ ;; and where we execute the chosen help command.
+ (local-map (make-sparse-keymap))
+ (new-minor-mode-map-alist minor-mode-map-alist)
+ (prev-frame (selected-frame))
+ config new-frame key char)
+ (when (string-match "%THIS-KEY%" help-screen)
+ (setq help-screen
+ (replace-match (help--key-description-fontified
+ (substring (this-command-keys) 0 -1))
+ t t help-screen)))
+ (unwind-protect
+ (let ((minor-mode-map-alist nil))
+ (setcdr local-map helped-map)
+ (define-key local-map [t] #'undefined)
+ ;; Make the scroll bar keep working normally.
+ (define-key local-map [vertical-scroll-bar]
+ (lookup-key global-map [vertical-scroll-bar]))
+ (if three-step-help
+ (progn
+ (setq key (let ((overriding-local-map local-map))
+ (read-key-sequence nil)))
+ ;; Make the HELP key translate to C-h.
+ (if (lookup-key function-key-map key)
+ (setq key (lookup-key function-key-map key)))
+ (setq char (aref key 0)))
+ (setq char ??))
+ (when (or (eq char ??) (eq char help-char)
+ (memq char help-event-list))
+ (setq config (current-window-configuration))
+ (pop-to-buffer (or buffer-name " *Metahelp*") nil t)
+ (and (fboundp 'make-frame)
+ (not (eq (window-frame)
+ prev-frame))
+ (setq new-frame (window-frame)
+ config nil))
+ (setq buffer-read-only nil)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (substitute-command-keys help-screen)))
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ (help-mode)
+ (variable-pitch-mode)
+ (setq new-minor-mode-map-alist minor-mode-map-alist))
+ (goto-char (point-min))
+ (while (or (memq char (append help-event-list
+ (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s
+ deletechar backspace vertical-scroll-bar
+ 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 end))
+ (scroll-up))
+ ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home))
+ (equal key "\M-v"))
+ (scroll-down))
+ ((memq char '(down))
+ (scroll-up 1))
+ ((memq char '(up))
+ (scroll-down 1)))
+ (error nil))
+ (let ((cursor-in-echo-area t)
+ (overriding-local-map local-map))
+ (frame-toggle-on-screen-keyboard (selected-frame) nil)
+ (setq key (read-key-sequence
+ (format "Type one of listed options%s: "
+ (if (pos-visible-in-window-p
+ (point-max))
+ ""
+ (concat ", or "
+ (help--key-description-fontified (kbd "<PageDown>"))
+ "/"
+ (help--key-description-fontified (kbd "<PageUp>"))
+ "/"
+ (help--key-description-fontified (kbd "SPC"))
+ "/"
+ (help--key-description-fontified (kbd "DEL"))
+ " to scroll")))
+ nil nil nil nil
+ ;; Disable ``text conversion''. OS
+ ;; input methods might otherwise chose
+ ;; to insert user input directly into
+ ;; a buffer.
+ t)
+ char (aref key 0)))
+
+ ;; If this is a scroll bar command, just run it.
+ (when (eq char 'vertical-scroll-bar)
+ (command-execute (lookup-key local-map key) nil key))))
+ ;; We don't need the prompt any more.
+ (message "")
+ ;; Mouse clicks are not part of the help feature,
+ ;; so reexecute them in the standard environment.
+ (if (listp char)
+ (setq unread-command-events
+ (cons char unread-command-events)
+ config nil)
+ (let ((defn (lookup-key local-map key)))
+ (if defn
+ (progn
+ (when config
+ (set-window-configuration config)
+ (setq config nil))
+ ;; Temporarily rebind `minor-mode-map-alist'
+ ;; to `new-minor-mode-map-alist' (Bug#10454).
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ ;; `defn' must make sure that its frame is
+ ;; selected, so we won't iconify it below.
+ (call-interactively defn))
+ (when new-frame
+ ;; Do not iconify the selected frame.
+ (unless (eq new-frame (selected-frame))
+ (iconify-frame new-frame))
+ (setq new-frame nil)))
+ (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
+ (iconify-frame new-frame))
+ (setq minor-mode-map-alist new-minor-mode-map-alist)))))
(provide 'help-macro)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 9c405efeee5..48433d899ab 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).")
'help-function 'describe-variable
'help-echo (purecopy "mouse-2, RET: describe this variable"))
+(define-button-type 'help-type
+ :supertype 'help-xref
+ 'help-function #'cl-describe-type
+ 'help-echo (purecopy "mouse-2, RET: describe this type"))
+
(define-button-type 'help-face
:supertype 'help-xref
'help-function 'describe-face
@@ -501,7 +506,17 @@ restore it properly when going back."
;; Disable `outline-minor-mode' in a reused Help buffer
;; created by `describe-bindings' that enables this mode.
(when (bound-and-true-p outline-minor-mode)
- (outline-minor-mode -1))
+ (outline-minor-mode -1)
+ (mapc #'kill-local-variable
+ '(outline-search-function
+ outline-regexp
+ outline-heading-end-regexp
+ outline-level
+ outline-minor-mode-cycle
+ outline-minor-mode-highlight
+ outline-minor-mode-use-buttons
+ outline-default-state
+ outline-default-rules)))
(when help-xref-stack-item
(push (cons (point) help-xref-stack-item) help-xref-stack)
(setq help-xref-forward-stack nil))
@@ -535,6 +550,9 @@ it does not already exist."
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
,#'describe-variable)
+ ;; FIXME: We could go crazy and add another entry so describe-symbol can be
+ ;; used with the slot names of CL structs (and/or EIEIO objects).
+ ("type" ,#'cl-find-class ,#'cl-describe-type)
("face" ,#'facep ,(lambda (s _b _f) (describe-face s))))
"List of providers of information about symbols.
Each element has the form (NAME TESTFUN DESCFUN) where:
diff --git a/lisp/help.el b/lisp/help.el
index a551dba5fe5..1ef46e394f3 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -151,7 +151,7 @@ buffer.")
("Mark & Kill"
(set-mark-command . "mark")
(kill-line . "kill line")
- (kill-ring-save . "kill region")
+ (kill-region . "kill region")
(yank . "yank")
(exchange-point-and-mark . "swap"))
("Projects"
@@ -165,13 +165,24 @@ buffer.")
(isearch-forward . "search")
(isearch-backward . "reverse search")
(query-replace . "search & replace")
- (fill-paragraph . "reformat"))))
+ (fill-paragraph . "reformat")))
+ "Data structure for `help-quick'.
+Value should be a list of elements, each element should of the form
+
+ (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...)
+
+where GROUP-NAME is the name of the group of the commands,
+COMMAND is the symbol of a command and DESCRIPTION is its short
+description, 10 to 15 char5acters at most.")
(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."
+ "Display a quick-help buffer showing popular commands and their bindings.
+The window showing quick-help can be toggled using \\[help-quick-toggle].
+You can click on a key binding shown in the quick-help buffer to display
+the documentation of the command bound to that key sequence."
(interactive)
(with-current-buffer (get-buffer-create "*Quick Help*")
(let ((inhibit-read-only t) (padding 2) blocks)
@@ -246,10 +257,14 @@ buffer.")
;; ... and shrink it immediately.
(fit-window-to-buffer))
(message
- (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle]."))))
+ (substitute-command-keys "Toggle display of quick-help buffer using \\[help-quick-toggle]."))))
(defun help-quick-toggle ()
- "Toggle the quick-help window."
+ "Toggle display of a window showing popular commands and their bindings.
+This toggles on and off the display of the quick-help buffer, which shows
+popular commands and their bindings as produced by `help-quick'.
+You can click on a key binding shown in the quick-help buffer to display
+the documentation of the command bound to that key sequence."
(interactive)
(if (and-let* ((window (get-buffer-window "*Quick Help*")))
(quit-window t window))
@@ -286,6 +301,8 @@ Do not call this in the scope of `with-help-window'."
(let ((first-message
(cond ((or
pop-up-frames
+ ;; FIXME: `special-display-p' is obsolete since
+ ;; the vars on which it depends are obsolete!
(special-display-p (buffer-name standard-output)))
(setq help-return-method (cons (selected-window) t))
;; If the help output buffer is a special display buffer,
@@ -367,9 +384,9 @@ Do not call this in the scope of `with-help-window'."
(propertize title 'face 'help-for-help-header)
"\n\n"
(help--for-help-make-commands commands))))
- sections ""))
+ sections))
-(defalias 'help 'help-for-help)
+(defalias 'help #'help-for-help)
(make-help-screen help-for-help
(purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
(concat
@@ -861,7 +878,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(format "%s (translated from %s)" string otherstring))))))
(defun help--binding-undefined-p (defn)
- (or (null defn) (integerp defn) (equal defn 'undefined)))
+ (or (null defn) (integerp defn) (equal defn #'undefined)))
(defun help--analyze-key (key untranslated &optional buffer)
"Get information about KEY its corresponding UNTRANSLATED events.
@@ -909,7 +926,9 @@ in the selected window."
(let ((key-desc (help-key-description key untranslated)))
(if (help--binding-undefined-p defn)
(format "%s%s is undefined" key-desc mouse-msg)
- (format "%s%s runs the command %S" key-desc mouse-msg defn)))
+ (format "%s%s runs the command %s" key-desc mouse-msg
+ (if (symbolp defn) (prin1-to-string defn)
+ (help-fns-function-name defn)))))
defn event mouse-msg)))
(defun help--filter-info-list (info-list i)
@@ -1206,7 +1225,7 @@ appeared on the mode-line."
(defun describe-minor-mode-completion-table-for-symbol ()
;; In order to list up all minor modes, minor-mode-list
;; is used here instead of minor-mode-alist.
- (delq nil (mapcar 'symbol-name minor-mode-list)))
+ (delq nil (mapcar #'symbol-name minor-mode-list)))
(defun describe-minor-mode-from-symbol (symbol)
"Display documentation of a minor mode given as a symbol, SYMBOL."
@@ -1629,34 +1648,14 @@ Return nil if the key sequence is too long."
(t value))))
(defun help--describe-command (definition &optional translation)
- (cond ((symbolp definition)
- (if (and (fboundp definition)
- help-buffer-under-preparation)
- (insert-text-button (symbol-name definition)
- 'type 'help-function
- 'help-args (list definition))
- (insert (symbol-name definition)))
- (insert "\n"))
- ((or (stringp definition) (vectorp definition))
+ (cond ((or (stringp definition) (vectorp definition))
(if translation
(insert (key-description definition nil) "\n")
+ ;; These should be rare nowadays, replaced by `kmacro's.
(insert "Keyboard Macro\n")))
((keymapp definition)
(insert "Prefix Command\n"))
- ((byte-code-function-p definition)
- (insert (format "[%s]\n"
- (buttonize "byte-code" #'disassemble definition))))
- ((and (consp definition)
- (memq (car definition) '(closure lambda)))
- (insert (format "[%s]\n"
- (buttonize
- (symbol-name (car definition))
- (lambda (_)
- (pp-display-expression
- definition "*Help Source*" t))
- nil "View definition"))))
- (t
- (insert "??\n"))))
+ (t (insert (help-fns-function-name definition) "\n"))))
(define-obsolete-function-alias 'help--describe-translation
#'help--describe-command "29.1")
@@ -1996,8 +1995,8 @@ and some others."
(if temp-buffer-resize-mode
;; `help-make-xrefs' may add a `back' button and thus increase the
;; text size, so `resize-temp-buffer-window' must be run *after* it.
- (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
- (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
+ (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append)
+ (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window)))
(defvar resize-temp-buffer-window-inhibit nil
"Non-nil means `resize-temp-buffer-window' should not resize.")
@@ -2241,11 +2240,32 @@ The `temp-buffer-window-setup-hook' hook is called."
;; Don't print to *Help*; that would clobber Help history.
(defun help-form-show ()
"Display the output of a non-nil `help-form'."
- (let ((msg (eval help-form)))
+ (let ((msg (eval help-form t)))
(if (stringp msg)
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
+(defun help--append-keystrokes-help (str)
+ (let* ((keys (this-single-command-keys))
+ (bindings (delete nil
+ (mapcar (lambda (map) (lookup-key map keys t))
+ (current-active-maps t)))))
+ (catch 'res
+ (dolist (val help-event-list)
+ (let ((key (vector (if (eql val 'help)
+ help-char
+ val))))
+ (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key)))
+ bindings)
+ (throw 'res
+ (concat
+ str
+ (substitute-command-keys
+ (format
+ " (\\`%s' for help)"
+ (key-description key))))))))
+ str)))
+
(defun help--docstring-quote (string)
"Return a doc string that represents STRING.
@@ -2333,7 +2353,7 @@ the same names as used in the original source code, when possible."
((or (and (byte-code-function-p def) (integerp (aref def 0)))
(subrp def) (module-function-p def))
(or (when preserve-names
- (let* ((doc (condition-case nil (documentation def) (error nil)))
+ (let* ((doc (condition-case nil (documentation def 'raw) (error nil)))
(docargs (if doc (car (help-split-fundoc doc nil))))
(arglist (if docargs
(cdar (read-from-string (downcase docargs)))))
@@ -2385,7 +2405,7 @@ the same names as used in the original source code, when possible."
(t arg)))
arglist)))
-(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1")
(defun help--make-usage-docstring (fn arglist)
(let ((print-escape-newlines t))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 6b9c623f31f..89c2bee2204 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -586,6 +586,7 @@ If a window system is unavailable, calls `hfy-fallback-color-values'."
(defvar hfy-cperl-mode-kludged-p nil)
(defun hfy-kludge-cperl-mode ()
+ ;; FIXME: Still?
"CPerl mode does its damnedest not to do some of its fontification when not
in a windowing system - try to trick it..."
(declare (obsolete nil "28.1"))
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 602f06338e2..c65213f5bde 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2376,135 +2376,135 @@ particular subset of them, and sorting by various criteria.
Operations on marked buffers:
\\<ibuffer-mode-map>
- `\\[ibuffer-do-save]' - Save the marked buffers.
- `\\[ibuffer-do-view]' - View the marked buffers in the selected frame.
- `\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
- `\\[ibuffer-do-revert]' - Revert the marked buffers.
- `\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers.
- `\\[ibuffer-do-toggle-lock]' - Toggle lock state of marked buffers.
- `\\[ibuffer-do-delete]' - Kill the marked buffers.
- `\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers.
- `\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers.
- `\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked
- buffers.
- `\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers.
- `\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression.
- `\\[ibuffer-do-print]' - Print the marked buffers.
- `\\[ibuffer-do-occur]' - List lines in all marked buffers which match
- a given regexp (like the function `occur').
- `\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked
- buffers to a shell command.
- `\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked
- buffers with the output of a shell command.
- `\\[ibuffer-do-shell-command-file]' - Run a shell command with the
- buffer's file as an argument.
- `\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This
- is a very flexible command. For example, if you want to make all
- of the marked buffers read-only, try using (read-only-mode 1) as
- the input form.
- `\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
- is evaluated.
- `\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer,
- but don't kill the associated buffer.
- `\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion.
+ \\[ibuffer-do-save] - Save the marked buffers.
+ \\[ibuffer-do-view] - View the marked buffers in the selected frame.
+ \\[ibuffer-do-view-other-frame] - View the marked buffers in another frame.
+ \\[ibuffer-do-revert] - Revert the marked buffers.
+ \\[ibuffer-do-toggle-read-only] - Toggle read-only state of marked buffers.
+ \\[ibuffer-do-toggle-lock] - Toggle lock state of marked buffers.
+ \\[ibuffer-do-delete] - Kill the marked buffers.
+ \\[ibuffer-do-isearch] - Do incremental search in the marked buffers.
+ \\[ibuffer-do-isearch-regexp] - Isearch for regexp in the marked buffers.
+ \\[ibuffer-do-replace-regexp] - Replace by regexp in each of the marked
+ buffers.
+ \\[ibuffer-do-query-replace] - Query replace in each of the marked buffers.
+ \\[ibuffer-do-query-replace-regexp] - As above, with a regular expression.
+ \\[ibuffer-do-print] - Print the marked buffers.
+ \\[ibuffer-do-occur] - List lines in all marked buffers which match
+ a given regexp (like the function `occur').
+ \\[ibuffer-do-shell-command-pipe] - Pipe the contents of the marked
+ buffers to a shell command.
+ \\[ibuffer-do-shell-command-pipe-replace] - Replace the contents of the marked
+ buffers with the output of a shell command.
+ \\[ibuffer-do-shell-command-file] - Run a shell command with the
+ buffer's file as an argument.
+ \\[ibuffer-do-eval] - Evaluate a form in each of the marked buffers. This
+ is a very flexible command. For example, if you want to make all
+ of the marked buffers read-only, try using (read-only-mode 1) as
+ the input form.
+ \\[ibuffer-do-view-and-eval] - As above, but view each buffer while the form
+ is evaluated.
+ \\[ibuffer-do-kill-lines] - Remove the marked lines from the *Ibuffer* buffer,
+ but don't kill the associated buffer.
+ \\[ibuffer-do-kill-on-deletion-marks] - Kill all buffers marked for deletion.
Marking commands:
- `\\[ibuffer-mark-forward]' - Mark the buffer at point.
- `\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark
- all unmarked buffers.
- `\\[ibuffer-change-marks]' - Change the mark used on marked buffers.
- `\\[ibuffer-unmark-forward]' - Unmark the buffer at point.
- `\\[ibuffer-unmark-backward]' - Unmark the previous buffer.
- `\\[ibuffer-unmark-all]' - Unmark buffers marked with MARK.
- `\\[ibuffer-unmark-all-marks]' - Unmark all marked buffers.
- `\\[ibuffer-mark-by-mode]' - Mark buffers by major mode.
- `\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers.
- This means that the buffer is modified, and has an associated file.
- `\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers,
- regardless of whether they have an associated file.
- `\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and
- ends with `*'.
- `\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have
- an associated file, but that file doesn't currently exist.
- `\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers.
- `\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired-mode'.
- `\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc.
- `\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'.
- `\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion.
- `\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp.
- `\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp.
- `\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp.
- `\\[ibuffer-mark-by-content-regexp]' - Mark buffers by their content, using a regexp.
- `\\[ibuffer-mark-by-locked]' - Mark all locked buffers.
+ \\[ibuffer-mark-forward] - Mark the buffer at point.
+ \\[ibuffer-toggle-marks] - Unmark all currently marked buffers, and mark
+ all unmarked buffers.
+ \\[ibuffer-change-marks] - Change the mark used on marked buffers.
+ \\[ibuffer-unmark-forward] - Unmark the buffer at point.
+ \\[ibuffer-unmark-backward] - Unmark the previous buffer.
+ \\[ibuffer-unmark-all] - Unmark buffers marked with MARK.
+ \\[ibuffer-unmark-all-marks] - Unmark all marked buffers.
+ \\[ibuffer-mark-by-mode] - Mark buffers by major mode.
+ \\[ibuffer-mark-unsaved-buffers] - Mark all \"unsaved\" buffers.
+ This means that the buffer is modified, and has an associated file.
+ \\[ibuffer-mark-modified-buffers] - Mark all modified buffers,
+ regardless of whether they have an associated file.
+ \\[ibuffer-mark-special-buffers] - Mark all buffers whose name begins and
+ ends with `*'.
+ \\[ibuffer-mark-dissociated-buffers] - Mark all buffers which have
+ an associated file, but that file doesn't currently exist.
+ \\[ibuffer-mark-read-only-buffers] - Mark all read-only buffers.
+ \\[ibuffer-mark-dired-buffers] - Mark buffers in `dired-mode'.
+ \\[ibuffer-mark-help-buffers] - Mark buffers in `help-mode', `apropos-mode', etc.
+ \\[ibuffer-mark-old-buffers] - Mark buffers older than `ibuffer-old-time'.
+ \\[ibuffer-mark-for-delete] - Mark the buffer at point for deletion.
+ \\[ibuffer-mark-by-name-regexp] - Mark buffers by their name, using a regexp.
+ \\[ibuffer-mark-by-mode-regexp] - Mark buffers by their major mode, using a regexp.
+ \\[ibuffer-mark-by-file-name-regexp] - Mark buffers by their filename, using a regexp.
+ \\[ibuffer-mark-by-content-regexp] - Mark buffers by their content, using a regexp.
+ \\[ibuffer-mark-by-locked] - Mark all locked buffers.
Filtering commands:
- `\\[ibuffer-filter-chosen-by-completion]' - Select and apply filter chosen by completion.
- `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
- `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
- `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
- `\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
- `\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
- `\\[ibuffer-filter-by-basename]' - Add a filter by basename.
- `\\[ibuffer-filter-by-directory]' - Add a filter by directory name.
- `\\[ibuffer-filter-by-filename]' - Add a filter by filename.
- `\\[ibuffer-filter-by-file-extension]' - Add a filter by file extension.
- `\\[ibuffer-filter-by-modified]' - Add a filter by modified buffers.
- `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate.
- `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
- `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
- `\\[ibuffer-filter-by-starred-name]' - Add a filter by special buffers.
- `\\[ibuffer-filter-by-visiting-file]' - Add a filter by buffers visiting files.
- `\\[ibuffer-save-filters]' - Save the current filters with a name.
- `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
- `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
- `\\[ibuffer-and-filter]' - Replace the top two filters with their logical AND.
- `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
- `\\[ibuffer-pop-filter]' - Remove the top filter.
- `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
- `\\[ibuffer-decompose-filter]' - Break down the topmost filter.
- `\\[ibuffer-filter-disable]' - Remove all filtering currently in effect.
+ \\[ibuffer-filter-chosen-by-completion] - Select and apply filter chosen by completion.
+ \\[ibuffer-filter-by-mode] - Add a filter by any major mode.
+ \\[ibuffer-filter-by-used-mode] - Add a filter by a major mode now in use.
+ \\[ibuffer-filter-by-derived-mode] - Add a filter by derived mode.
+ \\[ibuffer-filter-by-name] - Add a filter by buffer name.
+ \\[ibuffer-filter-by-content] - Add a filter by buffer content.
+ \\[ibuffer-filter-by-basename] - Add a filter by basename.
+ \\[ibuffer-filter-by-directory] - Add a filter by directory name.
+ \\[ibuffer-filter-by-filename] - Add a filter by filename.
+ \\[ibuffer-filter-by-file-extension] - Add a filter by file extension.
+ \\[ibuffer-filter-by-modified] - Add a filter by modified buffers.
+ \\[ibuffer-filter-by-predicate] - Add a filter by an arbitrary Lisp predicate.
+ \\[ibuffer-filter-by-size-gt] - Add a filter by buffer size.
+ \\[ibuffer-filter-by-size-lt] - Add a filter by buffer size.
+ \\[ibuffer-filter-by-starred-name] - Add a filter by special buffers.
+ \\[ibuffer-filter-by-visiting-file] - Add a filter by buffers visiting files.
+ \\[ibuffer-save-filters] - Save the current filters with a name.
+ \\[ibuffer-switch-to-saved-filters] - Switch to previously saved filters.
+ \\[ibuffer-add-saved-filters] - Add saved filters to current filters.
+ \\[ibuffer-and-filter] - Replace the top two filters with their logical AND.
+ \\[ibuffer-or-filter] - Replace the top two filters with their logical OR.
+ \\[ibuffer-pop-filter] - Remove the top filter.
+ \\[ibuffer-negate-filter] - Invert the logical sense of the top filter.
+ \\[ibuffer-decompose-filter] - Break down the topmost filter.
+ \\[ibuffer-filter-disable] - Remove all filtering currently in effect.
Filter group commands:
- `\\[ibuffer-filters-to-filter-group]' - Create filter group from filters.
- `\\[ibuffer-pop-filter-group]' - Remove top filter group.
- `\\[ibuffer-forward-filter-group]' - Move to the next filter group.
- `\\[ibuffer-backward-filter-group]' - Move to the previous filter group.
- `\\[ibuffer-clear-filter-groups]' - Remove all active filter groups.
- `\\[ibuffer-save-filter-groups]' - Save the current groups with a name.
- `\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups.
- `\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups.
+ \\[ibuffer-filters-to-filter-group] - Create filter group from filters.
+ \\[ibuffer-pop-filter-group] - Remove top filter group.
+ \\[ibuffer-forward-filter-group] - Move to the next filter group.
+ \\[ibuffer-backward-filter-group] - Move to the previous filter group.
+ \\[ibuffer-clear-filter-groups] - Remove all active filter groups.
+ \\[ibuffer-save-filter-groups] - Save the current groups with a name.
+ \\[ibuffer-switch-to-saved-filter-groups] - Restore previously saved groups.
+ \\[ibuffer-delete-saved-filter-groups] - Delete previously saved groups.
Sorting commands:
- `\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes.
- `\\[ibuffer-invert-sorting]' - Reverse the current sorting order.
- `\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically.
- `\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name.
- `\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time.
- `\\[ibuffer-do-sort-by-size]' - Sort the buffers by size.
- `\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode.
+ \\[ibuffer-toggle-sorting-mode] - Rotate between the various sorting modes.
+ \\[ibuffer-invert-sorting] - Reverse the current sorting order.
+ \\[ibuffer-do-sort-by-alphabetic] - Sort the buffers lexicographically.
+ \\[ibuffer-do-sort-by-filename/process] - Sort the buffers by the file name.
+ \\[ibuffer-do-sort-by-recency] - Sort the buffers by last viewing time.
+ \\[ibuffer-do-sort-by-size] - Sort the buffers by size.
+ \\[ibuffer-do-sort-by-major-mode] - Sort the buffers by major mode.
Other commands:
- `\\[ibuffer-update]' - Regenerate the list of all buffers.
- Prefix arg means to toggle whether buffers that match
- `ibuffer-maybe-show-predicates' should be displayed.
- `\\[ibuffer-auto-mode]' - Toggle automatic updates.
-
- `\\[ibuffer-switch-format]' - Change the current display format.
- `\\[forward-line]' - Move point to the next line.
- `\\[previous-line]' - Move point to the previous line.
- `\\[describe-mode]' - This help.
- `\\[ibuffer-diff-with-file]' - View the differences between this buffer
- and its associated file.
- `\\[ibuffer-visit-buffer]' - View the buffer on this line.
- `\\[ibuffer-visit-buffer-other-window]' - As above, but in another window.
- `\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select
- the new window.
- `\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line.
+ \\[ibuffer-update] - Regenerate the list of all buffers.
+ Prefix arg means to toggle whether buffers that match
+ `ibuffer-maybe-show-predicates' should be displayed.
+ \\[ibuffer-auto-mode] - Toggle automatic updates.
+
+ \\[ibuffer-switch-format] - Change the current display format.
+ \\[forward-line] - Move point to the next line.
+ \\[previous-line] - Move point to the previous line.
+ \\[describe-mode] - This help.
+ \\[ibuffer-diff-with-file] - View the differences between this buffer
+ and its associated file.
+ \\[ibuffer-visit-buffer] - View the buffer on this line.
+ \\[ibuffer-visit-buffer-other-window] - As above, but in another window.
+ \\[ibuffer-visit-buffer-other-window-noselect] - As both above, but don't select
+ the new window.
+ \\[ibuffer-bury-buffer] - Bury (not kill!) the buffer on this line.
** Information on Filtering:
@@ -2525,7 +2525,7 @@ with \"gnus\". You can accomplish this via:
\\[ibuffer-filter-by-name] ^gnus RET
Additionally, you can OR the top two filters together with
-`\\[ibuffer-or-filters]'. To see all buffers in either
+\\[ibuffer-or-filters]. To see all buffers in either
`emacs-lisp-mode' or `lisp-interaction-mode', type:
\\[ibuffer-filter-by-mode] emacs-lisp-mode RET
@@ -2535,9 +2535,9 @@ Additionally, you can OR the top two filters together with
Filters can also be saved and restored using mnemonic names: see the
functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'.
-To remove the top filter on the stack, use `\\[ibuffer-pop-filter]', and
+To remove the top filter on the stack, use \\[ibuffer-pop-filter], and
to disable all filtering currently in effect, use
-`\\[ibuffer-filter-disable]'.
+\\[ibuffer-filter-disable].
** Filter Groups:
@@ -2545,7 +2545,7 @@ Once one has mastered filters, the next logical step up is \"filter
groups\". A filter group is basically a named group of buffers which
match a filter, which are displayed together in an Ibuffer buffer. To
create a filter group, simply use the regular functions to create a
-filter, and then type `\\[ibuffer-filters-to-filter-group]'.
+filter, and then type \\[ibuffer-filters-to-filter-group].
A quick example will make things clearer. Suppose that one wants to
group all of one's Emacs Lisp buffers together. To do this, type:
@@ -2563,7 +2563,7 @@ multiple filter groups; instead, the first filter group is used. The
filter groups are displayed in this order of precedence.
You may rearrange filter groups by using the usual pair
-`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]'. Yanked groups
+\\[ibuffer-kill-line] and \\[ibuffer-yank]. Yanked groups
will be inserted before the group at point."
;; Include state info next to the mode name.
(setq-local mode-line-process
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index d49714f3204..aa3c5680a7e 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -789,10 +789,8 @@ and SUFFIX, if non-nil, are obtained from `affixation-function' or
`group-function'. Consecutive `equal' sections are avoided.
COMP is the element in PROSPECTS or a transformation also given
by `group-function''s second \"transformation\" protocol."
- (let* ((aff-fun (or (completion-metadata-get md 'affixation-function)
- (plist-get completion-extra-properties :affixation-function)))
- (ann-fun (or (completion-metadata-get md 'annotation-function)
- (plist-get completion-extra-properties :annotation-function)))
+ (let* ((aff-fun (completion-metadata-get md 'affixation-function))
+ (ann-fun (completion-metadata-get md 'annotation-function))
(grp-fun (and completions-group
(completion-metadata-get md 'group-function)))
(annotated
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 777aebb70cf..e583e0fe32c 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and allows functions
such as `edebug-defun' to work with such inputs."
:type 'boolean)
+(defcustom ielm-history-file-name
+ (locate-user-emacs-file "ielm-history.eld")
+ "If non-nil, name of the file to read/write IELM input history."
+ :type '(choice (const :tag "Disable input history" nil)
+ file)
+ :version "30.1")
+
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
@@ -503,6 +510,17 @@ behavior of the indirect buffer."
(funcall pp-default-function beg end)
end))
+;;; Input history
+
+(defvar ielm--exit nil
+ "Function to call when Emacs is killed.")
+
+(defun ielm--input-history-writer (buf)
+ "Return a function writing IELM input history to BUF."
+ (lambda ()
+ (with-current-buffer buf
+ (comint-write-input-ring))))
+
;;; Major mode
(define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM"
@@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which currently contains:
#'ielm-indirect-setup-hook 'append t)
(setq comint-indirect-setup-function #'emacs-lisp-mode)
+ ;; Input history
+ (setq-local comint-input-ring-file-name ielm-history-file-name)
+ (setq-local ielm--exit (ielm--input-history-writer (current-buffer)))
+ (setq-local kill-buffer-hook
+ (lambda ()
+ (funcall ielm--exit)
+ (remove-hook 'kill-emacs-hook ielm--exit)))
+ (unless noninteractive
+ (add-hook 'kill-emacs-hook ielm--exit))
+ (comint-read-input-ring t)
+
;; 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/iimage.el b/lisp/iimage.el
index 205141577c9..0f2297465fe 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -134,6 +134,7 @@ Examples of image filename patterns to match:
:max-width (- (nth 2 edges) (nth 0 edges))
:max-height (- (nth 3 edges) (nth 1 edges)))
keymap ,image-map
+ context-menu-functions (image-context-menu)
modification-hooks
(iimage-modification-hook)))
(remove-list-of-text-properties
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 355685e70fd..fa64f1ac03e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -654,8 +654,9 @@ Key bindings:
(unless (display-images-p)
(error "Display does not support images"))
- (major-mode-suspend)
- (setq major-mode 'image-mode)
+ (unless (eq major-mode 'image-mode)
+ (major-mode-suspend)
+ (setq major-mode 'image-mode))
(setq image-transform-resize image-auto-resize)
;; Bail out early if we have no image data.
diff --git a/lisp/image.el b/lisp/image.el
index 73801f88d1e..d7496485aca 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -193,6 +193,29 @@ or \"ffmpeg\") is installed."
"h" #'image-flip-horizontally
"v" #'image-flip-vertically))
+(defun image-context-menu (menu click)
+ "Populate MENU with image-related commands at CLICK."
+ (when (mouse-posn-property (event-start click) 'display)
+ (define-key menu [image-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Image")))
+ (easy-menu-define nil easy-menu nil
+ '("Image"
+ ["Zoom In" image-increase-size
+ :help "Enlarge the image"]
+ ["Zoom Out" image-decrease-size
+ :help "Shrink the image"]
+ ["Rotate Clockwise" image-rotate
+ :help "Rotate the image"]
+ ["Flip horizontally" image-flip-horizontally
+ :help "Flip horizontally"]
+ ["Flip vertically" image-flip-vertically
+ :help "Flip vertically"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar image])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item))))))
+
+ menu)
+
(defun image-load-path-for-library (library image &optional path no-error)
"Return a suitable search path for images used by LIBRARY.
@@ -494,9 +517,13 @@ use its file extension as image type.
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'. If the property `:scale' is not given and the
-display has a high resolution (more exactly, when the average width of a
-character in the default font is more than 10 pixels), the image is
+like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for
+the list of supported properties; see the nodes following that node
+for properties specific to certain image types.
+
+If the property `:scale' is not given and the display has a high
+resolution (more exactly, when the average width of a character
+in the default font is more than 10 pixels), the image is
automatically scaled up in proportion to the default font.
Value is the image created, or nil if images of type TYPE are not supported.
@@ -533,6 +560,16 @@ Images should not be larger than specified by `max-image-size'."
('t t)
('nil nil)
(func (funcall func image)))))))
+ ;; Add original map from map.
+ (when (and (plist-get props :map)
+ (not (plist-get props :original-map)))
+ (setq image (nconc image (list :original-map
+ (image--compute-original-map image)))))
+ ;; Add map from original map.
+ (when (and (plist-get props :original-map)
+ (not (plist-get props :map)))
+ (setq image (nconc image (list :map
+ (image--compute-map image)))))
image)))
(defun image--default-smoothing (image)
@@ -571,7 +608,11 @@ Internal use only."
Properties can be set with
(setf (image-property IMAGE PROPERTY) VALUE)
-If VALUE is nil, PROPERTY is removed from IMAGE."
+If VALUE is nil, PROPERTY is removed from IMAGE.
+
+See Info node `(elisp)Image Descriptors' for the list of
+supported properties; see the nodes following that node for
+properties specific to certain image types."
(declare (gv-setter image--set-property))
(plist-get (cdr image) property))
@@ -620,6 +661,7 @@ means display it in the right marginal area."
(overlay-put overlay 'put-image t)
(overlay-put overlay 'before-string string)
(overlay-put overlay 'keymap image-map)
+ (overlay-put overlay 'context-menu-functions '(image-context-menu))
overlay)))
@@ -672,8 +714,9 @@ is non-nil, this is inhibited."
inhibit-isearch ,inhibit-isearch
keymap ,(if slice
image-slice-map
- image-map)))))
-
+ image-map)
+ context-menu-functions
+ (image-context-menu)))))
;;;###autoload
(defun insert-sliced-image (image &optional string area rows cols)
@@ -709,7 +752,9 @@ The image is automatically split into ROWS x COLS slices."
(add-text-properties start (point)
`(display ,(list (list 'slice x y dx dy) image)
rear-nonsticky (display keymap)
- keymap ,image-slice-map))
+ keymap ,image-slice-map
+ context-menu-functions
+ (image-context-menu)))
(setq x (+ x dx))))
(setq x 0.0
y (+ y dy))
@@ -759,21 +804,25 @@ BUFFER nil or omitted means use the current buffer."
;;;###autoload
(defun find-image (specs &optional cache)
- "Find an image, choosing one of a list of image specifications.
+ "Find an image that satisfies one of a list of image specifications.
SPECS is a list of image specifications.
-Each image specification in SPECS is a property list. The contents of
-a specification are image type dependent. All specifications must at
-least contain either the property `:file FILE' or `:data DATA',
-where FILE is the file to load the image from, and DATA is a string
-containing the actual image data. If the property `:type TYPE' is
-omitted or nil, try to determine the image type from its first few
+Each image specification in SPECS is a property list. The
+contents of a specification are image type dependent; see the
+info node `(elisp)Image Descriptors' for details. All specifications
+must at least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file from which to load the image, and DATA is a
+string containing the actual image data. If the property `:type TYPE'
+is omitted or nil, try to determine the image type from its first few
bytes of image data. If that doesn't work, and the property `:file
-FILE' provide a file name, use its file extension as image type.
-If `:type TYPE' is provided, it must match the actual type
-determined for FILE or DATA by `create-image'. Return nil if no
-specification is satisfied.
+FILE' provide a file name, use its file extension as idication of the
+image type. If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'.
+
+The function returns the image specification for the first specification
+in the list whose TYPE is supported and FILE, if specified, exists. It
+returns nil if no specification in the list can be satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
@@ -1169,7 +1218,10 @@ has no effect."
If N is 3, then the image size will be increased by 30%. More
generally, the image size is multiplied by 1 plus N divided by 10.
N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(1+ (/ (prefix-numeric-value n) 10.0))
@@ -1181,7 +1233,7 @@ POSITION can be a buffer position or a marker, and defaults to point."
(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--change-size' just changes two values 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.
@@ -1192,7 +1244,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
If N is 3, then the image size will be decreased by 30%. More
generally, the image size is multiplied by 1 minus N divided by 10.
N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1204,7 +1259,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
(defun image-mouse-increase-size (&optional event)
"Increase the image size using the mouse-gesture EVENT.
This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1214,7 +1272,10 @@ EVENT, if any, by the default factor used by `image-increase-size'."
(defun image-mouse-decrease-size (&optional event)
"Decrease the image size using the mouse-gesture EVENT.
This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1265,7 +1326,9 @@ POSITION can be a buffer position or a marker, and defaults to point."
(new-image (image--image-without-parameters image))
(scale (image--current-scaling image new-image)))
(setcdr image (cdr new-image))
- (plist-put (cdr image) :scale (* scale factor))))
+ (plist-put (cdr image) :scale (* scale factor))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image--image-without-parameters (image)
(cons (pop image)
@@ -1292,7 +1355,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
If nil, ANGLE defaults to 90. Interactively, rotate the image 90
degrees clockwise with no prefix argument, and counter-clockwise
with a prefix argument. Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive (and current-prefix-arg '(-90)))
(let ((image (image--get-imagemagick-and-warn)))
(setf (image-property image :rotation)
@@ -1300,7 +1366,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)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image))))
(set-transient-map image--repeat-map nil nil
"Use %k for further adjustments"))
@@ -1321,23 +1389,190 @@ changing the displayed image size does not affect the saved image."
(read-file-name "Write image to file: ")))))
(defun image-flip-horizontally ()
- "Horizontally flip the image under point."
+ "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-flush image)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image-flip-vertically ()
- "Vertically flip the image under point."
+ "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-rotate 180)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+ "Recompute image map when scaling, rotating, or flipping an image."
+ :type 'boolean
+ :version "30.1")
+
+(defun image--compute-map (image)
+ "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip. When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+ (pcase-let* ((original-map (image-property image :original-map))
+ (map (copy-tree original-map t))
+ (scale (or (image-property image :scale) 1))
+ (rotation (or (image-property image :rotation) 0))
+ (flip (image-property image :flip))
+ ((and size `(,width . ,height)) (image-size image t)))
+ (when (and ; Handle only 90-degree rotations
+ (zerop (mod rotation 1))
+ (zerop (% (truncate rotation) 90)))
+ ;; SIZE fits MAP after transformations. Scale MAP before
+ ;; flip and rotate operations, since both need MAP to fit SIZE.
+ (image--scale-map map scale)
+ ;; In rendered images, rotation is always applied before flip.
+ (image--rotate-map
+ map rotation (if (or (= 90 rotation) (= 270 rotation))
+ ;; If rotated Ā±90Ā°, swap width and height.
+ (cons height width)
+ size))
+ ;; After rotation, there's no need to swap width and height.
+ (image--flip-map map flip size))
+ map))
+
+(defun image--compute-original-map (image)
+ "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+ (when (image-property image :map)
+ (let* ((original-map (copy-tree (image-property image :map) t))
+ (scale (or (image-property image :scale) 1))
+ (rotation (or (image-property image :rotation) 0))
+ (flip (image-property image :flip))
+ (size (image-size image t)))
+ (when (and ; Handle only 90-degree rotations
+ (zerop (mod rotation 1))
+ (zerop (% (truncate rotation) 90)))
+ ;; In rendered images, rotation is always applied before flip.
+ ;; To undo the transformation, flip before rotating. SIZE fits
+ ;; ORIGINAL-MAP before transformations are applied. Therefore,
+ ;; scale ORIGINAL-MAP after flip and rotate operations, since
+ ;; both need ORIGINAL-MAP to fit SIZE.
+ (image--flip-map original-map flip size)
+ (image--rotate-map original-map (- rotation) size)
+ (image--scale-map original-map (/ 1.0 scale)))
+ original-map)))
+
+(defun image--scale-map (map scale)
+ "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+ (unless (= 1 scale)
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (setf (caar coords) (round (* (caar coords) scale)))
+ (setf (cdar coords) (round (* (cdar coords) scale)))
+ (setf (cadr coords) (round (* (cadr coords) scale)))
+ (setf (cddr coords) (round (* (cddr coords) scale))))
+ ('circle
+ (setf (caar coords) (round (* (caar coords) scale)))
+ (setf (cdar coords) (round (* (cdar coords) scale)))
+ (setcdr coords (round (* (cdr coords) scale))))
+ ('poly
+ (dotimes (i (length coords))
+ (aset coords i
+ (round (* (aref coords i) scale))))))))
+ map)
+
+(defun image--rotate-map (map rotation size)
+ "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+ (unless (zerop rotation)
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (let ( x0 y0 ; New upper left corner
+ x1 y1) ; New bottom right corner
+ (pcase (truncate (mod rotation 360)) ; Set new corners to...
+ (90 ; ...old bottom left and upper right
+ (setq x0 (caar coords) y0 (cddr coords)
+ x1 (cadr coords) y1 (cdar coords)))
+ (180 ; ...old bottom right and upper left
+ (setq x0 (cadr coords) y0 (cddr coords)
+ x1 (caar coords) y1 (cdar coords)))
+ (270 ; ...old upper right and bottom left
+ (setq x0 (cadr coords) y0 (cdar coords)
+ x1 (caar coords) y1 (cddr coords))))
+ (setcar coords (image--rotate-coord x0 y0 rotation size))
+ (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+ ('circle
+ (setcar coords (image--rotate-coord
+ (caar coords) (cdar coords) rotation size)))
+ ('poly
+ (dotimes (i (length coords))
+ (when (= 0 (% i 2))
+ (pcase-let ((`(,x . ,y)
+ (image--rotate-coord
+ (aref coords i) (aref coords (1+ i)) rotation size)))
+ (aset coords i x)
+ (aset coords (1+ i) y))))))))
+ map)
+
+(defun image--rotate-coord (x y angle size)
+ "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90. Returns a cons cell of rounded
+coordinates (X1 Y1)."
+ (pcase-let* ((radian (* (/ angle 180.0) float-pi))
+ (`(,width . ,height) size)
+ ;; y is positive, but we are in the bottom-right quadrant
+ (y (- y))
+ ;; Rotate clockwise
+ (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+ (y1 (- (* (cos radian) y) (* (sin radian) x)))
+ ;; Translate image back into bottom-right quadrant
+ (`(,x1 . ,y1)
+ (pcase (truncate (mod angle 360))
+ (90 ; Translate right by height
+ (cons (+ x1 height) y1))
+ (180 ; Translate right by width and down by height
+ (cons (+ x1 width) (- y1 height)))
+ (270 ; Translate down by width
+ (cons x1 (- y1 width)))))
+ ;; Invert y1 to make both x1 and y1 positive
+ (y1 (- y1)))
+ (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+ "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+ (when flip
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (let ((x0 (- (car size) (cadr coords)))
+ (y0 (cdar coords))
+ (x1 (- (car size) (caar coords)))
+ (y1 (cddr coords)))
+ (setcar coords (cons x0 y0))
+ (setcdr coords (cons x1 y1))))
+ ('circle
+ (setf (caar coords) (- (car size) (caar coords))))
+ ('poly
+ (dotimes (i (length coords))
+ (when (= 0 (% i 2))
+ (aset coords i (- (car size) (aref coords i)))))))))
+ map)
+
(provide 'image)
;;; image.el ends here
diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el
index f4778d8e121..7219a106ca8 100644
--- a/lisp/image/image-dired-dired.el
+++ b/lisp/image/image-dired-dired.el
@@ -383,7 +383,7 @@ matching tag will be marked in the Dired buffer."
(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)
+ (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)))
diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el
index 7b4ca35a15e..2b5248cb14b 100644
--- a/lisp/image/image-dired-tags.el
+++ b/lisp/image/image-dired-tags.el
@@ -51,6 +51,7 @@ Return the value of last form in BODY."
"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."
+ (require 'image-dired) ; for `image-dired-dir'
(or (file-exists-p image-dired-tags-db-file)
(let (dir buf)
(unless (file-directory-p (setq dir (file-name-directory
diff --git a/lisp/info-look.el b/lisp/info-look.el
index da7beafe500..cd59fdf17d7 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -985,9 +985,8 @@ Return nil if there is nothing appropriate in the buffer near point."
finally return "(python)Index")))))
(info-lookup-maybe-add-help
- :mode 'cperl-mode
- :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*"
- :other-modes '(perl-mode))
+ :mode 'perl-mode
+ :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*")
(info-lookup-maybe-add-help
:mode 'latex-mode
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 7887909037b..95e9a1e55f7 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -79,9 +79,11 @@ If removing the last \"-<NUM>\" from the filename gives a file
which exists, then consider FILENAME a subfile. This is an
imperfect test, probably ought to open up the purported top file
and see what subfiles it says."
- (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename)
- (file-exists-p (concat (match-string 1 filename)
- (match-string 3 filename)))))
+ (let ((nondir (file-name-nondirectory filename)))
+ (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" nondir)
+ (file-exists-p (concat (file-name-directory filename)
+ (match-string 1 nondir)
+ (match-string 3 nondir))))))
(defmacro info-xref-with-file (filename &rest body)
;; checkdoc-params: (filename body)
diff --git a/lisp/info.el b/lisp/info.el
index 39ca88c358c..1e478cdbee9 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -213,6 +213,54 @@ a version of Emacs without installing it.")
These directories are searched after those in `Info-directory-list'."
:type '(repeat directory))
+(defcustom Info-url-alist
+ '((("auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
+ "ebrowse" "ede" "ediff" "edt" "efaq" "efaq-w32" "eglot" "eieio"
+ "eintr" "elisp" "emacs" "emacs-gnutls" "emacs-mime" "epa" "erc"
+ "ert" "eshell" "eudc" "eww" "flymake" "forms" "gnus"
+ "htmlfontify" "idlwave" "ido" "info" "mairix-el" "message"
+ "mh-e" "modus-themes" "newsticker" "nxml-mode" "octave-mode"
+ "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc"
+ "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode"
+ "todo-mode" "tramp" "transient" "url" "use-package" "vhdl-mode"
+ "vip" "viper" "vtable" "widget" "wisent" "woman") .
+ "https://www.gnu.org/software/emacs/manual/html_node/%m/%e"))
+ "Alist telling `Info-mode' where manuals are accessible online.
+
+Each element of this list has the form (MANUALs . URL-SPEC).
+MANUALs represents the name of one or more manuals. It can
+either be a string or a list of strings. URL-SPEC can be a
+string in which the substring \"%m\" will be expanded to the
+manual-name and \"%n\" to the node-name. \"%e\" will expand to
+the URL-encoded node-name, including the `.html' extension; in
+case of the Top node, it will expand to the empty string. (The
+URL-encoding of the node-name mimics GNU Texinfo, as documented
+at Info node `(texinfo)HTML Xref Node Name Expansion'.)
+Alternatively, URL-SPEC can be a function which is given
+manual-name, node-name and URL-encoded node-name as arguments,
+and is expected to return the corresponding URL as a string.
+
+This variable particularly affects the command
+`Info-goto-node-web', which see.
+
+The default value of this variable refers to the official,
+HTTPS-accessible HTML-representations of all manuals that Emacs
+includes. These URLs refer to the most recently released version
+of Emacs, disregarding the version of the running Emacs. In
+other words, the content of your local Info node and the
+associated online node may differ. The resource represented by
+the generated URL may even be not found by the gnu.org server."
+ :version "30.1"
+ :type '(alist
+ :tag "Mapping from manual-name(s) to URL-specification"
+ :key-type (choice
+ (string :tag "A single manual-name")
+ (repeat :tag "List of manual-names" string))
+ :value-type (choice
+ (string :tag "URL-specification string")
+ (function
+ :tag "URL-specification function"))))
+
(defcustom Info-scroll-prefer-subnodes nil
"If non-nil, \\<Info-mode-map>\\[Info-scroll-up] in a menu visits subnodes.
@@ -452,6 +500,7 @@ or `Info-virtual-nodes'."
(".info.bz2" . ("bzip2" "-dc"))
(".info.xz" . "unxz")
(".info.zst" . ("zstd" "-dc"))
+ (".info.lz" . ("lzip" "-dc"))
(".info" . nil)
("-info.Z" . "uncompress")
("-info.Y" . "unyabba")
@@ -460,6 +509,7 @@ or `Info-virtual-nodes'."
("-info.z" . "gunzip")
("-info.xz" . "unxz")
("-info.zst" . ("zstd" "-dc"))
+ ("-info.lz" . ("lzip" "-dc"))
("-info" . nil)
("/index.Z" . "uncompress")
("/index.Y" . "unyabba")
@@ -468,6 +518,7 @@ or `Info-virtual-nodes'."
("/index.bz2" . ("bzip2" "-dc"))
("/index.xz" . "unxz")
("/index.zst" . ("zstd" "-dc"))
+ ("/index.lz" . ("lzip" "-dc"))
("/index" . nil)
(".Z" . "uncompress")
(".Y" . "unyabba")
@@ -476,6 +527,7 @@ or `Info-virtual-nodes'."
(".bz2" . ("bzip2" "-dc"))
(".xz" . "unxz")
(".zst" . ("zstd" "-dc"))
+ (".lz" . ("lzip" "-dc"))
("" . nil)))
"List of file name suffixes and associated decoding commands.
Each entry should be (SUFFIX . STRING); the file is given to
@@ -732,8 +784,53 @@ in `Info-file-supports-index-cookies-list'."
(read-file-name "Info file name: " nil nil t))
(if (numberp current-prefix-arg)
(format "*info*<%s>" current-prefix-arg))))
- (info-setup file-or-node
- (switch-to-buffer-other-window (or buffer "*info*"))))
+ (info-pop-to-buffer file-or-node buffer t))
+
+(defun info-pop-to-buffer (&optional file-or-node buffer-or-name other-window)
+ "Put Info node FILE-OR-NODE in specified buffer and display it.
+Optional argument FILE-OR-NODE is as for `info'.
+
+If the optional argument BUFFER-OR-NAME is a buffer, use that
+buffer. If it is a string, use that string as the name of the
+buffer, creating it if it does not exist. Otherwise, use a
+buffer with the name `*info*', creating it if it does not exist.
+
+Optional argument OTHER-WINDOW nil means to prefer the selected
+window. OTHER-WINDOW non-nil means to prefer another window.
+Select the window used, if it has been made."
+ (let ((buffer (cond
+ ((bufferp buffer-or-name)
+ buffer-or-name)
+ ((stringp buffer-or-name)
+ (get-buffer-create buffer-or-name))
+ (t
+ (get-buffer-create "*info*")))))
+ (with-current-buffer buffer
+ (unless (derived-mode-p 'Info-mode)
+ (Info-mode)))
+
+ (let* ((window
+ (display-buffer buffer
+ (if other-window
+ '(nil (inhibit-same-window . t))
+ '(display-buffer-same-window)))))
+ (with-current-buffer buffer
+ (if file-or-node
+ ;; If argument already contains parentheses, don't add another set
+ ;; since the argument will then be parsed improperly. This also
+ ;; has the added benefit of allowing node names to be included
+ ;; following the parenthesized filename.
+ (Info-goto-node
+ (if (and (stringp file-or-node) (string-match "(.*)" file-or-node))
+ file-or-node
+ (concat "(" file-or-node ")")))
+ (if (and (zerop (buffer-size))
+ (null Info-history))
+ ;; If we just created the Info buffer, go to the directory.
+ (Info-directory))))
+
+ (when window
+ (select-window window)))))
;;;###autoload (put 'info 'info-file (purecopy "emacs"))
;;;###autoload
@@ -768,8 +865,8 @@ See a list of available Info commands in `Info-mode'."
;; 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*"))))
+
+ (info-pop-to-buffer file-or-node buffer))
(defun info-setup (file-or-node buffer)
"Display Info node FILE-OR-NODE in BUFFER."
@@ -789,6 +886,8 @@ See a list of available Info commands in `Info-mode'."
;; If we just created the Info buffer, go to the directory.
(Info-directory))))
+(make-obsolete 'info-setup "use `info-pop-to-buffer' instead" "30.1")
+
;;;###autoload
(defun info-emacs-manual ()
"Display the Emacs manual in Info mode."
@@ -927,7 +1026,7 @@ If NOERROR, inhibit error messages when we can't find the node."
(setq nodename (info--node-canonicalize-whitespace nodename))
(setq filename (Info-find-file filename noerror))
;; Go into Info buffer.
- (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename))
;; Record the node we are leaving, if we were in one.
(and (not no-going-back)
Info-current-file
@@ -957,7 +1056,7 @@ otherwise, that defaults to `Top'."
"Go to an Info node FILENAME and NODENAME, re-reading disk contents.
When *info* is already displaying FILENAME and NODENAME, the window position
is preserved, if possible."
- (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename))
(let ((old-filename Info-current-file)
(old-nodename Info-current-node)
(window-selected (eq (selected-window) (get-buffer-window)))
@@ -1807,33 +1906,52 @@ By default, go to the current Info node."
(Info-url-for-node (format "(%s)%s" filename node)))))
(defun Info-url-for-node (node)
- "Return a URL for NODE, a node in the GNU Emacs or Elisp manual.
-NODE should be a string on the form \"(manual)Node\". Only emacs
-and elisp manuals are supported."
- (unless (string-match "\\`(\\(.+\\))\\(.+\\)\\'" node)
- (error "Invalid node name %s" node))
- (let ((manual (match-string 1 node))
- (node (match-string 2 node)))
- (unless (member manual '("emacs" "elisp"))
- (error "Only emacs/elisp manuals are supported"))
- ;; Encode a bunch of characters the way that makeinfo does.
- (setq node
- (mapconcat (lambda (ch)
- (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
- (<= 33 ch 47) ; !"#$%&'()*+,-./
- (<= 58 ch 64) ; :;<=>?@
- (<= 91 ch 96) ; [\]_`
- (<= 123 ch 127)) ; {|}~ DEL
- (format "_00%x" ch)
- (char-to-string ch)))
- node
- ""))
- (concat "https://www.gnu.org/software/emacs/manual/html_node/"
- manual "/"
- (and (not (equal node "Top"))
+ "Return the URL corresponding to NODE.
+
+NODE should be a string of the form \"(manual)Node\"."
+ ;; GNU Texinfo skips whitespaces and newlines between the closing
+ ;; parenthesis and the node-name, i.e. space, tab, line feed and
+ ;; carriage return.
+ (unless (string-match "\\`(\\(.+\\))[ \t\n\r]*\\(.+\\)\\'" node)
+ (error "Invalid node-name %s" node))
+ ;; Use `if-let*' instead of `let*' so we check if an association was
+ ;; found.
+ (if-let* ((manual (match-string 1 node))
+ (node (match-string 2 node))
+ (association (seq-find
+ (lambda (pair)
+ (seq-contains-p (ensure-list (car pair))
+ manual #'string-equal-ignore-case))
+ Info-url-alist))
+ (url-spec (cdr association))
+ (encoded-node
+ ;; Reproduce GNU Texinfo's way of URL-encoding.
+ ;; (info "(texinfo) HTML Xref Node Name Expansion")
+ (if (equal node "Top")
+ ""
(concat
- (url-hexify-string (string-replace " " "-" node))
- ".html")))))
+ (url-hexify-string
+ (string-replace " " "-"
+ (mapconcat
+ (lambda (ch)
+ (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
+ (<= 33 ch 47) ; !"#$%&'()*+,-./
+ (<= 58 ch 64) ; :;<=>?@
+ (<= 91 ch 96) ; [\]_`
+ (<= 123 ch 127)) ; {|}~ DEL
+ (format "_00%x" ch)
+ (char-to-string ch)))
+ node "")))
+ ".html"))))
+ (cond
+ ((stringp url-spec)
+ (format-spec url-spec
+ `((?m . ,manual) (?n . ,node) (?e . ,encoded-node))))
+ ((functionp url-spec)
+ (funcall url-spec manual node encoded-node))
+ (t (error "URL-specification neither string nor function")))
+ (error "No URL-specification associated with manual-name `%s'"
+ manual)))
(defvar Info-read-node-completion-table)
@@ -2056,7 +2174,7 @@ If DIRECTION is `backward', search in the reverse direction."
(re-search-forward regexp nil t))
(signal 'user-search-failed (list regexp))))))
- (if (and bound (not found))
+ (if (and (or bound (not Info-current-subfile)) (not found))
(signal 'user-search-failed (list regexp)))
(unless (or found bound)
@@ -2290,7 +2408,7 @@ This command doesn't descend into sub-nodes, like \\<Info-mode-map>\\[Info-forwa
(interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
- (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (info-pop-to-buffer))
(Info-goto-node (Info-extract-pointer "next"))))
(defun Info-prev ()
@@ -2299,7 +2417,7 @@ This command doesn't go up to the parent node, like \\<Info-mode-map>\\[Info-bac
(interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
- (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (info-pop-to-buffer))
(Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))))
(defun Info-up (&optional same-file)
@@ -2308,7 +2426,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
- (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (info-pop-to-buffer))
(let ((old-node Info-current-node)
(old-file Info-current-file)
(node (Info-extract-pointer "up")) p)
@@ -4686,8 +4804,14 @@ the variable `Info-file-list-for-emacs'."
(eq command 'execute-extended-command))
(Info-goto-emacs-command-node
(read-command "Find documentation for command: ")))
+ ((symbolp command)
+ (Info-goto-emacs-command-node command))
(t
- (Info-goto-emacs-command-node command)))))
+ (message
+ (substitute-command-keys
+ (format
+ "\\`%s' invokes an anonymous command defined with `lambda'"
+ (key-description key))))))))
(defvar Info-link-keymap
(let ((keymap (make-sparse-keymap)))
@@ -5485,7 +5609,7 @@ completion alternatives to currently visited manuals."
(raise-frame (window-frame window))
(select-frame-set-input-focus (window-frame window))
(select-window window))
- (switch-to-buffer found)))
+ (info-pop-to-buffer nil found)))
;; The buffer doesn't exist; create it.
(info-initialize)
(info (Info-find-file manual)
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 3a191c5ecd3..4f3aab5a6be 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -683,11 +683,12 @@ We prefer the earliest unique letter."
strings))))
(complete-with-action action table string pred)))
nil t)))
- (when (cl-plusp (length name))
- (let ((glyph (if emoji-alternate-names
- (cadr (split-string name "\t"))
- (gethash name emoji--all-bases))))
- (cons glyph (gethash glyph emoji--derived))))))
+ (if (cl-plusp (length name))
+ (let ((glyph (if emoji-alternate-names
+ (cadr (split-string name "\t"))
+ (gethash name emoji--all-bases))))
+ (cons glyph (gethash glyph emoji--derived)))
+ (user-error "You didn't specify an emoji"))))
(defvar-keymap emoji-zoom-map
"+" #'emoji-zoom-increase
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 2c461a7f7ab..33e444507c4 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -645,8 +645,14 @@
(nil . "microsoft-cp1251")
(nil . "koi8-r"))
- (arabic ,(font-spec :registry "iso10646-1"
- :otf '(arab nil (init medi fina liga)))
+ (arabic ,(if (featurep 'android)
+ ;; The Android font driver does not support the
+ ;; detection of OTF tags but all fonts installed on
+ ;; Android with Arabic characters provide shaping
+ ;; information required for displaying Arabic text.
+ (font-spec :registry "iso10646-1" :script 'arabic)
+ (font-spec :registry "iso10646-1"
+ :otf '(arab nil (init medi fina liga))))
(nil . "MuleArabic-0")
(nil . "MuleArabic-1")
(nil . "MuleArabic-2")
@@ -657,7 +663,9 @@
(hebrew ,(font-spec :registry "iso10646-1" :script 'hebrew)
(nil . "ISO8859-8"))
- (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))
+ (khmer ,(if (featurep 'android)
+ (font-spec :registry "iso10646-1" :script 'khmer)
+ (font-spec :registry "iso10646-1" :otf '(khmr nil (pres)))))
(kana (nil . "JISX0208*")
(nil . "GB2312.1980-0")
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 07f11a62594..e80c42f523a 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -350,9 +350,10 @@ This also sets the following values:
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
-
- (if (eq system-type 'darwin)
- ;; The file-name coding system on Darwin systems is always utf-8.
+ (if (or (eq system-type 'darwin)
+ (eq system-type 'android))
+ ;; The file-name coding system on Darwin and Android systems is
+ ;; always UTF-8.
(setq default-file-name-coding-system 'utf-8-unix)
(if (and (or (not coding-system)
(coding-system-get coding-system 'ascii-compatible-p)))
@@ -2159,7 +2160,9 @@ See `set-language-info-alist' for use in programs."
(interactive
(list (read-language-name
'documentation
- (format-prompt "Describe language environment" current-language-environment))))
+ (format-prompt "Describe language environment"
+ current-language-environment)
+ current-language-environment)))
(let ((help-buffer-under-preparation t))
(if (null language-name)
(setq language-name current-language-environment))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 13feaee405a..4fddd2701d5 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -75,7 +75,7 @@ The codes are given in the following order:
Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy
biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'.
W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac
-polecenie `\\[kill-buffer]'.
+polecenie \\[kill-buffer].
Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich
znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
@@ -174,7 +174,7 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
If you read this text then you are either looking at the library's
source text or you have called the `ogonek-how' command. In the
-latter case you may remove this text using `\\[kill-buffer]'.
+latter case you may remove this text using \\[kill-buffer].
The library provides functions for changing the encoding of Polish
diacritic characters, the ones with an `ogonek' below or above them.
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 56f049aedf5..48d2ccb8828 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1324,9 +1324,11 @@ If STR has `advice' text property, append the following special event:
;; binding in `universal-argument-map' just return
;; (list KEY), otherwise act as if there was no
;; overriding map.
- (or (not (eq (cadr overriding-terminal-local-map)
- universal-argument-map))
- (lookup-key overriding-terminal-local-map (vector key))))
+ ;; We used to do that only for `universal-argument-map',
+ ;; but according to bug#68338 this should also apply to
+ ;; other transient maps. Let's hope it's OK to apply it
+ ;; to all `overriding-terminal-local-map's.
+ (lookup-key overriding-terminal-local-map (vector key)))
overriding-local-map)
(list key)
(quail-setup-overlays (quail-conversion-keymap))
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index c4706e061e3..42584f6548c 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -31,12 +31,12 @@
;; Convert cxterm dictionary (of TIT format) to quail-package.
;;
;; Usage (within Emacs):
-;; M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
+;; M-x tit-dic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
;; Usage (from shell):
-;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\
+;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\
;; [-dir DIR] [DIR | FILE] ...
;;
-;; When you run titdic-convert within Emacs, you have a chance to
+;; When you run `tit-dic-convert' within Emacs, you have a chance to
;; modify arguments of `quail-define-package' before saving the
;; converted file. For instance, you are likely to modify TITLE,
;; DOCSTRING, and KEY-BINDINGS.
@@ -90,7 +90,8 @@
;; \<quail-translation-docstring> is replaced by a description about
;; how to select a translation from a list of candidates.
-(defvar quail-cxterm-package-ext-info
+(define-obsolete-variable-alias 'quail-cxterm-package-ext-info 'tit-quail-cxterm-package-ext-info "30.1")
+(defvar tit-quail-cxterm-package-ext-info
'(("chinese-4corner" "å››č§’")
("chinese-array30" "ļ¼“ļ¼")
("chinese-ccdospy" "ē¼©ę‹¼"
@@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:äøŠč², 4:åŽ»č²,
(tit-moveleft ",<")
(tit-keyprompt nil))
- (generate-lisp-file-heading filename 'titdic-convert :code nil)
+ (generate-lisp-file-heading filename 'tit-dic-convert :code nil)
(princ ";; Quail package `")
(princ package)
(princ "\n")
@@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:äøŠč², 4:åŽ»č²,
(princ "(quail-define-package ")
;; Args NAME, LANGUAGE, TITLE
- (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info))))
+ (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info))))
(princ "\"")
(princ package)
(princ "\" \"")
@@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:äøŠč², 4:åŽ»č²,
(let ((doc (concat tit-prompt "\n"))
(comments (if tit-comments
(mapconcat #'identity (nreverse tit-comments) "\n")))
- (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
+ (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info))))
(if comments
(setq doc (concat doc "\n" comments "\n")))
(if doc-ext
@@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:äøŠč², 4:åŽ»č²,
;;;###autoload
(defun titdic-convert (filename &optional dirname)
+ (declare (obsolete tit-dic-convert "30.1"))
+ (tit-dic-convert filename dirname))
+(defun tit-dic-convert (filename &optional dirname)
"Convert a TIT dictionary of FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
@@ -531,21 +535,24 @@ the generated Quail package is saved."
;;;###autoload
(defun batch-titdic-convert (&optional force)
- "Run `titdic-convert' on the files remaining on the command line.
+ (declare (obsolete batch-tit-dic-convert "30.1"))
+ (batch-tit-dic-convert force))
+(defun batch-tit-dic-convert (&optional force)
+ "Run `tit-dic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
-For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
+For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to
generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
-To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
+To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"."
(defvar command-line-args-left) ; Avoid compiler warning.
(if (not noninteractive)
- (error "`batch-titdic-convert' should be used only with -batch"))
+ (error "`batch-tit-dic-convert' should be used only with -batch"))
(if (string= (car command-line-args-left) "-h")
(progn
(message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
- (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
+ (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert XXX.tit YYY.tit")
(message "To convert XXX.tit into DIR/xxx.el:")
- (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
+ (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir DIR XXX.tit"))
(let (targetdir filename files file)
(if (string= (car command-line-args-left) "-dir")
(progn
@@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(when (or force
(file-newer-than-file-p
file (tit-make-quail-package-file-name file targetdir)))
- (titdic-convert file targetdir))
+ (tit-dic-convert file targetdir))
(setq files (cdr files)))
(setq command-line-args-left (cdr command-line-args-left)))))
(kill-emacs 0))
@@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary.
;; )
-(defvar quail-misc-package-ext-info
+(define-obsolete-variable-alias 'quail-misc-package-ext-info 'tit-quail-misc-package-ext-info "30.1")
+(defvar tit-quail-misc-package-ext-info
'(("chinese-b5-tsangchi" "倉B"
"cangjie-table.b5" big5 "tsang-b5.el"
- tsang-b5-converter
+ tit--tsang-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-b5-quick" "ē°”B"
"cangjie-table.b5" big5 "quick-b5.el"
- quick-b5-converter
+ tit--quick-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-cns-tsangchi" "倉C"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
- tsang-cns-converter
+ tit--tsang-cns-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-cns-quick" "ē°”C"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
- quick-cns-converter
+ tit--quick-cns-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; #
@@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-py" "ę‹¼G"
"pinyin.map" cn-gb-2312 "PY.el"
- py-converter
+ tit--py-converter
"\
;; \"pinyin.map\" is included in a free package called CCE. It is
;; available at: [link needs updating -- SK 2021-09-27]
@@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-ziranma" "č‡Ŗē„¶"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
- ziranma-converter
+ tit--ziranma-converter
"\
;; \"ziranma.cin\" is included in a free package called CCE. It is
;; available at: [link needs updating -- SK 2021-09-27]
@@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-ctlau" "刘ē²¤"
"CTLau.html" cn-gb-2312 "CTLau.el"
- ctlau-gb-converter
+ tit--ctlau-gb-converter
"\
;; \"CTLau.html\" is available at:
;;
@@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
("chinese-ctlaub" "劉ē²µ"
"CTLau-b5.html" big5 "CTLau-b5.el"
- ctlau-b5-converter
+ tit--ctlau-b5-converter
"\
;; \"CTLau-b5.html\" is available at:
;;
@@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
-(defun tsang-quick-converter (dicbuf tsang-p big5-p)
+(define-obsolete-function-alias 'tsang-quick-converter #'tit--tsang-quick-converter "30.1")
+(defun tit--tsang-quick-converter (dicbuf tsang-p big5-p)
(let ((fulltitle (if tsang-p "倉頔" "ē°”ꘓ"))
dic)
(goto-char (point-max))
@@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(if big5-p (nth 1 elt) (nth 2 elt))))))
(insert ")\n")))
-(defun tsang-b5-converter (dicbuf)
- (tsang-quick-converter dicbuf t t))
+(define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter "30.1")
+(defun tit--tsang-b5-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf t t))
-(defun quick-b5-converter (dicbuf)
- (tsang-quick-converter dicbuf nil t))
+(define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter "30.1")
+(defun tit--quick-b5-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf nil t))
-(defun tsang-cns-converter (dicbuf)
- (tsang-quick-converter dicbuf t nil))
+(define-obsolete-function-alias 'tsang-cns-converter #'tit--tsang-cns-converter "30.1")
+(defun tit--tsang-cns-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf t nil))
-(defun quick-cns-converter (dicbuf)
- (tsang-quick-converter dicbuf nil nil))
+(define-obsolete-function-alias 'quick-cns-converter #'tit--quick-cns-converter "30.1")
+(defun tit--quick-cns-converter (dicbuf)
+ (tit--tsang-quick-converter dicbuf nil nil))
;; Generate a code of a Quail package in the current buffer from
;; Pinyin dictionary in the buffer DICBUF. The input method name of
;; the Quail package is NAME, and the title string is TITLE.
-(defun py-converter (dicbuf)
+(define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1")
+(defun tit--py-converter (dicbuf)
(goto-char (point-max))
(insert (format "%S\n" "ę±‰å­—č¾“å…„āˆ·ę‹¼éŸ³āˆ·
@@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones by digits
;; Ziranma dictionary in the buffer DICBUF. The input method name of
;; the Quail package is NAME, and the title string is TITLE.
-(defun ziranma-converter (dicbuf)
+(define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter "30.1")
+(defun tit--ziranma-converter (dicbuf)
(let (dic)
(with-current-buffer dicbuf
(goto-char (point-min))
@@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by one of `a' to
;; method name of the Quail package is NAME, and the title string is
;; TITLE. DESCRIPTION is the string shown by describe-input-method.
-(defun ctlau-converter (dicbuf description)
+(define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1")
+(defun tit--ctlau-converter (dicbuf description)
(goto-char (point-max))
(insert (format "%S\n" description))
(insert " '((\"\C-?\" . quail-delete-last-char)
@@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(forward-line 1)))
(insert ")\n"))
-(defun ctlau-gb-converter (dicbuf)
- (ctlau-converter dicbuf
+(define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter "30.1")
+(defun tit--ctlau-gb-converter (dicbuf)
+ (tit--ctlau-converter dicbuf
"ę±‰å­—č¾“å…„āˆ·åˆ˜é””ē„„式ē²¤éŸ³āˆ·
刘锔ē„„式ē²¤čÆ­ę³ØéŸ³ę–¹ę”ˆ
@@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to
Some infrequent GB characters are accessed by typing \\, followed by
the Cantonese romanization of the respective radical (éƒØ首)."))
-(defun ctlau-b5-converter (dicbuf)
- (ctlau-converter dicbuf
+(define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter "30.1")
+(defun tit--ctlau-b5-converter (dicbuf)
+ (tit--ctlau-converter dicbuf
"ę¼¢å­—č¼øå…„ļ¼šåŠ‰éŒ«ē„„式ē²µéŸ³ļ¼š
劉錫ē„„式ē²µčŖžę³ØéŸ³ę–¹ę”ˆ
@@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(declare-function dos-8+3-filename "dos-fns.el" (filename))
-(defun miscdic-convert (filename &optional dirname)
+(define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1")
+(defun tit-miscdic-convert (filename &optional dirname)
"Convert a dictionary file FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FInput method dictionary file: ")
(or (file-readable-p filename)
(error "%s does not exist" filename))
- (let ((tail quail-misc-package-ext-info)
+ (let ((tail tit-quail-misc-package-ext-info)
coding-system-for-write
slot
name title dicfile coding quailfile converter copyright)
@@ -1137,7 +1156,7 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
- (generate-lisp-file-heading quailfile 'miscdic-convert)
+ (generate-lisp-file-heading quailfile 'tit-miscdic-convert)
(insert (format-message ";; Quail package `%s'\n" name))
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";; Copyright notice of the source file\n")
@@ -1164,15 +1183,17 @@ the generated Quail package is saved."
quailfile :inhibit-provide t :compile t :coding nil)))
(setq tail (cdr tail)))))
-(defun batch-miscdic-convert ()
- "Run `miscdic-convert' on the files remaining on the command line.
+;; Used in `Makefile.in'.
+(define-obsolete-function-alias 'batch-miscdic-convert #'batch-tit-miscdic-convert "30.1")
+(defun batch-tit-miscdic-convert ()
+ "Run `tit-miscdic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
If there's an argument \"-dir\", the next argument specifies a directory
to store generated Quail packages."
(defvar command-line-args-left) ; Avoid compiler warning.
(if (not noninteractive)
- (error "`batch-miscdic-convert' should be used only with -batch"))
+ (error "`batch-tit-miscdic-convert' should be used only with -batch"))
(let ((dir default-directory)
filename)
(while command-line-args-left
@@ -1186,11 +1207,13 @@ to store generated Quail packages."
(if (file-directory-p filename)
(dolist (file (directory-files filename t nil t))
(or (file-directory-p file)
- (miscdic-convert file dir)))
- (miscdic-convert filename dir))))
+ (tit-miscdic-convert file dir)))
+ (tit-miscdic-convert filename dir))))
(kill-emacs 0))
-(defun pinyin-convert ()
+;; Used in `Makefile.in'.
+(define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1")
+(defun tit-pinyin-convert ()
"Convert text file pinyin.map into an elisp library.
The library is named pinyin.el, and contains the constant
`pinyin-character-map'."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 6b39054b512..a139a6fb84e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -282,13 +282,13 @@ Value is nil, t, or a function.
If nil, default to literal searches (note that `case-fold-search'
and `isearch-lax-whitespace' may still be applied).\\<isearch-mode-map>
-If t, default to regexp searches (as if typing `\\[isearch-toggle-regexp]' during
+If t, default to regexp searches (as if typing \\[isearch-toggle-regexp] during
isearch).
If a function, use that function as an `isearch-regexp-function'.
Example functions (and the keys to toggle them during isearch)
-are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp'
-\(`\\[isearch-toggle-symbol]'), and `char-fold-to-regexp' \(`\\[isearch-toggle-char-fold]')."
+are `word-search-regexp' \(\\[isearch-toggle-word]), `isearch-symbol-regexp'
+\(\\[isearch-toggle-symbol]), and `char-fold-to-regexp' \(\\[isearch-toggle-char-fold])."
;; :type is set below by `isearch-define-mode-toggle'.
:type '(choice (const :tag "Literal search" nil)
(const :tag "Regexp search" t)
@@ -2875,7 +2875,8 @@ The command accepts Unicode names like \"smiling face\" or
(isearch-search)
(when (and (memq isearch-wrap-pause '(no no-ding))
(not isearch-success))
- (isearch-repeat (if isearch-forward 'forward 'backward)))))
+ (let ((isearch-cmds isearch-cmds))
+ (isearch-repeat (if isearch-forward 'forward 'backward))))))
(isearch-push-state)
(if isearch-op-fun (funcall isearch-op-fun))
(isearch-update))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 3f33443f321..5037d8c5b2b 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
;; Author: JoĆ£o TĆ”vora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.23
+;; Version: 1.0.25
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -438,7 +438,7 @@ ignored."
`(canceled ,cancel-on-input-retval))
(t (while t (accept-process-output nil 30)))))
;; In normal operation, continuations for error/success is
- ;; handled by `jsonrpc-continue'. Timeouts also remove
+ ;; handled by `jsonrpc--continue'. Timeouts also remove
;; the continuation...
(pcase-let* ((`(,id ,_) id-and-timer))
;; ...but we still have to guard against exist explicit
@@ -689,8 +689,22 @@ With optional CLEANUP, kill any associated buffers."
(when-let (p (slot-value connection '-autoport-inferior)) (delete-process p))
(funcall (jsonrpc--on-shutdown connection) connection)))))
+(defvar jsonrpc--in-process-filter nil
+ "Non-nil if inside `jsonrpc--process-filter'.")
+
(cl-defun jsonrpc--process-filter (proc string)
"Called when new data STRING has arrived for PROC."
+ (when jsonrpc--in-process-filter
+ ;; Problematic recursive process filters may happen if
+ ;; `jsonrpc-connection-receive', called by us, eventually calls
+ ;; client code which calls `process-send-string' (which see) to,
+ ;; say send a follow-up message. If that happens to writes enough
+ ;; bytes for pending output to be received, we will lose JSONRPC
+ ;; messages. In that case, remove recursiveness by re-scheduling
+ ;; ourselves to run from within a timer as soon as possible
+ ;; (bug#60088)
+ (run-at-time 0 nil #'jsonrpc--process-filter proc string)
+ (cl-return-from jsonrpc--process-filter))
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let* ((conn (process-get proc 'jsonrpc-connection))
@@ -746,10 +760,11 @@ With optional CLEANUP, kill any associated buffers."
(setq message
(plist-put message :jsonrpc-json
(buffer-string)))
- (process-put proc 'jsonrpc-mqueue
- (nconc (process-get proc
- 'jsonrpc-mqueue)
- (list message)))))
+ ;; Put new messages at the front of the queue,
+ ;; this is correct as the order is reversed
+ ;; before putting the timers on `timer-list'.
+ (push message
+ (process-get proc 'jsonrpc-mqueue))))
(goto-char message-end)
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))
@@ -768,11 +783,20 @@ With optional CLEANUP, kill any associated buffers."
;; non-locally (typically the reply to a request), so do
;; this all this processing in top-level loops timer.
(cl-loop
+ ;; `timer-activate' orders timers by time, which is an
+ ;; very expensive operation when jsonrpc-mqueue is large,
+ ;; therefore the time object is reused for each timer
+ ;; created.
+ with time = (current-time)
for msg = (pop (process-get proc 'jsonrpc-mqueue)) while msg
- do (run-at-time 0 nil
- (lambda (m) (with-temp-buffer
- (jsonrpc-connection-receive conn m)))
- msg)))))))
+ do (let ((timer (timer-create)))
+ (timer-set-time timer time)
+ (timer-set-function timer
+ (lambda (conn msg)
+ (with-temp-buffer
+ (jsonrpc-connection-receive conn msg)))
+ (list conn msg))
+ (timer-activate timer))))))))
(defun jsonrpc--remove (conn id &optional deferred-spec)
"Cancel CONN's continuations for ID, including its timer, if it exists.
@@ -782,7 +806,7 @@ Return the full continuation (ID SUCCESS-FN ERROR-FN TIMER)"
(if deferred-spec (remhash deferred-spec defs))
(when-let ((ass (assq id conts)))
(cl-destructuring-bind (_ _ _ _ timer) ass
- (cancel-timer timer))
+ (when timer (cancel-timer timer)))
(setf conts (delete ass conts))
ass)))
@@ -1003,16 +1027,17 @@ of the API instead.")
(or method "")
(if id (format "[%s]" id) "")))))
(msg
- (cond ((eq format 'full)
- (format "%s%s\n" preamble (or json log-text)))
- ((eq format 'short)
- (format "%s%s\n" preamble (or log-text "")))
- (t
- (format "%s%s" preamble
- (or (and foreign-message
- (concat "\n" (pp-to-string
- foreign-message)))
- (concat log-text "\n")))))))
+ (pcase format
+ ('full (format "%s%s\n" preamble (or json log-text)))
+ ('short (format "%s%s\n" preamble (or log-text "")))
+ (_
+ (format "%s%s" preamble
+ (or (and foreign-message
+ (let ((lisp-indent-function ;bug#68072
+ #'lisp-indent-function))
+ (concat "\n" (pp-to-string
+ foreign-message))))
+ (concat log-text "\n")))))))
(goto-char (point-max))
;; XXX: could use `run-at-time' to delay server logs
;; slightly to play nice with verbose servers' stderr.
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 065c59da74c..b2b475c7d71 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -260,7 +260,7 @@ returned by \\[describe-key] (`describe-key')."
(setq word (concat (match-string 1 word)
(match-string 3 word)))
(not (string-match
- "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
+ "\\<\\(NUL\\|RET\\|LFD\\|TAB\\|ESC\\|SPC\\|DEL\\)$"
word))))
(setq key (list (intern word))))
((or (equal word "REM") (string-match "^;;" word))
@@ -577,9 +577,15 @@ should be a MENU form as accepted by `easy-menu-define'.
(let ((def (pop definitions)))
(if (eq key :menu)
(easy-menu-define nil keymap "" def)
- (if (member key seen-keys)
- (error "Duplicate definition for key: %S %s" key keymap)
- (push key seen-keys))
+ (when (member key seen-keys)
+ ;; Since the keys can be computed dynamically, it can
+ ;; very well happen that we get duplicate definitions
+ ;; due to some unfortunate configuration rather than
+ ;; due to an actual bug. While such duplicates are
+ ;; not desirable, they shouldn't prevent the users
+ ;; from getting their job done.
+ (message "Duplicate definition for key: %S %s" key keymap))
+ (push key seen-keys)
(keymap-set keymap key def)))))
keymap)))
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 93e8ab24971..b058eab7029 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -29,8 +29,8 @@
;;;###autoload
(defun setup-japanese-environment-internal ()
- (prefer-coding-system (if (memq system-type '(windows-nt ms-dos cygwin))
- 'japanese-shift-jis
+ (prefer-coding-system (if (memq system-type '(windows-nt ms-dos))
+ 'japanese-cp932
'utf-8))
(use-cjk-char-width-table 'ja_JP))
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index dd65409c839..8957d1a49af 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -79,7 +79,7 @@
(#x00A2 . #xFFE0) ; CENT SIGN FULLWIDTH CENT SIGN
(#x00A3 . #xFFE1) ; POUND SIGN FULLWIDTH POUND SIGN
(#x00AC . #xFFE2) ; NOT SIGN FULLWIDTH NOT SIGN
- (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
+ (#x00A6 . #xFFE4) ; BROKEN BAR FULLWIDTH BROKEN BAR
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ef672d6c2e5..b434ee0e37f 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -729,19 +729,19 @@ CONCEALED:
CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be.
-This is a minor mode. If called interactively, toggle the
-`Allout mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Allout 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.
+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 `allout-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(define-obsolete-function-alias 'outlinify-sticky #'allout-outlinify-sticky "29.1")
@@ -803,18 +803,18 @@ bindings for easy outline navigation and exposure control, extending
outline hot-spot navigation (see `allout-mode').
This is a minor mode. If called interactively, toggle the
-`Allout-Widgets mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Allout-Widgets 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.
+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 `allout-widgets-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "allout-widgets" '("allout-"))
@@ -1389,19 +1389,19 @@ Keymap summary
\\{artist-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Artist mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Artist 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.
+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 `artist-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "artist" '("artist-"))
@@ -1534,18 +1534,18 @@ When Auto-insert mode is enabled, when new files are created you can
insert a template for the file depending on the mode of the buffer.
This is a global minor mode. If called interactively, toggle the
-`Auto-Insert mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Auto-Insert 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.
+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 `(default-value \\='auto-insert-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "autoinsert" '("auto-insert"))
@@ -1571,19 +1571,19 @@ Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
-This is a minor mode. If called interactively, toggle the
-`Auto-Revert mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Auto-Revert
+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.
+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 `auto-revert-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-auto-revert-mode "autorevert" "\
@@ -1610,19 +1610,18 @@ suppressed by setting `auto-revert-verbose' to nil.
Use `auto-revert-mode' for changes other than appends!
This is a minor mode. If called interactively, toggle the
-`Auto-Revert-Tail mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Auto-Revert-Tail 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.
+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 `auto-revert-tail-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-auto-revert-tail-mode "autorevert" "\
@@ -1659,19 +1658,18 @@ It displays the text that `global-auto-revert-mode-text'
specifies in the mode line.
This is a global minor mode. If called interactively, toggle the
-`Global Auto-Revert mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Global Auto-Revert 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.
+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 `(default-value \\='global-auto-revert-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-"))
@@ -1774,18 +1772,18 @@ functions in `battery-update-functions', which can be used to
trigger actions based on battery-related events.
This is a global minor mode. If called interactively, toggle the
-`Display-Battery mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Display-Battery 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.
+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 `(default-value \\='display-battery-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "battery" '("battery-"))
@@ -1949,6 +1947,10 @@ Major mode for editing BibTeX style files.
;;; Generated autoloads from bind-key.el
(push (purecopy '(bind-key 2 4 1)) package--builtin-versions)
+(defvar personal-keybindings nil "\
+List of bindings performed by `bind-key'.
+
+Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)")
(autoload 'bind-key "bind-key" "\
Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed).
@@ -2022,7 +2024,7 @@ other modes. See `override-global-mode'.
(fn &rest ARGS)" nil t)
(autoload 'describe-personal-keybindings "bind-key" "\
Display all the personal keybindings defined by `bind-key'." t)
-(register-definition-prefixes "bind-key" '("bind-key" "override-global-m" "personal-keybindings"))
+(register-definition-prefixes "bind-key" '("bind-key" "override-global-m"))
;;; Generated autoloads from emacs-lisp/bindat.el
@@ -2755,37 +2757,36 @@ columns on its right towards the left.
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
This is a minor mode. If called interactively, toggle the
-`Bug-Reference mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Bug-Reference 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.
+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 `bug-reference-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'bug-reference-prog-mode "bug-reference" "\
Like `bug-reference-mode', but only buttonize in comments and strings.
This is a minor mode. If called interactively, toggle the
-`Bug-Reference-Prog mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Bug-Reference-Prog 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.
+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 `bug-reference-prog-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "bug-reference" '("bug-reference-"))
@@ -2939,12 +2940,6 @@ and corresponding effects.
;;; Generated autoloads from progmodes/c-ts-mode.el
-(autoload 'c-ts-base-mode "c-ts-mode" "\
-Major mode for editing C, powered by tree-sitter.
-
-\\{c-ts-base-mode-map}
-
-(fn)" t)
(autoload 'c-ts-mode "c-ts-mode" "\
Major mode for editing C, powered by tree-sitter.
@@ -2994,6 +2989,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'." t)
+(make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1")
(register-definition-prefixes "c-ts-mode" '("c-ts-"))
@@ -4380,19 +4376,19 @@ checking of documentation strings.
\\{checkdoc-minor-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Checkdoc minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Checkdoc
+minor 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.
+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 `checkdoc-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'checkdoc-package-keywords "checkdoc" "\
@@ -4478,19 +4474,18 @@ or call the function `cl-font-lock-built-in-mode'.")
Highlight built-in functions, variables, and types in `lisp-mode'.
This is a global minor mode. If called interactively, toggle the
-`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cl-Font-Lock-Built-In 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.
+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 `(default-value \\='cl-font-lock-built-in-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cl-font-lock" '("cl-font-lock-"))
@@ -4620,19 +4615,18 @@ macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects.
This is a global minor mode. If called interactively, toggle the
-`Cl-Old-Struct-Compat mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cl-Old-Struct-Compat 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.
+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 `(default-value \\='cl-old-struct-compat-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cl-lib" '("cl-"))
@@ -5032,6 +5026,16 @@ on third call it again advances points to the next difference and so on.
(register-definition-prefixes "compare-w" '("compare-"))
+;;; Generated autoloads from emacs-lisp/compat.el
+
+ (push (list 'compat
+ emacs-major-version
+ emacs-minor-version
+ 9999)
+ package--builtin-versions)
+(register-definition-prefixes "compat" '("compat-"))
+
+
;;; Generated autoloads from image/compface.el
(register-definition-prefixes "compface" '("uncompface"))
@@ -5180,18 +5184,18 @@ See `compilation-mode'.
This is a minor mode. If called interactively, toggle the
`Compilation-Shell minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+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.
+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 `compilation-shell-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'compilation-minor-mode "compile" "\
@@ -5201,20 +5205,19 @@ When Compilation minor mode is enabled, all the error-parsing
commands of Compilation major mode are available. See
`compilation-mode'.
-This is a minor mode. If called interactively, toggle the
-`Compilation minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Compilation
+minor 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.
+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 `compilation-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'compilation-next-error-function "compile" "\
@@ -5272,19 +5275,18 @@ this mode: `enable-completion', `save-completions-flag', and
options can be found in the `completion' group.
This is a global minor mode. If called interactively, toggle the
-`Dynamic-Completion mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Dynamic-Completion 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.
+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 `(default-value \\='dynamic-completion-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-"))
@@ -5304,19 +5306,18 @@ completion suggestion, and \\[completion-preview-prev-candidate]
cycles backward.
This is a minor mode. If called interactively, toggle the
-`Completion-Preview mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Completion-Preview 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.
+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 `completion-preview-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "completion-preview" '("completion-preview-"))
@@ -5543,6 +5544,7 @@ If FIX is non-nil, run `copyright-fix-years' instead.
;;; Generated autoloads from progmodes/cperl-mode.el
+(put 'cperl-file-style 'safe-local-variable 'stringp)
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
(put 'cperl-continued-brace-offset 'safe-local-variable 'integerp)
@@ -5550,7 +5552,6 @@ If FIX is non-nil, run `copyright-fix-years' instead.
(put 'cperl-continued-statement-offset 'safe-local-variable 'integerp)
(put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp)
(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp)
-(put 'cperl-file-style 'safe-local-variable 'stringp)
(autoload 'cperl-mode "cperl-mode" "\
Major mode for editing Perl code.
Expression and list commands understand all C brackets.
@@ -5903,19 +5904,19 @@ You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior.
-This is a global minor mode. If called interactively, toggle the
-`Cua mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Cua
+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.
+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 `(default-value \\='cua-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'cua-selection-mode "cua-base" "\
@@ -5938,19 +5939,18 @@ Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated.
This is a minor mode. If called interactively, toggle the
-`Cua-Rectangle-Mark mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cua-Rectangle-Mark 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.
+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 `cua-rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cua-rect" '("cua-"))
@@ -5966,19 +5966,18 @@ By convention, this is a list of symbols where each symbol stands for the
Keep cursor outside of any `cursor-intangible' text property.
This is a minor mode. If called interactively, toggle the
-`Cursor-Intangible mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Cursor-Intangible 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.
+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 `cursor-intangible-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'cursor-sensor-mode "cursor-sensor" "\
@@ -5991,18 +5990,18 @@ the cursor and DIR can be `entered' or `left' depending on whether the cursor
is entering the area covered by the text-property property or leaving it.
This is a minor mode. If called interactively, toggle the
-`Cursor-Sensor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Cursor-Sensor 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.
+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 `cursor-sensor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))
@@ -6115,6 +6114,11 @@ Customize GROUP, which must be a customization group, in another window.
Customize SYMBOL, which must be a user option.
(fn SYMBOL)" t)
+(autoload 'customize-toggle-option "cus-edit" "\
+Toggle the value of boolean option SYMBOL for this session.
+
+(fn SYMBOL)" t)
+(defalias 'toggle-option #'customize-toggle-option)
(defalias 'customize-variable-other-window 'customize-option-other-window)
(autoload 'customize-option-other-window "cus-edit" "\
Customize SYMBOL, which must be a user option.
@@ -6368,19 +6372,19 @@ Note, in addition to enabling this minor mode, the major mode must
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-This is a minor mode. If called interactively, toggle the `Cwarn
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Cwarn 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.
+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 `cwarn-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-cwarn-mode 'globalized-minor-mode t)
@@ -6871,19 +6875,18 @@ See `delete-selection-helper' and `delete-selection-pre-hook' for
information on adapting behavior of commands in Delete Selection mode.
This is a global minor mode. If called interactively, toggle the
-`Delete-Selection mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Delete-Selection 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.
+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 `(default-value \\='delete-selection-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'delete-active-region "delsel" "\
@@ -6964,13 +6967,6 @@ See Info node `(elisp)Derived Modes' for more details.
(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t)
(function-put 'define-derived-mode 'doc-string-elt 4)
(function-put 'define-derived-mode 'lisp-indent-function 'defun)
-(autoload 'derived-mode-init-mode-variables "derived" "\
-Initialize variables for a new MODE.
-Right now, if they don't already exist, set up a blank keymap, an
-empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used.
-
-(fn MODE)")
(register-definition-prefixes "derived" '("derived-mode-"))
@@ -7042,13 +7038,22 @@ or call the function `desktop-save-mode'.")
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-When Desktop Save mode is enabled, the state of Emacs is saved from
-one session to another. In particular, Emacs will save the desktop when
-it exits (this may prompt you; see the option `desktop-save'). The next
-time Emacs starts, if this mode is active it will restore the desktop.
+When Desktop Save mode is enabled, the state of Emacs is saved from one
+session to another. The saved Emacs \"desktop configuration\" includes the
+buffers, their file names, major modes, buffer positions, window and frame
+configuration, and some important global variables.
+
+To enable this feature for future sessions, customize `desktop-save-mode'
+to t, or add this line in your init file:
+
+ (desktop-save-mode 1)
-To manually save the desktop at any time, use the command `\\[desktop-save]'.
-To load it, use `\\[desktop-read]'.
+When this mode is enabled, Emacs will save the desktop when it exits
+(this may prompt you, see the option `desktop-save'). The next time
+Emacs starts, if this mode is active it will restore the desktop.
+
+To manually save the desktop at any time, use the command \\[desktop-save].
+To load it, use \\[desktop-read].
Once a desktop file exists, Emacs will auto-save it according to the
option `desktop-auto-save-timeout'.
@@ -7058,18 +7063,18 @@ To see all the options you can set, browse the `desktop' customization group.
For further details, see info node `(emacs)Saving Emacs Sessions'.
This is a global minor mode. If called interactively, toggle the
-`Desktop-Save mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Desktop-Save 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.
+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 `(default-value \\='desktop-save-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\
@@ -7503,19 +7508,19 @@ Toggle Diff minor mode.
\\{diff-minor-mode-map}
-This is a minor mode. If called interactively, toggle the `Diff
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Diff minor
+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.
+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 `diff-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+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 "\
@@ -7719,19 +7724,19 @@ This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory.
-This is a minor mode. If called interactively, toggle the
-`Dirtrack mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Dirtrack
+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.
+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 `dirtrack-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'dirtrack "dirtrack" "\
@@ -7750,7 +7755,7 @@ from `default-directory'.
(autoload 'disassemble "disass" "\
Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
-(a lambda expression or a compiled-function object).
+(a lambda expression or a byte-code-function object).
If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol.
@@ -7905,19 +7910,19 @@ not appear aligned.
See Info node `Displaying Boundaries' for details.
This is a minor mode. If called interactively, toggle the
-`Display-Fill-Column-Indicator mode' mode. If the prefix
-argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+`Display-Fill-Column-Indicator 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.
+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 `display-fill-column-indicator-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t)
@@ -7977,19 +7982,18 @@ customize `display-line-numbers-type'. To change the type while
the mode is on, set `display-line-numbers' directly.
This is a minor mode. If called interactively, toggle the
-`Display-Line-Numbers mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Display-Line-Numbers 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.
+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 `display-line-numbers-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-display-line-numbers-mode 'globalized-minor-mode t)
@@ -8066,19 +8070,18 @@ of `header-line-format', like this:
See also `line-number-display-width'.
This is a minor mode. If called interactively, toggle the
-`Header-Line-Indent mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Header-Line-Indent 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.
+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 `header-line-indent-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "display-line-numbers" '("display-line-numbers-" "header-line-indent--"))
@@ -8179,19 +8182,19 @@ Toggle displaying buffer via Doc View (Doc View minor mode).
See the command `doc-view-mode' for more information on this mode.
-This is a minor mode. If called interactively, toggle the
-`Doc-View minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Doc-View
+minor 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.
+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 `doc-view-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'doc-view-bookmark-jump "doc-view" "\
@@ -8250,19 +8253,19 @@ Toggle special insertion on double keypresses (Double mode).
When Double mode is enabled, some keys will insert different
strings when pressed twice. See `double-map' for details.
-This is a minor mode. If called interactively, toggle the
-`Double mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Double 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.
+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 `double-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "double" '("double-"))
@@ -8870,18 +8873,18 @@ This global minor mode enables `ede-minor-mode' in all buffers in
an EDE controlled project.
This is a global minor mode. If called interactively, toggle the
-`Global Ede mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Ede 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.
+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 `(default-value \\='global-ede-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede"))
@@ -8919,7 +8922,7 @@ An extant spec symbol is a symbol that is not a function and has a
`edebug-form-spec' property.
(fn SPEC)")
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
+(defalias 'edebug-defun #'edebug-eval-top-level-form)
(autoload 'edebug-eval-top-level-form "edebug" "\
Evaluate the top level form point is in, stepping through with Edebug.
This is like `eval-defun' except that it steps the code for Edebug
@@ -9285,9 +9288,9 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." t)
(autoload 'edit-kbd-macro "edmacro" "\
Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
-keyboard macro, `\\[view-lossage]' to edit the last 300
-keystrokes as a keyboard macro, or `\\[execute-extended-command]'
+Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last
+keyboard macro, \\[view-lossage] to edit the last 300
+keystrokes as a keyboard macro, or \\[execute-extended-command]
to edit a macro by its command name.
With a prefix argument, format the macro in a more concise way.
@@ -9359,7 +9362,7 @@ Turn on EDT Emulation." t)
;;; Generated autoloads from progmodes/eglot.el
-(push (purecopy '(eglot 1 16)) package--builtin-versions)
+(push (purecopy '(eglot 1 17)) package--builtin-versions)
(define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1")
(autoload 'eglot "eglot" "\
Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES.
@@ -9494,7 +9497,7 @@ SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor.
(fn CNAME SUPERCLASSES FILENAME DOC)")
-(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
+(register-definition-prefixes "eieio-core" '("cl--generic-struct-tag" "class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
;;; Generated autoloads from emacs-lisp/eieio-custom.el
@@ -9571,37 +9574,36 @@ inserted around the region instead.
To toggle the mode in a single buffer, use `electric-pair-local-mode'.
This is a global minor mode. If called interactively, toggle the
-`Electric-Pair mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Electric-Pair 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.
+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 `(default-value \\='electric-pair-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'electric-pair-local-mode "elec-pair" "\
Toggle `electric-pair-mode' only in this buffer.
This is a minor mode. If called interactively, toggle the
-`Electric-Pair-Local mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Electric-Pair-Local 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.
+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 `electric-pair-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "elec-pair" '("electric-pair-"))
@@ -9618,19 +9620,19 @@ to `elide-head-headers-to-hide'.
This is suitable as an entry on `find-file-hook' or appropriate
mode hooks.
-This is a minor mode. If called interactively, toggle the
-`Elide-Head mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Elide-Head
+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.
+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 `elide-head-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'elide-head "elide-head" "\
@@ -9998,19 +10000,19 @@ Commands:
\\{enriched-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Enriched mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Enriched
+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.
+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 `enriched-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'enriched-encode "enriched" "\
@@ -10231,19 +10233,19 @@ enough, since keyservers have strict timeout settings.
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
-This is a minor mode. If called interactively, toggle the
-`epa-mail mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `epa-mail
+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.
+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 `epa-mail-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'epa-mail-decrypt "epa-mail" "\
@@ -10293,18 +10295,18 @@ or call the function `epa-global-mail-mode'.")
Minor mode to hook EasyPG into Mail mode.
This is a global minor mode. If called interactively, toggle the
-`Epa-Global-Mail mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Epa-Global-Mail 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.
+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 `(default-value \\='epa-global-mail-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "epa-mail" '("epa-mail-"))
@@ -10356,84 +10358,77 @@ Look at CONFIG and try to expand GROUP.
;;; Generated autoloads from erc/erc.el
(push (purecopy '(erc 5 6 -4)) package--builtin-versions)
+(dolist (symbol '( erc-sasl erc-spelling ; 29
+ erc-imenu erc-nicks)) ; 30
+ (custom-add-load symbol symbol))
+(custom-autoload 'erc-modules "erc")
(autoload 'erc-select-read-args "erc" "\
-Prompt the user for values of nick, server, port, and password.
-With prefix arg, also prompt for user and full name.")
+Prompt for connection parameters and return them in a plist.
+By default, collect `:server', `:port', `:nickname', and
+`:password'. With a non-nil prefix argument, also prompt for
+`:user' and `:full-name'. Also return various environmental
+properties needed by entry-point commands, like `erc-tls'.")
(autoload 'erc-server-select "erc" "\
Interactively connect to a server from `erc-server-alist'." t)
(make-obsolete 'erc-server-select 'erc-tls "30.1")
(autoload 'erc "erc" "\
-ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC.
-
-It allows selecting connection parameters, and then starts ERC.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- id
-
-That is, if called with
+Connect to an Internet Relay Chat SERVER on a non-TLS PORT.
+Use NICK and USER, when non-nil, to inform the IRC commands of
+the same name, possibly factoring in a non-nil FULL-NAME as well.
+When PASSWORD is non-nil, also send an opening server password
+via the \"PASS\" command. Interactively, prompt for SERVER,
+PORT, NICK, and PASSWORD, along with USER and FULL-NAME when
+given a prefix argument. Non-interactively, expect the rarely
+needed ID parameter, when non-nil, to be a symbol or a string for
+naming the server buffer and identifying the connection
+unequivocally. Once connected, return the server buffer. (See
+Info node `(erc) Connecting' for details about all mentioned
+parameters.)
+
+Together with `erc-tls', this command serves as the main entry
+point for ERC, the powerful, modular, and extensible IRC client.
+Non-interactively, both commands accept the following keyword
+arguments, with their defaults supplied by the indicated
+\"compute\" functions:
+
+ :server `erc-compute-server'
+ :port `erc-compute-port'
+ :nick `erc-compute-nick'
+ :user `erc-compute-user'
+ :password N/A
+ :full-name `erc-compute-full-name'
+ :id' N/A
+
+For example, when called in the following manner
(erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of the other parameters.
-
-See `erc-tls' for the meaning of ID.
+ERC assigns SERVER and FULL-NAME the associated keyword values
+and defers to `erc-compute-port', `erc-compute-user', and
+`erc-compute-nick' for those respective parameters.
(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let ((erc--display-context `((erc-interactive-display . erc) ,@erc--display-context))) (erc-select-read-args))))
(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
-ERC is a powerful, modular, and extensible IRC client.
-This function is the main entry point for ERC over TLS.
-
-It allows selecting connection parameters, and then starts ERC
-over TLS.
-
-Non-interactively, it takes the keyword arguments
- (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- (user (erc-compute-user))
- password
- (full-name (erc-compute-full-name))
- client-certificate
- id
-
-That is, if called with
-
- (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-
-then the server and full-name will be set to those values,
-whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of their respective parameters.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the certificate key file name, and the second
-element is the certificate file name itself, or t, which means
-that `auth-source' will be queried for the key and the
-certificate. Authenticating using a TLS client certificate is
-also referred to as \"CertFP\" (Certificate Fingerprint)
-authentication by various IRC networks.
+Connect to an IRC server over a TLS-encrypted connection.
+Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along
+with USER and FULL-NAME when given a prefix argument.
+Non-interactively, also accept a CLIENT-CERTIFICATE, which should
+be a list containing the file name of the certificate's key
+followed by that of the certificate itself. Alternatively,
+accept a value of t instead of a list, to tell ERC to query
+`auth-source' for the certificate's details.
-Example usage:
+Example client certificate (CertFP) usage:
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
\\='(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))
-When present, ID should be a symbol or a string to use for naming
-the server buffer and identifying the connection unequivocally.
-See Info node `(erc) Network Identifier' for details. Like
-CLIENT-CERTIFICATE, this parameter cannot be specified
-interactively.
+See the alternative entry-point command `erc' as well as Info
+node `(erc) Connecting' for a fuller description of the various
+parameters, like ID.
(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls) (erc--display-context `((erc-interactive-display . erc-tls) ,@erc--display-context))) (erc-select-read-args))))
(autoload 'erc-handle-irc-url "erc" "\
@@ -10702,6 +10697,46 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
(register-definition-prefixes "ert" '("ert-"))
+;;; Generated autoloads from emacs-lisp/ert-font-lock.el
+
+(autoload 'ert-font-lock-deftest "ert-font-lock" "\
+Define test NAME (a symbol) using assertions from TEST-STR.
+
+Other than MAJOR-MODE and TEST-STR parameters, this macro accepts
+the same parameters and keywords as `ert-deftest' and is intended
+to be used through `ert'.
+
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t)
+(function-put 'ert-font-lock-deftest 'doc-string-elt 3)
+(function-put 'ert-font-lock-deftest 'lisp-indent-function 2)
+(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\
+Define test NAME (a symbol) using assertions from FILE.
+
+FILE - path to a file with assertions in ERT resource director as
+return by `ert-resource-directory'.
+
+Other than MAJOR-MODE and FILE parameters, this macro accepts the
+same parameters and keywords as `ert-deftest' and is intended to
+be used through `ert'.
+
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t)
+(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3)
+(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2)
+(autoload 'ert-font-lock-test-string "ert-font-lock" "\
+Check font faces in TEST-STRING set by MODE.
+
+The function is meant to be run from within an ERT test.
+
+(fn TEST-STRING MODE)")
+(autoload 'ert-font-lock-test-file "ert-font-lock" "\
+Check font faces in FILENAME set by MODE.
+
+The function is meant to be run from within an ERT test.
+
+(fn FILENAME MODE)")
+(register-definition-prefixes "ert-font-lock" '("ert-font-lock--"))
+
+
;;; Generated autoloads from emacs-lisp/ert-x.el
(autoload 'ert-kill-all-test-buffers "ert-x" "\
@@ -11087,6 +11122,49 @@ for \\[find-tag] (which see)." t)
(register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function"))
+;;; Generated autoloads from progmodes/etags-regen.el
+
+(put 'etags-regen-regexp-alist 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p (lambda (group) (and (consp group) (listp (car group)) (listp (cdr group)) (seq-every-p #'stringp (car group)) (seq-every-p #'stringp (cdr group)))) value))))
+(put 'etags-regen-file-extensions 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+(put 'etags-regen-ignores 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+(defvar etags-regen-mode nil "\
+Non-nil if Etags-Regen mode is enabled.
+See the `etags-regen-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 `etags-regen-mode'.")
+(custom-autoload 'etags-regen-mode "etags-regen" nil)
+(autoload 'etags-regen-mode "etags-regen" "\
+Minor mode to automatically generate and update tags tables.
+
+This minor mode generates the tags table automatically based on
+the current project configuration, and later updates it as you
+edit the files and save the changes.
+
+If you select a tags table manually (for example, using
+\\[visit-tags-table]), then this mode will be effectively
+disabled for the entire session. Use \\[tags-reset-tags-tables]
+to countermand the effect of a previous \\[visit-tags-table].
+
+This is a global minor mode. If called interactively, toggle the
+`Etags-Regen 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 `(default-value \\='etags-regen-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "etags-regen" '("etags-regen-"))
+
+
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util")
@@ -11892,19 +11970,19 @@ Minor mode for a buffer-specific default face.
When enabled, the face specified by the variable
`buffer-face-mode-face' is used to display the buffer text.
-This is a minor mode. If called interactively, toggle the
-`Buffer-Face mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Buffer-Face
+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.
+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 `buffer-face-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'buffer-face-set "face-remap" "\
@@ -12377,12 +12455,14 @@ earlier in the `setq-connection-local'. The return value of the
(fn [VARIABLE VALUE]...)" nil t)
(autoload 'connection-local-p "files-x" "\
Non-nil if VARIABLE has a connection-local binding in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used.
(fn VARIABLE &optional APPLICATION)" nil t)
(autoload 'connection-local-value "files-x" "\
Return connection-local VARIABLE for APPLICATION in `default-directory'.
+`default-directory' must be a remote file name.
If APPLICATION is nil, the value of
`connection-local-default-application' is used.
If VARIABLE does not have a connection-local binding, the return
@@ -12900,19 +12980,19 @@ suitable for the current buffer. The commands
`flymake-reporting-backends' summarize the situation, as does the
special *Flymake log* buffer.
-This is a minor mode. If called interactively, toggle the
-`Flymake mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Flymake
+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.
+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 `flymake-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'flymake-mode-on "flymake" "\
@@ -12977,19 +13057,19 @@ in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer.
-This is a minor mode. If called interactively, toggle the
-`Flyspell mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Flyspell
+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.
+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 `flyspell-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-on-flyspell "flyspell" "\
@@ -13045,7 +13125,7 @@ being able to use 144 or 216 lines instead of the normal 72... (your
mileage may vary).
To split one large window into two side-by-side windows, the commands
-`\\[split-window-right]' or `\\[follow-delete-other-windows-and-split]' can be used.
+\\[split-window-right] or \\[follow-delete-other-windows-and-split] can be used.
Only windows displayed in the same frame follow each other.
@@ -13054,19 +13134,19 @@ This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Follow mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Follow 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.
+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 `follow-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'follow-scroll-up-window "follow" "\
@@ -13152,19 +13232,19 @@ provides footnote support for `message-mode'. To get started,
play around with the following keys:
\\{footnote-minor-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Footnote mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Footnote
+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.
+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 `footnote-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "footnote" '("footnote-"))
@@ -13618,19 +13698,18 @@ being transferred. This list may grow up to a size of
the list) is deleted every time a new one is added (at the front).
This is a global minor mode. If called interactively, toggle the
-`Gdb-Enable-Debug mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Gdb-Enable-Debug 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.
+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 `(default-value \\='gdb-enable-debug)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'gdb "gdb-mi" "\
@@ -13794,19 +13873,19 @@ Minor mode for making identifiers likeThis readable.
When this mode is active, it tries to add virtual
separators (like underscores) at places they belong to.
-This is a minor mode. If called interactively, toggle the
-`Glasses mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Glasses
+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.
+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 `glasses-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "glasses" '("glasses-"))
@@ -13826,19 +13905,18 @@ If enabled, all glyphless characters will be displayed as boxes
that display their acronyms.
This is a minor mode. If called interactively, toggle the
-`Glyphless-Display mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Glyphless-Display 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.
+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 `glyphless-display-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "glyphless-mode" '("glyphless-mode-"))
@@ -14319,19 +14397,18 @@ Minor mode for providing mailing-list commands.
\\{gnus-mailing-list-mode-map}
This is a minor mode. If called interactively, toggle the
-`Gnus-Mailing-List mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Gnus-Mailing-List 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.
+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 `gnus-mailing-list-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))
@@ -14718,19 +14795,19 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
-This is a minor mode. If called interactively, toggle the
-`Goto-Address mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Goto-Address
+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.
+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 `goto-address-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-goto-address-mode 'globalized-minor-mode t)
@@ -14761,19 +14838,18 @@ See `goto-address-mode' for more information on Goto-Address mode.
Like `goto-address-mode', but only for comments and strings.
This is a minor mode. If called interactively, toggle the
-`Goto-Address-Prog mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Goto-Address-Prog 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.
+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 `goto-address-prog-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "goto-addr" '("goto-addr"))
@@ -15129,18 +15205,18 @@ or call the function `gud-tooltip-mode'.")
Toggle the display of GUD tooltips.
This is a global minor mode. If called interactively, toggle the
-`Gud-Tooltip mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Gud-Tooltip 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.
+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 `(default-value \\='gud-tooltip-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'lldb "gud" "\
@@ -15582,6 +15658,9 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer.
+When `describe-mode-outline' is non-nil, Outline minor mode
+is enabled in the Help buffer.
+
(fn &optional BUFFER)" t)
(autoload 'describe-widget "help-fns" "\
Display a buffer with information about a widget.
@@ -15907,19 +15986,19 @@ position (number of characters into buffer)
Hi-lock: end is found. A mode is excluded if it's in the list
`hi-lock-exclude-modes'.
-This is a minor mode. If called interactively, toggle the
-`Hi-Lock mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hi-Lock
+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.
+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 `hi-lock-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-hi-lock-mode 'globalized-minor-mode t)
@@ -16083,22 +16162,22 @@ Several variables affect how the hiding is done:
\\{hide-ifdef-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Hide-Ifdef mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hide-Ifdef
+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.
+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 `hide-ifdef-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
-(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef"))
+(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef"))
;;; Generated autoloads from progmodes/hideshow.el
@@ -16160,19 +16239,19 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'.
Key bindings:
\\{hs-minor-mode-map}
-This is a minor mode. If called interactively, toggle the `hs
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `hs minor
+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.
+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 `hs-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'turn-off-hideshow "hideshow" "\
@@ -16206,19 +16285,18 @@ buffer with the contents of a file
\\[highlight-compare-buffers] highlights differences between two buffers.
This is a minor mode. If called interactively, toggle the
-`Highlight-Changes mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Highlight-Changes 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.
+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 `highlight-changes-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'highlight-changes-visible-mode "hilit-chg" "\
@@ -16235,18 +16313,18 @@ This command does not itself set Highlight Changes mode.
This is a minor mode. If called interactively, toggle the
`Highlight-Changes-Visible mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+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.
+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 `highlight-changes-visible-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'highlight-changes-remove-highlight "hilit-chg" "\
@@ -16372,19 +16450,19 @@ 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.
-This is a minor mode. If called interactively, toggle the
-`Hl-Line mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Hl-Line
+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.
+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 `hl-line-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar global-hl-line-mode nil "\
@@ -16406,18 +16484,18 @@ Global-Hl-Line mode uses the function `global-hl-line-highlight'
on `post-command-hook'.
This is a global minor mode. If called interactively, toggle the
-`Global Hl-Line mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Hl-Line 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.
+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 `(default-value \\='global-hl-line-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-"))
@@ -16777,19 +16855,19 @@ An enhanced `icomplete-mode' that emulates `ido-mode'.
This global minor mode makes minibuffer completion behave
more like `ido-mode' than regular `icomplete-mode'.
-This is a global minor mode. If called interactively, toggle the
-`Fido mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Fido
+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.
+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 `(default-value \\='fido-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar icomplete-mode nil "\
@@ -16817,18 +16895,18 @@ completions:
\\{icomplete-minibuffer-map}
This is a global minor mode. If called interactively, toggle the
-`Icomplete mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Icomplete 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.
+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 `(default-value \\='icomplete-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar icomplete-vertical-mode nil "\
@@ -16849,19 +16927,18 @@ the value of `max-mini-window-height', and the way the mini-window is
resized depends on `resize-mini-windows'.
This is a global minor mode. If called interactively, toggle the
-`Icomplete-Vertical mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Icomplete-Vertical 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.
+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 `(default-value \\='icomplete-vertical-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar fido-vertical-mode nil "\
@@ -16879,18 +16956,18 @@ When turning on, if non-vertical `fido-mode' is off, turn it on.
If it's on, just add the vertical display.
This is a global minor mode. If called interactively, toggle the
-`Fido-Vertical mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Fido-Vertical 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.
+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 `(default-value \\='fido-vertical-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(when (locate-library "obsolete/iswitchb")
@@ -17380,19 +17457,19 @@ See `inferior-emacs-lisp-mode' for details.
(autoload 'iimage-mode "iimage" "\
Toggle Iimage mode on or off.
-This is a minor mode. If called interactively, toggle the
-`Iimage mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Iimage 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.
+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 `iimage-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))
@@ -17464,9 +17541,13 @@ use its file extension as image type.
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:mask MASK'. If the property `:scale' is not given and the
-display has a high resolution (more exactly, when the average width of a
-character in the default font is more than 10 pixels), the image is
+like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for
+the list of supported properties; see the nodes following that node
+for properties specific to certain image types.
+
+If the property `:scale' is not given and the display has a high
+resolution (more exactly, when the average width of a character
+in the default font is more than 10 pixels), the image is
automatically scaled up in proportion to the default font.
Value is the image created, or nil if images of type TYPE are not supported.
@@ -17531,21 +17612,25 @@ BUFFER nil or omitted means use the current buffer.
(fn START END &optional BUFFER)")
(autoload 'find-image "image" "\
-Find an image, choosing one of a list of image specifications.
+Find an image that satisfies one of a list of image specifications.
SPECS is a list of image specifications.
-Each image specification in SPECS is a property list. The contents of
-a specification are image type dependent. All specifications must at
-least contain either the property `:file FILE' or `:data DATA',
-where FILE is the file to load the image from, and DATA is a string
-containing the actual image data. If the property `:type TYPE' is
-omitted or nil, try to determine the image type from its first few
+Each image specification in SPECS is a property list. The
+contents of a specification are image type dependent; see the
+info node `(elisp)Image Descriptors' for details. All specifications
+must at least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file from which to load the image, and DATA is a
+string containing the actual image data. If the property `:type TYPE'
+is omitted or nil, try to determine the image type from its first few
bytes of image data. If that doesn't work, and the property `:file
-FILE' provide a file name, use its file extension as image type.
-If `:type TYPE' is provided, it must match the actual type
-determined for FILE or DATA by `create-image'. Return nil if no
-specification is satisfied.
+FILE' provide a file name, use its file extension as idication of the
+image type. If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'.
+
+The function returns the image specification for the first specification
+in the list whose TYPE is supported and FILE, if specified, exists. It
+returns nil if no specification in the list can be satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
@@ -17762,20 +17847,19 @@ are always available in Dired:
\\[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
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Image-Dired
+minor 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.
+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 `image-dired-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+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-dired" "\
@@ -17881,18 +17965,18 @@ An image file is one whose name has an extension in
`image-file-name-regexps'.
This is a global minor mode. If called interactively, toggle the
-`Auto-Image-File mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Auto-Image-File 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.
+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 `(default-value \\='auto-image-file-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "image-file" '("image-file-"))
@@ -17913,19 +17997,19 @@ Toggle Image minor mode in this buffer.
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], to switch back to
`image-mode' and display an image file as the actual image.
-This is a minor mode. If called interactively, toggle the `Image
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Image minor
+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.
+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 `image-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'image-mode-to-text "image-mode" "\
@@ -18126,19 +18210,18 @@ indented towards the left by the column number at the start of
that text.
This is a global minor mode. If called interactively, toggle the
-`Kill-Ring-Deindent mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Kill-Ring-Deindent 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.
+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 `(default-value \\='kill-ring-deindent-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "indent-aux" '("kill-ring-deindent-buffer-substring-function"))
@@ -18831,19 +18914,19 @@ SPC.
For spell-checking \"on the fly\", not just after typing SPC or
RET, use `flyspell-mode'.
-This is a minor mode. If called interactively, toggle the
-`ISpell minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `ISpell minor
+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.
+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 `ispell-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'ispell-message "ispell" "\
@@ -19049,7 +19132,7 @@ Major mode for editing JSON, powered by tree-sitter.
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 23)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 24)) package--builtin-versions)
(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
@@ -19849,7 +19932,7 @@ For example, in Usenet articles, sections of text quoted from another
author are indented, or have each line start with `>'. To quote a
section of text, define a keyboard macro which inserts `>', put point
and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
+\\[apply-macro-to-region-lines] to mark the entire section.
Suppose you wanted to build a keyword table in C where each entry
looked like this:
@@ -19871,7 +19954,7 @@ and write a macro to massage a word into a table entry:
\\C-x )
and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
+\\[apply-macro-to-region-lines] to build the table from the names.
(fn TOP BOTTOM &optional MACRO)" t)
(define-key ctl-x-map "q" 'kbd-macro-query)
@@ -20033,18 +20116,18 @@ headers (those specified by `mail-abbrev-mode-regexp'), based on
the entries in your `mail-personal-alias-file'.
This is a global minor mode. If called interactively, toggle the
-`Mail-Abbrevs mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Mail-Abbrevs 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.
+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 `(default-value \\='mail-abbrevs-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'mail-abbrevs-setup "mailabbrev" "\
@@ -20360,19 +20443,19 @@ The slave buffer is stored in the buffer-local variable `master-of'.
You can set this variable using `master-set-slave'. You can show
yourself the value of `master-of' by calling `master-show-slave'.
-This is a minor mode. If called interactively, toggle the
-`Master mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Master 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.
+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 `master-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "master" '("master-"))
@@ -20398,18 +20481,18 @@ recursion depth in the minibuffer prompt. This is only useful if
This is a global minor mode. If called interactively, toggle the
`Minibuffer-Depth-Indicate mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+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.
+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 `(default-value \\='minibuffer-depth-indicate-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "mb-depth" '("minibuffer-depth-"))
@@ -20565,7 +20648,7 @@ Major mode for editing MetaPost sources.
;;; Generated autoloads from mh-e/mh-acros.el
-(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating"))
+(register-definition-prefixes "mh-acros" '("mh-" "with-mh-folder-updating"))
;;; Generated autoloads from mh-e/mh-alias.el
@@ -20855,18 +20938,18 @@ or call the function `midnight-mode'.")
Non-nil means run `midnight-hook' at midnight.
This is a global minor mode. If called interactively, toggle the
-`Midnight mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Midnight 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.
+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 `(default-value \\='midnight-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'clean-buffer-list "midnight" "\
@@ -20910,19 +20993,19 @@ such that hitting RET would enter a non-default value, the prompt
is modified to remove the default indication.
This is a global minor mode. If called interactively, toggle the
-`Minibuffer-Electric-Default mode' mode. If the prefix argument
-is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+`Minibuffer-Electric-Default 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.
+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 `(default-value \\='minibuffer-electric-default-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "minibuf-eldef" '("minibuf"))
@@ -21440,19 +21523,19 @@ Toggle Msb mode.
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'.
-This is a global minor mode. If called interactively, toggle the
-`Msb mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the `Msb
+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.
+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 `(default-value \\='msb-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))
@@ -21741,18 +21824,18 @@ or call the function `mouse-wheel-mode'.")
Toggle mouse wheel support (Mouse Wheel mode).
This is a global minor mode. If called interactively, toggle the
-`Mouse-Wheel mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Mouse-Wheel 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.
+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 `(default-value \\='mouse-wheel-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
@@ -22763,7 +22846,7 @@ Coloring:
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 6 13)) package--builtin-versions)
+(push (purecopy '(org 9 6 15)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -23495,19 +23578,19 @@ Toggle Outline minor mode.
See the command `outline-mode' for more information on this mode.
-This is a minor mode. If called interactively, toggle the
-`Outline minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Outline
+minor 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.
+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 `outline-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'outline-search-level "outline" "\
@@ -24118,6 +24201,8 @@ FUN in `pred' and `app' can take one of the forms:
call it with one argument
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
+ (F ARG1 .. _ .. ARGn)
+ call F, passing EXPVAL at the _ position.
FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
@@ -24156,8 +24241,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the
EXP in each binding in BINDINGS can use the results of the destructuring
bindings that precede it in BINDINGS' order.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
(fn BINDINGS &rest BODY)" nil t)
@@ -24170,8 +24255,8 @@ All EXPs are evaluated first, and then used to perform destructuring
bindings by matching each EXP against its respective PATTERN. Then
BODY is evaluated with those bindings in effect.
-Each EXP should match (i.e. be of compatible structure) to its
-respective PATTERN; a mismatch may signal an error or may go
+Each EXP should match its respective PATTERN (i.e. be of structure
+compatible to PATTERN); a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
(fn BINDINGS &rest BODY)" nil t)
@@ -24773,11 +24858,6 @@ they are not by default assigned to keys." t)
(register-definition-prefixes "picture" '("picture-"))
-;;; Generated autoloads from language/pinyin.el
-
-(register-definition-prefixes "pinyin" '("pinyin-character-map"))
-
-
;;; Generated autoloads from textmodes/pixel-fill.el
(register-definition-prefixes "pixel-fill" '("pixel-fill-"))
@@ -24797,18 +24877,18 @@ or call the function `pixel-scroll-mode'.")
A minor mode to scroll text pixel-by-pixel.
This is a global minor mode. If called interactively, toggle the
-`Pixel-Scroll mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Pixel-Scroll 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.
+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 `(default-value \\='pixel-scroll-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'pixel-scroll-precision-scroll-down-page "pixel-scroll" "\
@@ -24838,19 +24918,18 @@ When enabled, this minor mode allows you to scroll the display
precisely, according to the turning of the mouse wheel.
This is a global minor mode. If called interactively, toggle the
-`Pixel-Scroll-Precision mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Pixel-Scroll-Precision 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.
+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 `(default-value \\='pixel-scroll-precision-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "pixel-scroll" '("pixel-"))
@@ -25614,8 +25693,6 @@ requires quoting, e.g. `\\[quoted-insert]<space>'.
(fn REGEXP)" t)
(autoload 'project-or-external-find-regexp "project" "\
Find all matches for REGEXP in the project roots or external roots.
-With \\[universal-argument] prefix, you can specify the file name
-pattern to search for.
(fn REGEXP)" t)
(autoload 'project-find-file "project" "\
@@ -25771,8 +25848,8 @@ Otherwise, `default-directory' is temporarily set to the current
project's root.
If OVERRIDING-MAP is non-nil, it will be used as
-`overriding-local-map' to provide shorter bindings from that map
-which will take priority over the global ones.
+`overriding-terminal-local-map' to provide shorter bindings
+from that map which will take priority over the global ones.
(fn &optional OVERRIDING-MAP PROMPT-FORMAT)" t)
(autoload 'project-prefix-or-any-command "project" "\
@@ -25822,7 +25899,7 @@ line and comments can also be enclosed in /* ... */.
If an optional argument SYSTEM is non-nil, set up mode for the given system.
To find out what version of Prolog mode you are running, enter
-`\\[prolog-mode-version]'.
+\\[prolog-mode-version].
Commands:
\\{prolog-mode-map}
@@ -26452,19 +26529,18 @@ or call the function `rcirc-track-minor-mode'.")
Global minor mode for tracking activity in rcirc buffers.
This is a global minor mode. If called interactively, toggle the
-`Rcirc-Track minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Rcirc-Track minor 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.
+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 `(default-value \\='rcirc-track-minor-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
@@ -26527,18 +26603,18 @@ buffers you switch to a lot, you can say something like the following:
(add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file)
This is a global minor mode. If called interactively, toggle the
-`Recentf mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Recentf 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.
+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 `(default-value \\='recentf-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "recentf" '("recentf-"))
@@ -26669,18 +26745,18 @@ Activates the region if it's inactive and Transient Mark mode is
on. Only lasts until the region is next deactivated.
This is a minor mode. If called interactively, toggle the
-`Rectangle-Mark mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Rectangle-Mark 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.
+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 `rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-"))
@@ -26708,19 +26784,19 @@ auto-filling.
For true \"word wrap\" behavior, use `visual-line-mode' instead.
-This is a minor mode. If called interactively, toggle the
-`Refill mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Refill 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.
+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 `refill-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "refill" '("refill-"))
@@ -26770,19 +26846,19 @@ on the menu bar.
------------------------------------------------------------------------------
-This is a minor mode. If called interactively, toggle the
-`Reftex mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Reftex 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.
+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 `reftex-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'reftex-reset-scanning-information "reftex" "\
@@ -27004,18 +27080,18 @@ keys for repeating.
See `describe-repeat-maps' for a list of all repeatable commands.
This is a global minor mode. If called interactively, toggle the
-`Repeat mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Repeat 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.
+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 `(default-value \\='repeat-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+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" "\
@@ -27091,19 +27167,19 @@ reveals invisible text around point.
Also see the `reveal-auto-hide' variable.
-This is a minor mode. If called interactively, toggle the
-`Reveal mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Reveal 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.
+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 `reveal-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar global-reveal-mode nil "\
@@ -27120,18 +27196,18 @@ Toggle Reveal mode in all buffers (Global Reveal mode).
Reveal mode renders invisible text around point visible again.
This is a global minor mode. If called interactively, toggle the
-`Global Reveal mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global Reveal 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.
+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 `(default-value \\='global-reveal-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "reveal" '("reveal-"))
@@ -27674,19 +27750,19 @@ conventionally have a suffix of `.rnc'). The variable
`rng-schema-locating-files' specifies files containing rules
to use for finding the schema.
-This is a minor mode. If called interactively, toggle the
-`Rng-Validate mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Rng-Validate
+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.
+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 `rng-validate-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rng-valid" '("rng-"))
@@ -27800,19 +27876,19 @@ When ReST minor mode is enabled, the ReST mode keybindings
are installed on top of the major mode bindings. Use this
for modes derived from Text mode, like Mail mode.
-This is a minor mode. If called interactively, toggle the `Rst
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Rst minor
+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.
+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 `rst-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "rst" '("rst-"))
@@ -27860,19 +27936,19 @@ Use the command `ruler-mode' to change this variable.")
(autoload 'ruler-mode "ruler-mode" "\
Toggle display of ruler in header line (Ruler mode).
-This is a minor mode. If called interactively, toggle the `Ruler
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Ruler 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.
+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 `ruler-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "ruler-mode" '("ruler-"))
@@ -28070,7 +28146,8 @@ For more details, see Info node `(elisp) Extending Rx'.
(fn NAME [(ARGS...)] RX)" nil t)
(function-put 'rx-define 'lisp-indent-function 'defun)
-(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.
+(autoload 'rx--pcase-macroexpander "rx" "\
+A pattern that matches strings against `rx' REGEXPS in sexp form.
REGEXPS are interpreted as in `rx'. The pattern matches any
string that is a match for REGEXPS, as if by `string-match'.
@@ -28084,7 +28161,9 @@ following constructs:
(backref REF) matches whatever the submatch REF matched.
REF can be a number, as usual, or a name
introduced by a previous (let REF ...)
- construct." (rx--pcase-expand regexps)))
+ construct.
+
+(fn &rest REGEXPS)")
(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
(define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander)
(autoload 'rx--pcase-expand "rx" "\
@@ -28164,18 +28243,18 @@ Calling it at any other time replaces your current minibuffer
histories, which is probably undesirable.
This is a global minor mode. If called interactively, toggle the
-`Savehist mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Savehist 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.
+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 `(default-value \\='savehist-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "savehist" '("savehist-"))
@@ -28198,18 +28277,18 @@ This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
This is a global minor mode. If called interactively, toggle the
-`Save-Place mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Save-Place 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.
+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 `(default-value \\='save-place-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'save-place-local-mode "saveplace" "\
@@ -28225,19 +28304,18 @@ file:
(save-place-mode 1)
This is a minor mode. If called interactively, toggle the
-`Save-Place-Local mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Save-Place-Local 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.
+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 `save-place-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "saveplace" '("save-place"))
@@ -28324,18 +28402,18 @@ When Scroll-All mode is enabled, scrolling commands invoked in
one window apply to all visible windows in the same frame.
This is a global minor mode. If called interactively, toggle the
-`Scroll-All mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Scroll-All 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.
+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 `(default-value \\='scroll-all-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "scroll-all" '("scroll-all-"))
@@ -28359,19 +28437,19 @@ boundaries during scrolling.
Note that the default key binding to `scroll' will not work on
MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
-This is a minor mode. If called interactively, toggle the
-`Scroll-Lock mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Scroll-Lock
+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.
+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 `scroll-lock-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "scroll-lock" '("scroll-lock-"))
@@ -28435,18 +28513,18 @@ Semantic mode.
\\{semantic-mode-map}
This is a global minor mode. If called interactively, toggle the
-`Semantic mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Semantic 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.
+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 `(default-value \\='semantic-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
@@ -28755,18 +28833,18 @@ Server mode runs a process that accepts commands from the
`server-start' for details.
This is a global minor mode. If called interactively, toggle the
-`Server mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Server 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.
+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 `(default-value \\='server-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'server-save-buffers-kill-terminal "server" "\
@@ -29107,6 +29185,10 @@ Make the shell buffer the current buffer, and return it.
;;; Generated autoloads from emacs-lisp/shortdoc.el
+(autoload 'shortdoc--check "shortdoc" "\
+
+
+(fn GROUP FUNCTIONS)")
(defvar shortdoc--groups nil)
(defmacro define-short-documentation-group (group &rest functions) "\
Add GROUP to the list of defined documentation groups.
@@ -29170,7 +29252,7 @@ execution of the documented form depends on some conditions.
A FUNC form can have any number of `:no-eval' (or `:no-value'),
`:no-eval*', `:result', `:result-string', `:eg-result' and
-`:eg-result-string' properties." (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups)))
+`:eg-result-string' properties." (declare (indent defun)) (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups)))
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
@@ -29435,19 +29517,19 @@ Minor mode to simplify editing output from the diff3 program.
\\{smerge-mode-map}
-This is a minor mode. If called interactively, toggle the
-`SMerge mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `SMerge 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.
+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 `smerge-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'smerge-start-session "smerge-mode" "\
@@ -29550,19 +29632,19 @@ with `so-long-variable-overrides'.
This minor mode is a standard `so-long-action' option.
-This is a minor mode. If called interactively, toggle the
-`So-Long minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `So-Long
+minor 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.
+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 `so-long-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'so-long-mode "so-long" "\
@@ -29640,18 +29722,18 @@ Use \\[so-long-customize] to open the customization group `so-long' to
configure the behavior.
This is a global minor mode. If called interactively, toggle the
-`Global So-Long mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Global So-Long 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.
+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 `(default-value \\='global-so-long-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "so-long" '("so-long-" "turn-o"))
@@ -29888,6 +29970,24 @@ For example: to sort lines in the region by the first word on each line
RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\"
(fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t)
+(autoload 'sort-on "sort" "\
+Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR.
+SEQUENCE should be the input sequence to sort.
+Elements of SEQUENCE are sorted by keys which are obtained by
+calling ACCESSOR on each element. ACCESSOR should be a function of
+one argument, an element of SEQUENCE, and should return the key
+value to be compared by PREDICATE for sorting the element.
+PREDICATE is the function for comparing keys; it is called with two
+arguments, the keys to compare, and should return non-nil if the
+first key should sort before the second key.
+The return value is always a new list.
+This function has the performance advantage of evaluating
+ACCESSOR only once for each element in the input SEQUENCE, and is
+therefore appropriate when computing the key by ACCESSOR is an
+expensive operation. This is known as the \"decorate-sort-undecorate\"
+paradigm, or the Schwartzian transform.
+
+(fn SEQUENCE PREDICATE ACCESSOR)")
(autoload 'sort-columns "sort" "\
Sort lines in region alphabetically by a certain range of columns.
For the purpose of this command, the region BEG...END includes
@@ -30667,18 +30767,18 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
\\{strokes-mode-map}
This is a global minor mode. If called interactively, toggle the
-`Strokes mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Strokes 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.
+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 `(default-value \\='strokes-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'strokes-decode-buffer "strokes" "\
@@ -30798,19 +30898,19 @@ called a `subword'. Here are some examples:
This mode changes the definition of a word so that word commands
treat nomenclature boundaries as word boundaries.
-This is a minor mode. If called interactively, toggle the
-`Subword mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Subword
+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.
+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 `subword-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-subword-mode 'globalized-minor-mode t)
@@ -30847,19 +30947,19 @@ syntax are treated as parts of words: e.g., in `superword-mode',
\\{superword-mode-map}
-This is a minor mode. If called interactively, toggle the
-`Superword mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Superword
+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.
+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 `superword-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-superword-mode 'globalized-minor-mode t)
@@ -30951,18 +31051,18 @@ mouse to transfer text between Emacs and other programs which use
GPM. This is due to limitations in GPM and the Linux kernel.
This is a global minor mode. If called interactively, toggle the
-`Gpm-Mouse mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Gpm-Mouse 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.
+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 `(default-value \\='gpm-mouse-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "t-mouse" '("gpm-mouse-"))
@@ -30973,19 +31073,19 @@ it is disabled.
(autoload 'tab-line-mode "tab-line" "\
Toggle display of tab line in the windows displaying the current buffer.
-This is a minor mode. If called interactively, toggle the
-`Tab-Line mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Tab-Line
+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.
+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 `tab-line-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(defvar-local tab-line-exclude nil)
@@ -31057,19 +31157,18 @@ variable's value can be toggled by \\[table-fixed-width-mode] at
run-time.
This is a minor mode. If called interactively, toggle the
-`Table-Fixed-Width mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Table-Fixed-Width 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.
+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 `table-fixed-width-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'table-insert "table" "\
@@ -31926,6 +32025,9 @@ such as if there are no commands in the file, the value of `tex-default-mode'
says which mode to use.
(fn)" t)
+ (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode))
+ (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode))
+ (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode))
(defalias 'TeX-mode #'tex-mode)
(defalias 'plain-TeX-mode #'plain-tex-mode)
(defalias 'LaTeX-mode #'latex-mode)
@@ -32475,19 +32577,19 @@ When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
representation for current major mode, the `tildify-space-string' buffer-local
variable will be set to the representation.
-This is a minor mode. If called interactively, toggle the
-`Tildify mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Tildify
+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.
+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 `tildify-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "tildify" '("tildify-"))
@@ -32523,25 +32625,25 @@ non-nil, the current day and date are displayed as well. This
runs the normal hook `display-time-hook' after each update.
This is a global minor mode. If called interactively, toggle the
-`Display-Time mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Display-Time 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.
+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 `(default-value \\='display-time-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
(autoload 'world-clock "time" "\
Display a world clock buffer with times in various time zones.
The variable `world-clock-list' specifies which time zones to use.
-To turn off the world time display, go to the window and type `\\[quit-window]'." t)
+To turn off the world time display, go to the window and type \\[quit-window]." t)
(autoload 'emacs-uptime "time" "\
Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
@@ -32822,21 +32924,16 @@ List all timers in a buffer.
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
-Convert a TIT dictionary of FILENAME into a Quail package.
-Optional argument DIRNAME if specified is the directory name under which
-the generated Quail package is saved.
-(fn FILENAME &optional DIRNAME)" t)
+
+(fn FILENAME &optional DIRNAME)")
+(make-obsolete 'titdic-convert 'tit-dic-convert "30.1")
(autoload 'batch-titdic-convert "titdic-cnv" "\
-Run `titdic-convert' on the files remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs.
-For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
- generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
-To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
+
(fn &optional FORCE)")
-(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter"))
+(make-obsolete 'batch-titdic-convert 'batch-tit-dic-convert "30.1")
+(register-definition-prefixes "titdic-cnv" '("batch-tit-" "tit-"))
;;; Generated autoloads from tmm.el
@@ -32914,7 +33011,7 @@ current (i.e., last displayed) category.
In Todo mode just the category's unfinished todo items are shown
by default. The done items are hidden, but typing
-`\\[todo-toggle-view-done-items]' displays them below the todo
+\\[todo-toggle-view-done-items] displays them below the todo
items. With non-nil user option `todo-show-with-done' both todo
and done items are always shown on visiting a category.
@@ -33013,6 +33110,61 @@ holds a keymap.
(register-definition-prefixes "tooltip" '("tooltip-"))
+;;; Generated autoloads from touch-screen.el
+
+(autoload 'touch-screen-hold "touch-screen" "\
+Handle a long press EVENT.
+Ding and select the window at EVENT, then activate the mark. If
+`touch-screen-word-select' is enabled, try to select the whole
+word around EVENT; otherwise, set point to the location of EVENT.
+
+(fn EVENT)" t)
+(autoload 'touch-screen-track-tap "touch-screen" "\
+Track a single tap starting from EVENT.
+EVENT should be a `touchscreen-begin' event.
+
+Read touch screen events until a `touchscreen-end' event is
+received with the same ID as in EVENT. If UPDATE is non-nil and
+a `touchscreen-update' event is received in the mean time and
+contains a touch point with the same ID as in EVENT, call UPDATE
+with that event and DATA.
+
+If THRESHOLD is non-nil, enforce a threshold of movement that is
+either itself or 10 pixels when it is not a number. If the
+aforementioned touch point moves beyond that threshold on any
+axis, return nil immediately, and further resume mouse event
+translation for the touch point at hand.
+
+Return nil immediately if any other kind of event is received;
+otherwise, return t once the `touchscreen-end' event arrives.
+
+(fn EVENT &optional UPDATE DATA THRESHOLD)")
+(autoload 'touch-screen-track-drag "touch-screen" "\
+Track a single drag starting from EVENT.
+EVENT should be a `touchscreen-begin' event.
+
+Read touch screen events until a `touchscreen-end' event is
+received with the same ID as in EVENT. For each
+`touchscreen-update' event received in the mean time containing a
+touch point with the same ID as in EVENT, call UPDATE with the
+touch point in event and DATA, once the touch point has moved
+significantly by at least 5 pixels from where it was in EVENT.
+
+Return nil immediately if any other kind of event is received;
+otherwise, return either t or `no-drag' once the
+`touchscreen-end' event arrives; return `no-drag' returned if the
+touch point in EVENT did not move significantly, and t otherwise.
+
+(fn EVENT UPDATE &optional DATA)")
+(autoload 'touch-screen-inhibit-drag "touch-screen" "\
+Inhibit subsequent `touchscreen-drag' events from being sent.
+Prevent `touchscreen-drag' and translated mouse events from being
+sent until the touch sequence currently being translated ends.
+Must be called from a command bound to a `touchscreen-hold' or
+`touchscreen-drag' event.")
+(register-definition-prefixes "touch-screen" '("touch-screen-"))
+
+
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
@@ -33224,55 +33376,13 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 7 1 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
;;; Generated autoloads from transient.el
(push (purecopy '(transient 0 5 2)) package--builtin-versions)
-(autoload 'transient-define-prefix "transient" "\
-Define NAME as a transient prefix command.
-
-ARGLIST are the arguments that command takes.
-DOCSTRING is the documentation string and is optional.
-
-These arguments can optionally be followed by key-value pairs.
-Each key has to be a keyword symbol, either `:class' or a keyword
-argument supported by the constructor of that class. The
-`transient-prefix' class is used if the class is not specified
-explicitly.
-
-GROUPs add key bindings for infix and suffix commands and specify
-how these bindings are presented in the popup buffer. At least
-one GROUP has to be specified. See info node `(transient)Binding
-Suffix and Infix Commands'.
-
-The BODY is optional. If it is omitted, then ARGLIST is also
-ignored and the function definition becomes:
-
- (lambda ()
- (interactive)
- (transient-setup \\='NAME))
-
-If BODY is specified, then it must begin with an `interactive'
-form that matches ARGLIST, and it must call `transient-setup'.
-It may however call that function only when some condition is
-satisfied; that is one of the reason why you might want to use
-an explicit BODY.
-
-All transients have a (possibly nil) value, which is exported
-when suffix commands are called, so that they can consume that
-value. For some transients it might be necessary to have a sort
-of secondary value, called a scope. Such a scope would usually
-be set in the commands `interactive' form and has to be passed
-to the setup function:
-
- (transient-setup \\='NAME nil nil :scope SCOPE)
-
-(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" nil t)
-(function-put 'transient-define-prefix 'lisp-indent-function 'defun)
-(function-put 'transient-define-prefix 'doc-string-elt 3)
(autoload 'transient-insert-suffix "transient" "\
Insert a SUFFIX into PREFIX before LOC.
PREFIX is a prefix command, a symbol.
@@ -33517,18 +33627,18 @@ sessions and after a crash. Manual changes to the file may result in
problems.
This is a global minor mode. If called interactively, toggle the
-`Type-Break mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Type-Break 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.
+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 `(default-value \\='type-break-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'type-break "type-break" "\
@@ -33914,18 +34024,18 @@ and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
that URL in a buffer.
This is a global minor mode. If called interactively, toggle the
-`Url-Handler mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Url-Handler 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.
+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 `(default-value \\='url-handler-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'url-file-handler "url-handlers" "\
@@ -34012,10 +34122,7 @@ URL can be a URL string, or a URL record of the type returned by
;;; Generated autoloads from url/url-mailto.el
-(autoload 'url-mail "url-mailto" "\
-
-
-(fn &rest ARGS)" t)
+(defalias 'url-mail #'message-mail)
(autoload 'url-mailto "url-mailto" "\
Handle the mailto: URL syntax.
@@ -34478,7 +34585,6 @@ Normalize arguments to delight.
;;; Generated autoloads from use-package/use-package-ensure-system-package.el
-(push (purecopy '(use-package-ensure-system-package 0 2)) package--builtin-versions)
(autoload 'use-package-normalize/:ensure-system-package "use-package-ensure-system-package" "\
Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND).
@@ -35192,6 +35298,25 @@ case, and the process object in the asynchronous case.
(progn
(load "vc-git" nil t)
(vc-git-registered file))))
+(autoload 'vc-git-grep "vc-git" "\
+Run git grep, searching for REGEXP in FILES in directory DIR.
+The search is limited to file names matching shell pattern FILES.
+FILES may use abbreviations defined in `grep-files-aliases', e.g.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
+
+With \\[universal-argument] prefix, you can edit the constructed shell command line
+before it is executed.
+With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
+
+Collect output in a buffer. While git grep runs asynchronously, you
+can use \\[next-error] (`next-error'), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
+to go to the lines where grep found matches.
+
+This command shares argument histories with \\[rgrep] and \\[grep].
+
+(fn REGEXP &optional FILES DIR)" t)
(register-definition-prefixes "vc-git" '("vc-"))
@@ -35317,7 +35442,7 @@ Key bindings:
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2023 6 6 141322628)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2024 3 1 121933719)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
\\<verilog-mode-map>
@@ -35592,7 +35717,7 @@ Usage:
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
+ tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to
tabs and vice versa.
Syntax-based indentation can be very slow in large files. Option
@@ -35903,7 +36028,7 @@ Usage:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
+ customization group `vhdl-highlight-faces' (\\[customize-group]). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
@@ -35963,14 +36088,14 @@ Usage:
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `\\[customize-option]'
- (`\\[customize-group]' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command \\[customize-option]
+ (\\[customize-group] for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`\\[vhdl-customize]' or menu)!
+ what other useful user options there are (\\[vhdl-customize] or menu)!
FILE EXTENSIONS:
@@ -35999,7 +36124,7 @@ Usage:
Maintenance:
------------
-To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
+To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
@@ -36264,19 +36389,19 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th
Entry to view-mode runs the normal hook `view-mode-hook'.
-This is a minor mode. If called interactively, toggle the `View
-mode' mode. If the prefix argument is positive, enable the mode,
-and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `View 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.
+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 `view-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'view-mode-enter "view" "\
@@ -36351,6 +36476,57 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t)
(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
+;;; Generated autoloads from visual-wrap.el
+
+(autoload 'visual-wrap-prefix-mode "visual-wrap" "\
+Display continuation lines with prefixes from surrounding context.
+
+To enable this minor mode across all buffers, enable
+`global-visual-wrap-prefix-mode'.
+
+This is a minor mode. If called interactively, toggle the
+`Visual-Wrap-Prefix 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 `visual-wrap-prefix-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(put 'global-visual-wrap-prefix-mode 'globalized-minor-mode t)
+(defvar global-visual-wrap-prefix-mode nil "\
+Non-nil if Global Visual-Wrap-Prefix mode is enabled.
+See the `global-visual-wrap-prefix-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-visual-wrap-prefix-mode'.")
+(custom-autoload 'global-visual-wrap-prefix-mode "visual-wrap" nil)
+(autoload 'global-visual-wrap-prefix-mode "visual-wrap" "\
+Toggle Visual-Wrap-Prefix mode in all buffers.
+With prefix ARG, enable Global Visual-Wrap-Prefix 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.
+
+Visual-Wrap-Prefix mode is enabled in all buffers where
+`visual-wrap-prefix-mode' would do it.
+
+See `visual-wrap-prefix-mode' for more information on
+Visual-Wrap-Prefix mode.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "visual-wrap" '("visual-wrap-"))
+
+
;;; Generated autoloads from emacs-lisp/vtable.el
(register-definition-prefixes "vtable" '("vtable"))
@@ -36532,18 +36708,18 @@ current function name is continuously displayed in the mode line,
in certain major modes.
This is a global minor mode. If called interactively, toggle the
-`Which-Function mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Which-Function 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.
+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 `(default-value \\='which-function-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "which-func" '("which-func"))
@@ -36561,19 +36737,19 @@ See also `whitespace-style', `whitespace-newline' and
This mode uses a number of faces to visualize the whitespace; see
the customization group `whitespace' for details.
-This is a minor mode. If called interactively, toggle the
-`Whitespace mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Whitespace
+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.
+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 `whitespace-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'whitespace-newline-mode "whitespace" "\
@@ -36587,19 +36763,18 @@ use `whitespace-mode'.
See also `whitespace-newline' and `whitespace-display-mappings'.
This is a minor mode. If called interactively, toggle the
-`Whitespace-Newline mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Whitespace-Newline 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.
+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 `whitespace-newline-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-whitespace-mode 'globalized-minor-mode t)
@@ -36646,18 +36821,18 @@ See also `whitespace-newline' and `whitespace-display-mappings'.
This is a global minor mode. If called interactively, toggle the
`Global Whitespace-Newline mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+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.
+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 `(default-value \\='global-whitespace-newline-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'whitespace-toggle-options "whitespace" "\
@@ -36961,19 +37136,19 @@ Show widget browser for WIDGET in other window.
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
-This is a minor mode. If called interactively, toggle the
-`Widget minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Widget minor
+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.
+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 `widget-minor-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "wid-browse" '("widget-"))
@@ -37068,18 +37243,18 @@ for a description of this minor mode.")
Global minor mode for default windmove commands.
This is a global minor mode. If called interactively, toggle the
-`Windmove mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Windmove 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.
+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 `(default-value \\='windmove-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(autoload 'windmove-default-keybindings "windmove" "\
@@ -37215,18 +37390,18 @@ sequence \\`C-c <left>'. If you change your mind (while undoing),
you can press \\`C-c <right>' (calling `winner-redo').
This is a global minor mode. If called interactively, toggle the
-`Winner mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Winner 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.
+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 `(default-value \\='winner-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "winner" '("winner-"))
@@ -37294,19 +37469,18 @@ Allow `word-wrap' to fold on all breaking whitespace characters.
The characters to break on are defined by `word-wrap-whitespace-characters'.
This is a minor mode. If called interactively, toggle the
-`Word-Wrap-Whitespace mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+`Word-Wrap-Whitespace 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.
+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 `word-wrap-whitespace-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t)
@@ -37557,18 +37731,18 @@ mouse functionality for such clicks is still available by holding
down the SHIFT key while pressing the mouse button.
This is a global minor mode. If called interactively, toggle the
-`Xterm-Mouse mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Xterm-Mouse 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.
+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 `(default-value \\='xterm-mouse-mode)'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-"))
@@ -37652,99 +37826,9 @@ run a specific program. The program must be a member of
(register-definition-prefixes "zone" '("zone-"))
-;;; Generated autoloads from emacs-lisp/ert-font-lock.el
-
-(autoload 'ert-font-lock-deftest "ert-font-lock" "\
-Define test NAME (a symbol) using assertions from TEST-STR.
-
-Other than MAJOR-MODE and TEST-STR parameters, this macro accepts
-the same parameters and keywords as `ert-deftest' and is intended
-to be used through `ert'.
-
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t)
-(function-put 'ert-font-lock-deftest 'doc-string-elt 3)
-(function-put 'ert-font-lock-deftest 'lisp-indent-function 2)
-(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\
-Define test NAME (a symbol) using assertions from FILE.
-
-FILE - path to a file with assertions in ERT resource director as
-return by `ert-resource-directory'.
-
-Other than MAJOR-MODE and FILE parameters, this macro accepts the
-same parameters and keywords as `ert-deftest' and is intended to
-be used through `ert'.
-
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t)
-(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3)
-(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2)
-(autoload 'ert-font-lock-test-string "ert-font-lock" "\
-Check font faces in TEST-STRING set by MODE.
-
-The function is meant to be run from within an ERT test.
-
-(fn TEST-STRING MODE)")
-(autoload 'ert-font-lock-test-file "ert-font-lock" "\
-Check font faces in FILENAME set by MODE.
-
-The function is meant to be run from within an ERT test.
-
-(fn FILENAME MODE)")
-(register-definition-prefixes "ert-font-lock" '("ert-font-lock--"))
-
-
-;;; Generated autoloads from touch-screen.el
-
-(autoload 'touch-screen-hold "touch-screen" "\
-Handle a long press EVENT.
-Ding and select the window at EVENT, then activate the mark. If
-`touch-screen-word-select' is enabled, try to select the whole
-word around EVENT; otherwise, set point to the location of EVENT.
-
-(fn EVENT)" t)
-(autoload 'touch-screen-track-tap "touch-screen" "\
-Track a single tap starting from EVENT.
-EVENT should be a `touchscreen-begin' event.
-
-Read touch screen events until a `touchscreen-end' event is
-received with the same ID as in EVENT. If UPDATE is non-nil and
-a `touchscreen-update' event is received in the mean time and
-contains a touch point with the same ID as in EVENT, call UPDATE
-with that event and DATA.
-
-If THRESHOLD is non-nil, enforce a threshold of movement that is
-either itself or 10 pixels when it is not a number. If the
-aforementioned touch point moves beyond that threshold on any
-axis, return nil immediately, and further resume mouse event
-translation for the touch point at hand.
-
-Return nil immediately if any other kind of event is received;
-otherwise, return t once the `touchscreen-end' event arrives.
-
-(fn EVENT &optional UPDATE DATA THRESHOLD)")
-(autoload 'touch-screen-track-drag "touch-screen" "\
-Track a single drag starting from EVENT.
-EVENT should be a `touchscreen-begin' event.
-
-Read touch screen events until a `touchscreen-end' event is
-received with the same ID as in EVENT. For each
-`touchscreen-update' event received in the mean time containing a
-touch point with the same ID as in EVENT, call UPDATE with the
-touch point in event and DATA, once the touch point has moved
-significantly by at least 5 pixels from where it was in EVENT.
+;;; Generated autoloads from net/tramp-androidsu.el
-Return nil immediately if any other kind of event is received;
-otherwise, return either t or `no-drag' once the
-`touchscreen-end' event arrives; return `no-drag' returned if the
-touch point in EVENT did not move significantly, and t otherwise.
-
-(fn EVENT UPDATE &optional DATA)")
-(autoload 'touch-screen-inhibit-drag "touch-screen" "\
-Inhibit subsequent `touchscreen-drag' events from being sent.
-Prevent `touchscreen-drag' and translated mouse events from being
-sent until the touch sequence currently being translated ends.
-Must be called from a command bound to a `touchscreen-hold' or
-`touchscreen-drag' event.")
-(register-definition-prefixes "touch-screen" '("touch-screen-"))
+(register-definition-prefixes "tramp-androidsu" '("tramp-androidsu-"))
;;; End of scraped data
@@ -37754,8 +37838,8 @@ Must be called from a command bound to a `touchscreen-hold' or
;; Local Variables:
;; version-control: never
;; no-update-autoloads: t
-;; no-byte-compile: t
;; no-native-compile: t
+;; no-byte-compile: t
;; coding: utf-8-emacs-unix
;; End:
diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el
index 577898f82bd..60c88221a65 100644
--- a/lisp/leim/quail/cyrillic.el
+++ b/lisp/leim/quail/cyrillic.el
@@ -1101,9 +1101,9 @@ as follows.
;; Ognyan Kulev <ogi@fmi.uni-sofia.bg> wrote:
;; I would suggest future `cyrillic-translit' to be with the
-;; modification of `cyrillic-translit-bulgarian' applied and the
+;; modification of `cyrillic-translit-bulgarian' (now deleted) applied and the
;; latter to disappear. It could be used by people who write
-;; bulgarian e-mails with latin letters for kick start (phonetic input
+;; Bulgarian e-mails with latin letters for kick start (phonetic input
;; method is not so obvious as translit input method but each letter
;; is one keypress and a *lot* of people know it).
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index c1348081d58..9ea23ec087c 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -476,7 +476,7 @@ Full key sequences are listed below:"
(defgroup tamil-input nil
"Translation rules for the Tamil input method."
:prefix "tamil-"
- :group 'leim)
+ :group 'quail)
(defcustom tamil-translation-rules
;; Vowels.
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index 0d2c1888426..25e7c4a64a8 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -1616,6 +1616,7 @@ Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
;; Italian (itln)
;; Spanish (spnsh)
;; Dvorak (dvorak)
+;; Colemak (colemak)
;;
;;; 92.12.15 created for Mule Ver.0.9.6 by Takahashi N. <ntakahas@etl.go.jp>
;;; 92.12.29 modified by Takahashi N. <ntakahas@etl.go.jp>
@@ -2224,6 +2225,55 @@ Dead accent is right to Ʀ." nil t t t t nil nil nil nil nil t)
("?" ?Z)
)
+;;
+(quail-define-package
+ "english-colemak" "English" "CM@" t
+ "English (ASCII) input method simulating Colemak keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~
+;; qQ wW fF pP gG jJ lL uU yY ;: [{ ]}
+;; aA rR sS tT dD hH nN eE iI oO '" \|
+;; zZ xX cC vV bB kK mM ,< .> /?
+
+(quail-define-rules
+ ("e" ?f)
+ ("r" ?p)
+ ("t" ?g)
+ ("y" ?j)
+ ("u" ?l)
+ ("i" ?u)
+ ("o" ?y)
+ ("p" ?\;)
+ ("s" ?r)
+ ("d" ?s)
+ ("f" ?t)
+ ("g" ?d)
+ ("j" ?n)
+ ("k" ?e)
+ ("l" ?i)
+ (";" ?o)
+ ("n" ?k)
+
+ ("E" ?F)
+ ("R" ?P)
+ ("T" ?G)
+ ("Y" ?J)
+ ("U" ?L)
+ ("I" ?U)
+ ("O" ?Y)
+ ("P" ?\:)
+ ("S" ?R)
+ ("D" ?S)
+ ("F" ?T)
+ ("G" ?D)
+ ("J" ?N)
+ ("K" ?E)
+ ("L" ?I)
+ (":" ?O)
+ ("N" ?K)
+ )
+
(quail-define-package
"latin-postfix" "Latin" "L<" t
"Latin character input method with postfix modifiers.
diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el
index de61481d7f1..676b3ab5c2e 100644
--- a/lisp/leim/quail/persian.el
+++ b/lisp/leim/quail/persian.el
@@ -500,7 +500,7 @@
;; RIGHT-TO-LEFT EMBEDDING (sets base dir to RTL but allows embedded text)
("&rle;" ?\u202B) ;; (ucs-insert #x202B) named: Ų²ŪŒŲ±Ł…ŲŖŁ†Ł Ų±Ų§Ų³ŲŖā€ŒŲØŁ‡ā€ŒŚ†Ł¾
;; POP DIRECTIONAL FORMATTING (used for RLE or LRE and RLO or LRO)
- ;; EMACS ANOMOLY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan)
+ ;; EMACS ANOMALY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan)
("&pdf;" ?\u202C) ;; (ucs-insert #x202C) named: Ł¾Ų§ŪŒŲ§Ł†Ł Ų²ŪŒŲ±Ł…ŲŖŁ†
("P" ?\u202C)
;; LEFT-TO-RIGHT OVERRIDE (overrides the bidirectional algorithm, display LTR)
diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el
index 59d1a82eb21..ae5941cbfc7 100644
--- a/lisp/leim/quail/vnvni.el
+++ b/lisp/leim/quail/vnvni.el
@@ -125,8 +125,8 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("A61" ?įŗ¤) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
("a62" ?įŗ§) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
("A62" ?įŗ¦) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
- ("a63" ?įŗ©) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
- ("A63" ?įŗØ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("a63" ?įŗ©) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+ ("A63" ?įŗØ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
("a64" ?įŗ«) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
("A64" ?įŗŖ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
("a65" ?įŗ­) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
@@ -135,42 +135,42 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("A81" ?įŗ®) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
("a82" ?įŗ±) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
("A82" ?įŗ°) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
- ("a83" ?įŗ³) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE
- ("A83" ?įŗ²) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE
+ ("a83" ?įŗ³) ; LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+ ("A83" ?įŗ²) ; LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
("a84" ?įŗµ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
("A84" ?įŗ“) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
("a85" ?įŗ·) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
("A85" ?įŗ¶) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
("e5" ?įŗ¹) ; LATIN SMALL LETTER E WITH DOT BELOW
("E5" ?įŗø) ; LATIN CAPITAL LETTER E WITH DOT BELOW
- ("e3" ?įŗ») ; LATIN SMALL LETTER E WITH HO6K ABOVE
- ("E3" ?įŗŗ) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE
+ ("e3" ?įŗ») ; LATIN SMALL LETTER E WITH HOOK ABOVE
+ ("E3" ?įŗŗ) ; LATIN CAPITAL LETTER E WITH HOOK ABOVE
("e4" ?įŗ½) ; LATIN SMALL LETTER E WITH TILDE
("E4" ?įŗ¼) ; LATIN CAPITAL LETTER E WITH TILDE
("e61" ?įŗæ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
("E61" ?įŗ¾) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
("e62" ?į») ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
("E62" ?į»€) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
- ("e63" ?į»ƒ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
- ("E63" ?į»‚) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("e63" ?į»ƒ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+ ("E63" ?į»‚) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
("e64" ?į»…) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
("E64" ?į»„) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
("e65" ?į»‡) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
("E65" ?į»†) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
- ("i3" ?į»‰) ; LATIN SMALL LETTER I WITH HO6K ABOVE
- ("I3" ?į»ˆ) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE
+ ("i3" ?į»‰) ; LATIN SMALL LETTER I WITH HOOK ABOVE
+ ("I3" ?į»ˆ) ; LATIN CAPITAL LETTER I WITH HOOK ABOVE
("i5" ?į»‹) ; LATIN SMALL LETTER I WITH DOT BELOW
("I5" ?į»Š) ; LATIN CAPITAL LETTER I WITH DOT BELOW
("o5" ?į») ; LATIN SMALL LETTER O WITH DOT BELOW
("O5" ?į»Œ) ; LATIN CAPITAL LETTER O WITH DOT BELOW
- ("o3" ?į») ; LATIN SMALL LETTER O WITH HO6K ABOVE
- ("O3" ?į»Ž) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE
+ ("o3" ?į») ; LATIN SMALL LETTER O WITH HOOK ABOVE
+ ("O3" ?į»Ž) ; LATIN CAPITAL LETTER O WITH HOOK ABOVE
("o61" ?į»‘) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
("O61" ?į») ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
("o62" ?į»“) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
("O62" ?į»’) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
- ("o63" ?į»•) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
- ("O63" ?į»”) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("o63" ?į»•) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+ ("O63" ?į»”) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
("o64" ?į»—) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
("O64" ?į»–) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
("o65" ?į»™) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7
@@ -179,22 +179,22 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("O71" ?į»š) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
("o72" ?į») ; LATIN SMALL LETTER O WITH HORN AND GRAVE
("O72" ?į»œ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
- ("o73" ?į»Ÿ) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE
- ("O73" ?į»ž) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE
+ ("o73" ?į»Ÿ) ; LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+ ("O73" ?į»ž) ; LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
("o74" ?į»”) ; LATIN SMALL LETTER O WITH HORN AND TILDE
("O74" ?į» ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
("o75" ?į»£) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7
("O75" ?į»¢) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7
("u5" ?į»„) ; LATIN SMALL LETTER U WITH DOT BELO7
("U5" ?į»¤) ; LATIN CAPITAL LETTER U WITH DOT BELO7
- ("u3" ?į»§) ; LATIN SMALL LETTER U WITH HO6K ABOVE
- ("U3" ?į»¦) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE
+ ("u3" ?į»§) ; LATIN SMALL LETTER U WITH HOOK ABOVE
+ ("U3" ?į»¦) ; LATIN CAPITAL LETTER U WITH HOOK ABOVE
("u71" ?į»©) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
("U71" ?į»Ø) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
("u72" ?į»«) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
("U72" ?į»Ŗ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
- ("u73" ?į»­) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE
- ("U73" ?į»¬) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE
+ ("u73" ?į»­) ; LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+ ("U73" ?į»¬) ; LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
("u74" ?į»Æ) ; LATIN SMALL LETTER U WITH HORN AND TILDE
("U74" ?į»®) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
("u75" ?į»±) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7
@@ -203,20 +203,20 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("Y2" ?į»²) ; LATIN CAPITAL LETTER Y WITH GRAVE
("y5" ?į»µ) ; LATIN SMALL LETTER Y WITH DOT BELO7
("Y5" ?į»“) ; LATIN CAPITAL LETTER Y WITH DOT BELO7
- ("y3" ?į»·) ; LATIN SMALL LETTER Y WITH HO6K ABOVE
- ("Y3" ?į»¶) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE
+ ("y3" ?į»·) ; LATIN SMALL LETTER Y WITH HOOK ABOVE
+ ("Y3" ?į»¶) ; LATIN CAPITAL LETTER Y WITH HOOK ABOVE
("y4" ?į»¹) ; LATIN SMALL LETTER Y WITH TILDE
("Y4" ?į»ø) ; LATIN CAPITAL LETTER Y WITH TILDE
("d9" ?đ) ; LATIN SMALL LETTER D WITH STROKE
("D9" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE
;("$$" ?ā‚«) ; U+20AB DONG SIGN (#### check)
- ("a22" ["a22"])
+ ("a22" ["a2"])
("A22" ["A2"])
("a11" ["a1"])
("A11" ["A1"])
- ("a66"' ["a6"])
- ("A66"' ["A6"])
+ ("a66" ["a6"])
+ ("A66" ["A6"])
("a44" ["a4"])
("A44" ["A4"])
("e22" ["e2"])
@@ -248,7 +248,7 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("i44" ["i4"])
("I44" ["I4"])
("u44" ["u4"])
- ("U44" ["u4"])
+ ("U44" ["U4"])
("o77" ["o7"])
("O77" ["O7"])
("u77" ["u7"])
@@ -283,7 +283,7 @@ and postfix: E66 -> E6, a55 -> a5, etc.
("Y33" ["Y3"])
("y44" ["y4"])
("Y44" ["Y4"])
- ("d9" ["d9"])
+ ("d99" ["d9"])
("D99" ["D9"])
;("$$$" ["$$"])
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c498c0e53af..c6a8dcbb909 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -635,6 +635,8 @@ directory got moved. This is set to be a pair in the form of:
(unwind-protect
(let ((tmp-dump-mode dump-mode)
(dump-mode nil)
+ ;; Set `lexical-binding' to nil by default
+ ;; in the dumped Emacs.
(lexical-binding nil))
(if (member tmp-dump-mode '("pdump" "pbootstrap"))
(dump-emacs-portable (expand-file-name output invocation-directory))
diff --git a/lisp/locate.el b/lisp/locate.el
index d86e7fa678f..70328d5184e 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -559,7 +559,7 @@ do not work in subdirectories.
(defun locate-tags ()
"Visit a tags table in `*Locate*' mode."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(let ((tags-table (locate-get-filename)))
(and (y-or-n-p (format "Visit tags table %s? " tags-table))
@@ -589,7 +589,7 @@ locate database using the shell command in `locate-update-command'."
(defun locate-find-directory ()
"Visit the directory of the file mentioned on this line."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(let ((directory-name (locate-get-dirname)))
(if (file-directory-p directory-name)
@@ -601,7 +601,7 @@ locate database using the shell command in `locate-update-command'."
(defun locate-find-directory-other-window ()
"Visit the directory of the file named on this line in other window."
- (interactive)
+ (interactive nil locate-mode)
(if (locate-main-listing-line-p)
(find-file-other-window (locate-get-dirname))
(message "This command only works inside main listing.")))
diff --git a/lisp/macros.el b/lisp/macros.el
index 0a04bad762a..7108a027ca6 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -197,7 +197,7 @@ For example, in Usenet articles, sections of text quoted from another
author are indented, or have each line start with `>'. To quote a
section of text, define a keyboard macro which inserts `>', put point
and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
+\\[apply-macro-to-region-lines] to mark the entire section.
Suppose you wanted to build a keyword table in C where each entry
looked like this:
@@ -219,7 +219,7 @@ and write a macro to massage a word into a table entry:
\\C-x )
and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names."
+\\[apply-macro-to-region-lines] to build the table from the names."
(interactive "r")
(or macro
(progn
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 668cae05521..cfdbc1b2509 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components' works."
;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
(defconst mail-extr-all-top-level-domains
- (let ((ob (make-vector 739 0)))
+ (let ((ob (obarray-make 739)))
(mapc
(lambda (x)
(put (intern (downcase (car x)) ob)
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 68d325ea261..c8006294a7d 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with no entries.)")
;;;###autoload
(defun mail-abbrevs-setup ()
"Initialize use of the `mailabbrev' package."
- (if (and (not (vectorp mail-abbrevs))
+ (if (and (not (obarrayp mail-abbrevs))
(file-exists-p mail-personal-alias-file))
(progn
(setq mail-abbrev-modtime
@@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with no entries.)")
"Read mail aliases from personal mail alias file and set `mail-abbrevs'.
By default this is the file specified by `mail-personal-alias-file'."
(setq file (expand-file-name (or file mail-personal-alias-file)))
- (if (vectorp mail-abbrevs)
+ (if (obarrayp mail-abbrevs)
nil
(setq mail-abbrevs nil)
(define-abbrev-table 'mail-abbrevs '()))
@@ -278,7 +278,7 @@ double-quotes."
;; true, and we do some evil space->comma hacking like /bin/mail does.
(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
;; Read the defaults first, if we have not done so.
- (unless (vectorp mail-abbrevs) (build-mail-abbrevs))
+ (unless (obarrayp mail-abbrevs) (build-mail-abbrevs))
;; strip garbage from front and end
(if (string-match "\\`[ \t\n,]+" definition)
(setq definition (substring definition (match-end 0))))
@@ -355,7 +355,7 @@ double-quotes."
(if mail-abbrev-aliases-need-to-be-resolved
(progn
;; (message "Resolving mail aliases...")
- (if (vectorp mail-abbrevs)
+ (if (obarrayp mail-abbrevs)
(mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs))
(setq mail-abbrev-aliases-need-to-be-resolved nil)
;; (message "Resolving mail aliases... done.")
@@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(defun mail-abbrev-insert-alias (&optional alias)
"Prompt for and insert a mail alias."
(interactive (progn
- (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup))
(list (completing-read "Expand alias: " mail-abbrevs nil t))))
- (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup))
(insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))
(mail-abbrev-expand-hook))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 74cf297c2fc..d422383acdf 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\) subexpressions.")
"\\(" cite-chars "[ \t]*\\)\\)+\\)"
"\\(.*\\)")
(beginning-of-line) (end-of-line)
- (1 font-lock-comment-delimiter-face nil t)
- (5 font-lock-comment-face nil t)))
+ (1 'font-lock-comment-delimiter-face nil t)
+ (5 'font-lock-comment-face nil t)))
'("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
. 'rmail-header-name))))
"Additional expressions to highlight in Rmail mode.")
@@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.")
(defun rmail-pop-to-buffer (&rest args)
"Like `pop-to-buffer', but with `split-width-threshold' set to nil."
(let (split-width-threshold)
- (apply 'pop-to-buffer args)))
+ (apply #'pop-to-buffer args)))
;; Perform BODY in the summary buffer
;; in such a way that its cursor is properly updated in its own window.
@@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the header of the message."
(defvar rmail-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "a" 'rmail-add-label)
- (define-key map "b" 'rmail-bury)
- (define-key map "c" 'rmail-continue)
- (define-key map "d" 'rmail-delete-forward)
- (define-key map "\C-d" 'rmail-delete-backward)
- (define-key map "e" 'rmail-edit-current-message)
+ (define-key map "a" #'rmail-add-label)
+ (define-key map "b" #'rmail-bury)
+ (define-key map "c" #'rmail-continue)
+ (define-key map "d" #'rmail-delete-forward)
+ (define-key map "\C-d" #'rmail-delete-backward)
+ (define-key map "e" #'rmail-edit-current-message)
;; If you change this, change the rmail-resend menu-item's :keys.
- (define-key map "f" 'rmail-forward)
- (define-key map "g" 'rmail-get-new-mail)
- (define-key map "h" 'rmail-summary)
- (define-key map "i" 'rmail-input)
- (define-key map "j" 'rmail-show-message)
- (define-key map "k" 'rmail-kill-label)
- (define-key map "l" 'rmail-summary-by-labels)
- (define-key map "\e\C-h" 'rmail-summary)
- (define-key map "\e\C-l" 'rmail-summary-by-labels)
- (define-key map "\e\C-r" 'rmail-summary-by-recipients)
- (define-key map "\e\C-s" 'rmail-summary-by-regexp)
- (define-key map "\e\C-f" 'rmail-summary-by-senders)
- (define-key map "\e\C-t" 'rmail-summary-by-topic)
- (define-key map "m" 'rmail-mail)
- (define-key map "\em" 'rmail-retry-failure)
- (define-key map "n" 'rmail-next-undeleted-message)
- (define-key map "\en" 'rmail-next-message)
- (define-key map "\e\C-n" 'rmail-next-labeled-message)
- (define-key map "o" 'rmail-output)
- (define-key map "\C-o" 'rmail-output-as-seen)
- (define-key map "p" 'rmail-previous-undeleted-message)
- (define-key map "\ep" 'rmail-previous-message)
- (define-key map "\e\C-p" 'rmail-previous-labeled-message)
- (define-key map "q" 'rmail-quit)
- (define-key map "r" 'rmail-reply)
+ (define-key map "f" #'rmail-forward)
+ (define-key map "g" #'rmail-get-new-mail)
+ (define-key map "h" #'rmail-summary)
+ (define-key map "i" #'rmail-input)
+ (define-key map "j" #'rmail-show-message)
+ (define-key map "k" #'rmail-kill-label)
+ (define-key map "l" #'rmail-summary-by-labels)
+ (define-key map "\e\C-h" #'rmail-summary)
+ (define-key map "\e\C-l" #'rmail-summary-by-labels)
+ (define-key map "\e\C-r" #'rmail-summary-by-recipients)
+ (define-key map "\e\C-s" #'rmail-summary-by-regexp)
+ (define-key map "\e\C-f" #'rmail-summary-by-senders)
+ (define-key map "\e\C-t" #'rmail-summary-by-topic)
+ (define-key map "m" #'rmail-mail)
+ (define-key map "\em" #'rmail-retry-failure)
+ (define-key map "n" #'rmail-next-undeleted-message)
+ (define-key map "\en" #'rmail-next-message)
+ (define-key map "\e\C-n" #'rmail-next-labeled-message)
+ (define-key map "o" #'rmail-output)
+ (define-key map "\C-o" #'rmail-output-as-seen)
+ (define-key map "p" #'rmail-previous-undeleted-message)
+ (define-key map "\ep" #'rmail-previous-message)
+ (define-key map "\e\C-p" #'rmail-previous-labeled-message)
+ (define-key map "q" #'rmail-quit)
+ (define-key map "r" #'rmail-reply)
;; I find I can't live without the default M-r command -- rms.
- ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards)
- (define-key map "s" 'rmail-expunge-and-save)
- (define-key map "\es" 'rmail-search)
- (define-key map "t" 'rmail-toggle-header)
- (define-key map "u" 'rmail-undelete-previous-message)
- (define-key map "v" 'rmail-mime)
- (define-key map "w" 'rmail-output-body-to-file)
- (define-key map "\C-c\C-w" 'rmail-widen)
- (define-key map "x" 'rmail-expunge)
- (define-key map "." 'rmail-beginning-of-message)
- (define-key map "/" 'rmail-end-of-message)
- (define-key map "<" 'rmail-first-message)
- (define-key map ">" 'rmail-last-message)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\177" 'scroll-down-command)
- (define-key map "?" 'describe-mode)
- (define-key map "\C-c\C-d" 'rmail-epa-decrypt)
- (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date)
- (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
- (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author)
- (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
- (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
- (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
- (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
- (define-key map "\C-c\C-n" 'rmail-next-same-subject)
- (define-key map "\C-c\C-p" 'rmail-previous-same-subject)
+ ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards)
+ (define-key map "s" #'rmail-expunge-and-save)
+ (define-key map "\es" #'rmail-search)
+ (define-key map "t" #'rmail-toggle-header)
+ (define-key map "u" #'rmail-undelete-previous-message)
+ (define-key map "v" #'rmail-mime)
+ (define-key map "w" #'rmail-output-body-to-file)
+ (define-key map "\C-c\C-w" #'rmail-widen)
+ (define-key map "x" #'rmail-expunge)
+ (define-key map "." #'rmail-beginning-of-message)
+ (define-key map "/" #'rmail-end-of-message)
+ (define-key map "<" #'rmail-first-message)
+ (define-key map ">" #'rmail-last-message)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map "\177" #'scroll-down-command)
+ (define-key map "?" #'describe-mode)
+ (define-key map "\C-c\C-d" #'rmail-epa-decrypt)
+ (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date)
+ (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject)
+ (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author)
+ (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient)
+ (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent)
+ (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines)
+ (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels)
+ (define-key map "\C-c\C-n" #'rmail-next-same-subject)
+ (define-key map "\C-c\C-p" #'rmail-previous-same-subject)
(define-key map [menu-bar] (make-sparse-keymap))
@@ -1344,9 +1344,9 @@ Instead, these commands are available:
(setq local-abbrev-table text-mode-abbrev-table)
;; Functions to support buffer swapping:
(add-hook 'write-region-annotate-functions
- 'rmail-write-region-annotate nil t)
- (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t)
- (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t))
+ #'rmail-write-region-annotate nil t)
+ (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t)
+ (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t))
(defun rmail-generate-viewer-buffer ()
"Return a reusable buffer suitable for viewing messages.
@@ -1363,7 +1363,7 @@ Create the buffer if necessary."
(file-name-nondirectory
(or buffer-file-name (buffer-name)))))))
(with-current-buffer newbuf
- (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t))
+ (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t))
newbuf)))
(defun rmail-swap-buffers ()
@@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection."
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
(setq-local auto-save-include-big-deletions t)
- (setq-local revert-buffer-function 'rmail-revert)
+ (setq-local revert-buffer-function #'rmail-revert)
(setq-local font-lock-defaults
'(rmail-font-lock-keywords
t t nil nil
@@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection."
(setq-local file-precious-flag t)
(setq-local desktop-save-buffer t)
(setq-local save-buffer-coding-system 'no-conversion)
- (setq next-error-move-function 'rmail-next-error-move))
+ (setq next-error-move-function #'rmail-next-error-move))
;; Handle M-x revert-buffer done in an rmail-mode buffer.
(defun rmail-revert (arg noconfirm)
@@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after the original."
(files (directory-files start t rmail-secondary-file-regexp)))
;; Sort here instead of in directory-files
;; because this list is usually much shorter.
- (sort files 'string<))))
+ (sort files #'string<))))
(defun rmail-list-to-menu (menu-name l action &optional full-name)
(let ((menu (make-sparse-keymap menu-name))
@@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after conversion."
rmail-movemail-flags)
(list file tofile)
(if password (list password) nil))))
- (apply 'call-process args))
+ (apply #'call-process args))
(if (not (buffer-modified-p errors))
;; No output => movemail won
nil
@@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil."
;; which will never be used.
(push nil messages-head)
(push ?0 deleted-head)
- (setq rmail-message-vector (apply 'vector messages-head)
+ (setq rmail-message-vector (apply #'vector messages-head)
rmail-deleted-vector (concat deleted-head))
(setq rmail-summary-vector (make-vector rmail-total-messages nil)
@@ -2712,7 +2712,9 @@ N defaults to the current message."
(and (string-match text-regexp content-type-header) t)))))
(defcustom rmail-show-message-verbose-min 200000
- "Message size at which to show progress messages for displaying it."
+ "Message size at which to show progress messages for displaying it.
+Messages longer than this (in characters) will produce echo-area
+messages when Rmail processes such a message for display."
:type 'integer
:group 'rmail
:version "23.1")
@@ -3603,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to confirm."
(cons (aref messages number) nil)))
(setq rmail-current-message new-message-number
rmail-total-messages counter
- rmail-message-vector (apply 'vector messages-head)
+ rmail-message-vector (apply #'vector messages-head)
rmail-deleted-vector (make-string (1+ counter) ?\s)
rmail-summary-vector (vconcat (nreverse new-summary))
- rmail-msgref-vector (apply 'vector (nreverse new-msgref))
+ rmail-msgref-vector (apply #'vector (nreverse new-msgref))
win t)))
(message "Expunging deleted messages...done")
(if (not win)
@@ -3889,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message into it."
(if (or references message-id)
(list (cons "References" (if references
(concat
- (mapconcat 'identity references " ")
+ (mapconcat #'identity references " ")
" " message-id)
message-id)))))))
@@ -4087,26 +4089,24 @@ typically for purposes of moderating a list."
(insert "Resent-Bcc: " (user-login-name) "\n"))
(insert "Resent-To: " (if (stringp address)
address
- (mapconcat 'identity address ",\n\t"))
+ (mapconcat #'identity address ",\n\t"))
"\n")
;; Expand abbrevs in the recipients.
(save-excursion
(if (featurep 'mailabbrev)
(let ((end (point-marker))
- (local-abbrev-table mail-abbrevs)
- (old-syntax-table (syntax-table)))
- (if (and (not (vectorp mail-abbrevs))
+ (local-abbrev-table mail-abbrevs))
+ (if (and (not (obarrayp mail-abbrevs))
(file-exists-p mail-personal-alias-file))
(build-mail-abbrevs))
(unless mail-abbrev-syntax-table
(mail-abbrev-make-syntax-table))
- (set-syntax-table mail-abbrev-syntax-table)
- (goto-char before)
- (while (and (< (point) end)
- (progn (forward-word-strictly 1)
- (<= (point) end)))
- (expand-abbrev))
- (set-syntax-table old-syntax-table))
+ (with-syntax-table mail-abbrev-syntax-table
+ (goto-char before)
+ (while (and (< (point) end)
+ (progn (forward-word-strictly 1)
+ (<= (point) end)))
+ (expand-abbrev))))
(expand-mail-aliases before (point)))))
;;>> Set up comment, if any.
(if (and (sequencep comment) (not (zerop (length comment))))
@@ -4333,7 +4333,7 @@ This has an effect only if a summary buffer exists."
(defun rmail-fontify-buffer-function ()
;; This function's symbol is bound to font-lock-fontify-buffer-function.
- (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
+ (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t)
;; If we're already showing a message, fontify it now.
(if rmail-current-message (rmail-fontify-message))
;; Prevent Font Lock mode from kicking in.
@@ -4344,7 +4344,7 @@ This has an effect only if a summary buffer exists."
(with-silent-modifications
(save-restriction
(widen)
- (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
+ (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t)
(remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
(font-lock-default-unfontify-buffer))))
@@ -4379,11 +4379,12 @@ browsing, and moving of messages."
"Install those variables used by speedbar to enhance rmail."
(unless rmail-speedbar-key-map
(setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
- (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
- (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
- (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
+ (declare-function speedbar-edit-line "speedbar")
+ (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line)
+ (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line)
+ (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line)
(define-key rmail-speedbar-key-map "M"
- 'rmail-speedbar-move-message-to-folder-on-line)))
+ #'rmail-speedbar-move-message-to-folder-on-line)))
;; Mouse-3.
(defvar rmail-speedbar-menu-items
@@ -4690,7 +4691,7 @@ Argument MIME is non-nil if this is a mime message."
(while (search-forward "\r\n" nil t)
(delete-region (- (point) 2) (- (point) 1))))))
)))
- ;; User wants to decrypt the message perenently.
+ ;; User wants to decrypt the message permanently.
(when (eq major-mode 'rmail-mode)
(rmail-add-label "decrypt"))
(setq decrypts (nreverse decrypts))
@@ -4827,7 +4828,8 @@ Content-Transfer-Encoding: base64\n")
(with-current-buffer
(if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer)
(setq buffer-file-coding-system rmail-message-encoding))))
-(add-hook 'after-save-hook 'rmail-after-save-hook)
+;; FIXME: Don't do it globally!!
+(add-hook 'after-save-hook #'rmail-after-save-hook)
;;; Mailing list support
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index d9c4cb8cfee..a13c42edb5c 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -31,7 +31,7 @@
;; Global to all RMAIL buffers. It exists for the sake of completion.
;; It is better to use strings with the label functions and let them
;; worry about making the label.
-(defvar rmail-label-obarray (make-vector 47 0)
+(defvar rmail-label-obarray (obarray-make 47)
"Obarray of labels used by Rmail.
`rmail-read-label' uses this to offer completion.")
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 18a36e5f0e9..48c5cb70b33 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -436,19 +436,19 @@ headers of the messages."
(unless (and rmail-summary-message-parents-vector
(= (length rmail-summary-message-parents-vector)
(1+ rmail-total-messages)))
- (rmail-summary-fill-message-parents-and-descs-vectors))
- (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil)))
- (rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
- (rmail-new-summary (format "thread containing message %d" msgnum)
- (list 'rmail-summary-by-thread msgnum)
- (if (and rmail-summary-progressively-narrow
- (rmail-summary--exists-1))
- (lambda (msg _msgnum)
- (and (aref rmail-summary-currently-displayed-msgs msg)
- (aref enc-msgs msg)))
+ (rmail-summary-fill-message-parents-and-descs-vectors)))
+ (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil)))
+ (rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
+ (rmail-new-summary (format "thread containing message %d" msgnum)
+ (list 'rmail-summary-by-thread msgnum)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
(lambda (msg _msgnum)
- (aref enc-msgs msg)))
- msgnum))))
+ (and (aref rmail-summary-currently-displayed-msgs msg)
+ (aref enc-msgs msg)))
+ (lambda (msg _msgnum)
+ (aref enc-msgs msg)))
+ msgnum)))
;;;###autoload
(defun rmail-summary-by-labels (labels)
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index c3fa738150e..9104feb6219 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -817,7 +817,7 @@ If there was no mail header with FIELD as its key, return the value of
(defun sc-mail-field-query (arg)
"View the value of a mail field.
-With `\\[universal-argument]', prompts for action on mail field.
+With \\[universal-argument], prompts for action on mail field.
Action can be one of: View, Modify, Add, or Delete."
(interactive "P")
(let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
@@ -1710,7 +1710,7 @@ Numeric ARG indicates which header style from `sc-rewrite-header-list'
to use when rewriting the header. No supplied ARG indicates use of
`sc-preferred-header-style'.
-With just `\\[universal-argument]', electric reference insert mode is
+With just \\[universal-argument], electric reference insert mode is
entered, regardless of the value of `sc-electric-references-p'. See
`sc-electric-mode' for more information."
(interactive "P")
@@ -1930,7 +1930,7 @@ With numeric ARG, inserts that many new lines."
(defun sc-insert-citation (arg)
"Insert citation string at beginning of current line if not already cited.
-With `\\[universal-argument]' insert citation even if line is already
+With \\[universal-argument] insert citation even if line is already
cited."
(interactive "P")
(save-excursion
diff --git a/lisp/man.el b/lisp/man.el
index 55cb9383bec..d96396483d3 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -761,7 +761,11 @@ and the `Man-section-translations-alist' variables)."
(setq name (match-string 2 ref)
section (match-string 1 ref))))
(if (string= name "")
- ref ; Return the reference as is
+ ;; see Bug#66390
+ (mapconcat 'identity
+ (mapcar #'shell-quote-argument
+ (split-string ref "\\s-+"))
+ " ") ; Return the reference as is
(if Man-downcase-section-letters-flag
(setq section (downcase section)))
(while slist
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 477e3036b47..320fabb54cf 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1353,6 +1353,15 @@ mail status in mode line"))
(frame-visible-p
(symbol-value 'speedbar-frame))))))
+ (bindings--define-key menu [showhide-outline-minor-mode]
+ '(menu-item "Outlines" outline-minor-mode
+ :help "Turn outline-minor-mode on/off"
+ :visible (seq-some #'local-variable-p
+ '(outline-search-function
+ outline-regexp outline-level))
+ :button (:toggle . (and (boundp 'outline-minor-mode)
+ outline-minor-mode))))
+
(bindings--define-key menu [showhide-tab-line-mode]
'(menu-item "Window Tab Line" global-tab-line-mode
:help "Turn window-local tab-lines on/off"
@@ -1438,6 +1447,14 @@ mail status in mode line"))
(defvar menu-bar-line-wrapping-menu
(let ((menu (make-sparse-keymap "Line Wrapping")))
+ (bindings--define-key menu [visual-wrap]
+ '(menu-item "Visual Wrap Prefix mode" visual-wrap-prefix-mode
+ :help "Display continuation lines with visual context-dependent prefix"
+ :visible (menu-bar-menu-frame-live-and-visible-p)
+ :button (:toggle
+ . (bound-and-true-p visual-wrap-prefix-mode))
+ :enable t))
+
(bindings--define-key menu [word-wrap]
'(menu-item "Word Wrap (Visual Line mode)"
menu-bar--visual-line-mode-enable
@@ -1821,6 +1838,9 @@ mail status in mode line"))
(bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project"))
menu))
+(defvar menu-bar-project-item
+ `(menu-item "Project" ,menu-bar-project-menu))
+
(defun menu-bar-read-mail ()
"Read mail using `read-mail-command'."
(interactive)
@@ -1908,7 +1928,7 @@ mail status in mode line"))
:help "Start language server suitable for this buffer's major-mode"))
(bindings--define-key menu [project]
- `(menu-item "Project" ,menu-bar-project-menu))
+ menu-bar-project-item)
(bindings--define-key menu [ede]
'(menu-item "Project Support (EDE)"
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 2684722eb26..bb3e67467d5 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -108,7 +108,7 @@ folder. This is useful for folders that are easily regenerated."
(window-config mh-previous-window-config))
(mh-set-folder-modified-p t) ; lock folder to kill it
(mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
- (when (boundp 'mh-speed-folder-map)
+ (when (and (boundp 'speedbar-buffer) speedbar-buffer)
(mh-speed-invalidate-map folder))
(mh-remove-from-sub-folders-cache folder)
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index f475973631c..59dad161c11 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1569,7 +1569,7 @@ If the folder returned doesn't exist then it is created."
(save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
(mh-remove-from-sub-folders-cache chosen-name)
- (when (boundp 'mh-speed-folder-map)
+ (when (and (boundp 'speedbar-buffer) speedbar-buffer)
(mh-speed-add-folder chosen-name))
chosen-name))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 7943879d887..9d5711105ba 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -795,7 +795,7 @@ used in searching."
(message "Creating %s" folder-name)
(mh-exec-cmd-error nil "folder" folder-name)
(mh-remove-from-sub-folders-cache folder-name)
- (when (boundp 'mh-speed-folder-map)
+ (when (and (boundp 'speedbar-buffer) speedbar-buffer)
(mh-speed-add-folder folder-name))
(message "Creating %s...done" folder-name))
(new-file-flag
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index fa2dcb4f698..0a844c538b4 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -150,8 +150,29 @@ The metadata of a completion table should be constant between two boundaries."
minibuffer-completion-table
minibuffer-completion-predicate))
+(defun completion--metadata-get-1 (metadata prop)
+ (or (alist-get prop metadata)
+ (plist-get completion-extra-properties
+ ;; Cache the keyword
+ (or (get prop 'completion-extra-properties--keyword)
+ (put prop 'completion-extra-properties--keyword
+ (intern (concat ":" (symbol-name prop))))))))
+
(defun completion-metadata-get (metadata prop)
- (cdr (assq prop metadata)))
+ "Get property PROP from completion METADATA.
+If the metadata specifies a completion category, the variables
+`completion-category-overrides' and
+`completion-category-defaults' take precedence for
+category-specific overrides. If the completion metadata does not
+specify the property, the `completion-extra-properties' plist is
+consulted. Note that the keys of the
+`completion-extra-properties' plist are keyword symbols, not
+plain symbols."
+ (if-let (((not (eq prop 'category)))
+ (cat (completion--metadata-get-1 metadata 'category))
+ (over (completion--category-override cat prop)))
+ (cdr over)
+ (completion--metadata-get-1 metadata prop)))
(defun complete-with-action (action collection string predicate)
"Perform completion according to ACTION.
@@ -300,7 +321,7 @@ the form (concat S2 S)."
;; Predicates are called differently depending on the nature of
;; the completion table :-(
(cond
- ((vectorp table) ;Obarray.
+ ((obarrayp table)
(lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
((hash-table-p table)
(lambda (s _v) (funcall pred (concat prefix s))))
@@ -1135,23 +1156,42 @@ styles for specific categories, such as files, buffers, etc."
(project-file (styles . (substring)))
(xref-location (styles . (substring)))
(info-menu (styles . (basic substring)))
- (symbol-help (styles . (basic shorthand substring))))
+ (symbol-help (styles . (basic shorthand substring)))
+ (calendar-month (display-sort-function . identity)))
"Default settings for specific completion categories.
+
Each entry has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
- `styles': the list of `completion-styles' to use for that category.
- `cycle': the `completion-cycle-threshold' to use for that category.
+- `cycle-sort-function': function to sort entries when cycling.
+- `display-sort-function': function to sort entries in *Completions*.
+- `group-function': function for grouping the completion candidates.
+- `annotation-function': function to add annotations in *Completions*.
+- `affixation-function': function to prepend/append a prefix/suffix.
+
Categories are symbols such as `buffer' and `file', used when
completing buffer and file names, respectively.
Also see `completion-category-overrides'.")
(defcustom completion-category-overrides nil
- "List of category-specific user overrides for completion styles.
+ "List of category-specific user overrides for completion metadata.
+
Each override has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
- `styles': the list of `completion-styles' to use for that category.
- `cycle': the `completion-cycle-threshold' to use for that category.
+- `cycle-sort-function': function to sort entries when cycling.
+- `display-sort-function': nil means to use either the sorting
+function from metadata, or if that is nil, fall back to `completions-sort';
+`identity' disables sorting and keeps the original order; and other
+possible values are the same as in `completions-sort'.
+- `group-function': function for grouping the completion candidates.
+- `annotation-function': function to add annotations in *Completions*.
+- `affixation-function': function to prepend/append a prefix/suffix.
+See more description of metadata in `completion-metadata'.
+
Categories are symbols such as `buffer' and `file', used when
completing buffer and file names, respectively.
@@ -1171,7 +1211,33 @@ overrides the default specified in `completion-category-defaults'."
,completion--styles-type)
(cons :tag "Completion Cycling"
(const :tag "Select one value from the menu." cycle)
- ,completion--cycling-threshold-type))))
+ ,completion--cycling-threshold-type)
+ (cons :tag "Cycle Sorting"
+ (const :tag "Select one value from the menu."
+ cycle-sort-function)
+ (choice (function :tag "Custom function")))
+ (cons :tag "Completion Sorting"
+ (const :tag "Select one value from the menu."
+ display-sort-function)
+ (choice (const :tag "Use default" nil)
+ (const :tag "No sorting" identity)
+ (const :tag "Alphabetical sorting"
+ minibuffer-sort-alphabetically)
+ (const :tag "Historical sorting"
+ minibuffer-sort-by-history)
+ (function :tag "Custom function")))
+ (cons :tag "Completion Groups"
+ (const :tag "Select one value from the menu."
+ group-function)
+ (choice (function :tag "Custom function")))
+ (cons :tag "Completion Annotation"
+ (const :tag "Select one value from the menu."
+ annotation-function)
+ (choice (function :tag "Custom function")))
+ (cons :tag "Completion Affixation"
+ (const :tag "Select one value from the menu."
+ affixation-function)
+ (choice (function :tag "Custom function"))))))
(defun completion--category-override (category tag)
(or (assq tag (cdr (assq category completion-category-overrides)))
@@ -1904,10 +1970,13 @@ appear to be a match."
;; Allow user to specify null string
((= beg end) (funcall exit-function))
;; The CONFIRM argument is a predicate.
- ((and (functionp minibuffer-completion-confirm)
- (funcall minibuffer-completion-confirm
- (buffer-substring beg end)))
- (funcall exit-function))
+ ((functionp minibuffer-completion-confirm)
+ (if (funcall minibuffer-completion-confirm
+ (buffer-substring beg end))
+ (funcall exit-function)
+ (unless completion-fail-discreetly
+ (ding)
+ (completion--message "No match"))))
;; See if we have a completion from the table.
((test-completion (buffer-substring beg end)
minibuffer-completion-table
@@ -2379,6 +2448,9 @@ candidates."
"Property list of extra properties of the current completion job.
These include:
+`:category': the kind of objects returned by `all-completions'.
+ Used by `completion-category-overrides'.
+
`:annotation-function': Function to annotate the completions buffer.
The function must accept one argument, a completion string,
and return either nil or a string which is to be displayed
@@ -2394,6 +2466,15 @@ These include:
`:annotation-function' when both are provided, so only this
function is used.
+`:group-function': Function for grouping the completion candidates.
+
+`:display-sort-function': Function to sort entries in *Completions*.
+
+`:cycle-sort-function': Function to sort entries when cycling.
+
+See more information about these functions above
+in `completion-metadata'.
+
`:exit-function': Function to run after completion is performed.
The function must accept two arguments, STRING and STATUS.
@@ -2516,12 +2597,8 @@ The candidate will still be chosen by `choose-completion' unless
base-size md
minibuffer-completion-table
minibuffer-completion-predicate))
- (ann-fun (or (completion-metadata-get all-md 'annotation-function)
- (plist-get completion-extra-properties
- :annotation-function)))
- (aff-fun (or (completion-metadata-get all-md 'affixation-function)
- (plist-get completion-extra-properties
- :affixation-function)))
+ (ann-fun (completion-metadata-get all-md 'annotation-function))
+ (aff-fun (completion-metadata-get all-md 'affixation-function))
(sort-fun (completion-metadata-get all-md 'display-sort-function))
(group-fun (completion-metadata-get all-md 'group-function))
(mainbuf (current-buffer))
@@ -3075,30 +3152,41 @@ the mode hook of this mode."
(setq-local minibuffer-completion-auto-choose nil)))
(defcustom minibuffer-visible-completions nil
- "When non-nil, visible completions can be navigated from the minibuffer.
-This means that when the *Completions* buffer is visible in a window,
-then you can use the arrow keys in the minibuffer to move the cursor
-in the *Completions* buffer. Then you can type `RET',
-and the candidate highlighted in the *Completions* buffer
-will be accepted.
-But when the *Completions* buffer is not displayed on the screen,
-then the arrow keys move point in the minibuffer as usual, and
-`RET' accepts the input typed in the minibuffer."
+ "Whether candidates shown in *Completions* can be navigated from minibuffer.
+When non-nil, if the *Completions* buffer is displayed in a window,
+you can use the arrow keys in the minibuffer to move the cursor in
+the window showing the *Completions* buffer. Typing `RET' selects
+the highlighted completion candidate.
+If the *Completions* buffer is not displayed on the screen, or this
+variable is nil, the arrow keys move point in the minibuffer as usual,
+and `RET' accepts the input typed into the minibuffer."
:type 'boolean
:version "30.1")
+(defvar minibuffer-visible-completions--always-bind nil
+ "If non-nil, force the `minibuffer-visible-completions' bindings on.")
+
+(defun minibuffer-visible-completions--filter (cmd)
+ "Return CMD if `minibuffer-visible-completions' bindings should be active."
+ (if minibuffer-visible-completions--always-bind
+ cmd
+ (when-let ((window (get-buffer-window "*Completions*" 0)))
+ (when (and (eq (buffer-local-value 'completion-reference-buffer
+ (window-buffer window))
+ (window-buffer (active-minibuffer-window)))
+ (if (eq cmd #'minibuffer-choose-completion-or-exit)
+ (with-current-buffer (window-buffer window)
+ (get-text-property (point) 'completion--string))
+ t))
+ cmd))))
+
(defun minibuffer-visible-completions-bind (binding)
"Use BINDING when completions are visible.
Return an item that is enabled only when a window
displaying the *Completions* buffer exists."
`(menu-item
"" ,binding
- :filter ,(lambda (cmd)
- (when-let ((window (get-buffer-window "*Completions*" 0)))
- (when (eq (buffer-local-value 'completion-reference-buffer
- (window-buffer window))
- (window-buffer (active-minibuffer-window)))
- cmd)))))
+ :filter ,#'minibuffer-visible-completions--filter))
(defvar-keymap minibuffer-visible-completions-map
:doc "Local keymap for minibuffer input with visible completions."
@@ -3409,9 +3497,10 @@ Fourth arg MUSTMATCH can take the following values:
input, but she needs to confirm her choice if she called
`minibuffer-complete' right before `minibuffer-complete-and-exit'
and the input is not an existing file.
-- a function, which will be called with the input as the
- argument. If the function returns a non-nil value, the
- minibuffer is exited with that argument as the value.
+- a function, which will be called with a single argument, the
+ input unquoted by `substitute-in-file-name', which see. If the
+ function returns a non-nil value, the minibuffer is exited with
+ that argument as the value.
- anything else behaves like t except that typing RET does not exit if it
does non-null completion.
@@ -3500,7 +3589,13 @@ See `read-file-name' for the meaning of the arguments."
(let ((ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
(pred (or predicate 'file-exists-p))
- (add-to-history nil))
+ (add-to-history nil)
+ (require-match (if (functionp mustmatch)
+ (lambda (input)
+ (funcall mustmatch
+ ;; User-supplied MUSTMATCH expects an unquoted filename
+ (substitute-in-file-name input)))
+ mustmatch)))
(let* ((val
(if (or (not (next-read-file-uses-dialog-p))
@@ -3536,7 +3631,7 @@ See `read-file-name' for the meaning of the arguments."
(read-file-name--defaults dir initial))))
(set-syntax-table minibuffer-local-filename-syntax))
(completing-read prompt 'read-file-name-internal
- pred mustmatch insdef
+ pred require-match insdef
'file-name-history default-filename)))
;; If DEFAULT-FILENAME not supplied and DIR contains
;; a file name, split it.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index d1b06c2040d..cef88dede8a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -393,6 +393,7 @@ and should return the same menu with changes such as added new menu items."
(function-item context-menu-local)
(function-item context-menu-minor)
(function-item context-menu-buffers)
+ (function-item context-menu-project)
(function-item context-menu-vc)
(function-item context-menu-ffap)
(function-item hi-lock-context-menu)
@@ -414,13 +415,17 @@ Each function receives the menu and the mouse click event
and returns the same menu after adding own menu items to the composite menu.
When there is a text property `context-menu-function' at CLICK,
it overrides all functions from `context-menu-functions'.
+Whereas the property `context-menu-functions' doesn't override
+the variable `context-menu-functions', but adds menus from the
+list in the property after adding menus from the variable.
At the end, it's possible to modify the final menu by specifying
the function `context-menu-filter-function'."
(let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))
(click (or click last-input-event))
- (window (posn-window (event-start click)))
- (fun (mouse-posn-property (event-start click)
- 'context-menu-function)))
+ (start (event-start click))
+ (window (posn-window start))
+ (fun (mouse-posn-property start 'context-menu-function))
+ (funs (mouse-posn-property start 'context-menu-functions)))
(unless (eq (selected-window) window)
(select-window window))
@@ -430,7 +435,9 @@ the function `context-menu-filter-function'."
(run-hook-wrapped 'context-menu-functions
(lambda (fun)
(setq menu (funcall fun menu click))
- nil)))
+ nil))
+ (dolist (fun funs)
+ (setq menu (funcall fun menu click))))
;; Remove duplicate separators as well as ones at the beginning or
;; end of the menu.
@@ -527,6 +534,12 @@ Some context functions add menu items below the separator."
(mouse-buffer-menu-keymap))
menu)
+(defun context-menu-project (menu _click)
+ "Populate MENU with project commands."
+ (define-key-after menu [separator-project] menu-bar-separator)
+ (define-key-after menu [project-menu] menu-bar-project-item)
+ menu)
+
(defun context-menu-vc (menu _click)
"Populate MENU with Version Control commands."
(define-key-after menu [separator-vc] menu-bar-separator)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 9577e0f2f42..768c70c2e3a 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1867,11 +1867,14 @@ A value of t means the main playlist.")
(defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t)
(defun mpc-volume-refresh ()
- ;; Maintain the volume.
- (setq mpc-volume
- (mpc-volume-widget
- (string-to-number (cdr (assq 'volume mpc-status)))))
- (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)))
+ "Maintain the volume."
+ (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))
+ (status-vol (cdr (assq 'volume mpc-status))))
+ ;; If MPD is paused or stopped the volume is nil.
+ (when status-vol
+ (setq mpc-volume
+ (mpc-volume-widget
+ (string-to-number status-vol))))
(when (buffer-live-p status-buf)
(with-current-buffer status-buf (force-mode-line-update)))))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b75b6f27d53..66a1fa1a706 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -34,8 +34,8 @@
;; Implementation note:
;;
;; I for one would prefer some way of converting the mouse-4/mouse-5
-;; events into different event types, like 'mwheel-up' or
-;; 'mwheel-down', but I cannot find a way to do this very easily (or
+;; events into different event types, like 'wheel-up' or
+;; 'wheel-down', but I cannot find a way to do this very easily (or
;; portably), so for now I just live with it.
(require 'timer)
@@ -56,49 +56,24 @@
(bound-and-true-p mouse-wheel-mode))
(mouse-wheel-mode 1)))
+(defvar mouse-wheel-obey-old-style-wheel-buttons t
+ "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events.
+These are the event names used historically in X11 before XInput2.
+They are sometimes generated by things like text-terminals as well.")
+
(defcustom mouse-wheel-down-event
- (if (or (featurep 'w32-win) (featurep 'ns-win)
- (featurep 'haiku-win) (featurep 'pgtk-win)
- (featurep 'android-win))
- 'wheel-up
- 'mouse-4)
- "Event used for scrolling down."
- :group 'mouse
- :type 'symbol
- :set 'mouse-wheel-change-button)
-
-(defcustom mouse-wheel-down-alternate-event
- (if (featurep 'xinput2)
- 'wheel-up
- (unless (featurep 'x)
- 'mouse-4))
- "Alternative wheel down event to consider."
+ (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4)
+ "Event used for scrolling down, beside `wheel-up', if any."
:group 'mouse
:type 'symbol
- :version "29.1"
- :set 'mouse-wheel-change-button)
+ :set #'mouse-wheel-change-button)
(defcustom mouse-wheel-up-event
- (if (or (featurep 'w32-win) (featurep 'ns-win)
- (featurep 'haiku-win) (featurep 'pgtk-win)
- (featurep 'android-win))
- 'wheel-down
- 'mouse-5)
- "Event used for scrolling up."
+ (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5)
+ "Event used for scrolling up, beside `wheel-down', if any."
:group 'mouse
:type 'symbol
- :set 'mouse-wheel-change-button)
-
-(defcustom mouse-wheel-up-alternate-event
- (if (featurep 'xinput2)
- 'wheel-down
- (unless (featurep 'x)
- 'mouse-5))
- "Alternative wheel up event to consider."
- :group 'mouse
- :type 'symbol
- :version "29.1"
- :set 'mouse-wheel-change-button)
+ :set #'mouse-wheel-change-button)
(defcustom mouse-wheel-click-event 'mouse-2
"Event that should be temporarily inhibited after mouse scrolling.
@@ -108,7 +83,7 @@ scrolling with the mouse wheel. To prevent that, this variable can be
set to the event sent when clicking on the mouse wheel button."
:group 'mouse
:type 'symbol
- :set 'mouse-wheel-change-button)
+ :set #'mouse-wheel-change-button)
(defcustom mouse-wheel-inhibit-click-time 0.35
"Time in seconds to inhibit clicking on mouse wheel button after scroll."
@@ -165,7 +140,7 @@ information, see `text-scale-adjust' and `global-text-scale-adjust'."
(const :tag "Scroll horizontally" :value hscroll)
(const :tag "Change buffer face size" :value text-scale)
(const :tag "Change global face size" :value global-text-scale)))))
- :set 'mouse-wheel-change-button
+ :set #'mouse-wheel-change-button
:version "28.1")
(defcustom mouse-wheel-progressive-speed t
@@ -216,15 +191,9 @@ Also see `mouse-wheel-tilt-scroll'."
:type 'boolean
:version "26.1")
-(defun mwheel-event-button (event)
- (let ((x (event-basic-type event)))
- ;; Map mouse-wheel events to appropriate buttons
- (if (eq 'mouse-wheel x)
- (let ((amount (car (cdr (cdr (cdr event))))))
- (if (< amount 0)
- mouse-wheel-up-event
- mouse-wheel-down-event))
- x)))
+;; This function used to handle the `mouse-wheel` event which was
+;; removed in 2003 by commit 9eb28007fb27, thus making it obsolete.
+(define-obsolete-function-alias 'mwheel-event-button #'event-basic-type "30.1")
(defun mwheel-event-window (event)
(posn-window (event-start event)))
@@ -255,34 +224,12 @@ Also see `mouse-wheel-tilt-scroll'."
"Function that does the job of scrolling right.")
(defvar mouse-wheel-left-event
- (if (or (featurep 'w32-win) (featurep 'ns-win)
- (featurep 'haiku-win) (featurep 'pgtk-win)
- (featurep 'android-win))
- 'wheel-left
- 'mouse-6)
- "Event used for scrolling left.")
-
-(defvar mouse-wheel-left-alternate-event
- (if (featurep 'xinput2)
- 'wheel-left
- (unless (featurep 'x)
- 'mouse-6))
- "Alternative wheel left event to consider.")
+ (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6)
+ "Event used for scrolling left, beside `wheel-left', if any.")
(defvar mouse-wheel-right-event
- (if (or (featurep 'w32-win) (featurep 'ns-win)
- (featurep 'haiku-win) (featurep 'pgtk-win)
- (featurep 'android-win))
- 'wheel-right
- 'mouse-7)
- "Event used for scrolling right.")
-
-(defvar mouse-wheel-right-alternate-event
- (if (featurep 'xinput2)
- 'wheel-right
- (unless (featurep 'x)
- 'mouse-7))
- "Alternative wheel right event to consider.")
+ (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7)
+ "Event used for scrolling right, beside `wheel-right', if any.")
(defun mouse-wheel--get-scroll-window (event)
"Return window for mouse wheel event EVENT.
@@ -311,6 +258,23 @@ active window."
frame nil t)))))
(mwheel-event-window event)))
+(defmacro mwheel--is-dir-p (dir button)
+ (declare (debug (sexp form)))
+ (let ((custom-var (intern (format "mouse-wheel-%s-event" dir)))
+ ;; N.B. that the direction `down' in a wheel event refers to
+ ;; the movement of the section of the buffer the window is
+ ;; displaying, that is to say, the direction `scroll-up' moves
+ ;; it in.
+ (event (intern (format "wheel-%s" (cond ((eq dir 'up)
+ 'down)
+ ((eq dir 'down)
+ 'up)
+ (t dir))))))
+ (macroexp-let2 nil butsym button
+ `(or (eq ,butsym ',event)
+ ;; We presume here `button' is never nil.
+ (eq ,butsym ,custom-var)))))
+
(defun mwheel-scroll (event &optional arg)
"Scroll up or down according to the EVENT.
This should be bound only to mouse buttons 4, 5, 6, and 7 on
@@ -347,18 +311,17 @@ value of ARG, and the command uses it in subsequent scrolls."
(when (numberp amt) (setq amt (* amt (event-line-count event))))
(condition-case nil
(unwind-protect
- (let ((button (mwheel-event-button event)))
- (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event
- mouse-wheel-down-alternate-event)))
+ (let ((button (event-basic-type event)))
+ (cond ((and (eq amt 'hscroll) (mwheel--is-dir-p down button))
(when (and (natnump arg) (> arg 0))
(setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-left-function
mwheel-scroll-right-function)
mouse-wheel-scroll-amount-horizontal))
- ((memq button (list mouse-wheel-down-event
- mouse-wheel-down-alternate-event))
- (condition-case nil (funcall mwheel-scroll-down-function amt)
+ ((mwheel--is-dir-p down button)
+ (condition-case nil
+ (funcall mwheel-scroll-down-function amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
(beginning-of-buffer
@@ -372,31 +335,30 @@ value of ARG, and the command uses it in subsequent scrolls."
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
- ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event
- mouse-wheel-up-alternate-event)))
+ ((and (eq amt 'hscroll) (mwheel--is-dir-p up button))
(when (and (natnump arg) (> arg 0))
(setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-right-function
mwheel-scroll-left-function)
mouse-wheel-scroll-amount-horizontal))
- ((memq button (list mouse-wheel-up-event
- mouse-wheel-up-alternate-event))
+ ((mwheel--is-dir-p up button)
(condition-case nil (funcall mwheel-scroll-up-function amt)
;; Make sure we do indeed scroll to the end of the buffer.
- (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
- ((memq button (list mouse-wheel-left-event
- mouse-wheel-left-alternate-event)) ; for tilt scroll
+ (end-of-buffer
+ (while t (funcall mwheel-scroll-up-function)))))
+ ((mwheel--is-dir-p left button) ; for tilt scroll
(when mouse-wheel-tilt-scroll
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-right-function
- mwheel-scroll-left-function) amt)))
- ((memq button (list mouse-wheel-right-event
- mouse-wheel-right-alternate-event)) ; for tilt scroll
+ mwheel-scroll-left-function)
+ amt)))
+ ((mwheel--is-dir-p right button) ; for tilt scroll
(when mouse-wheel-tilt-scroll
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-left-function
- mwheel-scroll-right-function) amt)))
+ mwheel-scroll-right-function)
+ amt)))
(t (error "Bad binding in mwheel-scroll"))))
(if (eq scroll-window selected-window)
;; If there is a temporarily active region, deactivate it if
@@ -434,14 +396,12 @@ See also `text-scale-adjust'."
(interactive (list last-input-event))
(let ((selected-window (selected-window))
(scroll-window (mouse-wheel--get-scroll-window event))
- (button (mwheel-event-button event)))
+ (button (event-basic-type event)))
(select-window scroll-window 'mark-for-redisplay)
(unwind-protect
- (cond ((memq button (list mouse-wheel-down-event
- mouse-wheel-down-alternate-event))
+ (cond ((mwheel--is-dir-p down button)
(text-scale-increase 1))
- ((memq button (list mouse-wheel-up-event
- mouse-wheel-up-alternate-event))
+ ((mwheel--is-dir-p up button)
(text-scale-decrease 1)))
(select-window selected-window))))
@@ -450,12 +410,10 @@ See also `text-scale-adjust'."
"Increase or decrease the global font size according to the EVENT.
This invokes `global-text-scale-adjust', which see."
(interactive (list last-input-event))
- (let ((button (mwheel-event-button event)))
- (cond ((memq button (list mouse-wheel-down-event
- mouse-wheel-down-alternate-event))
+ (let ((button (event-basic-type event)))
+ (cond ((mwheel--is-dir-p down button)
(global-text-scale-adjust 1))
- ((memq button (list mouse-wheel-up-event
- mouse-wheel-up-alternate-event))
+ ((mwheel--is-dir-p up button)
(global-text-scale-adjust -1)))))
(defun mouse-wheel--add-binding (key fun)
@@ -507,15 +465,13 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
;; Bindings for changing font size.
((and (consp binding) (eq (cdr binding) 'text-scale))
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-down-alternate-event
- mouse-wheel-up-alternate-event))
+ 'wheel-down 'wheel-up))
(when event
(mouse-wheel--add-binding `[,(append (car binding) (list event))]
'mouse-wheel-text-scale))))
((and (consp binding) (eq (cdr binding) 'global-text-scale))
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-down-alternate-event
- mouse-wheel-up-alternate-event))
+ 'wheel-down 'wheel-up))
(when event
(mouse-wheel--add-binding `[,(append (car binding) (list event))]
'mouse-wheel-global-text-scale))))
@@ -523,10 +479,7 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
(t
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
mouse-wheel-left-event mouse-wheel-right-event
- mouse-wheel-down-alternate-event
- mouse-wheel-up-alternate-event
- mouse-wheel-left-alternate-event
- mouse-wheel-right-alternate-event))
+ 'wheel-down 'wheel-up 'wheel-left 'wheel-right))
(when event
(dolist (key (mouse-wheel--create-scroll-keys binding event))
(mouse-wheel--add-binding key 'mwheel-scroll))))))))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 359453ca433..f22aa19f5e3 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist."
(defun browse-url-url-at-point ()
(or (thing-at-point 'url t)
;; assume that the user is pointing at something like gnu.org/gnu
- (let ((f (thing-at-point 'filename t)))
- (and f (concat browse-url-default-scheme "://" f)))))
+ (when-let ((f (thing-at-point 'filename t)))
+ (if (string-match-p browse-url-button-regexp f)
+ f
+ (concat browse-url-default-scheme "://" f)))))
;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
@@ -702,8 +704,10 @@ it defaults to the current region, else to the URL at or before
point. If invoked with a mouse button, it moves point to the
position clicked before acting.
-This function returns a list (URL NEW-WINDOW-FLAG)
-for use in `interactive'."
+This function returns a list (URL NEW-WINDOW-FLAG) for use in
+`interactive'. NEW-WINDOW-FLAG is the prefix arg; if
+`browse-url-new-window-flag' is non-nil, invert the prefix arg
+instead."
(let ((event (elt (this-command-keys) 0)))
(mouse-set-point event))
(list (read-string prompt (or (and transient-mark-mode mark-active
@@ -713,8 +717,7 @@ for use in `interactive'."
(buffer-substring-no-properties
(region-beginning) (region-end))))
(browse-url-url-at-point)))
- (not (eq (null browse-url-new-window-flag)
- (null current-prefix-arg)))))
+ (xor browse-url-new-window-flag current-prefix-arg)))
;; called-interactive-p needs to be called at a function's top-level, hence
;; this macro. We use that rather than interactive-p because
@@ -877,8 +880,8 @@ The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use.
-This command prompts for a URL, defaulting to the URL at or
-before point.
+Interactively, this command prompts for a URL, defaulting to the
+URL at or before point.
The additional ARGS are passed to the browser function. See the
doc strings of the actual functions, starting with
@@ -886,7 +889,9 @@ doc strings of the actual functions, starting with
significance of ARGS (most of the functions ignore it).
If ARGS are omitted, the default is to pass
-`browse-url-new-window-flag' as ARGS."
+`browse-url-new-window-flag' as ARGS. Interactively, pass the
+prefix arg as ARGS; if `browse-url-new-window-flag' is non-nil,
+invert the prefix arg instead."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
@@ -1322,7 +1327,7 @@ and instant messengers instead of opening it in a web browser."
:type 'boolean
:version "30.1")
-(declare-function android-browse-url "androidselect.c")
+(declare-function android-browse-url "../term/android-win")
;;;###autoload
(defun browse-url-default-android-browser (url &optional _new-window)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 77b334e704e..46f85daba24 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -371,11 +371,7 @@ object is returned instead of a list containing this single Lisp object.
(apply
#'dbus-message-internal dbus-message-type-method-call
bus service path interface method #'dbus-call-method-handler args))
- (result (unless executing-kbd-macro (cons :pending nil))))
-
- ;; While executing a keyboard macro, we run into an infinite loop,
- ;; receiving the event -1. So we don't try to get the result.
- ;; (Bug#62018)
+ (result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
;; `dbus-return-values-table'. If no timeout is given, use the
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 1981b757017..d4dfa33716c 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -787,7 +787,7 @@ FUNCTION is the callback which is called for each search result."
Optional argument NOMATCHING controls whether to suppress the display
of matching words."
- (message "Searching for %s in %s" word dictionary)
+ (insert (format-message "Searching for `%s' in `%s'\n" word dictionary))
(dictionary-send-command (concat "define "
(dictionary-encode-charset dictionary "")
" \""
@@ -799,13 +799,13 @@ of matching words."
(if (dictionary-check-reply reply 552)
(progn
(unless nomatching
- (insert "Word not found")
+ (insert (format-message "Word `%s' not found\n" word))
(dictionary-do-matching
word
dictionary
"."
(lambda (reply)
- (insert ", maybe you are looking for one of these words\n\n")
+ (insert "Maybe you are looking for one of these words\n")
(dictionary-display-only-match-result reply)))
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
@@ -1116,20 +1116,26 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(defun dictionary-new-matching (word)
"Run a new matching search on WORD."
- (dictionary-ensure-buffer)
(dictionary-store-positions)
- (dictionary-do-matching word dictionary-default-dictionary
- dictionary-default-strategy
- 'dictionary-display-match-result)
- (dictionary-store-state 'dictionary-do-matching
+ (dictionary-ensure-buffer)
+ (dictionary-new-matching-internal word dictionary-default-dictionary
+ dictionary-default-strategy
+ 'dictionary-display-match-result)
+ (dictionary-store-state 'dictionary-new-matching-internal
(list word dictionary-default-dictionary
dictionary-default-strategy
'dictionary-display-match-result)))
+(defun dictionary-new-matching-internal (word dictionary strategy function)
+ "Start a new matching for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result."
+ (dictionary-pre-buffer)
+ (dictionary-do-matching word dictionary strategy function))
+
(defun dictionary-do-matching (word dictionary strategy function)
"Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION."
- (message "Lookup matching words for %s in %s using %s"
- word dictionary strategy)
+ (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n"
+ word dictionary strategy))
(dictionary-send-command
(concat "match " (dictionary-encode-charset dictionary "") " "
(dictionary-encode-charset strategy "") " \""
@@ -1141,10 +1147,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(if (dictionary-check-reply reply 551)
(error "Strategy \"%s\" is invalid" strategy))
(if (dictionary-check-reply reply 552)
- (error (concat
- "No match for \"%s\" with strategy \"%s\" in "
- "dictionary \"%s\".")
- word strategy dictionary))
+ (let ((errmsg (format-message
+ (concat
+ "No match for `%s' with strategy `%s' in "
+ "dictionary `%s'.")
+ word strategy dictionary)))
+ (insert errmsg "\n")
+ (user-error errmsg)))
(unless (dictionary-check-reply reply 152)
(error "Unknown server answer: %s" (dictionary-reply reply)))
(funcall function reply)))
@@ -1172,8 +1181,6 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(defun dictionary-display-match-result (reply)
"Display the results in REPLY from a match operation."
- (dictionary-pre-buffer)
-
(let ((number (nth 1 (dictionary-reply-list reply)))
(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
(insert number " matching word" (if (equal number "1") "" "s")
@@ -1271,7 +1278,7 @@ prompt for DICTIONARY."
(interactive)
(let ((word (current-word)))
(unless word
- (error "No word at point"))
+ (user-error "No word at point"))
(dictionary-new-search (cons word dictionary-default-dictionary))))
(defun dictionary-previous ()
@@ -1311,7 +1318,8 @@ prompt for DICTIONARY."
(defun dictionary-popup-matching-words (&optional word)
"Display entries matching WORD or the current word if not given."
(interactive)
- (dictionary-do-matching (or word (current-word) (error "Nothing to search for"))
+ (dictionary-do-matching (or word (current-word)
+ (user-error "Nothing to search for"))
dictionary-default-dictionary
dictionary-default-popup-strategy
'dictionary-process-popup-replies))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 23ea88ef4ad..54f4d227a49 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
result))
;;; Interface functions.
-(defvar dns-cache (make-vector 4096 0))
+(defvar dns-cache (obarray-make 4096))
(defun dns-query-cached (name &optional type fullp reversep)
(let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 22f07cbc5b4..39ea964d47a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -182,6 +182,33 @@ the tab bar is enabled."
(const :tag "Open new tab when tab bar is enabled" tab-bar)
(const :tag "Never open URL in new tab" nil)))
+(defcustom eww-before-browse-history-function #'eww-delete-future-history
+ "A function to call to update history before browsing to a new page.
+EWW provides the following values for this option:
+
+* `eww-delete-future-history': Delete any history entries after the
+ currently-shown one. This is the default behavior, and works the same
+ as in most other web browsers.
+
+* `eww-clone-previous-history': Clone and prepend any history entries up
+ to the currently-shown one. This is like `eww-delete-future-history',
+ except that it preserves the previous contents of the history list at
+ the end.
+
+* `ignore': Preserve the current history unchanged. This will result in
+ the new page simply being prepended to the existing history list.
+
+You can also set this to any other function you wish."
+ :version "30.1"
+ :group 'eww
+ :type '(choice (function-item :tag "Delete future history"
+ eww-delete-future-history)
+ (function-item :tag "Clone previous history"
+ eww-clone-previous-history)
+ (function-item :tag "Preserve history"
+ ignore)
+ (function :tag "Custom function")))
+
(defcustom eww-after-render-hook nil
"A hook called after eww has finished rendering the buffer."
:version "25.1"
@@ -248,6 +275,27 @@ parameter, and should return the (possibly) transformed URL."
:type '(repeat function)
:version "29.1")
+(defcustom eww-readable-urls nil
+ "A list of regexps matching URLs to display in readable mode by default.
+EWW will display matching URLs using `eww-readable' (which see).
+
+Each element can be one of the following forms: a regular expression in
+string form or a cons cell of the form (REGEXP . READABILITY). If
+READABILITY is non-nil, this behaves the same as the string form;
+otherwise, URLs matching REGEXP will never be displayed in readable mode
+by default."
+ :type '(repeat (choice (string :tag "Readable URL")
+ (cons :tag "URL and Readability"
+ (string :tag "URL")
+ (radio (const :tag "Readable" t)
+ (const :tag "Non-readable" nil)))))
+ :version "30.1")
+
+(defcustom eww-readable-adds-to-history t
+ "If non-nil, calling `eww-readable' adds a new entry to the history."
+ :type 'boolean
+ :version "30.1")
+
(defface eww-form-submit
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
@@ -312,7 +360,10 @@ parameter, and should return the (possibly) transformed URL."
(defvar eww-data nil)
(defvar eww-history nil)
-(defvar eww-history-position 0)
+(defvar eww-history-position 0
+ "The 1-indexed position in `eww-history'.
+If zero, EWW is at the newest page, which isn't yet present in
+`eww-history'.")
(defvar eww-prompt-history nil)
(defvar eww-local-regex "localhost"
@@ -340,7 +391,7 @@ parameter, and should return the (possibly) transformed URL."
(defun eww-suggested-uris nil
"Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
- (let ((obseen (make-vector 42 0))
+ (let ((obseen (obarray-make 42))
(uris nil))
(dolist (fun eww-suggest-uris)
(let ((ret (funcall fun)))
@@ -402,6 +453,7 @@ For more information, see Info node `(eww) Top'."
(t
(get-buffer-create "*eww*"))))
(eww-setup-buffer)
+ (eww--before-browse)
;; Check whether the domain only uses "Highly Restricted" Unicode
;; IDNA characters. If not, transform to punycode to indicate that
;; there may be funny business going on.
@@ -433,11 +485,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 cbargs))
+ (url-retrieve url callback cbargs))
((eq eww-retrieve-command 'sync)
(let ((data-buffer (url-retrieve-synchronously url)))
(with-current-buffer data-buffer
- (apply #'eww-render nil url cbargs))))
+ (apply callback nil cbargs))))
(t
(let ((buffer (generate-new-buffer " *eww retrieve*"))
(error-buffer (generate-new-buffer " *eww error*")))
@@ -642,9 +694,9 @@ The renaming scheme is performed in accordance with
(insert (format "<a href=%S>Direct link to the document</a>"
url))
(goto-char (point-min))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((eww-html-p (car content-type))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((equal (car content-type) "application/pdf")
(eww-display-pdf))
((string-match-p "\\`image/" (car content-type))
@@ -654,7 +706,6 @@ The renaming scheme is performed in accordance with
(with-current-buffer buffer
(plist-put eww-data :url url)
(eww--after-page-change)
- (setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
(unless shr-fill-text
@@ -696,34 +747,40 @@ The renaming scheme is performed in accordance with
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
-(defun eww-display-html (charset url &optional document point buffer encode)
+(defun eww--parse-html-region (start end &optional coding-system)
+ "Parse the HTML between START and END, returning the DOM as an S-expression.
+Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
+
+This replaces the region with the preprocessed HTML."
+ (setq coding-system (or coding-system 'utf-8))
+ (with-restriction start end
+ (condition-case nil
+ (decode-coding-region (point-min) (point-max) coding-system)
+ (coding-system-error nil))
+ ;; Remove CRLF and replace NUL with &#0; before parsing.
+ (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
+ (replace-match (if (match-beginning 1) "" "&#0;") t t))
+ (eww--preprocess-html (point-min) (point-max))
+ (libxml-parse-html-region (point-min) (point-max))))
+
+(defsubst eww-document-base (url dom)
+ `(base ((href . ,url)) ,dom))
+
+(defun eww-display-document (document &optional point buffer)
(unless (fboundp 'libxml-parse-html-region)
(error "This function requires Emacs to be compiled with libxml2"))
+ (setq buffer (or buffer (current-buffer)))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
;; There should be a better way to abort loading images
;; asynchronously.
(setq url-queue nil)
- (let ((document
- (or document
- (list
- 'base (list (cons 'href url))
- (progn
- (setq encode (or encode charset 'utf-8))
- (condition-case nil
- (decode-coding-region (point) (point-max) encode)
- (coding-system-error nil))
- (save-excursion
- ;; Remove CRLF and replace NUL with &#0; before parsing.
- (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
- (replace-match (if (match-beginning 1) "" "&#0;") t t)))
- (eww--preprocess-html (point) (point-max))
- (libxml-parse-html-region (point) (point-max))))))
- (source (and (null document)
- (buffer-substring (point) (point-max)))))
+ (let ((url (when (eq (car document) 'base)
+ (alist-get 'href (cadr document)))))
+ (unless url
+ (error "Document is missing base URL"))
(with-current-buffer buffer
(setq bidi-paragraph-direction nil)
- (plist-put eww-data :source source)
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
@@ -764,6 +821,20 @@ The renaming scheme is performed in accordance with
(forward-line 1)))))
(eww-size-text-inputs))))
+(defun eww-display-html (charset url &optional document point buffer)
+ (let ((source (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (plist-put eww-data :source source)))
+ (unless document
+ (let ((dom (eww--parse-html-region (point) (point-max) charset)))
+ (when (eww-default-readable-p url)
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom))
+ (with-current-buffer buffer
+ (plist-put eww-data :readable t)))
+ (setq document (eww-document-base url dom))))
+ (eww-display-document document point buffer))
+
(defun eww-handle-link (dom)
(let* ((rel (dom-attr dom 'rel))
(href (dom-attr dom 'href))
@@ -905,6 +976,11 @@ The renaming scheme is performed in accordance with
`((?u . ,(or url ""))
(?t . ,title))))))))
+(defun eww--before-browse ()
+ (funcall eww-before-browse-history-function)
+ (setq eww-history-position 0
+ eww-data (list :title "")))
+
(defun eww--after-page-change ()
(eww-update-header-line-format)
(eww--rename-buffer))
@@ -1020,29 +1096,47 @@ The renaming scheme is performed in accordance with
"automatic"
bidi-paragraph-direction)))
-(defun eww-readable ()
- "View the main \"readable\" parts of the current web page.
+(defun eww-readable (&optional arg)
+ "Toggle display of only the main \"readable\" parts of the current web page.
This command uses heuristics to find the parts of the web page that
-contains the main textual portion, leaving out navigation menus and
-the like."
- (interactive nil eww-mode)
+contain the main textual portion, leaving out navigation menus and the
+like.
+
+If called interactively, toggle the display of the readable parts. If
+the prefix argument is positive, display the readable parts, and if it
+is zero or negative, display the full page.
+
+If called from Lisp, toggle the display of the readable parts if ARG is
+`toggle'. Display the readable parts if ARG is nil, omitted, or is a
+positive number. Display the full page if ARG is a negative number.
+
+When `eww-readable-adds-to-history' is non-nil, calling this function
+adds a new entry to `eww-history'."
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle))
+ eww-mode)
(let* ((old-data eww-data)
- (dom (with-temp-buffer
+ (make-readable (cond
+ ((eq arg 'toggle)
+ (not (plist-get old-data :readable)))
+ ((and (numberp arg) (< arg 1))
+ nil)
+ (t t)))
+ (dom (with-temp-buffer
(insert (plist-get old-data :source))
- (condition-case nil
- (decode-coding-region (point-min) (point-max) 'utf-8)
- (coding-system-error nil))
- (eww--preprocess-html (point-min) (point-max))
- (libxml-parse-html-region (point-min) (point-max))))
+ (eww--parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
- (eww-score-readability dom)
- (eww-save-history)
- (eww-display-html nil nil
- (list 'base (list (cons 'href base))
- (eww-highest-readability dom))
- nil (current-buffer))
- (dolist (elem '(:source :url :title :next :previous :up :peer))
- (plist-put eww-data elem (plist-get old-data elem)))
+ (when make-readable
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom)))
+ (when eww-readable-adds-to-history
+ (eww-save-history)
+ (eww--before-browse)
+ (dolist (elem '(:source :url :title :next :previous :up :peer))
+ (plist-put eww-data elem (plist-get old-data elem))))
+ (eww-display-document (eww-document-base base dom))
+ (plist-put eww-data :readable make-readable)
(eww--after-page-change)))
(defun eww-score-readability (node)
@@ -1085,6 +1179,19 @@ the like."
(setq result highest))))
result))
+(defun eww-default-readable-p (url)
+ "Return non-nil if URL should be displayed in readable mode by default.
+This consults the entries in `eww-readable-urls' (which see)."
+ (catch 'found
+ (let (result)
+ (dolist (regexp eww-readable-urls)
+ (if (consp regexp)
+ (setq result (cdr regexp)
+ regexp (car regexp))
+ (setq result t))
+ (when (string-match regexp url)
+ (throw 'found result))))))
+
(defvar-keymap eww-mode-map
"g" #'eww-reload ;FIXME: revert-buffer-function instead!
"G" #'eww
@@ -1129,9 +1236,9 @@ the like."
["Reload" eww-reload t]
["Follow URL in new buffer" eww-open-in-new-buffer]
["Back to previous page" eww-back-url
- :active (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :active (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Browse with external browser" eww-browse-with-external-browser t]
["Download" eww-download t]
["View page source" eww-view-source]
@@ -1155,9 +1262,9 @@ the like."
(easy-menu-define nil easy-menu nil
'("Eww"
["Back to previous page" eww-back-url
- :visible (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :visible (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Reload" eww-reload t]))
(dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
(when (consp item)
@@ -1280,16 +1387,20 @@ instead of `browse-url-new-window-flag'."
(interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
- (eww-save-history)
- (setq eww-history-position (+ eww-history-position 2))
+ (if (eww-save-history)
+ ;; We were at the latest page (which was just added to the
+ ;; history), so go back two entries.
+ (setq eww-history-position 2)
+ (setq eww-history-position (1+ eww-history-position)))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-forward-url ()
"Go to the next displayed page."
(interactive nil eww-mode)
- (when (zerop eww-history-position)
+ (when (<= eww-history-position 1)
(user-error "No next page"))
(eww-save-history)
+ (setq eww-history-position (1- eww-history-position))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-restore-history (elem)
@@ -1358,8 +1469,7 @@ just re-display the HTML already fetched."
(if local
(if (null (plist-get eww-data :dom))
(error "No current HTML data")
- (eww-display-html 'utf-8 url (plist-get eww-data :dom)
- (point) (current-buffer)))
+ (eww-display-document (plist-get eww-data :dom) (point)))
(let ((parsed (url-generic-parse-url url)))
(if (equal (url-type parsed) "file")
;; Use Tramp instead of url.el for files (since url.el
@@ -1959,6 +2069,7 @@ If EXTERNAL is double prefix, browse in new buffer."
(eww-same-page-p url (plist-get eww-data :url)))
(let ((point (point)))
(eww-save-history)
+ (eww--before-browse)
(plist-put eww-data :url url)
(goto-char (point-min))
(if-let ((match (text-property-search-forward 'shr-target-id target #'member)))
@@ -2064,9 +2175,10 @@ If CHARSET is nil then use UTF-8."
"Prompt for an EWW buffer to display in the selected window."
(interactive nil eww-mode)
(let ((completion-extra-properties
- '(:annotation-function (lambda (buf)
- (with-current-buffer buf
- (format " %s" (eww-current-url))))))
+ `(:annotation-function
+ ,(lambda (buf)
+ (with-current-buffer buf
+ (format " %s" (eww-current-url))))))
(curbuf (current-buffer)))
(pop-to-buffer-same-window
(read-buffer "Switch to EWW buffer: "
@@ -2225,7 +2337,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(when (and (not first)
(not (eobp)))
(forward-line 1))
@@ -2244,7 +2356,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(if first
(goto-char (point-max))
(beginning-of-line))
@@ -2288,11 +2400,69 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
;;; History code
(defun eww-save-history ()
+ "Save the current page's data to the history.
+If the current page is a historial one loaded from
+`eww-history' (e.g. by calling `eww-back-url'), this will update the
+page's entry in `eww-history' and return nil. Otherwise, add a new
+entry to `eww-history' and return t."
(plist-put eww-data :point (point))
(plist-put eww-data :text (buffer-string))
- (let ((history-delete-duplicates nil))
- (add-to-history 'eww-history eww-data eww-history-limit t))
- (setq eww-data (list :title "")))
+ (if (zerop eww-history-position)
+ (let ((history-delete-duplicates nil))
+ (add-to-history 'eww-history eww-data eww-history-limit t)
+ (setq eww-history-position 1)
+ t)
+ (setf (elt eww-history (1- eww-history-position)) eww-data)
+ nil))
+
+(defun eww-delete-future-history ()
+ "Remove any entries in `eww-history' after the currently-shown one.
+This is useful for `eww-before-browse-history-function' to make EWW's
+navigation to a new page from a historical one work like other web
+browsers: it will delete any \"future\" history elements before adding
+the new page to the end of the history.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A"
+ (when (> eww-history-position 1)
+ (setq eww-history (nthcdr (1- eww-history-position) eww-history)
+ ;; We don't really need to set this since `eww--before-browse'
+ ;; sets it too, but this ensures that other callers can use
+ ;; this function and get the expected results.
+ eww-history-position 1)))
+
+(defun eww-clone-previous-history ()
+ "Clone and prepend entries in `eww-history' up to the currently-shown one.
+These cloned entries get added to the beginning of `eww-history' so that
+it's possible to navigate back to the very first page for this EWW
+without deleting any history entries.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A E D C B A
+
+This is useful for setting `eww-before-browse-history-function' (which
+see)."
+ (when (> eww-history-position 1)
+ (setq eww-history (take eww-history-limit
+ (append (nthcdr (1- eww-history-position)
+ eww-history)
+ eww-history))
+ ;; As with `eww-delete-future-history', we don't really need
+ ;; to set this since `eww--before-browse' sets it too, but
+ ;; let's be thorough.
+ eww-history-position 1)))
(defvar eww-current-buffer)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index f10b5b8fc12..a06740528e9 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated."
(setq imap-capability nil)
(setq streams nil))))))
(when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ (setq imap-mailbox-data (obarray-make imap-mailbox-prime)))
;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer)
(when imap-stream
buffer))))
@@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select."
(concat (if examine "EXAMINE" "SELECT") " \""
mailbox "\"")))
(progn
- (setq imap-message-data (make-vector imap-message-prime 0)
+ (setq imap-message-data (obarray-make imap-message-prime)
imap-state (if examine 'examine 'selected))
imap-current-mailbox)
;; Failed SELECT/EXAMINE unselects current mailbox
@@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'."
(string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
@@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs."
(imap-mailbox-get-1 'appenduid mailbox)
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 17fdffd619d..09df5f5a9bb 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -784,8 +784,9 @@ size, and full-buffer size."
(or shr-current-font 'shr-text)))))))))
(defun shr-fill-lines (start end)
- (if (or (not shr-fill-text) (<= shr-internal-width 0))
- nil
+ "Indent and fill text from START to END.
+When `shr-fill-text' is nil, only indent."
+ (unless (<= shr-internal-width 0)
(save-restriction
(narrow-to-region start end)
(goto-char start)
@@ -807,6 +808,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
+ "Indent and fill the current line.
+When `shr-fill-text' is nil, only indent."
(let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
shr-indentation))
(continuation (get-text-property
@@ -821,9 +824,11 @@ size, and full-buffer size."
`,(shr-face-background face))))
(setq start (point))
(setq shr-indentation (or continuation shr-indentation))
- ;; If we have an indentation that's wider than the width we're
- ;; trying to fill to, then just give up and don't do any filling.
- (when (< shr-indentation shr-internal-width)
+ ;; Fill the current line, unless `shr-fill-text' is unset, or we
+ ;; have an indentation that's wider than the width we're trying to
+ ;; fill to.
+ (when (and shr-fill-text
+ (< shr-indentation shr-internal-width))
(shr-vertical-motion shr-internal-width)
(when (looking-at " $")
(delete-region (point) (line-end-position)))
@@ -1437,13 +1442,85 @@ ones, in case fg and bg are nil."
(shr-dom-print elem)))))
(insert (format "</%s>" (dom-tag dom))))
+(defconst shr-correct-attribute-case
+ '((attributename . attributeName)
+ (attributetype . attributeType)
+ (basefrequency . baseFrequency)
+ (baseprofile . baseProfile)
+ (calcmode . calcMode)
+ (clippathunits . clipPathUnits)
+ (diffuseconstant . diffuseConstant)
+ (edgemode . edgeMode)
+ (filterunits . filterUnits)
+ (glyphref . glyphRef)
+ (gradienttransform . gradientTransform)
+ (gradientunits . gradientUnits)
+ (kernelmatrix . kernelMatrix)
+ (kernelunitlength . kernelUnitLength)
+ (keypoints . keyPoints)
+ (keysplines . keySplines)
+ (keytimes . keyTimes)
+ (lengthadjust . lengthAdjust)
+ (limitingconeangle . limitingConeAngle)
+ (markerheight . markerHeight)
+ (markerunits . markerUnits)
+ (markerwidth . markerWidth)
+ (maskcontentunits . maskContentUnits)
+ (maskunits . maskUnits)
+ (numoctaves . numOctaves)
+ (pathlength . pathLength)
+ (patterncontentunits . patternContentUnits)
+ (patterntransform . patternTransform)
+ (patternunits . patternUnits)
+ (pointsatx . pointsAtX)
+ (pointsaty . pointsAtY)
+ (pointsatz . pointsAtZ)
+ (preservealpha . preserveAlpha)
+ (preserveaspectratio . preserveAspectRatio)
+ (primitiveunits . primitiveUnits)
+ (refx . refX)
+ (refy . refY)
+ (repeatcount . repeatCount)
+ (repeatdur . repeatDur)
+ (requiredextensions . requiredExtensions)
+ (requiredfeatures . requiredFeatures)
+ (specularconstant . specularConstant)
+ (specularexponent . specularExponent)
+ (spreadmethod . spreadMethod)
+ (startoffset . startOffset)
+ (stddeviation . stdDeviation)
+ (stitchtiles . stitchTiles)
+ (surfacescale . surfaceScale)
+ (systemlanguage . systemLanguage)
+ (tablevalues . tableValues)
+ (targetx . targetX)
+ (targety . targetY)
+ (textlength . textLength)
+ (viewbox . viewBox)
+ (viewtarget . viewTarget)
+ (xchannelselector . xChannelSelector)
+ (ychannelselector . yChannelSelector)
+ (zoomandpan . zoomAndPan))
+ "Attributes for correcting the case in SVG and MathML.
+Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .")
+
+(defun shr-correct-dom-case (dom)
+ "Correct the case for SVG segments."
+ (dolist (attr (dom-attributes dom))
+ (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case)))
+ (setcar attr rep)))
+ (dolist (child (dom-children dom))
+ (shr-correct-dom-case child))
+ dom)
+
(defun shr-tag-svg (dom)
(when (and (image-type-available-p 'svg)
(not shr-inhibit-images)
(dom-attr dom 'width)
(dom-attr dom 'height))
- (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8)
- 'image/svg+xml)
+ (funcall shr-put-image-function
+ (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8)
+ 'image/svg+xml)
"SVG Image")))
(defun shr-tag-sup (dom)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fddc6e21bcc..a6ba556e7ae 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -354,7 +354,7 @@ Used to bracket operations which move point in the sieve-buffer."
(let ((script (buffer-string))
(script-name (file-name-sans-extension (buffer-name)))
err)
- (with-current-buffer (get-buffer sieve-buffer)
+ (with-current-buffer sieve-buffer
(setq err (sieve-manage-putscript
(or name sieve-buffer-script-name script-name)
script sieve-manage-buffer))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2e4ad1cc412..da23d062c2e 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -263,9 +263,10 @@ arguments to pass to the OPERATION."
(tramp-convert-file-attributes v localname id-format
(and
(tramp-adb-send-command-and-check
- v (format "%s -d -l %s | cat"
+ v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
(with-current-buffer (tramp-get-buffer v)
(tramp-adb-sh-fix-ls-output)
(cdar (tramp-do-parse-file-attributes-with-ls v)))))))
@@ -316,9 +317,10 @@ arguments to pass to the OPERATION."
directory full match nosort id-format count
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s | cat"
+ v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
;; We insert also filename/. and filename/.., because "ls"
;; doesn't on some file systems, like "sdcard".
(unless (search-backward-regexp (rx "." eol) nil t)
@@ -440,10 +442,12 @@ Emacs dired can't find files."
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (tramp-adb-send-command
- v (format "%s -a %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (unless (tramp-adb-send-command-and-check
+ v (format "(%s -a %s; echo tramp_exit_status $?) | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname))
+ nil t)
+ (erase-buffer))
(mapcar
(lambda (f)
(if (file-directory-p (expand-file-name f directory))
@@ -504,12 +508,11 @@ Emacs dired can't find files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (if (tramp-file-property-p v localname "file-attributes")
- (tramp-check-cached-permissions v ?w)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ ;; The file-attributes cache is unreliable since its
+ ;; information does not take partition writability into
+ ;; account, so a call to test must never be skipped.
+ (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))
@@ -1142,17 +1145,23 @@ error and non-nil on success."
(while (search-forward-regexp (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
-(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
+(defun tramp-adb-send-command-and-check
+ (vec command &optional exit-status command-augmented-p)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit
status. If COMMAND is nil, just sends `echo $?'. Returns nil if
the exit status is not equal 0, and t otherwise.
+If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit
+status upon completion and need not be modified.
+
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-adb-send-command
vec (if command
- (format "%s; echo tramp_exit_status $?" command)
+ (if command-augmented-p
+ command
+ (format "%s; echo tramp_exit_status $?" command))
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
@@ -1230,7 +1239,7 @@ connection if a previous connection has died for some reason."
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
(args (tramp-expand-args
- vec 'tramp-login-args ?d (or device "")))
+ vec 'tramp-login-args nil ?d (or device "")))
(p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply
@@ -1257,7 +1266,7 @@ connection if a previous connection has died for some reason."
(tramp-set-connection-property
p "prompt" (rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
- vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ vec (format "PS1=\"///\"\"%s\"\"#$\" PS2=''" prompt))
;; Disable line editing.
(tramp-adb-send-command
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el
new file mode 100644
index 00000000000..09bee323f5e
--- /dev/null
+++ b/lisp/net/tramp-androidsu.el
@@ -0,0 +1,561 @@
+;;; tramp-androidsu.el --- Tramp method for Android superuser shells -*- lexical-binding:t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Po Lu
+;; 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:
+
+;; `su' method implementation for Android.
+;;
+;; The `su' method struggles (as do other shell-based methods) with the
+;; crippled versions of many Unix utilities installed on Android,
+;; workarounds for which are implemented in the `adb' method. This
+;; method defines a shell-based method that is identical in function to
+;; and replaces if connecting to a local Android machine `su', but
+;; reuses such code from the `adb' method where applicable and also
+;; provides for certain mannerisms of popular Android `su'
+;; implementations.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-adb)
+(require 'tramp-sh)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-method "androidsu"
+ "When this method name is used, forward all calls to su.")
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-mount-global-namespace t
+ "When non-nil, browse files from within the global mount namespace.
+On systems that assign each application a unique view of the
+filesystem by executing them within individual mount namespaces
+and thus conceal each application's data directories from
+others, invoke `su' with the option `-mm' in order for the shell
+launched to run within the global mount namespace, so that Tramp
+may edit files belonging to any and all applications."
+ :group 'tramp
+ :version "30.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-remote-path '("/system/bin"
+ "/system/xbin")
+ "Directories in which to search for transfer programs and the like."
+ :group 'tramp
+ :version "30.1"
+ :type '(list string))
+
+(defvar tramp-androidsu-su-mm-supported 'unknown
+ "Whether `su -mm' is supported on this system.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-shell-name "/system/bin/sh"
+ "Name of the local shell on Android.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp"
+ "Name of the local temporary directory on Android.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-androidsu-method
+ (tramp-login-program "su")
+ (tramp-login-args (("-") ("%u")))
+ (tramp-remote-shell ,tramp-androidsu-local-shell-name)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-tmpdir ,tramp-androidsu-local-tmp-directory)
+ (tramp-connection-timeout 10)
+ (tramp-shell-name ,tramp-androidsu-local-shell-name)))
+ (add-to-list 'tramp-default-user-alist
+ `(,tramp-androidsu-method nil ,tramp-root-id-string)))
+
+(defvar android-use-exec-loader) ; androidfns.c.
+
+(defun tramp-androidsu-maybe-open-connection (vec)
+ "Open a connection VEC if not already open.
+Mostly identical to `tramp-adb-maybe-open-connection', but also disables
+multibyte mode and waits for the shell prompt to appear."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-debug-message vec "Opening connection"
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name"))
+ (process-environment (copy-sequence process-environment)))
+ ;; Open a new connection.
+ (condition-case err
+ (unless (process-live-p p)
+ (with-tramp-progress-reporter
+ vec 3
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ (format "Opening connection %s for %s using %s"
+ process-name
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection %s for %s@%s using %s"
+ process-name
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+ (let* ((coding-system-for-read 'utf-8-unix)
+ (process-connection-type tramp-process-connection-type)
+ ;; The executable loader cannot execute setuid
+ ;; binaries, such as su.
+ (android-use-exec-loader nil)
+ (p (start-process (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ ;; Disregard
+ ;; `tramp-encoding-shell', as
+ ;; there's no guarantee that it's
+ ;; possible to execute it with
+ ;; `android-use-exec-loader' off.
+ tramp-androidsu-local-shell-name "-i"))
+ (user (tramp-file-name-user vec))
+ command)
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+ ;; Replace `login-args' place holders.
+ (setq command (format "exec su - %s || exit" user))
+ ;; Attempt to execute the shell inside the global mount
+ ;; namespace if requested.
+ (when tramp-androidsu-mount-global-namespace
+ (progn
+ (when (eq tramp-androidsu-su-mm-supported 'unknown)
+ ;; Change the prompt in advance so that
+ ;; `tramp-adb-send-command-and-check' can call
+ ;; `tramp-search-regexp'.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument
+ tramp-end-of-output)))
+ (setq tramp-androidsu-su-mm-supported
+ ;; Detect support for `su -mm'.
+ (tramp-adb-send-command-and-check
+ vec "su -mm -c 'exit 24'" 24)))
+ (when tramp-androidsu-su-mm-supported
+ (tramp-set-connection-property
+ vec "remote-namespace" t)
+ (setq command (format "exec su -mm - %s || exit"
+ user)))))
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-adb-send-command vec command t t)
+ ;; Android su binaries contact a background service to
+ ;; obtain authentication; during this process, input
+ ;; received is discarded, so input cannot be
+ ;; guaranteed to reach the root shell until its prompt
+ ;; is displayed.
+ (with-current-buffer (process-buffer p)
+ (tramp-wait-for-regexp p tramp-connection-timeout
+ "#[[:space:]]*$"))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+ ;; Change prompt.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument tramp-end-of-output)))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+ ;; Disable Unicode, for otherwise Unicode filenames will
+ ;; not be decoded correctly.
+ (tramp-adb-send-command vec "set +U")
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+ ;; Disable echo expansion.
+ (tramp-adb-send-command
+ vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
+ ;; Check whether the echo has really been disabled.
+ ;; Some implementations, like busybox, don't support
+ ;; disabling.
+ (tramp-adb-send-command vec "echo foo" t)
+ (with-current-buffer (process-buffer p)
+ (goto-char (point-min))
+ (when (looking-at-p "echo foo")
+ (tramp-set-connection-property p "remote-echo" t)
+ (tramp-message vec 5 "Remote echo still on. Ok.")
+ ;; Make sure backspaces and their echo are enabled
+ ;; and no line width magic interferes with them.
+ (tramp-adb-send-command
+ vec "stty icanon erase ^H cols 32767" t)))
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))))
+ ;; Cleanup, and propagate the signal.
+ ((error quit)
+ (tramp-cleanup-connection vec t)
+ (signal (car err) (cdr err)))))))
+
+(defun tramp-androidsu-generate-wrapper (function)
+ "Return connection wrapper function for FUNCTION.
+Return a function which temporarily substitutes local replacements for
+the `adb' method's connection management functions around a call to
+FUNCTION."
+ (lambda (&rest args)
+ (let ((tramp-adb-wait-for-output
+ (symbol-function #'tramp-adb-wait-for-output))
+ (tramp-adb-maybe-open-connection
+ (symbol-function #'tramp-adb-maybe-open-connection)))
+ (unwind-protect
+ (progn
+ ;; `tramp-adb-wait-for-output' addresses problems introduced
+ ;; by the adb utility itself, not Android utilities, so
+ ;; replace it with the regular Tramp function.
+ (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output)
+ ;; Likewise, except some special treatment is necessary on
+ ;; account of flaws in Android's su implementation.
+ (fset 'tramp-adb-maybe-open-connection
+ #'tramp-androidsu-maybe-open-connection)
+ (apply function args))
+ ;; Restore the original definitions of the functions overridden
+ ;; above.
+ (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output)
+ (fset 'tramp-adb-maybe-open-connection
+ tramp-adb-maybe-open-connection)))))
+
+(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file)
+
+(defalias 'tramp-androidsu-handle-delete-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory))
+
+(defalias 'tramp-androidsu-handle-delete-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file))
+
+(defalias 'tramp-androidsu-handle-directory-files-and-attributes
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-directory-files-and-attributes))
+
+(defalias 'tramp-androidsu-handle-exec-path
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path))
+
+(defalias 'tramp-androidsu-handle-file-attributes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes))
+
+(defalias 'tramp-androidsu-handle-file-executable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p))
+
+(defalias 'tramp-androidsu-handle-file-exists-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p))
+
+(defalias 'tramp-androidsu-handle-file-local-copy
+ #'tramp-sh-handle-file-local-copy)
+
+(defalias 'tramp-androidsu-handle-file-name-all-completions
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-file-name-all-completions))
+
+(defalias 'tramp-androidsu-handle-file-readable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p))
+
+(defalias 'tramp-androidsu-handle-file-system-info
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info))
+
+(defalias 'tramp-androidsu-handle-file-writable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p))
+
+(defalias 'tramp-androidsu-handle-make-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory))
+
+(defun tramp-androidsu-handle-make-process (&rest args)
+ "Like `tramp-handle-make-process', but modified for Android."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory tramp-compat-temporary-file-directory)
+ (name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (bufferp buffer) (string-or-null-p buffer))
+ (signal 'wrong-type-argument (list #'bufferp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (eq filter t) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
+ (env (mapcar
+ (lambda (elt)
+ (when (tramp-compat-string-search "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when
+ (and
+ (tramp-compat-string-search "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value 'process-environment))))
+ (setq env (cons elt env)))))
+ ;; Add remote path if exists.
+ (env (let ((remote-path
+ (string-join (tramp-get-remote-path v) ":")))
+ (setenv-internal env "PATH" remote-path 'keep)))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append
+ `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(string-join command " ")))
+ command))
+ p)
+ ;; Generate a command to start the process using `su' with
+ ;; suitable options for specifying the mount namespace and
+ ;; suchlike.
+ (setq
+ p (make-process
+ :name name :buffer buffer
+ :command (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-" user "-c") command)
+ (append (list "su" "-" user "-c") command))
+ :coding coding :noquery noquery :connection-type connection-type
+ :sentinel sentinel :stderr stderr))
+ ;; Set filter. Prior Emacs 29.1, it doesn't work reliably
+ ;; to provide it as `make-process' argument when filter is
+ ;; t. See Bug#51177.
+ (when filter
+ (set-process-filter p filter))
+ (tramp-post-process-creation p v)
+ ;; Query flag is overwritten in `tramp-post-process-creation',
+ ;; so we reset it.
+ (set-process-query-on-exit-flag p (null noquery))
+ ;; This is needed for ssh or PuTTY based processes, and
+ ;; only if the respective options are set. Perhaps, the
+ ;; setting could be more fine-grained.
+ ;; (process-put p 'tramp-shared-socket t)
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
+ (when (bufferp stderr)
+ (tramp-taint-remote-process-buffer stderr))
+ p)))))
+
+(defalias 'tramp-androidsu-handle-make-symbolic-link
+ #'tramp-sh-handle-make-symbolic-link)
+
+(defalias 'tramp-androidsu-handle-process-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file))
+
+(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file)
+
+(defalias 'tramp-androidsu-handle-set-file-modes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes))
+
+(defalias 'tramp-androidsu-handle-set-file-times
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times))
+
+(defalias 'tramp-androidsu-handle-get-remote-gid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid))
+
+(defalias 'tramp-androidsu-handle-get-remote-groups
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups))
+
+(defalias 'tramp-androidsu-handle-get-remote-uid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid))
+
+(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-file-name-handler-alist
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-androidsu-handle-copy-file)
+ (delete-directory . tramp-androidsu-handle-delete-directory)
+ (delete-file . tramp-androidsu-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-androidsu-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-androidsu-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-androidsu-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-androidsu-handle-file-executable-p)
+ (file-exists-p . tramp-androidsu-handle-file-exists-p)
+ (file-group-gid . tramp-handle-file-group-gid)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-androidsu-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions
+ . tramp-androidsu-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-androidsu-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-androidsu-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
+ (file-writable-p . tramp-androidsu-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
+ (load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-androidsu-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-androidsu-handle-make-process)
+ (make-symbolic-link . tramp-androidsu-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
+ (process-file . tramp-androidsu-handle-process-file)
+ (rename-file . tramp-androidsu-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-androidsu-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-androidsu-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
+ (tramp-get-remote-gid . tramp-androidsu-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-androidsu-handle-get-remote-groups)
+ (tramp-get-remote-uid . tramp-androidsu-handle-get-remote-uid)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-androidsu-handle-write-region))
+ "Alist of Tramp handler functions for superuser sessions on Android.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-androidsu-file-name-p (vec-or-filename)
+ "Check whether VEC-OR-FILENAME is for the `androidsu' method."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (equal (tramp-file-name-method vec) tramp-androidsu-method)))
+
+;;;###tramp-autoload
+(defun tramp-androidsu-file-name-handler (operation &rest args)
+ "Invoke the `androidsu' handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+ (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler))
+
+;;; Default connection-local variables for Tramp.
+
+(defconst tramp-androidsu-connection-local-default-variables
+ `((tramp-remote-path . ,tramp-androidsu-remote-path))
+ "Default connection-local variables for remote androidsu connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-androidsu-connection-local-default-profile
+ tramp-androidsu-connection-local-default-variables)
+
+(connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-androidsu-connection-local-default-profile)
+
+(with-eval-after-load 'shell
+ (connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-adb-connection-local-default-shell-profile
+ 'tramp-adb-connection-local-default-ps-profile))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-androidsu 'force)))
+
+(provide 'tramp-androidsu)
+;;; tramp-androidsu.el ends here
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 298cacdb0e0..59c4223794c 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -387,6 +387,8 @@ arguments to pass to the OPERATION."
;;;###autoload
(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
+ ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it
+ ;; isn't autoloaded.
(when (and tramp-archive-enabled
(not
(rassq 'tramp-archive-file-name-handler file-name-handler-alist)))
@@ -443,7 +445,7 @@ arguments to pass to the OPERATION."
(and (tramp-archive-file-name-p name)
(match-string 2 name)))
-(defvar tramp-archive-hash (make-hash-table :test 'equal)
+(defvar tramp-archive-hash (make-hash-table :test #'equal)
"Hash table for archive local copies.
The hash key is the archive name. The value is a cons of the
used `tramp-file-name' structure for tramp-gvfs, and the file
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 25123a6e282..225a26ad1cd 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) default
(let* ((hash (tramp-get-hash-table key))
@@ -191,7 +190,6 @@ Return DEFAULT if not set."
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) value
(let ((hash (tramp-get-hash-table key)))
@@ -224,7 +222,6 @@ Return VALUE."
;;;###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))
(unless (eq key tramp-cache-undefined)
(remhash property (tramp-get-hash-table key))
@@ -239,7 +236,6 @@ Return VALUE."
;; `file-name-directory' can return nil, for example for "~".
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
@@ -254,7 +250,6 @@ Return VALUE."
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(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))
(unless (eq key tramp-cache-undefined)
(tramp-message key 8 "%s" (tramp-file-name-localname key))
@@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY."
"Save PROPERTY, run BODY, reset PROPERTY.
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash) (gethash ,property hash))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (consp cached)
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-file-properties (key file properties &rest body)
@@ -356,22 +349,20 @@ Preserve timestamps."
PROPERTIES is a list of file properties (strings).
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (and (hash-table-p hash)
- (mapcar
- (lambda (property) (cons property (gethash property hash)))
- ,properties))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (consp (cdr value))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;; -- Properties --
@@ -473,38 +464,36 @@ used to cache connection properties of the local machine."
(defmacro with-tramp-saved-connection-property (key property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash)
- (gethash ,property hash tramp-cache-undefined))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (not (eq cached tramp-cache-undefined))
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-connection-properties (key properties &rest body)
"Save PROPERTIES, run BODY, reset PROPERTIES.
PROPERTIES is a list of file properties (strings)."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (mapcar
- (lambda (property)
- (cons property (gethash property hash tramp-cache-undefined)))
- ,properties)))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (not (eq (cdr value) tramp-cache-undefined))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;;###tramp-autoload
(defun tramp-cache-print (table)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index a545a8e7273..d3af7a009ec 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -281,7 +281,7 @@ non-nil."
;; Remove all buffers with a remote default-directory which fit the hook.
(dolist (name (tramp-list-remote-buffers))
(and (buffer-live-p (get-buffer name))
- (with-current-buffer (get-buffer name)
+ (with-current-buffer name
(run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook))
(kill-buffer name))))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 8065ba01734..98de0dba7ff 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -309,7 +309,7 @@ Also see `ignore'."
;; Macro `connection-local-p' is new in Emacs 30.1.
(if (macrop 'connection-local-p)
- (defalias 'tramp-compat-connection-local-p #'connection-local-p)
+ (defalias 'tramp-compat-connection-local-p 'connection-local-p)
(defmacro tramp-compat-connection-local-p (variable)
"Non-nil if VARIABLE has a connection-local binding in `default-directory'."
`(let (connection-local-variables-alist file-local-variables-alist)
@@ -330,6 +330,18 @@ Also see `ignore'."
;;; TODO:
;;
;; * Starting with Emacs 27.1, there's no need to escape open
-;; parentheses with a backslash in docstrings anymore.
+;; parentheses with a backslash in docstrings anymore. However,
+;; `outline-minor-mode' has still problems with this. Since there
+;; are developers using `outline-minor-mode' in Lisp files, we still
+;; keep this quoting.
+;;
+;; * Starting with Emacs 29.1, use `buffer-match-p'.
+;;
+;; * Starting with Emacs 29.1, use `string-split'.
+;;
+;; * Starting with Emacs 30.1, there is `handler-bind'. Use it
+;; instead of `condition-case' when the origin of an error shall be
+;; kept, for example when the HANDLER propagates the error with
+;; `(signal (car err) (cdr err)'.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index 1f578949e4d..30639cbeb85 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -31,15 +31,20 @@
;; Open a file on a running Docker container:
;;
;; C-x C-f /docker:USER@CONTAINER:/path/to/file
+;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file
;;
;; or Podman:
;;
;; C-x C-f /podman:USER@CONTAINER:/path/to/file
+;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file
;;
;; Where:
;; USER is the user on the container to connect as (optional).
;; CONTAINER is the container to connect to.
;;
+;; "docker" and "podman" are inline methods, "dockercp" and "podmancp"
+;; are out-of-band methods.
+;;
;;
;;
;; Open file in a Kubernetes container:
@@ -142,10 +147,20 @@ If it is nil, the default context will be used."
"Tramp method name to use to connect to Docker containers.")
;;;###tramp-autoload
+(defconst tramp-dockercp-method "dockercp"
+ "Tramp method name to use to connect to Docker containers.
+This is for out-of-band connections.")
+
+;;;###tramp-autoload
(defconst tramp-podman-method "podman"
"Tramp method name to use to connect to Podman containers.")
;;;###tramp-autoload
+(defconst tramp-podmancp-method "podmancp"
+ "Tramp method name to use to connect to Podman containers.
+This is for out-of-band connections.")
+
+;;;###tramp-autoload
(defconst tramp-kubernetes-method "kubernetes"
"Tramp method name to use to connect to Kubernetes containers.")
@@ -183,7 +198,8 @@ BODY is the backend specific code."
(defun tramp-container--completion-function (method)
"List running containers available for connection.
METHOD is the Tramp method to be used for \"ps\", either
-`tramp-docker-method' or `tramp-podman-method'.
+`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method',
+or `tramp-podmancp-method'.
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
@@ -376,6 +392,23 @@ see its function help for a description of the format."
(tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods
+ `(,tramp-dockercp-method
+ (tramp-login-program ,tramp-docker-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-docker-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
+ (add-to-list 'tramp-methods
`(,tramp-podman-method
(tramp-login-program ,tramp-podman-program)
(tramp-login-args (("exec")
@@ -389,6 +422,23 @@ see its function help for a description of the format."
(tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods
+ `(,tramp-podmancp-method
+ (tramp-login-program ,tramp-podman-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-podman-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
+ (add-to-list 'tramp-methods
`(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program)
(tramp-login-args (("%x") ; context and namespace.
@@ -432,10 +482,18 @@ see its function help for a description of the format."
`((tramp-container--completion-function ,tramp-docker-method)))
(tramp-set-completion-function
+ tramp-dockercp-method
+ `((tramp-container--completion-function ,tramp-dockercp-method)))
+
+ (tramp-set-completion-function
tramp-podman-method
`((tramp-container--completion-function ,tramp-podman-method)))
(tramp-set-completion-function
+ tramp-podmancp-method
+ `((tramp-container--completion-function ,tramp-podmancp-method)))
+
+ (tramp-set-completion-function
tramp-kubernetes-method
`((tramp-kubernetes--completion-function ,tramp-kubernetes-method)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 72589e7ce4a..93071ed7350 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
"Invoke the GVFS related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (unless tramp-gvfs-enabled
+ ;; `file-remote-p' must not return an error. (Bug#68976)
+ (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(if-let ((filename (apply #'tramp-file-name-for-operation operation args))
(tramp-gvfs-dbus-event-vector
@@ -2293,8 +2294,8 @@ connection if a previous connection has died for some reason."
;; indicated by the "mounted" signal, i.e. the
;; "fuse-mountpoint" file property.
(with-timeout
- ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
- tramp-connection-timeout)
+ ((tramp-get-method-parameter
+ vec 'tramp-connection-timeout tramp-connection-timeout)
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(tramp-error
vec 'file-error
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index c0b60f57e40..e1f0b2a3495 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'."
(when minibuffer-completing-file-name
(setq tramp-rfn-eshadow-overlay
(make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
- ;; Copy rfn-eshadow-overlay properties.
+ ;; Copy `rfn-eshadow-overlay' properties.
(let ((props (overlay-properties rfn-eshadow-overlay)))
(while props
;; The `field' property prevents correct minibuffer
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 96071e626a5..97e94a51e7a 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -353,6 +353,7 @@ applicable)."
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
forces the backtrace even if `tramp-verbose' is less than 10.
This function is meant for debugging purposes."
+ (declare (tramp-suppress-trace t))
(let ((tramp-verbose (if force 10 tramp-verbose)))
(when (>= tramp-verbose 10)
(tramp-message
@@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
+ (declare (tramp-suppress-trace t))
(let (signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
@@ -391,6 +393,7 @@ tramp-tests.el.")
"Emit an error, and show BUF.
If BUF is nil, show the connection buf. Wait for 30\", or until
an input event arrives. The other arguments are passed to `tramp-error'."
+ (declare (tramp-suppress-trace t))
(save-window-excursion
(let* ((buf (or (and (bufferp buf) buf)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
@@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
+ (declare (tramp-suppress-trace t))
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6489f473634..66e648624b2 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -38,7 +38,6 @@
(declare-function dired-compress-file "dired-aux")
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
-(defvar ls-lisp-use-insert-directory-program)
;; Added in Emacs 28.1.
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
@@ -283,6 +282,7 @@ The string is used in `tramp-methods'.")
(tramp-copy-program "nc")
;; We use "-v" for better error tracking.
(tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-copy-file-name (("%f")))
(tramp-remote-copy-program "nc")
;; We use "-p" as required for newer busyboxes. For older
;; busybox/nc versions, the value must be (("-l") ("%r")). This
@@ -429,6 +429,9 @@ The string is used in `tramp-methods'.")
eos)
nil ,(user-login-name))))
+(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f"))
+ "Default `tramp-copy-file-name' entry for out-of-band methods.")
+
;;;###tramp-autoload
(defconst tramp-completion-function-alist-rsh
'((tramp-parse-rhosts "/etc/hosts.equiv")
@@ -548,6 +551,7 @@ shell from reading its init file."
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -567,6 +571,7 @@ corresponding PATTERN matches, the ACTION function is called.")
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -2010,7 +2015,7 @@ ID-FORMAT valid values are `string' and `integer'."
#'copy-directory
(list dirname newname keep-date parents copy-contents))))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name (expand-file-name newname) nil
(tramp-flush-file-properties v localname)))))))
@@ -2149,24 +2154,24 @@ file names."
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
- ;; Handle `preserve-extended-attributes'. We ignore
- ;; possible errors, because ACL strings could be
- ;; incompatible.
- (when-let ((attributes (and preserve-extended-attributes
- (file-extended-attributes filename))))
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(tramp-compat-set-file-times
@@ -2398,10 +2403,10 @@ The method used must be an out-of-band method."
#'file-name-as-directory
#'identity)
(if v1
- (tramp-make-copy-program-file-name v1)
+ (tramp-make-copy-file-name v1)
(file-name-unquote filename)))
target (if v2
- (tramp-make-copy-program-file-name v2)
+ (tramp-make-copy-file-name v2)
(file-name-unquote newname)))
;; Check for listener port.
@@ -2438,9 +2443,9 @@ The method used must be an out-of-band method."
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-args
;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement for
+ ;; KEEP-DATE argument is non-nil), or a replacement for
;; the whole keep-date sublist.
- (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec))
;; `tramp-ssh-controlmaster-options' is a string instead
;; of a list. Unflatten it.
copy-args
@@ -2449,11 +2454,11 @@ The method used must be an out-of-band method."
(lambda (x) (if (tramp-compat-string-search " " x)
(split-string x) x))
copy-args))
- copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec)
remote-copy-program
(tramp-get-method-parameter v 'tramp-remote-copy-program)
remote-copy-args
- (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@@ -2636,7 +2641,7 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (if (and (featurep 'ls-lisp)
+ (if (and (boundp 'ls-lisp-use-insert-directory-program)
(not ls-lisp-use-insert-directory-program))
(tramp-handle-insert-directory
filename switches wildcard full-directory-p)
@@ -3652,20 +3657,20 @@ filled are described in `tramp-bundle-read-file-names'."
(dolist
(elt
- (ignore-errors
+ (with-current-buffer (tramp-get-connection-buffer vec)
;; We cannot use `tramp-send-command-and-read', because
;; this does not cooperate well with heredoc documents.
- (tramp-send-command
- vec
- (format
- "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n"
- tramp-end-of-heredoc
- (mapconcat #'tramp-shell-quote-argument files "\n")
- tramp-end-of-heredoc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer)))))
+ (unless (tramp-send-command-and-check
+ vec
+ (format
+ "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n"
+ tramp-end-of-heredoc
+ (mapconcat #'tramp-shell-quote-argument files "\n")
+ tramp-end-of-heredoc))
+ (tramp-error vec 'file-error "%s" (tramp-get-buffer-string)))
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))
(tramp-set-file-property vec (car elt) "file-exists-p" (nth 1 elt))
(tramp-set-file-property vec (car elt) "file-readable-p" (nth 2 elt))
@@ -4112,7 +4117,7 @@ Only send the definition if it has not already been done."
(unless (member name scripts)
(with-tramp-progress-reporter
vec 5 (format-message "Sending script `%s'" name)
- ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
+ ;; In bash, leading TABs like in `tramp-bundle-read-file-names'
;; could result in unwanted command expansion. Avoid this.
(setq script (tramp-compat-string-replace
(make-string 1 ?\t) (make-string 8 ? ) script))
@@ -5289,7 +5294,8 @@ connection if a previous connection has died for some reason."
(tramp-get-method-parameter hop 'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
- hop 'tramp-connection-timeout))
+ hop 'tramp-connection-timeout
+ tramp-connection-timeout))
(command
(tramp-get-method-parameter
hop 'tramp-login-program))
@@ -5347,14 +5353,14 @@ connection if a previous connection has died for some reason."
;; Add arguments for asynchronous processes.
(when process-name async-args)
(tramp-expand-args
- hop 'tramp-login-args
+ hop 'tramp-login-args nil
?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile))
?n (concat
"2>" (tramp-get-remote-null-device previous-hop))
?l (concat remote-shell " " extra-args " -i"))
;; A restricted shell does not allow "exec".
- (when r-shell '("&&" "exit" "||" "exit")))
+ (when r-shell '("&&" "exit")) '("||" "exit"))
" "))
;; Send the command.
@@ -5364,8 +5370,7 @@ connection if a previous connection has died for some reason."
p vec
(min
pos (with-current-buffer (process-buffer p) (point-max)))
- tramp-actions-before-shell
- (or connection-timeout tramp-connection-timeout))
+ tramp-actions-before-shell connection-timeout)
(tramp-message
vec 3 "Found remote shell prompt on `%s'" l-host)
@@ -5558,8 +5563,8 @@ raises an error."
string
""))
-(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
+(defun tramp-make-copy-file-name (vec)
+ "Create a file name suitable for out-of-band methods."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
@@ -5570,13 +5575,13 @@ 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 (rx "ftp" eos) method)
+ (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method)
(setq localname (tramp-unquote-shell-quote-argument localname)))
- (cond
- ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
- localname)
- ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname))
- (t (format "%s@%s:%s" user host localname)))))
+ (string-join
+ (apply #'tramp-expand-args vec
+ 'tramp-copy-file-name tramp-default-copy-file-name
+ (list ?h (or host "") ?u (or user "") ?f localname))
+ "")))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 8dad599c7e7..d0d56b8967e 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -322,7 +322,7 @@ arguments to pass to the OPERATION."
v (tramp-get-method-parameter v 'tramp-login-program)
nil outbuf display
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
@@ -424,7 +424,7 @@ connection if a previous connection has died for some reason."
(tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-expand-args
- vec 'tramp-mount-args
+ vec 'tramp-mount-args nil
?p (or (tramp-file-name-port vec) ""))))))
(tramp-error
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0c717c4a5aa..7bbfec62753 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -771,7 +771,7 @@ in case of error, t otherwise."
(tramp-get-connection-name vec) (current-buffer)
(append
(tramp-expand-args
- vec 'tramp-sudo-login
+ vec 'tramp-sudo-login nil
?h (or (tramp-file-name-host vec) "")
?u (or (tramp-file-name-user vec) ""))
(flatten-tree args))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2f6b526039f..5b101000926 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -67,11 +67,6 @@
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
-(defvar ls-lisp-dirs-first)
-(defvar ls-lisp-emulation)
-(defvar ls-lisp-ignore-case)
-(defvar ls-lisp-use-insert-directory-program)
-(defvar ls-lisp-verbosity)
(defvar tramp-prefix-format)
(defvar tramp-prefix-regexp)
(defvar tramp-method-regexp)
@@ -219,7 +214,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
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
- except Andtoid, this might not be true for the value that you
+ except Android, this might not be true for the value that you
decide to use. You Have Been Warned.
* `tramp-remote-shell-login'
@@ -306,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined:
This specifies the list of parameters to pass to the above mentioned
program, the hints for `tramp-login-args' also apply here.
+ * `tramp-copy-file-name'
+ The remote source or destination file name for out-of-band methods.
+ You can use \"%u\" and \"%h\" like in `tramp-login-args'.
+ Additionally, \"%f\" denotes the local file name part. This list
+ will be expanded to a string without spaces between the elements of
+ the list.
+
+ The default value is `tramp-default-copy-file-name'.
+
* `tramp-copy-env'
A list of environment variables and their values, which will
be set when calling `tramp-copy-program'.
@@ -320,8 +324,8 @@ pair of the form (KEY VALUE). The following KEYs are defined:
chosen port for the remote listener.
* `tramp-copy-keep-date'
- This specifies whether the copying program when the preserves the
- timestamp of the original file.
+ This specifies whether the copying program preserves the timestamp
+ of the original file.
* `tramp-copy-keep-tmpfile'
This specifies whether a temporary local file shall be kept
@@ -562,7 +566,7 @@ host runs a restricted shell, it shall be added to this list, too."
eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "30.1"
+ :version "29.3"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -750,9 +754,8 @@ The regexp should match at end of buffer."
;; A security key requires the user physically to touch the device
;; with their finger. We must tell it to the user.
-;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and
-;; Titankey, which have also passed the tests, do not show such a
-;; message.
+;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and
+;; Yubikey.
(defcustom tramp-security-key-confirm-regexp
(rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
@@ -775,6 +778,14 @@ The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
+;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey.
+(defcustom tramp-security-key-pin-regexp
+ (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n")))
+ "Regular expression matching security key PIN prompt.
+The regexp should match at end of buffer."
+ :version "29.3"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank)
"Operation not permitted")
@@ -1085,10 +1096,10 @@ Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos)
"Regexp matching localnames.")
-(defconst tramp-unknown-id-string "UNKNOWN"
+(defvar tramp-unknown-id-string "UNKNOWN"
"String used to denote an unknown user or group.")
-(defconst tramp-unknown-id-integer -1
+(defvar tramp-unknown-id-integer -1
"Integer used to denote an unknown user or group.")
;;;###tramp-autoload
@@ -1205,14 +1216,7 @@ The `ftp' syntax does not support methods.")
;; FIXME: This shouldn't be necessary.
(rx bos "/" (? "[" (* (not "]"))) eos)
(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)
+ (regexp tramp-prefix-regexp)
;; Optional multi-hops.
(* (regexp tramp-remote-file-name-spec-regexp)
@@ -1550,21 +1554,23 @@ LOCALNAME and HOP do not count."
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
-(defun tramp-get-method-parameter (vec param)
+(defun tramp-get-method-parameter (vec param &optional default)
"Return the method parameter PARAM.
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."
+entry does not exist, return DEFAULT."
(let ((hash-entry
(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)
;; Use the static value from `tramp-methods'.
- (when-let ((methods-entry
+ (if-let ((methods-entry
(assoc
param (assoc (tramp-file-name-method vec) tramp-methods))))
- (cadr methods-entry)))))
+ (cadr methods-entry)
+ ;; Return the default value.
+ default))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -2081,7 +2087,7 @@ without a visible progress reporter."
(defmacro with-tramp-timeout (list &rest body)
"Like `with-timeout', but allow SECONDS to be nil.
-(fn (SECONDS TIMEOUT-FORMS...) BODY)"
+\(fn (SECONDS TIMEOUT-FORMS...) BODY)"
(declare (indent 1) (debug ((form body) body)))
(let ((seconds (car list))
(timeout-forms (cdr list)))
@@ -2666,7 +2672,7 @@ not in completion mode."
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
- (rx bos (regexp tramp-prefix-regexp)
+ (rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
@@ -3198,7 +3204,7 @@ Host is always \"localhost\"."
(when (zerop (tramp-call-process nil "getent" nil t nil "passwd"))
(goto-char (point-min))
(cl-loop while (not (eobp)) collect
- (tramp-parse-etc-group-group))))
+ (tramp-parse-passwd-group))))
(tramp-parse-file filename #'tramp-parse-passwd-group))))
(defun tramp-parse-passwd-group ()
@@ -3948,6 +3954,9 @@ Let-bind it when necessary.")
(tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already.
+ ;; Note: We cannot use it as DEFAULT value of
+ ;; `tramp-get-method-parameter', because it would be evalled
+ ;; during the call.
(and (let ((non-essential t)) (tramp-connectable-p v))
(with-tramp-connection-property v "case-insensitive"
(ignore-errors
@@ -4196,6 +4205,11 @@ Let-bind it when necessary.")
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(require 'ls-lisp)
+ (defvar ls-lisp-dirs-first)
+ (defvar ls-lisp-emulation)
+ (defvar ls-lisp-ignore-case)
+ (defvar ls-lisp-use-insert-directory-program)
+ (defvar ls-lisp-verbosity)
(unless switches (setq switches ""))
;; Mark trailing "/".
(when (and (directory-name-p filename)
@@ -4752,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(defvar tramp-extra-expand-args nil
"Method specific arguments.")
-(defun tramp-expand-args (vec parameter &rest spec-list)
+(defun tramp-expand-args (vec parameter default &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
-substitution.
+substitution. DEFAULT is used when PARAMETER is not specified.
SPEC-LIST is a list of char/value pairs used for
`format-spec-make'. It is appended by `tramp-extra-expand-args',
a connection-local variable."
- (let ((args (tramp-get-method-parameter vec parameter))
+ (let ((args (tramp-get-method-parameter vec parameter default))
(extra-spec-list
(mapcar
#'eval
@@ -4939,7 +4953,7 @@ a connection-local variable."
(mapcar
(lambda (x) (split-string x " "))
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
?d (or device "") ?a (or pta "") ?l ""))))
@@ -5442,7 +5456,7 @@ of."
prompt)
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (setq prompt (concat (match-string 1) " "))
+ (setq prompt (concat (string-trim (match-string 1)) " "))
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -5518,14 +5532,16 @@ 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 (rx (any "\r\n")) "" (match-string 0))
+ (with-temp-message (concat (string-trim (match-string 0)) " ")
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
(while (not (ignore-error file-error
(tramp-wait-for-regexp
- proc 0.1 tramp-security-key-confirmed-regexp)))
+ proc 0.1
+ (rx (| (regexp tramp-security-key-confirmed-regexp)
+ (regexp tramp-security-key-pin-regexp)
+ (regexp tramp-security-key-timeout-regexp))))))
(when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
(throw 'tramp-action 'timeout))
(redisplay 'force))))))
@@ -6324,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir"
- (let ((dir
- (tramp-make-tramp-file-name
- vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
+ (let ((dir (tramp-make-tramp-file-name
+ vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp"))))
(or (and (file-directory-p dir) (file-writable-p dir)
(tramp-file-local-name dir))
(tramp-error vec 'file-error "Directory %s not accessible" dir))
@@ -6571,12 +6586,13 @@ Consults the auth-source package."
(tramp-get-connection-property key "login-as")))
(host (tramp-file-name-host-port vec))
(pw-prompt
- (or prompt
- (with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (if (string-match-p "passphrase" (match-string 1))
- (match-string 0)
- (format "%s for %s " (capitalize (match-string 1)) key)))))
+ (string-trim-left
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (if (string-match-p "passphrase" (match-string 1))
+ (match-string 0)
+ (format "%s for %s " (capitalize (match-string 1)) key))))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
(auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index bfabbbeaf34..c131d39c110 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.7.0-pre
+;; Version: 2.7.1-pre
;; Package-Requires: ((emacs "27.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.7.0-pre"
+(defconst tramp-version "2.7.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -78,7 +78,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "27.1"))
"ok"
- (format "Tramp 2.7.0-pre is not fit for %s"
+ (format "Tramp 2.7.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 6abc6e163ed..2692df9d7fa 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -23,7 +23,7 @@
;;; Commentary:
;; This package provides an implementation of the Desktop Notifications
-;; <https://developer.gnome.org/notification-spec/>.
+;; <https://specifications.freedesktop.org/notification-spec/latest/>.
;; In order to activate this package, you must add the following code
;; into your .emacs:
diff --git a/lisp/obarray.el b/lisp/obarray.el
index a26992df8e2..5e646db9ab7 100644
--- a/lisp/obarray.el
+++ b/lisp/obarray.el
@@ -27,24 +27,13 @@
;;; Code:
-(defconst obarray-default-size 59
- "The value 59 is an arbitrary prime number that gives a good hash.")
+(defconst obarray-default-size 4)
+(make-obsolete-variable 'obarray-default-size
+ "obarrays now grow automatically." "30.1")
-(defun obarray-make (&optional size)
- "Return a new obarray of size SIZE or `obarray-default-size'."
- (let ((size (or size obarray-default-size)))
- (if (< 0 size)
- (make-vector size 0)
- (signal 'wrong-type-argument '(size 0)))))
-
-(defun obarray-size (ob)
- "Return the number of slots of obarray OB."
- (length ob))
-
-(defun obarrayp (object)
- "Return t if OBJECT is an obarray."
- (and (vectorp object)
- (< 0 (length object))))
+(defun obarray-size (_ob)
+ (declare (obsolete "obarrays now grow automatically." "30.1"))
+ obarray-default-size)
;; Donā€™t use obarray as a variable name to avoid shadowing.
(defun obarray-get (ob name)
@@ -54,7 +43,7 @@ Return nil otherwise."
(defun obarray-put (ob name)
"Return symbol named NAME from obarray OB.
-Creates and adds the symbol if doesn't exist."
+Creates and adds the symbol if it doesn't exist."
(intern name ob))
(defun obarray-remove (ob name)
diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el
index 26648a4d7bb..8fdcebbd1c4 100644
--- a/lisp/obsolete/eieio-compat.el
+++ b/lisp/obsolete/eieio-compat.el
@@ -150,10 +150,9 @@ Summary:
(lambda (tag &rest _)
(and (symbolp tag) (setq tag (cl--find-class tag))
(eieio--class-p tag)
- (let ((superclasses (eieio--class-precedence-list tag))
+ (let ((superclasses (cl--class-allparents tag))
(specializers ()))
(dolist (superclass superclasses)
- (setq superclass (eieio--class-name superclass))
(push superclass specializers)
(push `(eieio--static ,superclass) specializers))
(nreverse specializers)))))
@@ -240,7 +239,7 @@ Summary:
(declare (obsolete cl-no-applicable-method "25.1"))
(apply #'cl-no-applicable-method method object args))
-(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
+(define-obsolete-function-alias 'call-next-method #'cl-call-next-method "25.1")
(defun next-method-p ()
(declare (obsolete cl-next-method-p "25.1"))
;; EIEIO's `next-method-p' just returned nil when called in an
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 3f05b7fe7ac..e1ea9141f0d 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values."
This hook is run during minibuffer setup if `iswitchb' is active.
For instance:
\(add-hook \\='iswitchb-minibuffer-setup-hook
- \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3)))
+ \\='\(lambda () (setq-local max-mini-window-height 3)))
will constrain the minibuffer to a maximum height of 3 lines when
iswitchb is running."
:type 'hook)
@@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'."
"Set up minibuffer for `iswitchb-buffer'.
Copied from `icomplete-minibuffer-setup-hook'."
(when (iswitchb-entryfn-p)
- (set (make-local-variable 'iswitchb-use-mycompletion) t)
+ (setq-local iswitchb-use-mycompletion t)
(add-hook 'pre-command-hook #'iswitchb-pre-command nil t)
(add-hook 'post-command-hook #'iswitchb-post-command nil t)
(run-hooks 'iswitchb-minibuffer-setup-hook)))
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 6aa388805f2..f065bcaff26 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -116,17 +116,14 @@ newlines are indicated with a symbol."
;; Turn on longlines mode
(progn
(use-hard-newlines 1 'never)
- (set (make-local-variable 'require-final-newline) nil)
+ (setq-local require-final-newline nil)
(add-to-list 'buffer-file-format 'longlines)
(add-hook 'change-major-mode-hook #'longlines-mode-off nil t)
(add-hook 'before-revert-hook #'longlines-before-revert-hook nil t)
(make-local-variable 'longlines-auto-wrap)
- (set (make-local-variable 'isearch-search-fun-function)
- #'longlines-search-function)
- (set (make-local-variable 'replace-search-function)
- #'longlines-search-forward)
- (set (make-local-variable 'replace-re-search-function)
- #'longlines-re-search-forward)
+ (setq-local isearch-search-fun-function #'longlines-search-function)
+ (setq-local replace-search-function #'longlines-search-forward)
+ (setq-local replace-re-search-function #'longlines-re-search-forward)
(add-function :filter-return (local 'filter-buffer-substring-function)
#'longlines-encode-string)
(when longlines-wrap-follows-window-size
@@ -136,8 +133,7 @@ newlines are indicated with a symbol."
(window-width)))
longlines-wrap-follows-window-size
2)))
- (set (make-local-variable 'fill-column)
- (- (window-width) dw)))
+ (setq-local fill-column (- (window-width) dw)))
(add-hook 'window-configuration-change-hook
#'longlines-window-change-function nil t))
(let ((buffer-undo-list t)
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index 6c00ad201f1..4c7b653155e 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -85,9 +85,9 @@ is true, or else the output buffer is displayed."
(set-buffer standard-output)
(insert-buffer-substring pgg-errors-buffer))))
-(defvar pgg-passphrase-cache (make-vector 7 0))
+(defvar pgg-passphrase-cache (obarray-make 7))
-(defvar pgg-pending-timers (make-vector 7 0)
+(defvar pgg-pending-timers (obarray-make 7)
"Hash table for managing scheduled pgg cache management timers.
We associate key and timer, so the timer can be canceled if a new
diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el
index 7393bebdce1..7da51a8a4a8 100644
--- a/lisp/obsolete/quickurl.el
+++ b/lisp/obsolete/quickurl.el
@@ -447,7 +447,7 @@ The key bindings for `quickurl-list-mode' are:
(defun quickurl-list-populate-buffer ()
"Populate the `quickurl-list' buffer."
- (with-current-buffer (get-buffer quickurl-list-buffer-name)
+ (with-current-buffer quickurl-list-buffer-name
(let* ((sizes (or (cl-loop for url in quickurl-urls
collect (length (quickurl-url-description url)))
(list 20)))
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index e0826475e32..258b2b519d9 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -169,12 +169,12 @@ See \\[compile]."
;; compilation-parse-errors will find referenced files by Tramp.
(with-current-buffer next-error-last-buffer
(when (fboundp 'tramp-make-tramp-file-name)
- (set (make-local-variable 'comint-file-name-prefix)
- (funcall
- #'tramp-make-tramp-file-name
- nil ;; method.
- remote-compile-user
- remote-compile-host
- ""))))))
+ (setq-local comint-file-name-prefix
+ (funcall
+ #'tramp-make-tramp-file-name
+ nil ;; method.
+ remote-compile-user
+ remote-compile-host
+ ""))))))
;;; rcompile.el ends here
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index d335aab7499..f834f05cb6d 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -93,7 +93,7 @@
(mapcar #'org-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
- (with-current-buffer (get-buffer "*Calculator*")
+ (with-current-buffer "*Calculator*"
(prog1
(calc-eval (calc-top 1))
(calc-pop 1)))))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index f8195a053bc..06249ed48fa 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3883,7 +3883,7 @@ generating a new one."
;; buffer found
(get-buffer org-agenda-buffer-name)
;; C-u parameter is same as last call
- (with-current-buffer (get-buffer org-agenda-buffer-name)
+ (with-current-buffer org-agenda-buffer-name
(and
(equal current-prefix-arg
org-agenda-last-prefix-arg)
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 6e87e870996..ef96dc024d1 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -6556,7 +6556,7 @@ the expected result."
(error "org-element: Parsing aborted by user. Cache has been cleared.
If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report)."))
(message (substitute-command-keys
- "`org-element--parse-buffer': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.")
+ "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.")
(- org-element--cache-interrupt-C-g-max-count
org-element--cache-interrupt-C-g-count)))
(unless element
diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el
index 73b3c9bbf8c..be90ca398a1 100644
--- a/lisp/org/org-fold-core.el
+++ b/lisp/org/org-fold-core.el
@@ -433,7 +433,7 @@ Return nil when there is no matching folding spec."
(org-fold-core-get-folding-spec-from-alias spec-or-alias))
(defsubst org-fold-core--check-spec (spec-or-alias)
- "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'."
+ "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core-folding-spec-list'."
(unless (org-fold-core-folding-spec-p spec-or-alias)
(error "%s is not a valid folding spec" spec-or-alias)))
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index 737eab5d2bb..fe3bbc658ff 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -109,6 +109,13 @@ previous one, unless VALUE is nil. Return the updated list."
(let ((new-templates nil))
(pcase-dolist (`(,name . ,value) templates)
(let ((old-definition (assoc name new-templates)))
+ ;; This code can be evaluated unconditionally, as a part of
+ ;; loading Org mode. We *must not* evaluate any code present
+ ;; inside the Org buffer while loading. Org buffers may come
+ ;; from various sources, like received email messages from
+ ;; potentially malicious senders. Org mode might be used to
+ ;; preview such messages and no code evaluation from inside the
+ ;; received Org text should ever happen without user consent.
(when (and (stringp value) (string-match-p "\\`(eval\\>" value))
;; Pre-process the evaluation form for faster macro expansion.
(let* ((args (org-macro--makeargs value))
@@ -121,7 +128,7 @@ previous one, unless VALUE is nil. Return the updated list."
(cadr (read value))
(error
(user-error "Invalid definition for macro %S" name)))))
- (setq value (eval (macroexpand-all `(lambda ,args ,body)) t))))
+ (setq value `(lambda ,args ,body))))
(cond ((and value old-definition) (setcdr old-definition value))
(old-definition)
(t (push (cons name (or value "")) new-templates)))))
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 5df6062e464..aafbdf0e0aa 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -982,7 +982,7 @@ Otherwise, return nil."
"Splits STRING into substrings at SEPARATORS.
SEPARATORS is a regular expression. When nil, it defaults to
-\"[ \f\t\n\r\v]+\".
+\"[ \\f\\t\\n\\r\\v]+\".
Unlike `split-string', matching SEPARATORS at the beginning and
end of string are ignored."
@@ -1072,7 +1072,7 @@ Return width in pixels when PIXELS is non-nil."
;; FIXME: Fallback to old limited version, because
;; `window-pixel-width' is buggy in older Emacs.
(org--string-width-1 string)
- ;; Wrap/line prefix will make `window-text-pizel-size' return too
+ ;; Wrap/line prefix will make `window-text-pixel-size' return too
;; large value including the prefix.
(remove-text-properties 0 (length string)
'(wrap-prefix t line-prefix t)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 2c5de69a36c..678936f3417 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1140,6 +1140,24 @@ the following lines anywhere in the buffer:
:package-version '(Org . "8.0")
:type 'boolean)
+(defvar untrusted-content) ; defined in files.el
+(defvar org--latex-preview-when-risky nil
+ "If non-nil, enable LaTeX preview in Org buffers from unsafe source.
+
+Some specially designed LaTeX code may generate huge pdf or log files
+that may exhaust disk space.
+
+This variable controls how to handle LaTeX preview when rendering LaTeX
+fragments that originate from incoming email messages. It has no effect
+when Org mode is unable to determine the origin of the Org buffer.
+
+An Org buffer is considered to be from unsafe source when the
+variable `untrusted-content' has a non-nil value in the buffer.
+
+If this variable is non-nil, LaTeX previews are rendered unconditionally.
+
+This variable may be renamed or changed in the future.")
+
(defcustom org-insert-mode-line-in-empty-file nil
"Non-nil means insert the first line setting Org mode in empty files.
When the function `org-mode' is called interactively in an empty file, this
@@ -4558,12 +4576,16 @@ from file or URL, and return nil.
If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
is available. This option applies only if FILE is a URL."
(let* ((is-url (org-url-p file))
+ (is-remote (condition-case nil
+ (file-remote-p file)
+ ;; In case of error, be safe.
+ (t t)))
(cache (and is-url
(not nocache)
(gethash file org--file-cache))))
(cond
(cache)
- (is-url
+ ((or is-url is-remote)
(if (org--should-fetch-remote-resource-p file)
(condition-case error
(with-current-buffer (url-retrieve-synchronously file)
@@ -4649,9 +4671,9 @@ returns non-nil if any of them match."
(propertize domain 'face '(:inherit org-link :weight normal))
") as safe.\n ")
"")
- (propertize "f" 'face 'success)
(if current-file
(concat
+ (propertize "f" 'face 'success)
" to download this resource, and permanently mark all resources in "
(propertize current-file 'face 'underline)
" as safe.\n ")
@@ -4685,7 +4707,7 @@ returns non-nil if any of them match."
(if (and (= char ?f) current-file)
(concat "file://" current-file) uri))
"\\'")))))
- (prog1 (memq char '(?y ?n ?! ?d ?\s ?f))
+ (prog1 (memq char '(?y ?! ?d ?\s ?f))
(quit-window t)))))))
(defun org-extract-log-state-settings (x)
@@ -15696,6 +15718,7 @@ fragments in the buffer."
(interactive "P")
(cond
((not (display-graphic-p)) nil)
+ ((and untrusted-content (not org--latex-preview-when-risky)) nil)
;; Clear whole buffer.
((equal arg '(64))
(org-clear-latex-preview (point-min) (point-max))
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 3d4d998432d..d3a90179d73 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -1008,7 +1008,10 @@ will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(org-export-to-buffer 'beamer "*Org BEAMER Export*"
- async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+ async subtreep visible-only body-only ext-plist
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode)))
;;;###autoload
(defun org-beamer-export-to-latex
diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el
index aef25232c20..38460d1749e 100644
--- a/lisp/org/ox-koma-letter.el
+++ b/lisp/org/ox-koma-letter.el
@@ -911,7 +911,9 @@ non-nil."
(let (org-koma-letter-special-contents)
(org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*"
async subtreep visible-only body-only ext-plist
- (lambda () (LaTeX-mode)))))
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode))))
;;;###autoload
(defun org-koma-letter-export-to-latex
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index 9d250f716b6..98b388081ea 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -978,7 +978,7 @@ The most comprehensive option can be set with,
which causes source code to be run through
`engrave-faces-latex-buffer', which generates colorings using
Emacs' font-lock information. This requires the Emacs package
-engrave-faces (available from ELPA), and the LaTeX package
+engrave-faces (available from GNU ELPA), and the LaTeX package
fvextra be installed.
The styling of the engraved result can be customized with
@@ -1262,9 +1262,10 @@ block-specific options, you may use the following syntax:
(defcustom org-latex-engraved-theme nil
"The theme that should be used for engraved code, when non-nil.
-This can be set to any theme defined in `engrave-faces-themes' or
-loadable by Emacs. When set to t, the current Emacs theme is
-used. When nil, no theme is applied."
+This can be set to any theme defined in `engrave-faces-themes'
+(from the engrave-faces package) or loadable by Emacs. When set
+to t, the current Emacs theme is used. When nil, no theme is
+applied."
:group 'org-export-latex
:package-version '(Org . "9.6")
:type 'symbol)
@@ -1631,7 +1632,7 @@ explicitly been loaded. Then it is added to the rest of
package's options.
The optional argument to Babel or the mandatory argument to
-`\babelprovide' command may be \"AUTO\" which is then replaced
+`\\babelprovide' command may be \"AUTO\" which is then replaced
with the language of the document or
`org-export-default-language' unless language in question is
already loaded.
@@ -3666,7 +3667,7 @@ CONTENTS is the contents of the object."
;; takes care of tables with a "verbatim" mode. Otherwise, it
;; delegates the job to either `org-latex--table.el-table',
;; `org-latex--org-table', `org-latex--math-table' or
-;; `org-latex--org-tabbing' functions,
+;; `org-table--org-tabbing' functions,
;; depending of the type of the table and the mode requested.
;;
;; `org-latex--align-string' is a subroutine used to build alignment
@@ -4159,7 +4160,10 @@ will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
(org-export-to-buffer 'latex "*Org LATEX Export*"
- async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+ async subtreep visible-only body-only ext-plist
+ (if (fboundp 'major-mode-remap)
+ (major-mode-remap 'latex-mode)
+ #'LaTeX-mode)))
;;;###autoload
(defun org-latex-convert-region-to-latex ()
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 19bf559c9e7..bf2d9b569af 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g.,
(interactive)
(org-export-to-buffer \\='latex \"*Org LATEX Export*\"
async subtreep visible-only body-only ext-plist
- #\\='LaTeX-mode))
+ (major-mode-remap \\='latex-mode)))
When expressed as an anonymous function, using `lambda',
POST-PROCESS needs to be quoted.
diff --git a/lisp/outline.el b/lisp/outline.el
index 96e0d0df205..40a75701cbf 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -260,7 +260,7 @@ non-nil and point is located on the heading line.")
'(
;; Highlight headings according to the level.
(eval . (list (or outline-search-function
- (concat "^\\(?:" outline-regexp "\\).*"))
+ (concat "^\\(?:" outline-regexp "\\).*" outline-heading-end-regexp))
0 '(if outline-minor-mode
(if outline-minor-mode-highlight
(list 'face (outline-font-lock-face)))
@@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable
buffers because it modifies them.
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
+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."
;; The value `insert' is not intended to be customizable.
@@ -686,7 +686,7 @@ If POS is nil, use `point' instead."
(defun outline-back-to-heading (&optional invisible-ok)
"Move to previous heading line, or beg of this line if it's a heading.
Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
- (beginning-of-line)
+ (forward-line 0)
(or (outline-on-heading-p invisible-ok)
(let (found)
(save-excursion
@@ -705,7 +705,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
"Return t if point is on a (visible) heading line.
If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(and (bolp) (or invisible-ok (not (outline-invisible-p)))
(if outline-search-function
(funcall outline-search-function nil nil nil t)
@@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
(not (string-match (concat "\\`\\(?:" outline-regexp "\\)")
(concat head " "))))
(setq head (concat head " ")))
- (unless (bolp) (end-of-line) (newline))
+ (unless (bolp) (goto-char (pos-eol)) (newline))
(insert head)
(unless (eolp)
(save-excursion (newline-and-indent)))
@@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative.
A heading line is one that starts with a `*' (or that
`outline-regexp' matches)."
(interactive "p")
- (if (< arg 0)
- (beginning-of-line)
- (end-of-line))
+ (goto-char (if (< arg 0) (pos-bol) (pos-eol)))
(let ((regexp (unless outline-search-function
(concat "^\\(?:" outline-regexp "\\)")))
found-heading-p)
@@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that
(re-search-forward regexp nil 'move)))
(outline-invisible-p (match-beginning 0))))
(setq arg (1- arg)))
- (if found-heading-p (beginning-of-line))))
+ (if found-heading-p (forward-line 0))))
(defun outline-previous-visible-heading (arg)
"Move to the previous heading line.
@@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and mark at the end."
(let ((beg))
(if (outline-on-heading-p)
;; we are already looking at a heading
- (beginning-of-line)
+ (forward-line 0)
;; else go back to previous heading
(outline-previous-visible-heading 1))
(setq beg (point))
@@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is not a heading."
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
((save-excursion
- (beginning-of-line)
+ (forward-line 0)
(if outline-search-function
(funcall outline-search-function nil nil nil t)
(looking-at outline-regexp)))
@@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any."
(interactive)
(save-excursion
(outline-back-to-heading)
- (if (not (outline-invisible-p (line-end-position)))
+ (if (not (outline-invisible-p (pos-eol)))
(outline-hide-subtree)
(outline-show-children)
(outline-show-entry))))
@@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL."
(defun outline--insert-button (type)
(with-silent-modifications
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(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)))))
@@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL."
(when (eq outline-minor-mode-use-buttons 'insert)
(let ((inhibit-read-only t))
(insert (apply #'propertize " " (text-properties-at (point))))
- (beginning-of-line)))
+ (forward-line 0)))
(setq o (make-overlay (point) (1+ (point))))
(overlay-put o 'outline-button t)
(overlay-put o 'evaporate t))
@@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL."
(when from
(save-excursion
(goto-char from)
- (setq from (line-beginning-position))))
+ (setq from (pos-bol))))
(outline-map-region
(lambda ()
(let ((close-p (save-excursion
diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el
index facca4107a1..95b6859dd23 100644
--- a/lisp/pcmpl-git.el
+++ b/lisp/pcmpl-git.el
@@ -88,7 +88,7 @@ Files listed by `git ls-files ARGS' satisfy the predicate."
(pcomplete-entries
nil (pcmpl-git--tracked-file-predicate "-m"))))
;; Complete all tracked files
- ((or "mv" "rm" "grep" "status")
+ ((or "mv" "rm" "grep" "status" "blame")
(pcomplete-here
(pcomplete-entries nil (pcmpl-git--tracked-file-predicate))))
;; Complete revisions
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 3aee0b296f6..d0defc54174 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -61,7 +61,7 @@
(pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?")
(while (pcomplete-here (pcomplete-entries) nil #'identity)))
-(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
+(defvar pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
(defun pcmpl-linux-fs-types ()
"Return a list of available fs modules on GNU/Linux systems."
@@ -69,7 +69,7 @@
(directory-files
(format pcmpl-linux-fs-modules-path-format kernel-ver))))
-(defconst pcmpl-linux-mtab-file "/etc/mtab")
+(defvar pcmpl-linux-mtab-file "/etc/mtab")
(defun pcmpl-linux-mounted-directories ()
"Return a list of mounted directory names."
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 196c5f159cd..0b34712a50c 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1140,7 +1140,7 @@ Typing SPC flushes the help buffer."
(let (event)
(prog1
(catch 'done
- (while (with-current-buffer (get-buffer "*Completions*")
+ (while (with-current-buffer "*Completions*"
(setq event (read-event)))
(cond
((eq event ?\s)
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index c8e9d097a5f..c4697a0d3b9 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -65,7 +65,7 @@
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
"Delimiter used to separate cookie file entries.")
-(defvar cookie-cache (make-vector 511 0)
+(defvar cookie-cache (obarray-make 511)
"Cache of cookie files that have already been snarfed.")
(defun cookie-check-file (file)
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index bfc28ec9f89..56f166c10f1 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -481,7 +481,7 @@ The most useful commands are:
"Checkpoint the current cipher alphabet.
This records the current alphabet so you can return to it later.
You may have any number of checkpoints.
-Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
+Type \\[decipher-restore-checkpoint] to restore a checkpoint."
(interactive "sCheckpoint description: " decipher-mode)
(or (stringp desc)
(setq desc ""))
@@ -508,7 +508,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
If point is not on a checkpoint line, moves to the first checkpoint line.
If point is on a checkpoint, restores that checkpoint.
-Type `\\[decipher-make-checkpoint]' to make a checkpoint."
+Type \\[decipher-make-checkpoint] to make a checkpoint."
(interactive nil decipher-mode)
(beginning-of-line)
(if (looking-at "%!\\([A-Z ]+\\)!")
@@ -524,7 +524,7 @@ Type `\\[decipher-make-checkpoint]' to make a checkpoint."
;; Move to the first checkpoint:
(goto-char (point-min))
(if (re-search-forward "^%![A-Z ]+!" nil t)
- (message "Select the checkpoint to restore and type `%s'"
+ (message "Select the checkpoint to restore and type %s"
(substitute-command-keys "\\[decipher-restore-checkpoint]"))
(error "No checkpoints in this buffer"))))
diff --git a/lisp/proced.el b/lisp/proced.el
index 3435f1ab8cd..1d257b6bd4d 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -362,9 +362,13 @@ of `proced-grammar-alist'."
:type 'integer)
(defcustom proced-auto-update-flag nil
- "Non-nil for auto update of a Proced buffer.
-Can be changed interactively via `proced-toggle-auto-update'."
- :type 'boolean)
+ "Non-nil means auto update proced buffers.
+Special value `visible' means only update proced buffers that are currently
+displayed in a window. Can be changed interactively via
+`proced-toggle-auto-update'."
+ :type '(radio (const :tag "Don't auto update" nil)
+ (const :tag "Only update visible proced buffers" visible)
+ (const :tag "Update all proced buffers" t)))
(make-variable-buffer-local 'proced-auto-update-flag)
(defcustom proced-tree-flag nil
@@ -951,28 +955,40 @@ Proced buffers."
"Auto-update Proced buffers using `run-at-time'.
If there are no proced buffers, cancel the timer."
- (unless (seq-filter (lambda (buf)
- (with-current-buffer buf
- (when (eq major-mode 'proced-mode)
- (if proced-auto-update-flag
- (proced-update t t))
- t)))
- (buffer-list))
+ (if-let (buffers (match-buffers '(derived-mode . proced-mode)))
+ (dolist (buf buffers)
+ (when-let ((flag (buffer-local-value 'proced-auto-update-flag buf))
+ ((or (not (eq flag 'visible))
+ (get-buffer-window buf 'visible))))
+ (with-current-buffer buf
+ (proced-update t t))))
(cancel-timer proced-auto-update-timer)
(setq proced-auto-update-timer nil)))
(defun proced-toggle-auto-update (arg)
"Change whether this Proced buffer is updated automatically.
With prefix ARG, update this buffer automatically if ARG is positive,
-otherwise do not update. Sets the variable `proced-auto-update-flag'.
-The time interval for updates is specified via `proced-auto-update-interval'."
+update the buffer only when the buffer is displayed in a window if ARG is 0,
+otherwise do not update. Sets the variable `proced-auto-update-flag' by
+cycling between nil, `visible' and t. The time interval for updates is
+specified via `proced-auto-update-interval'."
(interactive (list (or current-prefix-arg 'toggle)) proced-mode)
(setq proced-auto-update-flag
- (cond ((eq arg 'toggle) (not proced-auto-update-flag))
- (arg (> (prefix-numeric-value arg) 0))
+ (cond ((eq arg 'toggle)
+ (cond ((not proced-auto-update-flag) 'visible)
+ ((eq proced-auto-update-flag 'visible) t)
+ (t nil)))
+ (arg
+ (setq arg (prefix-numeric-value arg))
+ (message "%s" arg)
+ (cond ((> arg 0) t)
+ ((eq arg 0) 'visible)
+ (t nil)))
(t (not proced-auto-update-flag))))
(message "Proced auto update %s"
- (if proced-auto-update-flag "enabled" "disabled")))
+ (cond ((eq proced-auto-update-flag 'visible) "enabled (only when buffer is visible)")
+ (proced-auto-update-flag "enabled (unconditionally)")
+ (t "disabled"))))
;;; Mark
@@ -2261,7 +2277,7 @@ If LOG is a string and there are more args, it is formatted with
those ARGS. Usually the LOG string ends with a \\n.
End each bunch of errors with (proced-log t signal):
this inserts the current time, buffer and signal at the start of the page,
-and \f (formfeed) at the end."
+and \\f (formfeed) at the end."
(let ((obuf (current-buffer)))
(with-current-buffer (get-buffer-create proced-log-buffer)
(goto-char (point-max))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 80f84037a63..4e02cd1d890 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -38,8 +38,7 @@
(defcustom profiler-sampling-interval 1000000
"Default sampling interval in nanoseconds."
- :type 'natnum
- :group 'profiler)
+ :type 'natnum)
;;; Utilities
@@ -68,7 +67,7 @@
collect c into s
do (cl-decf i)
finally return
- (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+ (apply #'string (if (eq (car s) ?,) (cdr s) s)))
(profiler-ensure-string number)))
(defun profiler-format (fmt &rest args)
@@ -76,7 +75,7 @@
for arg in args
for str = (cond
((consp subfmt)
- (apply 'profiler-format subfmt arg))
+ (apply #'profiler-format subfmt arg))
((stringp subfmt)
(format subfmt arg))
((and (symbolp subfmt)
@@ -91,7 +90,8 @@
if (< width len)
collect (progn (put-text-property (max 0 (- width 2)) len
'invisible 'profiler str)
- str) into frags
+ str)
+ into frags
else
collect
(let ((padding (make-string (max 0 (- width len)) ?\s)))
@@ -100,32 +100,11 @@
(right (concat padding str))))
into frags
finally return (apply #'concat frags)))
-
-
-;;; Entries
-
-(defun profiler-format-entry (entry)
- "Format ENTRY in human readable string.
-ENTRY would be a function name of a function itself."
- (cond ((memq (car-safe entry) '(closure lambda))
- (format "#<lambda %#x>" (sxhash entry)))
- ((byte-code-function-p entry)
- (format "#<compiled %#x>" (sxhash entry)))
- ((or (subrp entry) (symbolp entry) (stringp entry))
- (format "%s" entry))
- (t
- (format "#<unknown %#x>" (sxhash entry)))))
-
-(defun profiler-fixup-entry (entry)
- (if (symbolp entry)
- entry
- (profiler-format-entry entry)))
-
;;; Backtraces
(defun profiler-fixup-backtrace (backtrace)
- (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+ (apply #'vector (mapcar #'help-fns-function-name backtrace)))
;;; Logs
@@ -434,18 +413,15 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(defcustom profiler-report-closed-mark "+"
"An indicator of closed calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-open-mark "-"
"An indicator of open calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-leaf-mark " "
"An indicator of calltree leaves."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defvar profiler-report-cpu-line-format
'((17 right ((12 right)
@@ -474,17 +450,18 @@ Do not touch this variable directly.")
(let ((string (cond
((eq entry t)
"Others")
- ((and (symbolp entry)
- (fboundp entry))
- (propertize (symbol-name entry)
- 'face 'link
- 'follow-link "\r"
- 'mouse-face 'highlight
- 'help-echo "\
+ (t (propertize (help-fns-function-name entry)
+ ;; Override the `button-map' which
+ ;; otherwise adds RET, mouse-1, and TAB
+ ;; bindings we don't want. :-(
+ 'keymap '(make-sparse-keymap)
+ 'follow-link "\r"
+ ;; FIXME: The help-echo code gets confused
+ ;; by the `follow-link' property and rewrites
+ ;; `mouse-2' to `mouse-1' :-(
+ 'help-echo "\
mouse-2: jump to definition\n\
-RET: expand or collapse"))
- (t
- (profiler-format-entry entry)))))
+RET: expand or collapse")))))
(propertize string 'profiler-entry entry)))
(defun profiler-report-make-name-part (tree)
@@ -719,10 +696,13 @@ point."
(current-buffer))
(and event (setq event (event-end event))
(posn-set-point event))
- (let ((tree (profiler-report-calltree-at-point)))
- (when tree
- (let ((entry (profiler-calltree-entry tree)))
- (find-function entry))))))
+ (save-excursion
+ (forward-line 0)
+ (let ((eol (pos-eol)))
+ (forward-button 1)
+ (if (> (point) eol)
+ (error "No entry found")
+ (push-button))))))
(defun profiler-report-describe-entry ()
"Describe entry at point."
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 29ff521253b..977a3d72cb7 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -493,7 +493,7 @@ and set it if applicable."
;; the values of the From, To, and Cc headers.
(let (header-values)
(with-current-buffer
- (get-buffer gnus-original-article-buffer)
+ gnus-original-article-buffer
(save-excursion
(goto-char (point-min))
;; The Newsgroup is omitted because we already matched
diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el
index 07161025d5d..e48bcc64f14 100644
--- a/lisp/progmodes/c-ts-common.el
+++ b/lisp/progmodes/c-ts-common.el
@@ -37,9 +37,8 @@
;;
;; For indenting statements:
;;
-;; - Set `c-ts-common-indent-offset',
-;; `c-ts-common-indent-block-type-regexp', and
-;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent
+;; - Set `c-ts-common-indent-offset', and
+;; `c-ts-common-indent-type-regexp-alist', then use simple-indent
;; offset `c-ts-common-statement-offset' in
;; `treesit-simple-indent-rules'.
@@ -331,9 +330,9 @@ If NODE is nil, return nil."
Assumes the anchor is (point-min), i.e., the 0th column.
This function basically counts the number of block nodes (i.e.,
-brackets) (defined by `c-ts-common-indent-block-type-regexp')
+brackets) (see `c-ts-common-indent-type-regexp-alist')
between NODE and the root node (not counting NODE itself), and
-multiply that by `c-ts-common-indent-offset'.
+multiplies that by `c-ts-common-indent-offset'.
To support GNU style, on each block level, this function also
checks whether the opening bracket { is on its own line, if so,
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index e5835bdb62d..3a89f0f494b 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -97,7 +97,7 @@
"Toggle the comment style between block and line comments.
Optional numeric ARG, if supplied, switches to block comment
style when positive, to line comment style when negative, and
-just toggles it when zero or left out."
+just toggles it when zero or omitted."
(interactive "P")
(let ((prevstate-line (string= comment-start "// ")))
(when (or (not arg)
@@ -147,9 +147,9 @@ symbol."
"Style used for indentation.
The selected style could be one of GNU, K&R, LINUX or BSD. If
-one of the supplied styles doesn't suffice, a function could be
-set instead. This function is expected to return a list that
-follows the form of `treesit-simple-indent-rules'."
+one of the supplied styles doesn't suffice, the value could be
+a function instead. This function is expected to return a list
+that follows the form of `treesit-simple-indent-rules'."
:version "29.1"
:type '(choice (symbol :tag "Gnu" gnu)
(symbol :tag "K&R" k&r)
@@ -202,8 +202,8 @@ To set the default indent style globally, use
(if (derived-mode-p 'c-ts-mode) 'c 'cpp))))))
(defcustom c-ts-mode-emacs-sources-support t
- "Whether to enable Emacs source-specific features.
-This enables detection of definitions of Lisp function using
+ "Whether to enable Emacs source-specific C features.
+This enables detection of definitions of Lisp functions via
the DEFUN macro.
This needs to be set before enabling `c-ts-mode'; if you change
the value after enabling `c-ts-mode', toggle the mode off and on
@@ -243,7 +243,7 @@ again."
< and > are usually punctuation, e.g., in ->. But when used for
templates, they should be considered pairs.
-This function checks for < and > in the changed RANGES and apply
+This function checks for < and > in the changed RANGES and applies
appropriate text property to alter the syntax of template
delimiters < and >'s."
(goto-char beg)
@@ -284,9 +284,9 @@ is actually the parent of point at the moment of indentation."
"Return the start of the previous named sibling of NODE.
This anchor handles the special case where the previous sibling
-is a labeled_statement, in that case, return the child of the
+is a labeled_statement; in that case, return the child of the
labeled statement instead. (Actually, recursively go down until
-the node isn't a labeled_statement.) Eg,
+the node isn't a labeled_statement.) E.g.,
label:
int x = 1;
@@ -295,10 +295,11 @@ label:
The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than
the labeled_statement.
-Return nil if a) there is no prev-sibling, or 2) prev-sibling
+Return nil if a) there is no prev-sibling, or b) prev-sibling
doesn't have a child.
-PARENT and BOL are like other anchor functions."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(when-let ((prev-sibling
(or (treesit-node-prev-sibling node t)
(treesit-node-prev-sibling
@@ -336,7 +337,7 @@ PARENT and BOL are like other anchor functions."
(defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _)
"Like the standalone-parent anchor but skips preproc nodes.
-PARENT is the same as other anchor functions."
+PARENT is the parent of the current node."
(save-excursion
(treesit-node-start
(treesit-parent-until
@@ -353,13 +354,15 @@ PARENT is the same as other anchor functions."
(defun c-ts-mode--standalone-grandparent (_node parent bol &rest args)
"Like the standalone-parent anchor but pass it the grandparent.
-PARENT, BOL, ARGS are the same as other anchor functions."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(apply (alist-get 'standalone-parent treesit-simple-indent-presets)
parent (treesit-node-parent parent) bol args))
(defun c-ts-mode--else-heuristic (node parent bol &rest _)
"Heuristic matcher for when \"else\" is followed by a closing bracket.
-NODE, PARENT, and BOL are the same as in other matchers."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(and (null node)
(save-excursion
(forward-line -1)
@@ -757,7 +760,7 @@ MODE is either `c' or `cpp'."
(defun c-ts-mode--declarator-identifier (node &optional qualified)
"Return the identifier of the declarator node NODE.
-If QUALIFIED is non-nil, include the names space part of the
+If QUALIFIED is non-nil, include the namespace part of the
identifier and return a qualified_identifier."
(pcase (treesit-node-type node)
;; Recurse.
@@ -782,7 +785,7 @@ identifier and return a qualified_identifier."
node)))
(defun c-ts-mode--fontify-declarator (node override start end &rest _args)
- "Fontify a declarator (whatever under the \"declarator\" field).
+ "Fontify a declarator (whatever is under the \"declarator\" field).
For NODE, OVERRIDE, START, END, and ARGS, see
`treesit-font-lock-rules'."
(let* ((identifier (c-ts-mode--declarator-identifier node))
@@ -817,7 +820,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
-Don't fontify if it is a function identifier. For NODE,
+Don't fontify it if it is a function identifier. For NODE,
OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'."
(when (not (equal (treesit-node-type
(treesit-node-parent node))
@@ -911,7 +914,8 @@ Return nil if NODE is not a defun node or doesn't have a name."
t))
((or "struct_specifier" "enum_specifier"
"union_specifier" "class_specifier"
- "namespace_definition")
+ "namespace_definition"
+ "preproc_def" "preproc_function_def")
(treesit-node-child-by-field-name node "name"))
;; DEFUNs in Emacs sources.
("expression_statement"
@@ -922,11 +926,22 @@ Return nil if NODE is not a defun node or doesn't have a name."
name)))
t))
+;;; Outline minor mode
+
+(defun c-ts-mode--outline-predicate (node)
+ "Match outlines on lines with function names."
+ (or (and (equal (treesit-node-type node) "function_declarator")
+ (equal (treesit-node-type (treesit-node-parent node))
+ "function_definition"))
+ ;; DEFUNs in Emacs sources.
+ (and c-ts-mode-emacs-sources-support
+ (c-ts-mode--emacs-defun-p node))))
+
;;; Defun navigation
(defun c-ts-mode--defun-valid-p (node)
"Return non-nil if NODE is a valid defun node.
-Ie, NODE is not nested."
+That is, NODE is not nested."
(let ((top-level-p (lambda (node)
(not (treesit-node-top-level
node (rx (or "function_definition"
@@ -965,8 +980,7 @@ Basically, if NODE is a class, return non-nil; if NODE is a
function but is under a class, return non-nil; if NODE is a
top-level function, return nil.
-This is for the Class subindex in
-`treesit-simple-imenu-settings'."
+This is for the Class subindex in `treesit-simple-imenu-settings'."
(pcase (treesit-node-type node)
;; The Class subindex only has class_specifier and
;; function_definition.
@@ -977,7 +991,7 @@ This is for the Class subindex in
(defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends.
-Structs in C ends with a semicolon, but the semicolon is not
+Structs in C end with a semicolon, but the semicolon is not
considered part of the struct node, so point would stop before
the semicolon. This function skips the semicolon."
(when (looking-at (rx (* (or " " "\t")) ";"))
@@ -997,7 +1011,7 @@ the semicolon. This function skips the semicolon."
(list node parent bol)))
(defun c-ts-mode--emacs-defun-p (node)
- "Return non-nil if NODE is a Lisp function defined using DEFUN.
+ "Return non-nil if NODE is a Lisp function defined via DEFUN.
This function detects Lisp primitives defined in Emacs source
files using the DEFUN macro."
(and (equal (treesit-node-type node) "expression_statement")
@@ -1018,15 +1032,15 @@ files using the DEFUN macro."
"Return the defun node at point.
In addition to regular C functions, this function recognizes
-definitions of Lisp primitrives in Emacs source files using DEFUN,
-if `c-ts-mode-emacs-sources-support' is non-nil.
+definitions of Lisp primitrives in Emacs source files defined
+via DEFUN, if `c-ts-mode-emacs-sources-support' is non-nil.
Note that DEFUN is parsed by tree-sitter as two separate
nodes, one for the declaration and one for the body; this
function returns the declaration node.
If RANGE is non-nil, return (BEG . END) where BEG end END
-encloses the whole defun. This is for when the entire defun
+enclose the whole defun. This is for when the entire defun
is required, not just the declaration part for DEFUN."
(when-let* ((node (treesit-defun-at-point))
(defun-range (cons (treesit-node-start node)
@@ -1055,7 +1069,7 @@ is required, not just the declaration part for DEFUN."
"Return the name of the current defun.
This is used for `add-log-current-defun-function'.
In addition to regular C functions, this function also recognizes
-Emacs primitives defined using DEFUN in Emacs sources,
+Emacs primitives defined via DEFUN in Emacs sources,
if `c-ts-mode-emacs-sources-support' is non-nil."
(or (treesit-add-log-current-defun)
(c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point))))
@@ -1133,7 +1147,7 @@ For BOL see `treesit-simple-indent-rules'."
(defun c-ts-mode--reverse-ranges (ranges beg end)
"Reverse RANGES and return the new ranges between BEG and END.
-Positions that were included RANGES are not in the returned
+Positions that were included in RANGES are not in the returned
ranges, and vice versa.
Return nil if RANGES is nil. This way, passing the returned
@@ -1179,7 +1193,6 @@ BEG and END are described in `treesit-range-rules'."
"C-c C-c" #'comment-region
"C-c C-k" #'c-ts-mode-toggle-comment-style)
-;;;###autoload
(define-derived-mode c-ts-base-mode prog-mode "C"
"Major mode for editing C, powered by tree-sitter.
@@ -1195,7 +1208,9 @@ BEG and END are described in `treesit-range-rules'."
"enum_specifier"
"union_specifier"
"class_specifier"
- "namespace_definition")
+ "namespace_definition"
+ "preproc_def"
+ "preproc_function_def")
(and c-ts-mode-emacs-sources-support
'(;; DEFUN.
"expression_statement"
@@ -1259,6 +1274,10 @@ BEG and END are described in `treesit-range-rules'."
eos)
c-ts-mode--defun-for-class-in-imenu-p nil))))
+ ;; Outline minor mode
+ (setq-local treesit-outline-predicate
+ #'c-ts-mode--outline-predicate)
+
(setq-local treesit-font-lock-feature-list
c-ts-mode--feature-list))
@@ -1270,7 +1289,7 @@ BEG and END are described in `treesit-range-rules'."
This mode is independent from the classic cc-mode.el based
`c-mode', so configuration variables of that mode, like
-`c-basic-offset', doesn't affect this mode.
+`c-basic-offset', don't affect this mode.
To use tree-sitter C/C++ modes by default, evaluate
@@ -1279,7 +1298,7 @@ To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
-in your configuration."
+in your init files."
:group 'c
:after-hook (c-ts-mode-set-modeline)
@@ -1314,6 +1333,8 @@ in your configuration."
(lambda (_pos) 'c))
(treesit-font-lock-recompute-features '(emacs-devel)))))
+(derived-mode-add-parents 'c-ts-mode '(c-mode))
+
;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++"
"Major mode for editing C++, powered by tree-sitter.
@@ -1329,7 +1350,7 @@ To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
-in your configuration.
+in your init files.
Since this mode uses a parser, unbalanced brackets might cause
some breakage in indentation/fontification. Therefore, it's
@@ -1357,6 +1378,8 @@ recommended to enable `electric-pair-mode' with this mode."
(setq-local add-log-current-defun-function
#'c-ts-mode--emacs-current-defun-name))))
+(derived-mode-add-parents 'c++-ts-mode '(c++-mode))
+
(easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map)
"Menu for `c-ts-mode' and `c++-ts-mode'."
'("C/C++"
@@ -1422,38 +1445,35 @@ matching on file name insufficient for detecting major mode that
should be used.
This function attempts to use file contents to determine whether
-the code is C or C++ and based on that chooses whether to enable
+the code is C or C++, and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'."
+ (declare (obsolete c-or-c++-mode "30.1"))
(interactive)
- (if (save-excursion
- (save-restriction
- (save-match-data ; Why `save-match-data'?
- (widen)
- (goto-char (point-min))
- (re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
- (c++-ts-mode)
- (c-ts-mode)))
+ (let ((mode
+ (if (save-excursion
+ (save-restriction
+ (save-match-data ; Why `save-match-data'?
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
+ 'c++-ts-mode
+ 'c-ts-mode)))
+ (funcall (major-mode-remap mode))))
+
;; The entries for C++ must come first to prevent *.c files be taken
;; as C++ on case-insensitive filesystems, since *.C files are C++,
;; not C.
(if (treesit-ready-p 'cpp)
- (add-to-list 'auto-mode-alist
- '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'"
- . c++-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults
+ '(c++-mode . c++-ts-mode)))
(when (treesit-ready-p 'c)
- (add-to-list 'auto-mode-alist
- '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode))
- (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode))
- ;; image-mode's association must be before the C mode, otherwise XPM
- ;; images will be initially visited as C files. Also note that the
- ;; regexp must be different from what files.el does, or else
- ;; add-to-list will not add the association where we want it.
- (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode)))
-
-(if (and (treesit-ready-p 'cpp)
- (treesit-ready-p 'c))
- (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults '(c++-mode . c++-ts-mode))
+ (add-to-list 'major-mode-remap-defaults '(c-mode . c-ts-mode)))
+
+(when (and (treesit-ready-p 'cpp)
+ (treesit-ready-p 'c))
+ (add-to-list 'major-mode-remap-defaults '(c-or-c++-mode . c-or-c++-ts-mode)))
(provide 'c-ts-mode)
(provide 'c++-ts-mode)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index f84d95dbc94..e45ab76ec07 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -2425,7 +2425,7 @@ system."
(error "Unknown base mode `%s'" base-mode))
(put mode 'c-fallback-mode base-mode))
-(defvar c-lang-constants (make-vector 151 0))
+(defvar c-lang-constants (obarray-make 151))
;; Obarray used as a cache to keep track of the language constants.
;; The constants stored are those defined by `c-lang-defconst' and the values
;; computed by `c-lang-const'. It's mostly used at compile time but it's not
@@ -2630,7 +2630,7 @@ constant. A file is identified by its base name."
;; Clear the evaluated values that depend on this source.
(let ((agenda (get sym 'dependents))
- (visited (make-vector 101 0))
+ (visited (obarray-make 101))
ptr)
(while agenda
(setq sym (car agenda)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 4c591fbba36..8c505e9556a 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -11476,7 +11476,7 @@ This function might do hidden buffer changes."
;; an arglist it would be a meaningless expression because
;; the result isn't used. We therefore choose to recognize
;; it as a declaration when there's "symmetrical WS" around
- ;; the "*" or the flag `c-assymetry-fontification-flag' is
+ ;; the "*" or the flag `c-asymmetry-fontification-flag' is
;; not set. We only allow a suffix (which makes the
;; construct look like a function call) when `at-decl-start'
;; provides additional evidence that we do have a
@@ -12346,13 +12346,21 @@ comment at the start of cc-engine.el for more info."
(zerop (c-backward-token-2 1 t lim))
t)
(or (looking-at c-block-stmt-1-key)
- (and (eq (char-after) ?\()
- (zerop (c-backward-token-2 1 t lim))
- (if (looking-at c-block-stmt-hangon-key)
- (zerop (c-backward-token-2 1 t lim))
- t)
- (or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key))))
+ (or
+ (and
+ (eq (char-after) ?\()
+ (zerop (c-backward-token-2 1 t lim))
+ (if (looking-at c-block-stmt-hangon-key)
+ (zerop (c-backward-token-2 1 t lim))
+ t)
+ (or (looking-at c-block-stmt-2-key)
+ (looking-at c-block-stmt-1-2-key)))
+ (and (looking-at c-paren-clause-key)
+ (zerop (c-backward-token-2 1 t lim))
+ (if (looking-at c-negation-op-re)
+ (zerop (c-backward-token-2 1 t lim))
+ t)
+ (looking-at c-block-stmt-with-key))))
(point))))
(defun c-after-special-operator-id (&optional lim)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 89f197b98e6..6419d6cf05a 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1112,7 +1112,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;;
;; If TYPES is t, fontify all identifiers as types; if it is a number, a
- ;; buffer position, additionally set the `c-deftype' text property on the
+ ;; buffer position, additionally set the `c-typedef' text property on the
;; keyword at that position; if it is nil fontify as either variables or
;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we
;; are not at the top-level ("top-level" includes being directly inside a
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index ad21bd1d5ef..06b919f26fd 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -817,7 +817,7 @@ there be copies of the opener contained in the multi-line string."
(c-lang-defconst c-cpp-or-ml-match-offset
;; The offset to be added onto match numbers for a multi-line string in
- ;; matches for `c-cpp-or-ml-string-opener-re'.
+ ;; matches for `c-ml-string-cpp-or-opener-re'.
t (if (c-lang-const c-anchored-cpp-prefix)
(+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix)))
2))
@@ -1599,6 +1599,12 @@ operators."
(c-lang-defvar c-assignment-op-regexp
(c-lang-const c-assignment-op-regexp))
+(c-lang-defconst c-negation-op-re
+ ;; Regexp matching the negation operator.
+ t "!\\([^=]\\|$\\)")
+
+(c-lang-defvar c-negation-op-re (c-lang-const c-negation-op-re))
+
(c-lang-defconst c-arithmetic-operators
"List of all arithmetic operators, including \"+=\", etc."
;; Note: in the following, there are too many operators for AWK and IDL.
@@ -3163,6 +3169,30 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-const c-block-stmt-2-kwds)))))
(c-lang-defvar c-opt-block-stmt-key (c-lang-const c-opt-block-stmt-key))
+(c-lang-defconst c-paren-clause-kwds
+ "Keywords which can stand in the place of paren sexps in conditionals.
+This applies only to conditionals in `c-block-stmt-with-kwds'."
+ t nil
+ c++ '("consteval"))
+
+(c-lang-defconst c-paren-clause-key
+ ;; Regexp matching a keyword in `c-paren-clause-kwds'.
+ t (c-make-keywords-re t
+ (c-lang-const c-paren-clause-kwds)))
+(c-lang-defvar c-paren-clause-key (c-lang-const c-paren-clause-key))
+
+(c-lang-defconst c-block-stmt-with-kwds
+ "Statement keywords which can be followed by a keyword instead of a parens.
+Such a keyword is a member of `c-paren-clause-kwds."
+ t nil
+ c++ '("if"))
+
+(c-lang-defconst c-block-stmt-with-key
+ ;; Regexp matching a keyword in `c-block-stmt-with-kwds'.
+ t (c-make-keywords-re t
+ (c-lang-const c-block-stmt-with-kwds)))
+(c-lang-defvar c-block-stmt-with-key (c-lang-const c-block-stmt-with-key))
+
(c-lang-defconst c-simple-stmt-kwds
"Statement keywords followed by an expression or nothing."
t '("break" "continue" "goto" "return")
@@ -3511,7 +3541,7 @@ Note that Java specific rules are currently applied to tell this from
(let* ((alist (c-lang-const c-keyword-member-alist))
kwd lang-const-list
- (obarray (make-vector (* (length alist) 2) 0)))
+ (obarray (obarray-make (* (length alist) 2))))
(while alist
(setq kwd (caar alist)
lang-const-list (cdar alist)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 64a679eacc7..1a9d0907bd0 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -2902,15 +2902,19 @@ This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'."
(interactive)
- (if (save-excursion
- (save-restriction
- (save-match-data
- (widen)
- (goto-char (point-min))
- (re-search-forward c-or-c++-mode--regexp
- (+ (point) c-guess-region-max) t))))
- (c++-mode)
- (c-mode)))
+ (let ((mode
+ (if (save-excursion
+ (save-restriction
+ (save-match-data
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward c-or-c++-mode--regexp
+ (+ (point) c-guess-region-max) t))))
+ 'c++-mode
+ 'c-mode)))
+ (funcall (if (fboundp 'major-mode-remap)
+ (major-mode-remap mode)
+ mode))))
;; Support for C++
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index d933e4ebb81..b70806f4c30 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -32,10 +32,8 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-query-capture "treesit.c")
-(declare-function treesit-induce-sparse-tree "treesit.c")
-(declare-function treesit-node-child "treesit.c")
-(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-search-subtree "treesit.c")
(defcustom cmake-ts-mode-indent-offset 2
"Number of spaces for each indentation step in `cmake-ts-mode'."
@@ -195,37 +193,14 @@ Check if a node type is available, then return the right font lock rules."
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `cmake-ts-mode'.")
-(defun cmake-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (func-tree (treesit-induce-sparse-tree
- node "function_def" nil 1000))
- (func-index (cmake-ts-mode--imenu-1 func-tree)))
- (append
- (when func-index `(("Function" . ,func-index))))))
-
-(defun cmake-ts-mode--imenu-1 (node)
- "Helper for `cmake-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (children (cdr node))
- (subtrees (mapcan #'cmake-ts-mode--imenu-1
- children))
- (name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("function_def"
- (treesit-node-text
- (treesit-node-child (treesit-node-child ts-node 0) 2) t)))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((or (null ts-node) (null name)) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
+(defun cmake-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "function_def" "macro_def")
+ (treesit-node-text
+ (treesit-search-subtree node "^argument$" nil nil 3)
+ t))))
;;;###autoload
(define-derived-mode cmake-ts-mode prog-mode "CMake"
@@ -241,8 +216,15 @@ the subtrees."
(setq-local comment-end "")
(setq-local comment-start-skip (rx "#" (* (syntax whitespace))))
+ ;; Defuns.
+ (setq-local treesit-defun-type-regexp (rx (or "function" "macro")
+ "_def"))
+ (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name)
+
;; Imenu.
- (setq-local imenu-create-index-function #'cmake-ts-mode--imenu)
+ (setq-local treesit-simple-imenu-settings
+ `(("Function" "^function_def$")
+ ("Macro" "^macro_def$")))
(setq-local which-func-functions nil)
;; Indent.
@@ -261,6 +243,8 @@ the subtrees."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'cmake-ts-mode '(cmake-mode))
+
(if (treesit-ready-p 'cmake)
(add-to-list 'auto-mode-alist
'("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4af6a96900a..11d400e145a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -362,6 +362,28 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(ruby-Test::Unit
"^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
+ ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1.
+ (lua
+ ,(rx bol
+ (+? (not (in "\t\n")))
+ ": "
+ (group (+? (not (in "\t\n"))))
+ ":"
+ (group (+ (in "0-9")))
+ ": "
+ (+ nonl)
+ "\nstack traceback:\n\t")
+ 1 2 nil 2 1)
+ (lua-stack
+ ,(rx bol "\t"
+ (| "[C]:"
+ (: (group (+? (not (in "\t\n"))))
+ ":"
+ (? (group (+ (in "0-9")))
+ ":")))
+ " in ")
+ 1 2 nil 0 1)
+
(gmake
;; Set GNU make error messages as INFO level.
;; It starts with the name of the make program which is variable,
@@ -1868,6 +1890,12 @@ process from additional information inserted by Emacs."
(defvar-local compilation--start-time nil
"The time when the compilation started as returned by `float-time'.")
+(defun compilation--downcase-mode-name (mode)
+ "Downcase the name of major MODE, even if MODE is not a string.
+The function `downcase' will barf if passed the name of a `major-mode'
+which is not a string, but instead a symbol or a list."
+ (downcase (format-mode-line mode)))
+
;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp
continue)
@@ -2059,11 +2087,12 @@ Returns the compilation buffer created."
(get-buffer-process
(with-no-warnings
(comint-exec
- outbuf (downcase mode-name)
+ outbuf (compilation--downcase-mode-name mode-name)
shell-file-name
nil `(,shell-command-switch ,command)))))
- (start-file-process-shell-command (downcase mode-name)
- outbuf command))))
+ (start-file-process-shell-command
+ (compilation--downcase-mode-name mode-name)
+ outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process
'((:propertize ":%s" face compilation-mode-line-run)
@@ -2768,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)."
(let ((buffer (compilation-find-buffer)))
(if (get-buffer-process buffer)
(interrupt-process (get-buffer-process buffer))
- (error "The %s process is not running" (downcase mode-name)))))
+ (error "The %s process is not running"
+ (compilation--downcase-mode-name mode-name)))))
(defalias 'compile-mouse-goto-error 'compile-goto-error)
@@ -3122,7 +3152,16 @@ and overlay is highlighted between MK and END-MK."
(cancel-timer next-error-highlight-timer))
(remove-hook 'pre-command-hook
#'compilation-goto-locus-delete-o))
-
+
+(defun compilation--expand-fn (directory filename)
+ "Expand FILENAME or resolve its true name.
+Unlike `expand-file-name', `file-truename' follows symlinks, which
+we try to avoid if possible."
+ (let* ((expandedname (expand-file-name filename directory)))
+ (if (file-exists-p expandedname)
+ expandedname
+ (file-truename (file-name-concat directory filename)))))
+
(defun compilation-find-file-1 (marker filename directory &optional formats)
(or formats (setq formats '("%s")))
(let ((dirs compilation-search-path)
@@ -3143,8 +3182,8 @@ and overlay is highlighted between MK and END-MK."
fmts formats)
;; For each directory, try each format string.
(while (and fmts (null buffer))
- (setq name (file-truename
- (file-name-concat thisdir (format (car fmts) filename)))
+ (setq name (compilation--expand-fn thisdir
+ (format (car fmts) filename))
buffer (and (file-exists-p name)
(find-file-noselect name))
fmts (cdr fmts)))
@@ -3166,8 +3205,8 @@ and overlay is highlighted between MK and END-MK."
(setq thisdir (car dirs)
fmts formats)
(while (and fmts (null buffer))
- (setq name (file-truename
- (file-name-concat thisdir (format (car fmts) filename)))
+ (setq name (compilation--expand-fn thisdir
+ (format (car fmts) filename))
buffer (and (file-exists-p name)
(find-file-noselect name))
fmts (cdr fmts)))
@@ -3227,8 +3266,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(ding) (sit-for 2))
((and (file-directory-p name)
(not (file-exists-p
- (setq name (file-truename
- (file-name-concat name filename))))))
+ (setq name (compilation--expand-fn name filename)))))
(message "No `%s' in directory %s" filename origname)
(ding) (sit-for 2))
(t
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 9f7f29b8182..11709bfe00b 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -162,6 +162,9 @@ for constructs with multiline if/unless/while/until/for/foreach condition."
(defcustom cperl-file-style nil
"Indentation style to use in cperl-mode.
+Setting this option will override options as given in
+`cperl-style-alist' for the keyword provided here. If nil, then
+the individual options as customized are used.
\"PBP\" is the style recommended in the Book \"Perl Best
Practices\" by Damian Conway. \"CPerl\" is the traditional style
of cperl-mode, and \"PerlStyle\" follows the Perl documentation
@@ -1130,7 +1133,7 @@ Unless KEEP, removes the old indentation."
["Fix whitespace on indent" cperl-toggle-construct-fix t]
["Auto-help on Perl constructs" cperl-toggle-autohelp t]
["Auto fill" auto-fill-mode t])
- ("Indent styles..."
+ ("Default indent styles..."
["CPerl" (cperl-set-style "CPerl") t]
["PBP" (cperl-set-style "PBP") t]
["PerlStyle" (cperl-set-style "PerlStyle") t]
@@ -1141,6 +1144,15 @@ Unless KEEP, removes the old indentation."
["Whitesmith" (cperl-set-style "Whitesmith") t]
["Memorize Current" (cperl-set-style "Current") t]
["Memorized" (cperl-set-style-back) cperl-old-style])
+ ("Indent styles for current buffer..."
+ ["CPerl" (cperl-set-style "CPerl") t]
+ ["PBP" (cperl-file-style "PBP") t]
+ ["PerlStyle" (cperl-file-style "PerlStyle") t]
+ ["GNU" (cperl-file-style "GNU") t]
+ ["C++" (cperl-file-style "C++") t]
+ ["K&R" (cperl-file-style "K&R") t]
+ ["BSD" (cperl-file-style "BSD") t]
+ ["Whitesmith" (cperl-file-style "Whitesmith") t])
("Micro-docs"
["Tips" (describe-variable 'cperl-tips) t]
["Problems" (describe-variable 'cperl-problems) t]
@@ -1922,9 +1934,12 @@ or as help on variables `cperl-tips', `cperl-problems',
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
+(derived-mode-add-parents 'cperl-mode '(perl-mode))
+
(defun cperl--set-file-style ()
(when cperl-file-style
- (cperl-set-style cperl-file-style)))
+ (cperl-file-style cperl-file-style)))
+
;; Fix for perldb - make default reasonable
(defun cperl-db ()
@@ -4001,7 +4016,10 @@ recursive calls in starting lines of here-documents."
;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
"\\|"
;; -------- backslash-escaped stuff, don't interpret it
- "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy
+ "\\\\\\(['`\"($]\\)" ; BACKWACKED something-hairy
+ "\\|"
+ ;; -------- $\ is a variable in code, but not in a string
+ "\\(\\$\\\\\\)")
"")))
warning-message)
(unwind-protect
@@ -4055,7 +4073,12 @@ recursive calls in starting lines of here-documents."
(cperl-modify-syntax-type bb cperl-st-punct)))
;; No processing in strings/comments beyond this point:
((or (nth 3 state) (nth 4 state))
- t) ; Do nothing in comment/string
+ ;; Edge case: In a double-quoted string, $\ is not the
+ ;; punctuation variable, $ must not quote \ here. We
+ ;; generally make $ a punctuation character in strings
+ ;; and comments (Bug#69604).
+ (when (match-beginning 22)
+ (cperl-modify-syntax-type (match-beginning 22) cperl-st-punct)))
((match-beginning 1) ; POD section
;; "\\(\\`\n?\\|^\n\\)="
(setq b (match-beginning 0)
@@ -6496,6 +6519,10 @@ See examples in `cperl-style-examples'.")
(defun cperl-set-style (style)
"Set CPerl mode variables to use one of several different indentation styles.
+This command sets the default values for the variables. It does
+not affect buffers visiting files where the style has been set as
+a file or directory variable. To change the indentation style of
+a buffer, use the command `cperl-file-style' instead.
The arguments are a string representing the desired style.
The list of styles is in `cperl-style-alist', available styles
are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\"
@@ -6516,7 +6543,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(let ((style (cdr (assoc style cperl-style-alist))) setting)
(while style
(setq setting (car style) style (cdr style))
- (set (car setting) (cdr setting)))))
+ (set-default-toplevel-value (car setting) (cdr setting))))
+ (set-default-toplevel-value 'cperl-file-style style))
(defun cperl-set-style-back ()
"Restore a style memorized by `cperl-set-style'."
@@ -6526,7 +6554,20 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(while cperl-old-style
(setq setting (car cperl-old-style)
cperl-old-style (cdr cperl-old-style))
- (set (car setting) (cdr setting)))))
+ (set-default-toplevel-value (car setting) (cdr setting)))))
+
+(defun cperl-file-style (style)
+ "Set the indentation style for the current buffer to STYLE.
+The list of styles is in `cperl-style-alist', available styles
+are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\"
+and \"Whitesmith\"."
+ (interactive
+ (list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
+ (dolist (setting (cdr (assoc style cperl-style-alist)) style)
+ (let ((option (car setting))
+ (value (cdr setting)))
+ (set (make-local-variable option) value)))
+ (setq-local cperl-file-style style))
(declare-function Info-find-node "info"
(filename nodename &optional no-going-back strict-case
@@ -6581,14 +6622,13 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
read))))
(let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
- pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner
+ pos isvar height iniheight frheight buf win iniwin not-loner
max-height char-height buf-list)
(if (string-match "^-[a-zA-Z]$" command)
(setq cmd-desc "^-X[ \t\n]"))
(setq isvar (string-match "^[$@%]" command)
buf (cperl-info-buffer isvar)
- iniwin (selected-window)
- fr1 (window-frame iniwin))
+ iniwin (selected-window))
(set-buffer buf)
(goto-char (point-min))
(or isvar
@@ -6609,11 +6649,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(or (not win)
(eq (window-buffer win) buf)
(set-window-buffer win buf))
- (and win (setq fr2 (window-frame win)))
- (if (or (not fr2) (eq fr1 fr2))
- (pop-to-buffer buf)
- (special-display-popup-frame buf) ; Make it visible
- (select-window win))
+ (pop-to-buffer buf)
(goto-char pos) ; Needed (?!).
;; Resize
(setq iniheight (window-height)
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 7bf57bcbe21..9782eb443f2 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -495,9 +495,12 @@ compilation and evaluation time conflicts."
(unless (eq (char-after) ?{)
(ignore-errors (backward-up-list 1 t t)))
(save-excursion
- ;; 'new' should be part of the line
+ ;; 'new' should be part of the line, but should not trigger if
+ ;; statement has already ended, like for 'var x = new X();'.
+ ;; Also, deal with the possible end of line obscured by a
+ ;; trailing comment.
(goto-char (c-point 'iopl))
- (looking-at ".*new.*")))
+ (looking-at "^[^//]*new[^//]*;$")))
;; Line should not already be terminated
(save-excursion
(goto-char (c-point 'eopl))
@@ -998,6 +1001,8 @@ Key bindings:
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode)))
+(derived-mode-add-parents 'csharp-ts-mode '(csharp-mode))
+
(provide 'csharp-mode)
;;; csharp-mode.el ends here
diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el
index 334f3064d98..e31fd86bbdf 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -31,10 +31,8 @@
(eval-when-compile (require 'rx))
(declare-function treesit-parser-create "treesit.c")
-(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
-(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(defvar dockerfile-ts-mode--syntax-table
@@ -118,38 +116,15 @@ continuation to the previous entry."
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings.")
-(defun dockerfile-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (stage-tree (treesit-induce-sparse-tree
- node "from_instruction"
- nil 1000))
- (stage-index (dockerfile-ts-mode--imenu-1 stage-tree)))
- (when stage-index `(("Stage" . ,stage-index)))))
-
-(defun dockerfile-ts-mode--imenu-1 (node)
- "Helper for `dockerfile-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (children (cdr node))
- (subtrees (mapcan #'dockerfile-ts-mode--imenu-1
- children))
- (name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("from_instruction"
- (treesit-node-text
- (or (treesit-node-child-by-field-name ts-node "as")
- (treesit-node-child ts-node 1)) t)))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((or (null ts-node) (null name)) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
+(defun dockerfile-ts-mode--stage-name (node)
+ "Return the stage name of NODE.
+Return nil if there is no name or if NODE is not a stage node."
+ (pcase (treesit-node-type node)
+ ("from_instruction"
+ (treesit-node-text
+ (or (treesit-node-child-by-field-name node "as")
+ (treesit-node-child node 1))
+ t))))
;;;###autoload
(define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile"
@@ -166,8 +141,8 @@ the subtrees."
(setq-local comment-start-skip (rx "#" (* (syntax whitespace))))
;; Imenu.
- (setq-local imenu-create-index-function
- #'dockerfile-ts-mode--imenu)
+ (setq-local treesit-simple-imenu-settings
+ `(("Stage" "\\`from_instruction\\'" nil dockerfile-ts-mode--stage-name)))
(setq-local which-func-functions nil)
;; Indent.
@@ -190,6 +165,8 @@ the subtrees."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'dockerfile-ts-mode '(dockerfile-mode))
+
(if (treesit-ready-p 'dockerfile)
(add-to-list 'auto-mode-alist
;; NOTE: We can't use `rx' here, as it breaks bootstrap.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index d330e6e23cb..7d2f1a55165 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -2,12 +2,12 @@
;; Copyright (C) 2018-2024 Free Software Foundation, Inc.
-;; Version: 1.16
+;; Version: 1.17
;; 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.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1"))
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1"))
;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
@@ -226,90 +226,108 @@ automatically)."
when probe return (cons probe args)
finally (funcall err)))))))
-(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer"))
- ((cmake-mode cmake-ts-mode) . ("cmake-language-server"))
- (vimrc-mode . ("vim-language-server" "--stdio"))
- ((python-mode python-ts-mode)
- . ,(eglot-alternatives
- '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp")))
- ((js-json-mode json-mode json-ts-mode)
- . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
- ("vscode-json-languageserver" "--stdio")
- ("json-languageserver" "--stdio"))))
- (((js-mode :language-id "javascript")
- (js-ts-mode :language-id "javascript")
- (tsx-ts-mode :language-id "typescriptreact")
- (typescript-ts-mode :language-id "typescript")
- (typescript-mode :language-id "typescript"))
- . ("typescript-language-server" "--stdio"))
- ((bash-ts-mode sh-mode) . ("bash-language-server" "start"))
- ((php-mode phps-mode)
- . ,(eglot-alternatives
- '(("phpactor" "language-server")
- ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php"))))
- ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode)
- . ,(eglot-alternatives
- '("clangd" "ccls")))
- (((caml-mode :language-id "ocaml")
- (tuareg-mode :language-id "ocaml") reason-mode)
- . ("ocamllsp"))
- ((ruby-mode ruby-ts-mode)
- . ("solargraph" "socket" "--port" :autoport))
- (haskell-mode
- . ("haskell-language-server-wrapper" "--lsp"))
- (elm-mode . ("elm-language-server"))
- (mint-mode . ("mint" "ls"))
- (kotlin-mode . ("kotlin-language-server"))
- ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode)
- . ("gopls"))
- ((R-mode ess-r-mode) . ("R" "--slave" "-e"
- "languageserver::run()"))
- ((java-mode java-ts-mode) . ("jdtls"))
- ((dart-mode dart-ts-mode)
- . ("dart" "language-server"
- "--client-id" "emacs.eglot-dart"))
- ((elixir-mode elixir-ts-mode heex-ts-mode)
- . ,(if (and (fboundp 'w32-shell-dos-semantics)
- (w32-shell-dos-semantics))
- '("language_server.bat")
- (eglot-alternatives
- '("language_server.sh" "start_lexical.sh"))))
- (ada-mode . ("ada_language_server"))
- (scala-mode . ,(eglot-alternatives
- '("metals" "metals-emacs")))
- (racket-mode . ("racket" "-l" "racket-langserver"))
- ((tex-mode context-mode texinfo-mode bibtex-mode)
- . ,(eglot-alternatives '("digestif" "texlab")))
- (erlang-mode . ("erlang_ls" "--transport" "stdio"))
- ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio"))
- (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd")))
- (nickel-mode . ("nls"))
- (gdscript-mode . ("localhost" 6008))
- ((fortran-mode f90-mode) . ("fortls"))
- (futhark-mode . ("futhark" "lsp"))
- ((lua-mode lua-ts-mode) . ,(eglot-alternatives
- '("lua-language-server" "lua-lsp")))
- (zig-mode . ("zls"))
- ((css-mode css-ts-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 dockerfile-ts-mode) . ("docker-langserver" "--stdio"))
- ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode)
- . ("clojure-lsp"))
- ((csharp-mode csharp-ts-mode)
- . ,(eglot-alternatives
- '(("omnisharp" "-lsp")
- ("csharp-ls"))))
- (purescript-mode . ("purescript-language-server" "--stdio"))
- ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
- (markdown-mode
- . ,(eglot-alternatives
- '(("marksman" "server")
- ("vscode-markdown-language-server" "--stdio"))))
- (graphviz-dot-mode . ("dot-language-server" "--stdio"))
- (terraform-mode . ("terraform-ls" "serve"))
- ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")))
+(defvar eglot-server-programs
+ ;; FIXME: Maybe this info should be distributed into the major modes
+ ;; themselves where they could set a buffer-local `eglot-server-program'
+ ;; instead of keeping this database centralized.
+ ;; FIXME: With `derived-mode-add-parents' in Emacsā‰„30, some of
+ ;; those entries can be simplified, but we keep them for when
+ ;; `eglot.el' is installed via GNU ELPA in an older Emacs.
+ `(((rust-ts-mode rust-mode) . ("rust-analyzer"))
+ ((cmake-mode cmake-ts-mode) . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server" "--stdio"))
+ ((python-mode python-ts-mode)
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("basedpyright-langserver" "--stdio")
+ ("pyright-langserver" "--stdio")
+ "jedi-language-server" "ruff-lsp")))
+ ((js-json-mode json-mode json-ts-mode)
+ . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
+ ("vscode-json-languageserver" "--stdio")
+ ("json-languageserver" "--stdio"))))
+ (((js-mode :language-id "javascript")
+ (js-ts-mode :language-id "javascript")
+ (tsx-ts-mode :language-id "typescriptreact")
+ (typescript-ts-mode :language-id "typescript")
+ (typescript-mode :language-id "typescript"))
+ . ("typescript-language-server" "--stdio"))
+ ((bash-ts-mode sh-mode) . ("bash-language-server" "start"))
+ ((php-mode phps-mode php-ts-mode)
+ . ,(eglot-alternatives
+ '(("phpactor" "language-server")
+ ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php"))))
+ ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode)
+ . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml") reason-mode)
+ . ("ocamllsp"))
+ ((ruby-mode ruby-ts-mode)
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (elm-mode . ("elm-language-server"))
+ (mint-mode . ("mint" "ls"))
+ ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server"))
+ ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode)
+ . ("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+ "languageserver::run()"))
+ ((java-mode java-ts-mode) . ("jdtls"))
+ ((dart-mode dart-ts-mode)
+ . ("dart" "language-server"
+ "--client-id" "emacs.eglot-dart"))
+ ((elixir-mode elixir-ts-mode heex-ts-mode)
+ . ,(if (and (fboundp 'w32-shell-dos-semantics)
+ (w32-shell-dos-semantics))
+ '("language_server.bat")
+ (eglot-alternatives
+ '("language_server.sh" "start_lexical.sh"))))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ,(eglot-alternatives
+ '("metals" "metals-emacs")))
+ (racket-mode . ("racket" "-l" "racket-langserver"))
+ ((tex-mode context-mode texinfo-mode bibtex-mode)
+ . ,(eglot-alternatives '("digestif" "texlab")))
+ (erlang-mode . ("erlang_ls" "--transport" "stdio"))
+ ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio"))
+ (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd")))
+ (nickel-mode . ("nls"))
+ ((nushell-mode nushell-ts-mode) . ("nu" "--lsp"))
+ (gdscript-mode . ("localhost" 6008))
+ (fennel-mode . ("fennel-ls"))
+ (move-mode . ("move-analyzer"))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (futhark-mode . ("futhark" "lsp"))
+ ((lua-mode lua-ts-mode) . ,(eglot-alternatives
+ '("lua-language-server" "lua-lsp")))
+ (zig-mode . ("zls"))
+ ((css-mode css-ts-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 dockerfile-ts-mode) . ("docker-langserver" "--stdio"))
+ ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode)
+ . ("clojure-lsp"))
+ ((csharp-mode csharp-ts-mode)
+ . ,(eglot-alternatives
+ '(("omnisharp" "-lsp")
+ ("csharp-ls"))))
+ (purescript-mode . ("purescript-language-server" "--stdio"))
+ ((perl-mode cperl-mode)
+ . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
+ (markdown-mode
+ . ,(eglot-alternatives
+ '(("marksman" "server")
+ ("vscode-markdown-language-server" "--stdio"))))
+ (graphviz-dot-mode . ("dot-language-server" "--stdio"))
+ (terraform-mode . ("terraform-ls" "serve"))
+ ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))
+ (sml-mode
+ . ,(lambda (_interactive project)
+ (list "millet-ls" (project-root project)))))
"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
@@ -575,7 +593,7 @@ It is nil if Eglot is not byte-complied.")
(defvaralias 'eglot-{} 'eglot--{})
-(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.")
+(defconst eglot--{} (make-hash-table :size 0) "The empty JSON object.")
(defun eglot--executable-find (command &optional remote)
"Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
@@ -590,7 +608,7 @@ It is nil if Eglot is not byte-complied.")
(let ((vec (copy-sequence url-path-allowed-chars)))
(aset vec ?: nil) ;; see github#639
vec)
- "Like `url-path-allows-chars' but more restrictive.")
+ "Like `url-path-allowed-chars' but more restrictive.")
;;; Message verification helpers
@@ -1797,6 +1815,12 @@ If optional MARKER, return a marker instead"
;;; More helpers
+(defconst eglot--uri-path-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?: nil) ;; see github#639
+ vec)
+ "Like `url-path-allowed-chars' but more restrictive.")
+
(defun eglot--snippet-expansion-fn ()
"Compute a function to expand snippets.
Doubles as an indicator of snippet support."
@@ -3054,9 +3078,14 @@ for which LSP on-type-formatting should be requested."
finally (cl-return comp)))
(defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t))
+(defun eglot--dumb-tryc (pat table pred point)
+ (let ((probe (funcall table pat pred nil)))
+ (cond ((eq probe t) t)
+ (probe (cons probe (length probe)))
+ (t (cons pat point)))))
(add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex)))
-(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore eglot--dumb-allc))
+(add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc))
(defun eglot-completion-at-point ()
"Eglot's `completion-at-point' function."
@@ -3115,7 +3144,8 @@ for which LSP on-type-formatting should be requested."
items)))
;; (trace-values "Requested" (length proxies) cachep bounds)
(setq eglot--capf-session
- (if cachep (list bounds retval resolved orig-pos) :none))
+ (if cachep (list bounds retval resolved orig-pos
+ bounds-string) :none))
(setq local-cache retval)))))
(resolve-maybe
;; Maybe completion/resolve JSON object `lsp-comp' into
@@ -3135,7 +3165,8 @@ for which LSP on-type-formatting should be requested."
(>= (cdr bounds) (cdr (nth 0 eglot--capf-session))))
(setq local-cache (nth 1 eglot--capf-session)
resolved (nth 2 eglot--capf-session)
- orig-pos (nth 3 eglot--capf-session))
+ orig-pos (nth 3 eglot--capf-session)
+ bounds-string (nth 4 eglot--capf-session))
;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos)
)
(list
@@ -3605,16 +3636,17 @@ edit proposed by the server."
(defun eglot--code-action-bounds ()
"Calculate appropriate bounds depending on region and point."
- (let (diags)
+ (let (diags boftap)
(cond ((use-region-p) `(,(region-beginning) ,(region-end)))
((setq diags (flymake-diagnostics (point)))
(cl-loop for d in diags
minimizing (flymake-diagnostic-beg d) into beg
maximizing (flymake-diagnostic-end d) into end
finally (cl-return (list beg end))))
+ ((setq boftap (bounds-of-thing-at-point 'sexp))
+ (list (car boftap) (cdr boftap)))
(t
- (let ((boftap (bounds-of-thing-at-point 'sexp)))
- (list (car boftap) (cdr boftap)))))))
+ (list (point) (point))))))
(defun eglot-code-actions (beg &optional end action-kind interactive)
"Find LSP code actions of type ACTION-KIND between BEG and END.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 00910fb67c7..8a713bd19a2 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map."
(load (byte-compile-dest-file buffer-file-name)))
(declare-function native-compile "comp")
-(declare-function comp-write-bytecode-file "comp")
+(declare-function comp--write-bytecode-file "comp")
(defun emacs-lisp-native-compile ()
"Native-compile the current buffer's file (if it has changed).
@@ -233,7 +233,7 @@ visited by the current buffer."
(byte-to-native-output-buffer-file nil)
(eln (native-compile buffer-file-name)))
(when eln
- (comp-write-bytecode-file eln))))
+ (comp--write-bytecode-file eln))))
(defun emacs-lisp-native-compile-and-load ()
"Native-compile the current buffer's file (if it has changed), then load it.
@@ -309,7 +309,7 @@ Comments in the form will be lost."
INTERACTIVE non-nil means ask the user for confirmation; this
happens in interactive invocations."
(interactive "p")
- (if lexical-binding
+ (if (and (local-variable-p 'lexical-binding) lexical-binding)
(when interactive
(message "lexical-binding already enabled!")
(ding))
@@ -371,6 +371,12 @@ be used instead.
;; Font-locking support.
+(defun elisp--font-lock-shorthand (_limit)
+ ;; Add faces on shorthands between point and LIMIT.
+ ;; ...
+ ;; Return nil to tell font-lock, that there's nothing left to do.
+ nil)
+
(defun elisp--font-lock-flush-elisp-buffers (&optional file)
;; We're only ever called from after-load-functions, load-in-progress can
;; still be t in case of nested loads.
@@ -657,12 +663,13 @@ functions are annotated with \"<f>\" via the
(save-excursion
(backward-sexp 1)
(skip-chars-forward "`',ā€˜#")
- (point))
+ (min (point) pos))
(scan-error pos)))
(end
- (unless (or (eq beg (point-max))
- (member (char-syntax (char-after beg))
- '(?\" ?\()))
+ (cond
+ ((and (< beg (point-max))
+ (memq (char-syntax (char-after beg))
+ '(?w ?\\ ?_)))
(condition-case nil
(save-excursion
(goto-char beg)
@@ -670,7 +677,11 @@ functions are annotated with \"<f>\" via the
(skip-chars-backward "'ā€™")
(when (>= (point) pos)
(point)))
- (scan-error pos))))
+ (scan-error pos)))
+ ((or (>= beg (point-max))
+ (memq (char-syntax (char-after beg))
+ '(?\) ?\s)))
+ beg)))
;; t if in function position.
(funpos (eq (char-before beg) ?\())
(quoted (elisp--form-quoted-p beg))
@@ -1577,9 +1588,6 @@ character)."
(buffer-substring-no-properties beg end))
))))
-
-(defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
-
(defun eval-sexp-add-defvars (exp &optional pos)
"Prepend EXP with all the `defvar's that precede it in the buffer.
POS specifies the starting position where EXP was found and defaults to point."
@@ -1621,16 +1629,10 @@ integer value is also printed as a character of that codepoint.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(interactive "P")
- (if (null eval-expression-debug-on-error)
- (values--store-value
- (elisp--eval-last-sexp eval-last-sexp-arg-internal))
- (let ((value
- (let ((debug-on-error elisp--eval-last-sexp-fake-value))
- (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
- debug-on-error))))
- (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
- (setq debug-on-error (cdr value)))
- (car value))))
+ (values--store-value
+ (handler-bind ((error (if eval-expression-debug-on-error
+ #'eval-expression--debug #'ignore)))
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal))))
(defun elisp--eval-defun-1 (form)
"Treat some expressions in FORM specially.
@@ -1689,8 +1691,7 @@ Return the result of evaluation."
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(defvar elisp--eval-defun-result)
- (let ((debug-on-error eval-expression-debug-on-error)
- (edebugging edebug-all-defs)
+ (let ((edebugging edebug-all-defs)
elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
@@ -1769,15 +1770,9 @@ which see."
(defvar edebug-all-defs)
(eval-defun (not edebug-all-defs)))
(t
- (if (null eval-expression-debug-on-error)
- (elisp--eval-defun)
- (let (new-value value)
- (let ((debug-on-error elisp--eval-last-sexp-fake-value))
- (setq value (elisp--eval-defun))
- (setq new-value debug-on-error))
- (unless (eq elisp--eval-last-sexp-fake-value new-value)
- (setq debug-on-error new-value))
- value)))))
+ (handler-bind ((error (if eval-expression-debug-on-error
+ #'eval-expression--debug #'ignore)))
+ (elisp--eval-defun)))))
;;; ElDoc Support
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index b493195eedd..9804152d9ab 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -360,13 +360,19 @@
(defvar elixir-ts--font-lock-settings
(treesit-font-lock-rules
:language 'elixir
- :feature 'elixir-function-name
+ :feature 'elixir-definition
`((call target: (identifier) @target-identifier
+ (arguments
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments)))
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
(arguments (identifier) @font-lock-function-name-face)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
- (call target: (identifier) @font-lock-function-name-face))
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier)) @font-lock-variable-name-face)))
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
@@ -379,13 +385,15 @@
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
- (call target: (identifier) @font-lock-function-name-face))
+ (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier)) @font-lock-variable-name-face)))
(do_block)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(call target: (identifier) @target-identifier
(arguments
(binary_operator
- left: (call target: (identifier) @font-lock-function-name-face)))
+ left: (call target: (identifier) @font-lock-function-name-face
+ (arguments ((identifier)) @font-lock-variable-name-face))))
(do_block)
(:match ,elixir-ts--definition-keywords-re @target-identifier))
(unary_operator
@@ -521,8 +529,8 @@
operator: "/" right: (integer)))
(call
target: (dot right: (identifier) @font-lock-function-call-face))
- (unary_operator operator: "&" @font-lock-variable-name-face
- operand: (integer) @font-lock-variable-name-face)
+ (unary_operator operator: "&" @font-lock-variable-use-face
+ operand: (integer) @font-lock-variable-use-face)
(unary_operator operator: "&" @font-lock-operator-face
operand: (list)))
@@ -537,16 +545,18 @@
:language 'elixir
:feature 'elixir-variable
- '((binary_operator left: (identifier) @font-lock-variable-name-face)
- (binary_operator right: (identifier) @font-lock-variable-name-face)
- (arguments ( (identifier) @font-lock-variable-name-face))
- (tuple (identifier) @font-lock-variable-name-face)
- (list (identifier) @font-lock-variable-name-face)
- (pair value: (identifier) @font-lock-variable-name-face)
- (body (identifier) @font-lock-variable-name-face)
- (unary_operator operand: (identifier) @font-lock-variable-name-face)
- (interpolation (identifier) @font-lock-variable-name-face)
- (do_block (identifier) @font-lock-variable-name-face))
+ '((binary_operator left: (identifier) @font-lock-variable-use-face)
+ (binary_operator right: (identifier) @font-lock-variable-use-face)
+ (arguments ( (identifier) @font-lock-variable-use-face))
+ (tuple (identifier) @font-lock-variable-use-face)
+ (list (identifier) @font-lock-variable-use-face)
+ (pair value: (identifier) @font-lock-variable-use-face)
+ (body (identifier) @font-lock-variable-use-face)
+ (unary_operator operand: (identifier) @font-lock-variable-use-face)
+ (interpolation (identifier) @font-lock-variable-use-face)
+ (do_block (identifier) @font-lock-variable-use-face)
+ (access_call target: (identifier) @font-lock-variable-use-face)
+ (access_call "[" key: (identifier) @font-lock-variable-use-face "]"))
:language 'elixir
:feature 'elixir-builtin
@@ -697,11 +707,10 @@ Return nil if NODE is not a defun node or doesn't have a name."
;; Font-lock.
(setq-local treesit-font-lock-settings elixir-ts--font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-doc elixir-function-name)
+ '(( elixir-comment elixir-doc elixir-definition)
( elixir-string elixir-keyword elixir-data-type)
- ( elixir-sigil elixir-variable elixir-builtin
- elixir-string-escape)
- ( elixir-function-call elixir-operator elixir-number )))
+ ( elixir-sigil elixir-builtin elixir-string-escape)
+ ( elixir-function-call elixir-variable elixir-operator elixir-number )))
;; Imenu.
@@ -734,17 +743,18 @@ Return nil if NODE is not a defun node or doesn't have a name."
heex-ts--indent-rules))
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-doc elixir-function-name
+ '(( elixir-comment elixir-doc elixir-definition
heex-comment heex-keyword heex-doctype )
( elixir-string elixir-keyword elixir-data-type
heex-component heex-tag heex-attribute heex-string )
- ( elixir-sigil elixir-variable elixir-builtin
- elixir-string-escape)
- ( elixir-function-call elixir-operator elixir-number ))))
+ ( elixir-sigil elixir-builtin elixir-string-escape)
+ ( elixir-function-call elixir-variable elixir-operator elixir-number ))))
(treesit-major-mode-setup)
(setq-local syntax-propertize-function #'elixir-ts--syntax-propertize)))
+(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode))
+
(if (treesit-ready-p 'elixir)
(progn
(add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode))
diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el
new file mode 100644
index 00000000000..6cd78d3577a
--- /dev/null
+++ b/lisp/progmodes/etags-regen.el
@@ -0,0 +1,431 @@
+;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov <dmitry@gutov.dev>
+;; Keywords: tools
+
+;; 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:
+
+;; Simple automatic tags generation with updates on save.
+;;
+;; This mode provides automatic indexing for Emacs "go to definition"
+;; feature, the `xref-go-forward' command (bound to `M-.' by default).
+;;
+;; At the moment reindexing works off before/after-save-hook, but to
+;; handle more complex changes (for example, the user switching to
+;; another branch from the terminal) we can look into plugging into
+;; something like `filenotify'.
+;;
+;; Note that this feature disables itself if the user has some tags
+;; table already visited (with `M-x visit-tags-table', or through an
+;; explicit prompt triggered by some feature that requires tags).
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup etags-regen nil
+ "Auto-(re)generating tags."
+ :group 'tools)
+
+(defvar etags-regen--tags-file nil)
+(defvar etags-regen--tags-root nil)
+(defvar etags-regen--new-file nil)
+
+(declare-function project-root "project")
+(declare-function project-files "project")
+(declare-function dired-glob-regexp "dired")
+
+(defcustom etags-regen-program (executable-find "etags")
+ "Name of the etags program used by `etags-regen-mode'.
+
+If you only have `ctags' installed, you can also set this to
+\"ctags -e\". Some features might not be supported this way."
+ ;; Always having our 'etags' here would be easier, but we can't
+ ;; always rely on it being installed. So it might be ctags's etags.
+ :type 'file
+ :version "30.1")
+
+(defcustom etags-regen-tags-file "TAGS"
+ "Name of the tags file to create inside the project by `etags-regen-mode'.
+
+The value should either be a simple file name (no directory
+specified), or a function that accepts the project root directory
+and returns a distinct absolute file name for its tags file. The
+latter possibility is useful when you prefer to store the tag
+files somewhere else, for example in `temporary-file-directory'."
+ :type '(choice (string :tag "File name")
+ (function :tag "Function that returns file name"))
+ :version "30.1")
+
+(defcustom etags-regen-program-options nil
+ "List of additional options for etags program invoked by `etags-regen-mode'."
+ :type '(repeat string)
+ :version "30.1")
+
+(defcustom etags-regen-regexp-alist nil
+ "Mapping of languages to etags regexps for `etags-regen-mode'.
+
+These regexps are used in addition to the tags made with the
+standard parsing based on the language.
+
+The value must be a list where each element has the
+form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and
+TAG-REGEXPS are lists of strings.
+
+Each language should be one of the recognized by etags, see
+`etags --help'. Each tag regexp should be a string in the format
+documented for the `--regex' arguments (without `{language}').
+
+We currently support only Emacs's etags program with this option."
+ :type '(repeat
+ (cons
+ :tag "Languages group"
+ (repeat (string :tag "Language name"))
+ (repeat (string :tag "Tag Regexp"))))
+ :version "30.1")
+
+;;;###autoload
+(put 'etags-regen-regexp-alist 'safe-local-variable
+ (lambda (value)
+ (and (listp value)
+ (seq-every-p
+ (lambda (group)
+ (and (consp group)
+ (listp (car group))
+ (listp (cdr group))
+ (seq-every-p #'stringp (car group))
+ (seq-every-p #'stringp (cdr group))))
+ value))))
+
+;; We have to list all extensions: etags falls back to Fortran
+;; when it cannot determine the type of the file.
+;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html
+(defcustom etags-regen-file-extensions
+ '("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp"
+ "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl"
+ "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada")
+ "Code file extensions for `etags-regen-mode'.
+
+File extensions to generate the tags for."
+ :type '(repeat (string :tag "File extension"))
+ :version "30.1")
+
+;;;###autoload
+(put 'etags-regen-file-extensions 'safe-local-variable
+ (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+
+;; FIXME: We don't support root anchoring yet.
+(defcustom etags-regen-ignores nil
+ "Additional ignore rules, in the format of `project-ignores'."
+ :type '(repeat
+ (string :tag "Glob to ignore"))
+ :version "30.1")
+
+;;;###autoload
+(put 'etags-regen-ignores 'safe-local-variable
+ (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+
+(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*")
+
+(defvar etags-regen--rescan-files-limit 100)
+
+(defun etags-regen--all-mtimes (proj)
+ (let ((files (etags-regen--all-files proj))
+ (mtimes (make-hash-table :test 'equal))
+ file-name-handler-alist)
+ (dolist (f files)
+ (condition-case nil
+ (puthash f
+ (file-attribute-modification-time
+ (file-attributes f))
+ mtimes)
+ (file-missing nil)))
+ mtimes))
+
+(defun etags-regen--choose-tags-file (proj)
+ (if (functionp etags-regen-tags-file)
+ (funcall etags-regen-tags-file (project-root proj))
+ (expand-file-name etags-regen-tags-file (project-root proj))))
+
+(defun etags-regen--refresh (proj)
+ (save-excursion
+ (let* ((tags-file (etags-regen--choose-tags-file proj))
+ (tags-mtime (file-attribute-modification-time
+ (file-attributes tags-file)))
+ (all-mtimes (etags-regen--all-mtimes proj))
+ added-files
+ changed-files
+ removed-files)
+ (etags-regen--visit-table tags-file (project-root proj))
+ (set-buffer (get-file-buffer tags-file))
+ (dolist (file (tags-table-files))
+ (let ((mtime (gethash file all-mtimes)))
+ (cond
+ ((null mtime)
+ (push file removed-files))
+ ((time-less-p tags-mtime mtime)
+ (push file changed-files)
+ (remhash file all-mtimes))
+ (t
+ (remhash file all-mtimes)))))
+ (maphash
+ (lambda (key _value)
+ (push key added-files))
+ all-mtimes)
+ (if (> (+ (length added-files)
+ (length changed-files)
+ (length removed-files))
+ etags-regen--rescan-files-limit)
+ (progn
+ (message "etags-regen: Too many changes, falling back to full rescan")
+ (etags-regen--tags-cleanup))
+ (dolist (file (nconc removed-files changed-files))
+ (etags-regen--remove-tag file))
+ (when (or changed-files added-files)
+ (apply #'etags-regen--append-tags
+ (nconc changed-files added-files)))
+ (when (or changed-files added-files removed-files)
+ (let ((save-silently t)
+ (message-log-max nil))
+ (save-buffer 0)))))))
+
+(defun etags-regen--maybe-generate ()
+ (let (proj)
+ (when (and etags-regen--tags-root
+ (not (file-in-directory-p default-directory
+ etags-regen--tags-root)))
+ (etags-regen--tags-cleanup))
+ (when (and (not etags-regen--tags-root)
+ ;; If existing table is visited that's not generated by
+ ;; this mode, skip all functionality.
+ (not (or tags-file-name
+ tags-table-list))
+ (file-exists-p (etags-regen--choose-tags-file
+ (setq proj (project-current)))))
+ (message "Found existing tags table, refreshing...")
+ (etags-regen--refresh proj))
+ (when (and (not (or tags-file-name
+ tags-table-list))
+ (setq proj (or proj (project-current))))
+ (message "Generating new tags table...")
+ (let ((start (time-to-seconds)))
+ (etags-regen--tags-generate proj)
+ (message "...done (%.2f s)" (- (time-to-seconds) start))))))
+
+(defun etags-regen--all-files (proj)
+ (let* ((root (project-root proj))
+ (default-directory root)
+ ;; TODO: Make the scanning more efficient, e.g. move the
+ ;; filtering by glob to project (project-files-filtered...).
+ (files (project-files proj))
+ (match-re (concat
+ "\\."
+ (regexp-opt etags-regen-file-extensions)
+ "\\'"))
+ (ir-start (1- (length root)))
+ (ignores-regexps
+ (mapcar #'etags-regen--ignore-regexp
+ etags-regen-ignores)))
+ (cl-delete-if
+ (lambda (f) (or (not (string-match-p match-re f))
+ (string-match-p "/\\.#" f) ;Backup files.
+ (cl-some (lambda (ignore) (string-match ignore f ir-start))
+ ignores-regexps)))
+ files)))
+
+(defun etags-regen--ignore-regexp (ignore)
+ (require 'dired)
+ ;; It's somewhat brittle to rely on Dired.
+ (let ((re (dired-glob-regexp ignore)))
+ ;; We could implement root anchoring here, but \\= doesn't work in
+ ;; string-match :-(.
+ (concat (unless (eq ?/ (aref re 3)) "/")
+ ;; Cutting off the anchors added by `dired-glob-regexp'.
+ (substring re 2 (- (length re) 2))
+ ;; This way we allow a glob to match against a directory
+ ;; name, or a file name. And when it ends with / already,
+ ;; no need to add the anchoring.
+ (unless (eq ?/ (aref re (- (length re) 3)))
+ ;; Either match a full name segment, or eos.
+ "\\(?:/\\|\\'\\)"))))
+
+(defun etags-regen--tags-generate (proj)
+ (let* ((root (project-root proj))
+ (default-directory root)
+ (files (etags-regen--all-files proj))
+ (tags-file (etags-regen--choose-tags-file proj))
+ (ctags-p (etags-regen--ctags-p))
+ (command (format "%s %s %s - -o %s"
+ etags-regen-program
+ (mapconcat #'identity
+ (etags-regen--build-program-options ctags-p)
+ " ")
+ ;; ctags's etags requires '-L' for stdin input.
+ (if ctags-p "-L" "")
+ tags-file)))
+ (with-temp-buffer
+ (mapc (lambda (f)
+ (insert f "\n"))
+ files)
+ (shell-command-on-region (point-min) (point-max) command
+ nil nil etags-regen--errors-buffer-name t))
+ (etags-regen--visit-table tags-file root)))
+
+(defun etags-regen--visit-table (tags-file root)
+ ;; Invalidate the scanned tags after any change is written to disk.
+ (add-hook 'after-save-hook #'etags-regen--update-file)
+ (add-hook 'before-save-hook #'etags-regen--mark-as-new)
+ (setq etags-regen--tags-file tags-file
+ etags-regen--tags-root root)
+ (visit-tags-table etags-regen--tags-file))
+
+(defun etags-regen--ctags-p ()
+ (string-search "Ctags"
+ (shell-command-to-string
+ (format "%s --version" etags-regen-program))))
+
+(defun etags-regen--build-program-options (ctags-p)
+ (when (and etags-regen-regexp-alist ctags-p)
+ (user-error "etags-regen-regexp-alist is not supported with Ctags"))
+ (nconc
+ (mapcan
+ (lambda (group)
+ (mapcan
+ (lambda (lang)
+ (mapcar (lambda (regexp)
+ (concat "--regex="
+ (shell-quote-argument
+ (format "{%s}%s" lang regexp))))
+ (cdr group)))
+ (car group)))
+ etags-regen-regexp-alist)
+ (mapcar #'shell-quote-argument
+ etags-regen-program-options)))
+
+(defun etags-regen--update-file ()
+ ;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer
+ ;; the updates and do them later in bursts when the table is used.
+ (let* ((file-name buffer-file-name)
+ (tags-file-buf (and etags-regen--tags-root
+ (get-file-buffer etags-regen--tags-file)))
+ (relname (concat "/" (file-relative-name file-name
+ etags-regen--tags-root)))
+ (ignores etags-regen-ignores)
+ pr should-scan)
+ (save-excursion
+ (when tags-file-buf
+ (cond
+ ((and etags-regen--new-file
+ (kill-local-variable 'etags-regen--new-file)
+ (setq pr (project-current))
+ (equal (project-root pr) etags-regen--tags-root)
+ (member file-name (project-files pr)))
+ (set-buffer tags-file-buf)
+ (setq should-scan t))
+ ((progn (set-buffer tags-file-buf)
+ (etags-regen--remove-tag file-name))
+ (setq should-scan t))))
+ (when (and should-scan
+ (not (cl-some
+ (lambda (ignore)
+ (string-match-p
+ (etags-regen--ignore-regexp ignore)
+ relname))
+ ignores)))
+ (etags-regen--append-tags file-name)
+ (let ((save-silently t)
+ (message-log-max nil))
+ (save-buffer 0))))))
+
+(defun etags-regen--remove-tag (file-name)
+ (goto-char (point-min))
+ (when (search-forward (format "\f\n%s," file-name) nil t)
+ (let ((start (match-beginning 0)))
+ (search-forward "\f\n" nil 'move)
+ (let ((inhibit-read-only t))
+ (delete-region start
+ (if (eobp)
+ (point)
+ (- (point) 2)))))
+ t))
+
+(defun etags-regen--append-tags (&rest file-names)
+ (goto-char (point-max))
+ (let ((options (etags-regen--build-program-options (etags-regen--ctags-p)))
+ (inhibit-read-only t))
+ ;; XXX: call-process is significantly faster, though.
+ ;; Like 10ms vs 20ms here. But `shell-command' makes it easy to
+ ;; direct stderr to a separate buffer.
+ (shell-command
+ (format "%s %s %s -o -"
+ etags-regen-program (mapconcat #'identity options " ")
+ (mapconcat #'identity file-names " "))
+ t etags-regen--errors-buffer-name))
+ ;; FIXME: Is there a better way to do this?
+ ;; Completion table is the only remaining place where the
+ ;; update is not incremental.
+ (setq-default tags-completion-table nil))
+
+(defun etags-regen--mark-as-new ()
+ (when (and etags-regen--tags-root
+ (not buffer-file-number))
+ (setq-local etags-regen--new-file t)))
+
+(defun etags-regen--tags-cleanup ()
+ (when etags-regen--tags-file
+ (let ((buffer (get-file-buffer etags-regen--tags-file)))
+ (and buffer
+ (kill-buffer buffer)))
+ (tags-reset-tags-tables)
+ (setq tags-file-name nil
+ tags-table-list nil
+ etags-regen--tags-file nil
+ etags-regen--tags-root nil))
+ (remove-hook 'after-save-hook #'etags-regen--update-file)
+ (remove-hook 'before-save-hook #'etags-regen--mark-as-new))
+
+(defvar etags-regen-mode-map (make-sparse-keymap))
+
+;;;###autoload
+(define-minor-mode etags-regen-mode
+ "Minor mode to automatically generate and update tags tables.
+
+This minor mode generates the tags table automatically based on
+the current project configuration, and later updates it as you
+edit the files and save the changes.
+
+If you select a tags table manually (for example, using
+\\[visit-tags-table]), then this mode will be effectively
+disabled for the entire session. Use \\[tags-reset-tags-tables]
+to countermand the effect of a previous \\[visit-tags-table]."
+ :global t
+ (if etags-regen-mode
+ (progn
+ (advice-add 'etags--xref-backend :before
+ #'etags-regen--maybe-generate)
+ (advice-add 'tags-completion-at-point-function :before
+ #'etags-regen--maybe-generate))
+ (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate)
+ (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate)
+ (etags-regen--tags-cleanup)))
+
+(provide 'etags-regen)
+
+;;; etags-regen.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b9bd772ddfc..597612196fd 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1488,7 +1488,7 @@ hits the start of file."
(setq symbs (symbol-value symbs))
(insert (format-message "symbol `%s' has no value\n" symbs))
(setq symbs nil)))
- (if (vectorp symbs)
+ (if (obarrayp symbs)
(mapatoms ins-symb symbs)
(dolist (sy symbs)
(funcall ins-symb (car sy))))
@@ -2065,7 +2065,8 @@ for \\[find-tag] (which see)."
(user-error "%s"
(substitute-command-keys
"No tags table loaded; try \\[visit-tags-table]")))
- (let ((comp-data (tags-completion-at-point-function)))
+ (let ((comp-data (tags-completion-at-point-function))
+ (completion-ignore-case (find-tag--completion-ignore-case)))
(if (null comp-data)
(user-error "Nothing to complete")
(completion-in-region (car comp-data) (cadr comp-data)
@@ -2183,7 +2184,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(setq symbs (symbol-value symbs))
(warn "symbol `%s' has no value" symbs)
(setq symbs nil))
- (if (vectorp symbs)
+ (if (obarrayp symbs)
(mapatoms add-xref symbs)
(dolist (sy symbs)
(funcall add-xref (car sy))))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 3f8aec27833..779c612f479 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -715,7 +715,7 @@ associated `flymake-category' return DEFAULT."
(delete-overlay ov)))
(defun flymake--eol-overlay-summary (src-ovs)
- "Helper function for `flymake--eol-overlay-update'."
+ "Helper function for `flymake--update-eol-overlays'."
(cl-flet ((summarize (d)
(propertize (flymake-diagnostic-oneliner d t) 'face
(flymake--lookup-type-property (flymake--diag-type d)
@@ -744,7 +744,7 @@ associated `flymake-category' return DEFAULT."
(defun flymake--update-eol-overlays ()
"Update the `before-string' property of end-of-line overlays."
- (save-excursion
+ (save-restriction
(widen)
(dolist (o (overlays-in (point-min) (point-max)))
(when (overlay-get o 'flymake--eol-overlay)
@@ -1569,13 +1569,19 @@ correctly.")
,flymake-mode-line-lighter
mouse-face mode-line-highlight
help-echo
- ,(lambda (&rest _)
- (concat
- (format "%s known backends\n" (hash-table-count flymake--state))
- (format "%s running\n" (length (flymake-running-backends)))
- (format "%s disabled\n" (length (flymake-disabled-backends)))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode"))
+ ,(lambda (w &rest _)
+ (with-current-buffer (window-buffer w)
+ ;; Mouse can activate tool-tip without window being active.
+ ;; `flymake--state' is buffer local and is null when line
+ ;; lighter appears in *Help* `describe-mode'.
+ (concat
+ (unless (null flymake--state)
+ (concat
+ (format "%s known backends\n" (hash-table-count flymake--state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode")))
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
@@ -1637,14 +1643,16 @@ correctly.")
(defvar flymake--mode-line-counter-map
(let ((map (make-sparse-keymap)))
+ ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events
+ ;; and vice versa!!
(define-key map (vector 'mode-line mouse-wheel-down-event)
#'flymake--mode-line-counter-scroll-prev)
(define-key map [mode-line wheel-down]
- #'flymake--mode-line-counter-scroll-prev)
+ #'flymake--mode-line-counter-scroll-next)
(define-key map (vector 'mode-line mouse-wheel-up-event)
#'flymake--mode-line-counter-scroll-next)
(define-key map [mode-line wheel-up]
- #'flymake--mode-line-counter-scroll-next)
+ #'flymake--mode-line-counter-scroll-prev)
map))
(defun flymake--mode-line-counter-1 (type)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index e08653f7f9e..c8b086cfad2 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1880,7 +1880,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(defun gdb-clear-inferior-io ()
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
- (erase-buffer)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
(defconst breakpoint-xpm-data
@@ -2866,7 +2867,8 @@ current thread and update GDB buffers."
(defun gdb-clear-partial-output ()
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
- (erase-buffer)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
;; Parse GDB/MI result records: this process converts
;; list [...] -> list
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index 65adc1c55ea..cc330688dc3 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -261,7 +261,11 @@
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'go-ts-mode '(go-mode))
+
(if (treesit-ready-p 'go)
+ ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist'
+ ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'?
(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)))
(defun go-ts-mode--defun-name (node &optional skip-prefix)
@@ -437,6 +441,8 @@ what the parent of the node would be if it were a node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'go-mod-ts-mode '(go-mod-mode))
+
(if (treesit-ready-p 'gomod)
(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index be6357f4139..f10b047cc74 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -243,7 +243,7 @@ Check it when `gud-running' is t")
:visible (eq gud-minor-mode 'gdbmi)]
["Print Expression" gud-print
:enable (not gud-running)]
- ["Dump object-Derefenrece" gud-pstar
+ ["Dump object-Dereference" gud-pstar
:label (if (eq gud-minor-mode 'jdb)
"Dump object"
"Print Dereference")
@@ -3671,8 +3671,7 @@ Treats actions as defuns."
(remove-hook 'after-save-hook #'gdb-create-define-alist t))))
(defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode
- python-mode c-ts-mode c++-ts-mode
- python-ts-mode)
+ python-mode)
"List of modes for which to enable GUD tooltips."
:type '(repeat (symbol :tag "Major mode"))
:group 'tooltip)
@@ -3708,10 +3707,9 @@ only tooltips in the buffer containing the overlay arrow."
#'gud-tooltip-activate-mouse-motions-if-enabled)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (if (and gud-tooltip-mode
- (memq major-mode gud-tooltip-modes))
- (gud-tooltip-activate-mouse-motions t)
- (gud-tooltip-activate-mouse-motions nil)))))
+ (gud-tooltip-activate-mouse-motions
+ (and gud-tooltip-mode
+ (derived-mode-p gud-tooltip-modes))))))
(defvar gud-tooltip-mouse-motions-active nil
"Locally t in a buffer if tooltip processing of mouse motion is enabled.")
diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el
index 7b53a44deb2..07b8bfdc74f 100644
--- a/lisp/progmodes/heex-ts-mode.el
+++ b/lisp/progmodes/heex-ts-mode.el
@@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward."
("Slot" "\\`slot\\'" nil nil)
("Tag" "\\`tag\\'" nil nil)))
+ ;; Outline minor mode
+ ;; `heex-ts-mode' inherits from `html-mode' that sets
+ ;; regexp-based outline variables. So need to restore
+ ;; the default values of outline variables to be able
+ ;; to use `treesit-outline-predicate' derived
+ ;; from `treesit-simple-imenu-settings' above.
+ (kill-local-variable 'outline-heading-end-regexp)
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-level)
+
(setq-local treesit-font-lock-settings heex-ts--font-lock-settings)
(setq-local treesit-simple-indent-rules heex-ts--indent-rules)
@@ -177,6 +187,8 @@ With ARG, do it many times. Negative ARG means move backward."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'heex-ts-mode '(heex-mode))
+
(if (treesit-ready-p 'heex)
;; Both .heex and the deprecated .leex files should work
;; with the tree-sitter-heex grammar.
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 3b7eb393561..98e567299a1 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within."
(defun hif-after-revert-function ()
(and hide-ifdef-mode hide-ifdef-hiding
(hide-ifdefs nil nil t)))
-(add-hook 'after-revert-hook 'hif-after-revert-function)
+(add-hook 'after-revert-hook #'hif-after-revert-function)
(defun hif-end-of-line ()
"Find the end-point of line concatenation."
@@ -474,7 +474,7 @@ Everything including these lines is made invisible."
(defun hif-eval (form)
"Evaluate hideif internal representation."
- (let ((val (eval form)))
+ (let ((val (eval form t)))
(if (stringp val)
(or (get-text-property 0 'hif-value val)
val)
@@ -542,7 +542,7 @@ that form should be displayed.")
(defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*")
(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
-(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)"))
+(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)"))
(defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
@@ -679,7 +679,7 @@ that form should be displayed.")
("..." . hif-etc)
("defined" . hif-defined)))
-(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
+(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist))
(defconst hif-token-regexp
;; The ordering of regexp grouping is crucial to `hif-strtok'
@@ -690,7 +690,7 @@ that form should be displayed.")
;; decimal/octal:
"\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?"
hif-numtype-suffix-regexp "?\\)"
- "\\|" (regexp-opt (mapcar 'car hif-token-alist) t)
+ "\\|" (regexp-opt (mapcar #'car hif-token-alist) t)
"\\|\\(\\w+\\)"))
;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"")
@@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup."
(t
(setq hif-simple-token-only nil)
- (intern-safe string)))))
+ (hif--intern-safe string)))))
(defun hif-backward-comment (&optional start end)
"If we're currently within a C(++) comment, skip them backwards."
@@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input."
(t
(error "Invalid token to stringify"))))
-(defun intern-safe (str)
+(defun hif--intern-safe (str)
(if (stringp str)
(intern str)))
@@ -1750,7 +1750,7 @@ and `+='...)."
;; Split REM-BODY @ __VA_ARGS__ into LEFT and right
(setq part nil)
(if (zerop va)
- (setq left nil ; __VA_ARGS__ trimed
+ (setq left nil ; __VA_ARGS__ trimmed
rem-body (cdr rem-body))
(setq left rem-body
rem-body (cdr (nthcdr va rem-body))) ; _V_ removed
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index b181b21118f..07616960565 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -254,6 +254,9 @@ This has effect only if `search-invisible' is set to `open'."
;;;###autoload
(defvar hs-special-modes-alist
+ ;; FIXME: Currently the check is made via
+ ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention
+ ;; to the mode hierarchy.
(mapcar #'purecopy
'((c-mode "{" "}" "/[*/]" nil nil)
(c-ts-mode "{" "}" "/[*/]" nil nil)
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 217b2ab6691..7bed69a738b 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -631,7 +631,7 @@ Needs additional info stored in global `idlwave-completion-help-info'."
Those words in `idlwave-completion-help-links' have links. The
`idlwave-help-link' face is used for this."
(if idlwave-highlight-help-links-in-completion
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(save-excursion
(let* ((case-fold-search t)
(props (list 'face 'idlwave-help-link))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index b5470b5490d..b5d91f46b17 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -96,8 +96,8 @@
(defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> "
"Regexp to match IDL prompt at beginning of a line.
-For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
-The \"^\r?\" is needed, to indicate the beginning of the line, with
+For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \".
+The \"^\\r?\" is needed, to indicate the beginning of the line, with
optional return character (which IDL seems to output randomly).
This variable is used to initialize `comint-prompt-regexp' in the
process buffer."
@@ -829,7 +829,7 @@ IDL has currently stepped.")
3. Routine Info
------------
- `\\[idlwave-routine-info]' displays information about an IDL routine near point,
+ \\[idlwave-routine-info] displays information about an IDL routine near point,
just like in `idlwave-mode'. The module used is the one at point or
the one whose argument list is being edited.
To update IDLWAVE's knowledge about compiled or edited modules, use
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 4b96461d773..30442fa0d34 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -657,7 +657,7 @@ When you specify a class, this information can be stored as a text
property on the `->' arrow in the source code, so that during the same
editing session, IDLWAVE will not have to ask again. When this
variable is non-nil, IDLWAVE will store and reuse the class information.
-The class stored can be checked and removed with `\\[idlwave-routine-info]'
+The class stored can be checked and removed with \\[idlwave-routine-info]
on the arrow.
The default of this variable is nil, since the result of commands then
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index 0b1ac49b99f..bb4a7df3340 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -74,7 +74,12 @@
((parent-is "program") column-0 0)
((match "}" "element_value_array_initializer")
parent-bol 0)
- ((node-is "}") column-0 c-ts-common-statement-offset)
+ ((node-is
+ ,(format "\\`%s\\'"
+ (regexp-opt '("constructor_body" "class_body" "interface_body"
+ "block" "switch_block" "array_initializer"))))
+ parent-bol 0)
+ ((node-is "}") standalone-parent 0)
((node-is ")") parent-bol 0)
((node-is "else") parent-bol 0)
((node-is "]") parent-bol 0)
@@ -86,10 +91,10 @@
((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset)
((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset)
((parent-is "interface_body") column-0 c-ts-common-statement-offset)
- ((parent-is "constructor_body") column-0 c-ts-common-statement-offset)
+ ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset)
((parent-is "enum_body_declarations") parent-bol 0)
((parent-is "enum_body") column-0 c-ts-common-statement-offset)
- ((parent-is "switch_block") column-0 c-ts-common-statement-offset)
+ ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset)
((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset)
((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset)
((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset)
@@ -125,7 +130,7 @@
((parent-is "case_statement") parent-bol java-ts-mode-indent-offset)
((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset)
((parent-is "do_statement") parent-bol java-ts-mode-indent-offset)
- ((parent-is "block") column-0 c-ts-common-statement-offset)))
+ ((parent-is "block") standalone-parent java-ts-mode-indent-offset)))
"Tree-sitter indent rules.")
(defvar java-ts-mode--keywords
@@ -401,6 +406,8 @@ Return nil if there is no name or if NODE is not a defun node."
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
+(derived-mode-add-parents 'java-ts-mode '(java-mode))
+
(if (treesit-ready-p 'java)
(add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode)))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 0115feb0e97..6cb84592896 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3418,6 +3418,26 @@ This function is intended for use in `after-change-functions'."
;;; Tree sitter integration
+(defun js--treesit-font-lock-compatibility-definition-feature ()
+ "Font lock helper, to handle different releases of tree-sitter-javascript.
+Check if a node type is available, then return the right font lock rules
+for \"definition\" feature."
+ (condition-case nil
+ (progn (treesit-query-capture 'javascript '((function_expression) @cap))
+ ;; Starting from version 0.20.2 of the grammar.
+ '((function_expression
+ name: (identifier) @font-lock-function-name-face)
+ (variable_declarator
+ name: (identifier) @font-lock-function-name-face
+ value: [(function_expression) (arrow_function)])))
+ (error
+ ;; An older version of the grammar.
+ '((function
+ name: (identifier) @font-lock-function-name-face)
+ (variable_declarator
+ name: (identifier) @font-lock-function-name-face
+ value: [(function) (arrow_function)])))))
+
(defun js-jsx--treesit-indent-compatibility-bb1f97b ()
"Indent rules helper, to handle different releases of tree-sitter-javascript.
Check if a node type is available, then return the right indent rules."
@@ -3529,8 +3549,7 @@ Check if a node type is available, then return the right indent rules."
:language 'javascript
:feature 'definition
- '((function
- name: (identifier) @font-lock-function-name-face)
+ `(,@(js--treesit-font-lock-compatibility-definition-feature)
(class_declaration
name: (identifier) @font-lock-type-face)
@@ -3550,10 +3569,6 @@ Check if a node type is available, then return the right indent rules."
name: (identifier) @font-lock-variable-name-face)
(variable_declarator
- name: (identifier) @font-lock-function-name-face
- value: [(function) (arrow_function)])
-
- (variable_declarator
name: [(array_pattern (identifier) @font-lock-variable-name-face)
(object_pattern
(shorthand_property_identifier_pattern) @font-lock-variable-name-face)])
@@ -3702,6 +3717,9 @@ Currently there are `js-mode' and `js-ts-mode'."
(define-derived-mode js-mode js-base-mode "JavaScript"
"Major mode for editing JavaScript."
:group 'js
+ (js--mode-setup))
+
+(defun js--mode-setup ()
;; Ensure all CC Mode "lang variables" are set to valid values.
(c-init-language-vars js-mode)
(setq-local indent-line-function #'js-indent-line)
@@ -3898,6 +3916,8 @@ See `treesit-thing-settings' for more information.")
(add-to-list 'auto-mode-alist
'("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode))))
+(derived-mode-add-parents 'js-ts-mode '(js-mode))
+
(defvar js-ts--s-p-query
(when (treesit-available-p)
(treesit-query-compile 'javascript
@@ -3924,7 +3944,9 @@ See `treesit-thing-settings' for more information.")
(put-text-property (1- ne) ne 'syntax-table syntax)))))
;;;###autoload
-(define-derived-mode js-json-mode js-mode "JSON"
+(define-derived-mode js-json-mode prog-mode "JSON"
+ :syntax-table js-mode-syntax-table
+ (js--mode-setup) ;Reuse most of `js-mode', but not as parent (bug#67463).
(setq-local js-enabled-frameworks nil)
;; Speed up `syntax-ppss': JSON files can be big but can't hold
;; regexp matchers nor #! thingies (and `js-enabled-frameworks' is nil).
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index 32bc10bbda9..1fb96555010 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -164,6 +164,8 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-major-mode-setup))
+(derived-mode-add-parents 'json-ts-mode '(json-mode))
+
(if (treesit-ready-p 'json)
(add-to-list 'auto-mode-alist
'("\\.json\\'" . json-ts-mode)))
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 3b600f59521..407ef230c32 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -26,8 +26,8 @@
;; This package provides `lua-ts-mode' which is a major mode for Lua
;; files that uses Tree Sitter to parse the language.
;;
-;; This package is compatible with and tested against the grammar
-;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua
+;; This package is compatible with and tested against the grammar for
+;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua
;;; Code:
@@ -60,66 +60,77 @@
:options '(flymake-mode
hs-minor-mode
outline-minor-mode)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-indent-offset 4
"Number of spaces for each indentation step in `lua-ts-mode'."
:type 'natnum
:safe 'natnump
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-luacheck-program "luacheck"
"Location of the Luacheck program."
:type '(choice (const :tag "None" nil) string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-buffer "*Lua*"
"Name of the inferior Lua buffer."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-program "lua"
"Program to run in the inferior Lua process."
:type '(choice (const :tag "None" nil) string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-options '("-i")
"Command line options for the inferior Lua process."
:type '(repeat string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-startfile nil
"File to load into the inferior Lua process at startup."
:type '(choice (const :tag "None" nil) (file :must-match t))
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-prompt ">"
"Prompt used by the inferior Lua process."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-prompt-continue ">>"
"Continuation prompt used by the inferior Lua process."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-history nil
"File used to save command history of the inferior Lua process."
:type '(choice (const :tag "None" nil) file)
:safe 'string-or-null-p
- :group 'lua-ts
+ :version "30.1")
+
+(defcustom lua-ts-indent-continuation-lines t
+ "Controls how multi-line if/else statements are aligned.
+
+If t, then continuation lines are indented by `lua-ts-indent-offset':
+
+ if a
+ and b then
+ print(1)
+ end
+
+If nil, then continuation lines are aligned with the beginning of
+the statement:
+
+ if a
+ and b then
+ print(1)
+ end"
+ :type 'boolean
+ :safe 'booleanp
:version "30.1")
(defvar lua-ts--builtins
@@ -295,6 +306,8 @@ values of OVERRIDE."
(node-is ")")
(node-is "}"))
standalone-parent 0)
+ ((match null "table_constructor")
+ standalone-parent lua-ts-indent-offset)
((or (and (parent-is "arguments") lua-ts--first-child-matcher)
(and (parent-is "parameters") lua-ts--first-child-matcher)
(and (parent-is "table_constructor") lua-ts--first-child-matcher))
@@ -329,6 +342,17 @@ values of OVERRIDE."
((or (match "end" "function_definition")
(node-is "end"))
standalone-parent 0)
+ ((n-p-gp "expression_list" "assignment_statement" "variable_declaration")
+ lua-ts--variable-declaration-continuation-anchor
+ lua-ts-indent-offset)
+ ((and (parent-is "binary_expression")
+ lua-ts--variable-declaration-continuation)
+ lua-ts--variable-declaration-continuation-anchor
+ lua-ts-indent-offset)
+ ((and (lambda (&rest _) lua-ts-indent-continuation-lines)
+ (parent-is "binary_expression"))
+ standalone-parent lua-ts-indent-offset)
+ ((parent-is "binary_expression") standalone-parent 0)
((or (parent-is "function_declaration")
(parent-is "function_definition")
(parent-is "do_statement")
@@ -415,6 +439,22 @@ values of OVERRIDE."
(treesit-induce-sparse-tree parent #'lua-ts--function-definition-p)))
(= 1 (length (cadr sparse-tree)))))
+(defun lua-ts--variable-declaration-continuation (node &rest _)
+ "Matches if NODE is part of a multi-line variable declaration."
+ (treesit-parent-until node
+ (lambda (p)
+ (equal "variable_declaration"
+ (treesit-node-type p)))))
+
+(defun lua-ts--variable-declaration-continuation-anchor (node &rest _)
+ "Return the start position of the variable declaration for NODE."
+ (save-excursion
+ (goto-char (treesit-node-start
+ (lua-ts--variable-declaration-continuation node)))
+ (when (looking-back (rx bol (* whitespace))
+ (line-beginning-position))
+ (point))))
+
(defvar lua-ts--syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?+ "." table)
@@ -577,7 +617,7 @@ Calls REPORT-FN directly."
nil t)))
(select-window (display-buffer lua-ts-inferior-buffer
'((display-buffer-reuse-window
- display-buffer-pop-up-frame)
+ display-buffer-pop-up-window)
(reusable-frames . t))))
(get-buffer-process (current-buffer)))
@@ -725,7 +765,7 @@ Calls REPORT-FN directly."
"vararg_expression"))))
(text "comment"))))
- ;; Imenu.
+ ;; Imenu/Outline.
(setq-local treesit-simple-imenu-settings
`(("Requires"
"\\`function_call\\'"
@@ -740,16 +780,6 @@ Calls REPORT-FN directly."
;; Which-function.
(setq-local which-func-functions (treesit-defun-at-point))
- ;; Outline.
- (setq-local outline-regexp
- (rx (seq (0+ space)
- (or (seq "--[[" (0+ space) eol)
- (seq symbol-start
- (or "do" "for" "if" "repeat" "while"
- (seq (? (seq "local" (1+ space)))
- "function"))
- symbol-end)))))
-
;; Align.
(setq-local align-indent-before-aligning t)
@@ -757,6 +787,8 @@ Calls REPORT-FN directly."
(add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil 'local))
+(derived-mode-add-parents 'lua-ts-mode '(lua-mode))
+
(when (treesit-ready-p 'lua)
(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode)))
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index 09cb848fd52..2bb31988290 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -325,20 +325,20 @@ followed by the first character of the construct.
;;
;; Module definitions.
("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
+ (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t))
;;
;; Import directives.
("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
- (1 font-lock-keyword-face)
+ (1 'font-lock-keyword-face)
(font-lock-match-c-style-declaration-item-and-skip-to-next
nil (goto-char (match-end 0))
- (1 font-lock-constant-face)))
+ (1 'font-lock-constant-face)))
;;
;; Pragmas as warnings.
;; Spencer Allain <sallain@teknowledge.com> says do them as comments...
;; ("<\\*.*\\*>" . font-lock-warning-face)
;; ... but instead we fontify the first word.
- ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
+ ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend)
)
"Subdued level highlighting for Modula-3 modes.")
@@ -366,26 +366,29 @@ followed by the first character of the construct.
"LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
"ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
)
- (list
- ;;
- ;; Keywords except those fontified elsewhere.
- (concat "\\<\\(" m3-keywords "\\)\\>")
- ;;
- ;; Builtins.
- (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
- ;;
- ;; Type names.
- (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
- ;;
- ;; Fontify tokens as function names.
- '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
- (1 font-lock-keyword-face)
+ `(
+ ;;
+ ;; Keywords except those fontified elsewhere.
+ ,(concat "\\<\\(" m3-keywords "\\)\\>")
+ ;;
+ ;; Builtins.
+ (,(concat "\\<\\(" m3-builtins "\\)\\>")
+ (0 'font-lock-builtin-face))
+ ;;
+ ;; Type names.
+ (,(concat "\\<\\(" m3-types "\\)\\>")
+ (0 'font-lock-type-face))
+ ;;
+ ;; Fontify tokens as function names.
+ ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
+ (1 'font-lock-keyword-face)
(font-lock-match-c-style-declaration-item-and-skip-to-next
nil (goto-char (match-end 0))
- (1 font-lock-function-name-face)))
- ;;
- ;; Fontify constants as references.
- '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face)
+ (1 'font-lock-function-name-face)))
+ ;;
+ ;; Fontify constants as references.
+ ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>"
+ (0 'font-lock-constant-face))
))))
"Gaudy level highlighting for Modula-3 modes.")
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 5e8263cb646..a80e12b8129 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -281,7 +281,7 @@ nested routine.")
(eval-when-compile
(pcase-defmacro opascal--in (set)
- `(pred (pcase--flip memq ,set))))
+ `(pred (memq _ ,set))))
(defun opascal-string-of (start end)
;; Returns the buffer string from start to end.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f74390841fe..f6c4dbed1e2 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -251,7 +251,16 @@
;; correctly the \() construct (Bug#11996) as well as references
;; to string values.
("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss))
- (string-to-syntax "."))))
+ (string-to-syntax "."))))
+ ;; A "$" in Perl code must escape the next char to protect against
+ ;; misinterpreting Perl's punctuation variables as unbalanced
+ ;; quotes or parens. This is not needed in strings and broken in
+ ;; the special case of "$\"" (Bug#69604). Make "$" a punctuation
+ ;; char in strings.
+ ("\\$" (0 (if (save-excursion
+ (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (string-to-syntax "/"))))
;; Handle funny names like $DB'stop.
("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index a6f14a0865c..a10e24f3e28 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -229,7 +229,8 @@ See the doc string of `project-find-functions' for the general form
of the project instance object."
(unless directory (setq directory (or project-current-directory-override
default-directory)))
- (let ((pr (project--find-in-directory directory)))
+ (let ((pr (project--find-in-directory directory))
+ (non-essential (not maybe-prompt)))
(cond
(pr)
((unless project-current-directory-override
@@ -602,7 +603,7 @@ See `project-vc-extra-root-markers' for the marker value format.")
(goto-char (point-min))
;; Kind of a hack to distinguish a submodule from
;; other cases of .git files pointing elsewhere.
- (looking-at "gitdir: [./]+/\\.git/modules/"))
+ (looking-at "gitdir: .+/\\.git/\\(worktrees/.*\\)?modules/"))
t)
(t nil))))
@@ -808,8 +809,10 @@ DIRS must contain directory names."
(with-temp-buffer
(setq default-directory dir)
(let ((enable-local-variables :all))
- (hack-dir-local-variables-non-file-buffer))
- (symbol-value var)))
+ (hack-dir-local-variables))
+ ;; Don't use `hack-local-variables-apply' to avoid setting modes.
+ (alist-get var file-local-variables-alist
+ (symbol-value var))))
(cl-defmethod project-buffers ((project (head vc)))
(let* ((root (expand-file-name (file-name-as-directory (project-root project))))
@@ -992,9 +995,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
;;;###autoload
(defun project-or-external-find-regexp (regexp)
- "Find all matches for REGEXP in the project roots or external roots.
-With \\[universal-argument] prefix, you can specify the file name
-pattern to search for."
+ "Find all matches for REGEXP in the project roots or external roots."
(interactive (list (project--read-regexp)))
(require 'xref)
(let* ((pr (project-current t))
@@ -1363,6 +1364,7 @@ If you exit the `query-replace', you can later continue the
(defvar compilation-read-command)
(declare-function compilation-read-command "compile")
+(declare-function recompile "compile")
(defun project-prefixed-buffer-name (mode)
(concat "*"
@@ -1396,6 +1398,18 @@ If non-nil, it overrides `compilation-buffer-name-function' for
compilation-buffer-name-function)))
(call-interactively #'compile)))
+(defun project-recompile (&optional edit-command)
+ "Run `recompile' with appropriate buffer."
+ (declare (interactive-only recompile))
+ (interactive "P")
+ (let ((compilation-buffer-name-function
+ (or project-compilation-buffer-name-function
+ ;; Should we error instead? When there's no
+ ;; project-specific naming, there is no point in using
+ ;; this command.
+ compilation-buffer-name-function)))
+ (recompile edit-command)))
+
(defcustom project-ignore-buffer-conditions nil
"List of conditions to filter the buffers to be switched to.
If any of these conditions are satisfied for a buffer in the
@@ -1502,7 +1516,8 @@ ARG, show only buffers that are visiting files."
(lambda (buffer)
(let ((name (buffer-name buffer))
(file (buffer-file-name buffer)))
- (and (or (not (string= (substring name 0 1) " "))
+ (and (or Buffer-menu-show-internal
+ (not (string= (substring name 0 1) " "))
file)
(not (eq buffer (current-buffer)))
(or file (not Buffer-menu-files-only)))))
@@ -1512,6 +1527,7 @@ ARG, show only buffers that are visiting files."
(let ((buf (list-buffers-noselect
arg (with-current-buffer
(get-buffer-create "*Buffer List*")
+ (setq-local Buffer-menu-show-internal nil)
(let ((Buffer-menu-files-only arg))
(funcall buffer-list-function))))))
(with-current-buffer buf
@@ -1694,7 +1710,10 @@ With some possible metadata (to be decided).")
(let ((name (car elem)))
(list (if (file-remote-p name) name
(abbreviate-file-name name)))))
- (read (current-buffer))))))
+ (condition-case nil
+ (read (current-buffer))
+ (end-of-file
+ (warn "Failed to read the projects list file due to unexpected EOF")))))))
(unless (seq-every-p
(lambda (elt) (stringp (car-safe elt)))
project--list)
@@ -1850,12 +1869,12 @@ Otherwise, `default-directory' is temporarily set to the current
project's root.
If OVERRIDING-MAP is non-nil, it will be used as
-`overriding-local-map' to provide shorter bindings from that map
-which will take priority over the global ones."
+`overriding-terminal-local-map' to provide shorter bindings
+from that map which will take priority over the global ones."
(interactive)
(let* ((pr (project-current t))
(prompt-format (or prompt-format "[execute in %s]:"))
- (command (let ((overriding-local-map overriding-map))
+ (command (let ((overriding-terminal-local-map overriding-map))
(key-binding (read-key-sequence
(format prompt-format (project-root pr)))
t)))
@@ -2124,12 +2143,10 @@ is part of the default mode line beginning with Emacs 30."
:group 'project
:version "30.1")
-(defvar project-menu-entry
- `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu)))
-
(defvar project-mode-line-map
(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1] project-menu-entry)
+ (define-key map [mode-line down-mouse-1]
+ (bound-and-true-p menu-bar-project-item))
map))
(defvar project-mode-line-face nil
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index a65943a48eb..97f08a79ccd 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1148,7 +1148,7 @@ line and comments can also be enclosed in /* ... */.
If an optional argument SYSTEM is non-nil, set up mode for the given system.
To find out what version of Prolog mode you are running, enter
-`\\[prolog-mode-version]'.
+\\[prolog-mode-version].
Commands:
\\{prolog-mode-map}"
@@ -1268,7 +1268,7 @@ imitating normal Unix input editing.
\\[comint-quit-subjob] sends quit signal, likewise.
To find out what version of Prolog mode you are running, enter
-`\\[prolog-mode-version]'."
+\\[prolog-mode-version]."
(require 'compile)
(setq comint-input-filter 'prolog-input-filter)
(setq mode-line-process '(": %s"))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 1148da11a06..8279617b6e7 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") (compat "28.1.2.1") (seq "2.23"))
+;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -128,9 +128,9 @@
;; receiving escape sequences (with some limitations, i.e. completion
;; in blocks does not work). The code executed for the "fallback"
;; completion can be found in `python-shell-completion-setup-code' and
-;; `python-shell-completion-string-code' variables. Their default
-;; values enable completion for both CPython and IPython, and probably
-;; any readline based shell (it's known to work with PyPy). If your
+;; `python-shell-completion-get-completions'. Their default values
+;; enable completion for both CPython and IPython, and probably any
+;; readline based shell (it's known to work with PyPy). If your
;; Python installation lacks readline (like CPython for Windows),
;; installing pyreadline (URL `https://ipython.org/pyreadline.html')
;; should suffice. To troubleshoot why you are not getting any
@@ -141,6 +141,12 @@
;; If you see an error, then you need to either install pyreadline or
;; setup custom code that avoids that dependency.
+;; By default, the "native" completion uses the built-in rlcompleter.
+;; To use other readline completer (e.g. Jedi) or a custom one, you just
+;; need to set it in the PYTHONSTARTUP file. You can set an
+;; Emacs-specific completer by testing the environment variable
+;; INSIDE_EMACS.
+
;; Shell virtualenv support: The shell also contains support for
;; virtualenvs and other special environment modifications thanks to
;; `python-shell-process-environment' and `python-shell-exec-path'.
@@ -267,7 +273,7 @@
(eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'.
(require 'treesit)
(require 'pcase)
-(require 'compat nil 'noerror)
+(require 'compat)
(require 'project nil 'noerror)
(require 'seq)
@@ -909,6 +915,7 @@ is used to limit the scan."
"Put `syntax-table' property correctly on single/triple quotes."
(let* ((ppss (save-excursion (backward-char 3) (syntax-ppss)))
(string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (string-literal-concat (numberp (nth 3 ppss)))
(quote-starting-pos (- (point) 3))
(quote-ending-pos (point)))
(cond ((or (nth 4 ppss) ;Inside a comment
@@ -921,6 +928,8 @@ is used to limit the scan."
((nth 5 ppss)
;; The first quote is escaped, so it's not part of a triple quote!
(goto-char (1+ quote-starting-pos)))
+ ;; Handle string literal concatenation (bug#45897)
+ (string-literal-concat nil)
((null string-start)
;; This set of quotes delimit the start of a string. Put
;; string fence syntax on last quote. (bug#49518)
@@ -1117,7 +1126,7 @@ fontified."
(defun python--treesit-fontify-union-types (node override start end &optional type-regex &rest _)
"Fontify nested union types in the type hints.
-For examlpe, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This
+For example, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This
structure is represented via nesting binary_operator and
subscript nodes. This function iterates over all levels and
highlight identifier nodes. If TYPE-REGEX is not nil fontify type
@@ -1275,7 +1284,7 @@ fontified."
(subscript (identifier) @font-lock-type-face)
(subscript (attribute attribute: (identifier) @font-lock-type-face))]))
- ;; Patern matching: case [str(), pack0.Type0()]. Take only the
+ ;; Pattern matching: case [str(), pack0.Type0()]. Take only the
;; last identifier.
(class_pattern (dotted_name (identifier) @font-lock-type-face :anchor))
@@ -1359,15 +1368,15 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(save-excursion
(goto-char start)
(while (re-search-forward (rx (or "\"\"\"" "'''")) end t)
- (let ((node (treesit-node-at (point))))
- ;; The triple quotes surround a non-empty string.
- (when (equal (treesit-node-type node) "string_content")
- (let ((start (treesit-node-start node))
- (end (treesit-node-end node)))
- (put-text-property (1- start) start
- 'syntax-table (string-to-syntax "|"))
- (put-text-property end (min (1+ end) (point-max))
- 'syntax-table (string-to-syntax "|"))))))))
+ (let ((node (treesit-node-at (- (point) 3))))
+ ;; Handle triple-quoted strings.
+ (pcase (treesit-node-type node)
+ ("string_start"
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "|")))
+ ("string_end"
+ (put-text-property (- (point) 3) (- (point) 2)
+ 'syntax-table (string-to-syntax "|"))))))))
;;; Indentation
@@ -3512,6 +3521,16 @@ eventually provide a shell."
:version "25.1"
:type 'hook)
+(defconst python-shell-setup-code
+ "\
+try:
+ import tty
+except ImportError:
+ pass
+else:
+ tty.setraw(0)"
+ "Code used to setup the inferior Python processes.")
+
(defconst python-shell-eval-setup-code
"\
def __PYTHON_EL_eval(source, filename):
@@ -3577,10 +3596,12 @@ The coding cookie regexp is specified in PEP 263.")
(format "exec(%s)\n" (python-shell--encode-string string))))))
;; Bootstrap: the normal definition of `python-shell-send-string'
;; depends on the Python code sent here.
+ (python-shell-send-string-no-output python-shell-setup-code)
(python-shell-send-string-no-output python-shell-eval-setup-code)
(python-shell-send-string-no-output python-shell-eval-file-setup-code))
(with-current-buffer (current-buffer)
(let ((inhibit-quit nil))
+ (python-shell-readline-detect)
(run-hooks 'python-shell-first-prompt-hook))))))
output)
@@ -3601,7 +3622,6 @@ interpreter is run. Variables
`python-shell-prompt-block-regexp',
`python-shell-font-lock-enable',
`python-shell-completion-setup-code',
-`python-shell-completion-string-code',
`python-eldoc-setup-code',
`python-ffap-setup-code' can
customize this mode for different Python interpreters.
@@ -4241,8 +4261,9 @@ def __PYTHON_EL_get_completions(text):
completions = []
completer = None
+ import json
try:
- import readline
+ import readline, re
try:
import __builtin__
@@ -4253,16 +4274,29 @@ def __PYTHON_EL_get_completions(text):
is_ipython = ('__IPYTHON__' in builtins or
'__IPYTHON__active' in builtins)
- splits = text.split()
- is_module = splits and splits[0] in ('from', 'import')
-
- if is_ipython and is_module:
- from IPython.core.completerlib import module_completion
- completions = module_completion(text.strip())
- elif is_ipython and '__IP' in builtins:
- completions = __IP.complete(text)
- elif is_ipython and 'get_ipython' in builtins:
- completions = get_ipython().Completer.all_completions(text)
+
+ if is_ipython and 'get_ipython' in builtins:
+ def filter_c(prefix, c):
+ if re.match('_+(i?[0-9]+)?$', c):
+ return False
+ elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix):
+ return False
+ return True
+
+ import IPython
+ try:
+ if IPython.version_info[0] >= 6:
+ from IPython.core.completer import provisionalcompleter
+ with provisionalcompleter():
+ completions = [
+ [c.text, c.start, c.end, c.type or '?', c.signature or '']
+ for c in get_ipython().Completer.completions(text, len(text))
+ if filter_c(text, c.text)]
+ else:
+ part, matches = get_ipython().Completer.complete(line_buffer=text)
+ completions = [text + m[len(part):] for m in matches if filter_c(text, m)]
+ except:
+ pass
else:
# Try to reuse current completer.
completer = readline.get_completer()
@@ -4285,7 +4319,7 @@ def __PYTHON_EL_get_completions(text):
finally:
if getattr(completer, 'PYTHON_EL_WRAPPED', False):
completer.print_mode = True
- return completions"
+ return json.dumps(completions)"
"Code used to setup completion in inferior Python processes."
:type 'string)
@@ -4326,6 +4360,26 @@ When a match is found, native completion is disabled."
:version "25.1"
:type 'float)
+(defvar python-shell-readline-completer-delims nil
+ "Word delimiters used by the readline completer.
+It is automatically set by Python shell. An empty string means no
+characters are considered delimiters and the readline completion
+considers the entire line of input. A value of nil means the Python
+shell has no readline support.")
+
+(defun python-shell-readline-detect ()
+ "Detect the readline support for Python shell completion."
+ (let* ((process (python-shell-get-process))
+ (output (python-shell-send-string-no-output "
+try:
+ import readline
+ print(readline.get_completer_delims())
+except:
+ print('No readline support')" process)))
+ (setq-local python-shell-readline-completer-delims
+ (unless (string-search "No readline support" output)
+ (string-trim-right output)))))
+
(defvar python-shell-completion-native-redirect-buffer
" *Python completions redirect*"
"Buffer to be used to redirect output of readline commands.")
@@ -4492,21 +4546,15 @@ With argument MSG show activation/deactivation message."
(cond
((python-shell-completion-native-interpreter-disabled-p)
(python-shell-completion-native-turn-off msg))
- ((python-shell-completion-native-setup)
+ ((and python-shell-readline-completer-delims
+ (python-shell-completion-native-setup))
(when msg
(message "Shell native completion is enabled.")))
- (t (lwarn
- '(python python-shell-completion-native-turn-on-maybe)
- :warning
- (concat
- "Your `python-shell-interpreter' doesn't seem to "
- "support readline, yet `python-shell-completion-native-enable' "
- (format "was t and %S is not part of the "
- (file-name-nondirectory python-shell-interpreter))
- "`python-shell-completion-native-disabled-interpreters' "
- "list. Native completions have been disabled locally. "
- "Consider installing the python package \"readline\". "))
- (python-shell-completion-native-turn-off msg))))))
+ (t
+ (when msg
+ (message (concat "Python does not use GNU readline;"
+ " no completion in multi-line commands.")))
+ (python-shell-completion-native-turn-off nil))))))
(defun python-shell-completion-native-turn-on-maybe-with-msg ()
"Like `python-shell-completion-native-turn-on-maybe' but force messages."
@@ -4531,6 +4579,8 @@ With argument MSG show activation/deactivation message."
(let* ((original-filter-fn (process-filter process))
(redirect-buffer (get-buffer-create
python-shell-completion-native-redirect-buffer))
+ (sep (if (string= python-shell-readline-completer-delims "")
+ "[\n\r]+" "[ \f\t\n\r\v()]+"))
(trigger "\t")
(new-input (concat input trigger))
(input-length
@@ -4573,28 +4623,80 @@ With argument MSG show activation/deactivation message."
process python-shell-completion-native-output-timeout
comint-redirect-finished-regexp)
(re-search-backward "0__dummy_completion__" nil t)
- (cl-remove-duplicates
- (split-string
- (buffer-substring-no-properties
- (line-beginning-position) (point-min))
- "[ \f\t\n\r\v()]+" t)
- :test #'string=))))
+ (let ((str (buffer-substring-no-properties
+ (line-beginning-position) (point-min))))
+ ;; The readline completer is allowed to return a list
+ ;; of (text start end type signature) as a JSON
+ ;; string. See the return value for IPython in
+ ;; `python-shell-completion-setup-code'.
+ (if (string= "[" (substring str 0 1))
+ (condition-case nil
+ (python--parse-json-array str)
+ (t (cl-remove-duplicates (split-string str sep t)
+ :test #'string=)))
+ (cl-remove-duplicates (split-string str sep t)
+ :test #'string=))))))
(set-process-filter process original-filter-fn)))))
(defun python-shell-completion-get-completions (process input)
"Get completions of INPUT using PROCESS."
(with-current-buffer (process-buffer process)
- (let ((completions
- (python-util-strip-string
- (python-shell-send-string-no-output
- (format
- "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))"
+ (python--parse-json-array
+ (python-shell-send-string-no-output
+ (format "%s\nprint(__PYTHON_EL_get_completions(%s))"
python-shell-completion-setup-code
(python-shell--encode-string input))
- process))))
- (when (> (length completions) 2)
- (split-string completions
- "^'\\|^\"\\|;\\|'$\\|\"$" t)))))
+ process))))
+
+(defun python-shell--get-multiline-input ()
+ "Return lines at a multi-line input in Python shell."
+ (save-excursion
+ (let ((p (point)) lines)
+ (when (progn
+ (beginning-of-line)
+ (looking-back python-shell-prompt-block-regexp (pos-bol)))
+ (push (buffer-substring-no-properties (point) p) lines)
+ (while (progn (comint-previous-prompt 1)
+ (looking-back python-shell-prompt-block-regexp (pos-bol)))
+ (push (buffer-substring-no-properties (point) (pos-eol)) lines))
+ (push (buffer-substring-no-properties (point) (pos-eol)) lines))
+ lines)))
+
+(defun python-shell--extra-completion-context ()
+ "Get extra completion context of current input in Python shell."
+ (let ((lines (python-shell--get-multiline-input))
+ (python-indent-guess-indent-offset nil))
+ (when (not (zerop (length lines)))
+ (with-temp-buffer
+ (delay-mode-hooks
+ (insert (string-join lines "\n"))
+ (python-mode)
+ (python-shell-completion-extra-context))))))
+
+(defun python-shell-completion-extra-context (&optional pos)
+ "Get extra completion context at position POS in Python buffer.
+If optional argument POS is nil, use current position.
+
+Readline completers could use current line as the completion
+context, which may be insufficient. In this function, extra
+context (e.g. multi-line function call) is found and reformatted
+as one line, which is required by native completion."
+ (let (bound p)
+ (save-excursion
+ (and pos (goto-char pos))
+ (setq bound (pos-bol))
+ (python-nav-up-list -1)
+ (when (and (< (point) bound)
+ (or
+ (looking-back
+ (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t)
+ (progn
+ (forward-line 0)
+ (looking-at "^[ \t]*\\(from \\)"))))
+ (setq p (match-beginning 1))))
+ (when p
+ (replace-regexp-in-string
+ "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound))))))
(defvar-local python-shell--capf-cache nil
"Variable to store cached completions and invalidation keys.")
@@ -4609,21 +4711,27 @@ using that one instead of current buffer's process."
;; Working on a shell buffer: use prompt end.
(cdr (python-util-comint-last-prompt))
(line-beginning-position)))
- (import-statement
- (when (string-match-p
- (rx (* space) word-start (or "from" "import") word-end space)
- (buffer-substring-no-properties line-start (point)))
- (buffer-substring-no-properties line-start (point))))
+ (no-delims
+ (and (not (if is-shell-buffer
+ (eq 'font-lock-comment-face
+ (get-text-property (1- (point)) 'face))
+ (python-syntax-context 'comment)))
+ (with-current-buffer (process-buffer process)
+ (if python-shell-completion-native-enable
+ (string= python-shell-readline-completer-delims "")
+ (or (string-match-p "ipython[23]?\\'" python-shell-interpreter)
+ (equal python-shell-readline-completer-delims ""))))))
(start
(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))
+ (if (or no-delims
+ (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)))))
@@ -4663,18 +4771,56 @@ using that one instead of current buffer's process."
(t #'python-shell-completion-native-get-completions))))
(prev-prompt (car python-shell--capf-cache))
(re (or (cadr python-shell--capf-cache) regexp-unmatchable))
- (prefix (buffer-substring-no-properties start end)))
+ (prefix (buffer-substring-no-properties start end))
+ (prefix-offset 0)
+ (extra-context (when no-delims
+ (if is-shell-buffer
+ (python-shell--extra-completion-context)
+ (python-shell-completion-extra-context))))
+ (extra-offset (length extra-context)))
+ (unless (zerop extra-offset)
+ (setq prefix (concat extra-context prefix)))
;; To invalidate the cache, we check if the prompt position or the
;; completion prefix changed.
(unless (and (equal prev-prompt (car prompt-boundaries))
- (string-match re prefix))
+ (string-match re prefix)
+ (setq prefix-offset (- (length prefix) (match-end 1))))
(setq python-shell--capf-cache
`(,(car prompt-boundaries)
,(if (string-empty-p prefix)
regexp-unmatchable
- (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'"))
- ,@(funcall completion-fn process (or import-statement prefix)))))
- (list start end (cddr python-shell--capf-cache))))
+ (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'"))
+ ,@(funcall completion-fn process prefix))))
+ (let ((cands (cddr python-shell--capf-cache)))
+ (cond
+ ((stringp (car cands))
+ (if no-delims
+ ;; Reduce completion candidates due to long prefix.
+ (if-let ((Lp (length prefix))
+ ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix))
+ (L (match-beginning 0)))
+ ;; If extra-offset is not zero:
+ ;; start end
+ ;; o------------------o---------o-------o
+ ;; |<- extra-offset ->|
+ ;; |<----------- L ------------>|
+ ;; new-start
+ (list (+ start L (- extra-offset)) end
+ (mapcar (lambda (s) (substring s L)) cands))
+ (list end end (mapcar (lambda (s) (substring s Lp)) cands)))
+ (list start end cands)))
+ ;; python-shell-completion(-native)-get-completions may produce a
+ ;; list of (text start end type signature) for completion.
+ ((consp (car cands))
+ (list (+ start (nth 1 (car cands)) (- extra-offset))
+ ;; Candidates may be cached, so the end position should
+ ;; be adjusted according to current completion prefix.
+ (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset)
+ cands
+ :annotation-function
+ (lambda (c) (concat " " (nth 3 (assoc c cands))))
+ :company-docsig
+ (lambda (c) (nth 4 (assoc c cands)))))))))
(define-obsolete-function-alias
'python-shell-completion-complete-at-point
@@ -6260,7 +6406,9 @@ point's current `syntax-ppss'."
counter)))
(python-util-forward-comment -1)
(python-nav-beginning-of-statement)
- (cond ((bobp))
+ (cond ((and (bobp) (save-excursion
+ (python-util-forward-comment)
+ (looking-at-p re))))
((python-info-assignment-statement-p) t)
((python-info-looking-at-beginning-of-defun))
(t nil))))))
@@ -6995,6 +7143,8 @@ implementations: `python-mode' and `python-ts-mode'."
(add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode))
(add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode))))
+(derived-mode-add-parents 'python-ts-mode '(python-mode))
+
;;; Completion predicates for M-x
;; Commands that only make sense when editing Python code.
(dolist (sym '(python-add-import
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index 598eaa461ff..7133cb0b5b0 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -1133,6 +1133,7 @@ leading double colon is not added."
"singleton_class"
"module"
"method"
+ "singleton_method"
"array"
"hash"
"parenthesized_statements"
@@ -1178,6 +1179,19 @@ leading double colon is not added."
;; Imenu.
(setq-local imenu-create-index-function #'ruby-ts--imenu)
+ ;; Outline minor mode.
+ (setq-local treesit-outline-predicate
+ (rx bos (or "singleton_method"
+ "method"
+ "alias"
+ "class"
+ "module")
+ eos))
+ ;; Restore default values of outline variables
+ ;; to use `treesit-outline-predicate'.
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-level)
+
(setq-local treesit-simple-indent-rules (ruby-ts--indent-rules))
;; Font-lock.
@@ -1196,19 +1210,11 @@ leading double colon is not added."
(setq-local syntax-propertize-function #'ruby-ts--syntax-propertize))
+(derived-mode-add-parents 'ruby-ts-mode '(ruby-mode))
+
(if (treesit-ready-p 'ruby)
- ;; Copied from ruby-mode.el.
- (add-to-list 'auto-mode-alist
- (cons (concat "\\(?:\\.\\(?:"
- "rbw?\\|ru\\|rake\\|thor"
- "\\|jbuilder\\|rabl\\|gemspec\\|podspec"
- "\\)"
- "\\|/"
- "\\(?:Gem\\|Rake\\|Cap\\|Thor"
- "\\|Puppet\\|Berks\\|Brew"
- "\\|Vagrant\\|Guard\\|Pod\\)file"
- "\\)\\'")
- 'ruby-ts-mode)))
+ (add-to-list 'major-mode-remap-defaults
+ '(ruby-mode . ruby-ts-mode)))
(provide 'ruby-ts-mode)
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index c5fc57cc374..c67ac43e4d0 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -474,6 +474,8 @@ See `prettify-symbols-compose-predicate'."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'rust-ts-mode '(rust-mode))
+
(if (treesit-ready-p 'rust)
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 0562415b4e5..ab95dc9f924 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1054,7 +1054,8 @@ subshells can nest."
;; a normal command rather than the real `in' keyword.
;; I.e. we should look back to try and find the
;; corresponding `case'.
- (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_<in")
+ ;; Also recognize OpenBSD's case X { ... } (bug#55764).
+ (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_<in\\|.{")
;; ";; esac )" is a case that looks
;; like a case-pattern but it's really just a close
;; paren after a case statement. I.e. if we skipped
@@ -1638,6 +1639,8 @@ not written in Bash or sh."
(setq-local treesit-defun-type-regexp "function_definition")
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'bash-ts-mode '(sh-mode))
+
(advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode
;; Give it lower precedence than normal advice, so other
;; advices take precedence over it.
@@ -2057,9 +2060,9 @@ May return nil if the line should not be treated as continued."
(sh-var-value 'sh-indent-for-case-label)))
(`(:before . ,(or "(" "{" "[" "while" "if" "for" "case"))
(cond
- ((and (equal token "{") (smie-rule-parent-p "for"))
+ ((and (equal token "{") (smie-rule-parent-p "for" "case"))
(let ((data (smie-backward-sexp "in")))
- (when (equal (nth 2 data) "for")
+ (when (member (nth 2 data) '("for" "case"))
`(column . ,(smie-indent-virtual)))))
((not (smie-rule-prev-p "&&" "||" "|"))
(when (smie-rule-hanging-p)
@@ -2303,7 +2306,7 @@ Point should be before the newline."
When used interactively, insert the proper starting #!-line,
and make the visited file executable via `executable-set-magic',
perhaps querying depending on the value of `executable-query'.
-(If given a prefix (i.e., `\\[universal-argument]') don't insert any starting #!
+(If given a prefix (i.e., \\[universal-argument]) don't insert any starting #!
line.)
When this function is called noninteractively, INSERT-FLAG (the third
diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el
index e9c6afff440..ab1d76ab20e 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -124,6 +124,7 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((parent-is "object_type") parent-bol typescript-ts-mode-indent-offset)
((parent-is "enum_body") parent-bol typescript-ts-mode-indent-offset)
((parent-is "class_body") parent-bol typescript-ts-mode-indent-offset)
+ ((parent-is "interface_body") parent-bol typescript-ts-mode-indent-offset)
((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset)
((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "binary_expression") parent-bol typescript-ts-mode-indent-offset)
@@ -199,183 +200,197 @@ Argument LANGUAGE is either `typescript' or `tsx'."
[(nested_identifier (identifier)) (identifier)]
@typescript-ts-jsx-tag-face)))))
+(defun tsx-ts-mode--font-lock-compatibility-function-expression (language)
+ "Handle tree-sitter grammar breaking change for `function' expression.
+
+LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the
+typescript/tsx grammar, `function' becomes `function_expression'."
+ (condition-case nil
+ (progn (treesit-query-capture language '((function_expression) @cap))
+ ;; New version of the grammar
+ 'function_expression)
+ (treesit-query-error
+ ;; Old version of the grammar
+ 'function)))
+
(defun typescript-ts-mode--font-lock-settings (language)
"Tree-sitter font-lock settings.
Argument LANGUAGE is either `typescript' or `tsx'."
- (treesit-font-lock-rules
- :language language
- :feature 'comment
- `([(comment) (hash_bang_line)] @font-lock-comment-face)
-
- :language language
- :feature 'constant
- `(((identifier) @font-lock-constant-face
- (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face))
- [(true) (false) (null)] @font-lock-constant-face)
-
- :language language
- :feature 'keyword
- `([,@typescript-ts-mode--keywords] @font-lock-keyword-face
- [(this) (super)] @font-lock-keyword-face)
-
- :language language
- :feature 'string
- `((regex pattern: (regex_pattern)) @font-lock-regexp-face
- (string) @font-lock-string-face
- (template_string) @js--fontify-template-string
- (template_substitution ["${" "}"] @font-lock-misc-punctuation-face))
-
- :language language
- :override t ;; for functions assigned to variables
- :feature 'declaration
- `((function
- name: (identifier) @font-lock-function-name-face)
- (function_declaration
- name: (identifier) @font-lock-function-name-face)
- (function_signature
- name: (identifier) @font-lock-function-name-face)
-
- (method_definition
- name: (property_identifier) @font-lock-function-name-face)
- (method_signature
- name: (property_identifier) @font-lock-function-name-face)
- (required_parameter (identifier) @font-lock-variable-name-face)
- (optional_parameter (identifier) @font-lock-variable-name-face)
-
- (variable_declarator
- name: (identifier) @font-lock-function-name-face
- value: [(function) (arrow_function)])
-
- (variable_declarator
- name: (identifier) @font-lock-variable-name-face)
-
- (enum_declaration (identifier) @font-lock-type-face)
-
- (extends_clause value: (identifier) @font-lock-type-face)
- ;; extends React.Component<T>
- (extends_clause value: (member_expression
- object: (identifier) @font-lock-type-face
- property: (property_identifier) @font-lock-type-face))
-
- (arrow_function
- parameter: (identifier) @font-lock-variable-name-face)
-
- (variable_declarator
- name: (array_pattern
- (identifier)
- (identifier) @font-lock-function-name-face)
- value: (array (number) (function)))
-
- (catch_clause
- parameter: (identifier) @font-lock-variable-name-face)
-
- ;; full module imports
- (import_clause (identifier) @font-lock-variable-name-face)
- ;; named imports with aliasing
- (import_clause (named_imports (import_specifier
- alias: (identifier) @font-lock-variable-name-face)))
- ;; named imports without aliasing
- (import_clause (named_imports (import_specifier
- !alias
- name: (identifier) @font-lock-variable-name-face)))
-
- ;; full namespace import (* as alias)
- (import_clause (namespace_import (identifier) @font-lock-variable-name-face)))
-
- :language language
- :feature 'identifier
- `((nested_type_identifier
- module: (identifier) @font-lock-type-face)
-
- (type_identifier) @font-lock-type-face
-
- (predefined_type) @font-lock-type-face
-
- (new_expression
- constructor: (identifier) @font-lock-type-face)
-
- (enum_body (property_identifier) @font-lock-type-face)
-
- (enum_assignment name: (property_identifier) @font-lock-type-face)
-
- (variable_declarator
- name: (identifier) @font-lock-variable-name-face)
-
- (for_in_statement
- left: (identifier) @font-lock-variable-name-face)
-
- (arrow_function
- parameters:
- [(_ (identifier) @font-lock-variable-name-face)
- (_ (_ (identifier) @font-lock-variable-name-face))
- (_ (_ (_ (identifier) @font-lock-variable-name-face)))]))
-
- :language language
- :feature 'property
- `((property_signature
- name: (property_identifier) @font-lock-property-name-face)
- (public_field_definition
- name: (property_identifier) @font-lock-property-name-face)
-
- (pair key: (property_identifier) @font-lock-property-use-face)
-
- ((shorthand_property_identifier) @font-lock-property-use-face))
-
- :language language
- :feature 'expression
- '((assignment_expression
- left: [(identifier) @font-lock-function-name-face
- (member_expression
- property: (property_identifier) @font-lock-function-name-face)]
- right: [(function) (arrow_function)]))
-
- :language language
- :feature 'function
- '((call_expression
- function:
- [(identifier) @font-lock-function-call-face
- (member_expression
- property: (property_identifier) @font-lock-function-call-face)]))
-
- :language language
- :feature 'pattern
- `((pair_pattern
- key: (property_identifier) @font-lock-property-use-face
- value: [(identifier) @font-lock-variable-name-face
- (assignment_pattern left: (identifier) @font-lock-variable-name-face)])
-
- (array_pattern (identifier) @font-lock-variable-name-face)
-
- ((shorthand_property_identifier_pattern) @font-lock-variable-name-face))
-
- :language language
- :feature 'jsx
- (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language)
- `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face)))
-
- :language language
- :feature 'number
- `((number) @font-lock-number-face
- ((identifier) @font-lock-number-face
- (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face)))
-
- :language language
- :feature 'operator
- `([,@typescript-ts-mode--operators] @font-lock-operator-face
- (ternary_expression ["?" ":"] @font-lock-operator-face))
-
- :language language
- :feature 'bracket
- '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face)
-
- :language language
- :feature 'delimiter
- '((["," "." ";" ":"]) @font-lock-delimiter-face)
-
- :language language
- :feature 'escape-sequence
- :override t
- '((escape_sequence) @font-lock-escape-face)))
+ (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language)))
+ (treesit-font-lock-rules
+ :language language
+ :feature 'comment
+ `([(comment) (hash_bang_line)] @font-lock-comment-face)
+
+ :language language
+ :feature 'constant
+ `(((identifier) @font-lock-constant-face
+ (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face))
+ [(true) (false) (null)] @font-lock-constant-face)
+
+ :language language
+ :feature 'keyword
+ `([,@typescript-ts-mode--keywords] @font-lock-keyword-face
+ [(this) (super)] @font-lock-keyword-face)
+
+ :language language
+ :feature 'string
+ `((regex pattern: (regex_pattern)) @font-lock-regexp-face
+ (string) @font-lock-string-face
+ (template_string) @js--fontify-template-string
+ (template_substitution ["${" "}"] @font-lock-misc-punctuation-face))
+
+ :language language
+ :override t ;; for functions assigned to variables
+ :feature 'declaration
+ `((,func-exp
+ name: (identifier) @font-lock-function-name-face)
+ (function_declaration
+ name: (identifier) @font-lock-function-name-face)
+ (function_signature
+ name: (identifier) @font-lock-function-name-face)
+
+ (method_definition
+ name: (property_identifier) @font-lock-function-name-face)
+ (method_signature
+ name: (property_identifier) @font-lock-function-name-face)
+ (required_parameter (identifier) @font-lock-variable-name-face)
+ (optional_parameter (identifier) @font-lock-variable-name-face)
+
+ (variable_declarator
+ name: (identifier) @font-lock-function-name-face
+ value: [(,func-exp) (arrow_function)])
+
+ (variable_declarator
+ name: (identifier) @font-lock-variable-name-face)
+
+ (enum_declaration (identifier) @font-lock-type-face)
+
+ (extends_clause value: (identifier) @font-lock-type-face)
+ ;; extends React.Component<T>
+ (extends_clause value: (member_expression
+ object: (identifier) @font-lock-type-face
+ property: (property_identifier) @font-lock-type-face))
+
+ (arrow_function
+ parameter: (identifier) @font-lock-variable-name-face)
+
+ (variable_declarator
+ name: (array_pattern
+ (identifier)
+ (identifier) @font-lock-function-name-face)
+ value: (array (number) (,func-exp)))
+
+ (catch_clause
+ parameter: (identifier) @font-lock-variable-name-face)
+
+ ;; full module imports
+ (import_clause (identifier) @font-lock-variable-name-face)
+ ;; named imports with aliasing
+ (import_clause (named_imports (import_specifier
+ alias: (identifier) @font-lock-variable-name-face)))
+ ;; named imports without aliasing
+ (import_clause (named_imports (import_specifier
+ !alias
+ name: (identifier) @font-lock-variable-name-face)))
+
+ ;; full namespace import (* as alias)
+ (import_clause (namespace_import (identifier) @font-lock-variable-name-face)))
+
+ :language language
+ :feature 'identifier
+ `((nested_type_identifier
+ module: (identifier) @font-lock-type-face)
+
+ (type_identifier) @font-lock-type-face
+
+ (predefined_type) @font-lock-type-face
+
+ (new_expression
+ constructor: (identifier) @font-lock-type-face)
+
+ (enum_body (property_identifier) @font-lock-type-face)
+
+ (enum_assignment name: (property_identifier) @font-lock-type-face)
+
+ (variable_declarator
+ name: (identifier) @font-lock-variable-name-face)
+
+ (for_in_statement
+ left: (identifier) @font-lock-variable-name-face)
+
+ (arrow_function
+ parameters:
+ [(_ (identifier) @font-lock-variable-name-face)
+ (_ (_ (identifier) @font-lock-variable-name-face))
+ (_ (_ (_ (identifier) @font-lock-variable-name-face)))]))
+
+ :language language
+ :feature 'property
+ `((property_signature
+ name: (property_identifier) @font-lock-property-name-face)
+ (public_field_definition
+ name: (property_identifier) @font-lock-property-name-face)
+
+ (pair key: (property_identifier) @font-lock-property-use-face)
+
+ ((shorthand_property_identifier) @font-lock-property-use-face))
+
+ :language language
+ :feature 'expression
+ `((assignment_expression
+ left: [(identifier) @font-lock-function-name-face
+ (member_expression
+ property: (property_identifier) @font-lock-function-name-face)]
+ right: [(,func-exp) (arrow_function)]))
+
+ :language language
+ :feature 'function
+ '((call_expression
+ function:
+ [(identifier) @font-lock-function-call-face
+ (member_expression
+ property: (property_identifier) @font-lock-function-call-face)]))
+
+ :language language
+ :feature 'pattern
+ `((pair_pattern
+ key: (property_identifier) @font-lock-property-use-face
+ value: [(identifier) @font-lock-variable-name-face
+ (assignment_pattern left: (identifier) @font-lock-variable-name-face)])
+
+ (array_pattern (identifier) @font-lock-variable-name-face)
+
+ ((shorthand_property_identifier_pattern) @font-lock-variable-name-face))
+
+ :language language
+ :feature 'jsx
+ (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language)
+ `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face)))
+
+ :language language
+ :feature 'number
+ `((number) @font-lock-number-face
+ ((identifier) @font-lock-number-face
+ (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face)))
+
+ :language language
+ :feature 'operator
+ `([,@typescript-ts-mode--operators] @font-lock-operator-face
+ (ternary_expression ["?" ":"] @font-lock-operator-face))
+
+ :language language
+ :feature 'bracket
+ '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face)
+
+ :language language
+ :feature 'delimiter
+ '((["," "." ";" ":"]) @font-lock-delimiter-face)
+
+ :language language
+ :feature 'escape-sequence
+ :override t
+ '((escape_sequence) @font-lock-escape-face))))
(defvar typescript-ts-mode--sentence-nodes
'("import_statement"
@@ -491,6 +506,8 @@ This mode is intended to be inherited by concrete major modes."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'typescript-ts-mode '(typescript-mode))
+
(if (treesit-ready-p 'typescript)
(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)))
@@ -548,6 +565,8 @@ at least 3 (which is the default value)."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'tsx-ts-mode '(tsx-mode))
+
(defvar typescript-ts--s-p-query
(when (treesit-available-p)
(treesit-query-compile 'typescript
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 6081372af33..a83bad0e8ed 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2023.06.06.141322628
+;; Version: 2024.03.01.121933719
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2023-06-06-86c6984-vpo-GNU"
+(defconst verilog-mode-version "2024-03-01-7448f97-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -2556,11 +2556,13 @@ find the errors."
(defconst verilog-assignment-operation-re-2
(concat "\\(.*?\\)" verilog-assignment-operator-re))
+;; Loosely related to IEEE 1800's concurrent_assertion_statement
+(defconst verilog-concurrent-assertion-statement-re
+ "\\(\\<\\(assert\\|assume\\|cover\\|restrict\\)\\>\\s-+\\<\\(property\\|sequence\\)\\>\\)\\|\\(\\<assert\\>\\)")
+
(defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*"))
(defconst verilog-property-re
- (concat "\\(" verilog-label-re "\\)?"
- ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>"
- "\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(assert\\)"))
+ (concat "\\(" verilog-label-re "\\)?" verilog-concurrent-assertion-statement-re))
(defconst verilog-no-indent-begin-re
(eval-when-compile
@@ -2715,7 +2717,6 @@ find the errors."
"\\(\\<fork\\>\\)\\|" ; 7
"\\(\\<if\\>\\)\\|"
verilog-property-re "\\|"
- "\\(\\(" verilog-label-re "\\)?\\<assert\\>\\)\\|"
"\\(\\<clocking\\>\\)\\|"
"\\(\\<task\\>\\)\\|"
"\\(\\<function\\>\\)\\|"
@@ -4843,7 +4844,7 @@ Uses `verilog-scan' cache."
(not (or (looking-at "\\<") (forward-word-strictly -1)))
;; stop if we see an assertion (perhaps labeled)
(and
- (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)")
+ (looking-at (concat "\\(\\w+\\W*:\\W*\\)?" verilog-concurrent-assertion-statement-re))
(progn
(setq h (point))
(save-excursion
@@ -4970,7 +4971,7 @@ More specifically, point @ in the line foo : @ begin"
(while t
(verilog-re-search-backward
(concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
- "\\(\\<endcase\\>\\)\\>")
+ "\\(\\<endcase\\>\\)")
nil 'move)
(cond
((match-end 4)
@@ -5010,7 +5011,7 @@ More specifically, after a generate and before an endgenerate."
(while (and
(/= nest 0)
(verilog-re-search-backward
- "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>" nil 'move)
+ "\\<\\(?:\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\)\\>" nil 'move)
(cond
((match-end 1) ; module - we have crawled out
(throw 'done 1))
@@ -5038,7 +5039,7 @@ More specifically, after a generate and before an endgenerate."
(save-excursion
(while (and
(/= nest 0)
- (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move)
+ (verilog-re-search-backward "\\<\\(?:\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\)\\>" lim 'move)
(cond
((match-end 1) ; fork
(setq nest (1- nest)))
@@ -5335,7 +5336,7 @@ primitive or interface named NAME."
(match-end 3)
(goto-char there)
(let ((nest 0)
- (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
+ (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(\\<assert\\>\\)"))
(catch 'skip
(while (verilog-re-search-backward reg nil 'move)
(cond
@@ -5802,7 +5803,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'."
(dir (file-name-directory (or filename buffer-file-name)))
(cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
- (with-current-buffer (get-buffer "*Verilog-Preprocessed*")
+ (with-current-buffer "*Verilog-Preprocessed*"
(insert (concat "// " cmd "\n"))
(call-process shell-file-name nil t nil shell-command-switch cmd)
(verilog-mode)
@@ -6244,7 +6245,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(match-end 22))
(throw 'continue 'foo))
- ((looking-at "\\<class\\|struct\\|function\\|task\\>")
+ ((looking-at "\\<\\(?:class\\|struct\\|function\\|task\\)\\>")
;; *sigh* These words have an optional prefix:
;; extern {virtual|protected}? function a();
;; and we don't want to confuse this with
@@ -6268,12 +6269,16 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(throw 'nesting 'defun))))
;;
- ((looking-at "\\<property\\>")
+ ((looking-at "\\<\\(property\\|sequence\\)\\>")
;; *sigh*
- ;; {assert|assume|cover} property (); are complete
- ;; and could also be labeled: - foo: assert property
- ;; but
- ;; property ID () ... needs endproperty
+ ;; - {assert|assume|cover|restrict} property (); are complete
+ ;; - cover sequence (); is complete
+ ;; and could also be labeled:
+ ;; - foo: assert property
+ ;; - bar: cover sequence
+ ;; but:
+ ;; - property ID () ... needs endproperty
+ ;; - sequence ID () ... needs endsequence
(verilog-beg-of-statement)
(if (looking-at verilog-property-re)
(throw 'continue 'statement) ; We don't need an endproperty for these
@@ -6940,7 +6945,7 @@ Also move point to constraint."
(let ( (pt (point)) (pass 0))
(verilog-backward-ws&directives)
(verilog-backward-token)
- (if (looking-at (concat "\\<constraint\\|coverpoint\\|cross\\|with\\>\\|" verilog-in-constraint-re))
+ (if (looking-at (concat "\\<\\(?:constraint\\|coverpoint\\|cross\\|with\\)\\>\\|" verilog-in-constraint-re))
(progn (setq pass 1)
(if (looking-at "\\<with\\>")
(progn (verilog-backward-ws&directives)
@@ -6981,7 +6986,7 @@ Also move point to constraint."
(save-excursion
(if (and (equal (char-after) ?\{)
(verilog-backward-token))
- (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
+ (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>")
nil)))
(defun verilog-at-struct-mv-p ()
@@ -6989,7 +6994,7 @@ Also move point to constraint."
(let ((pt (point)))
(if (and (equal (char-after) ?\{)
(verilog-backward-token))
- (if (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
+ (if (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>")
(progn (verilog-beg-of-statement) (point))
(progn (goto-char pt) nil))
(progn (goto-char pt) nil))))
@@ -9675,7 +9680,7 @@ Return an array of [outputs inouts inputs wire reg assign const gparam intf]."
(cond
;; {..., a, b} requires us to recurse on a,b
;; To support {#{},{#{a,b}} we'll just split everything on [{},]
- ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr)
+ ((string-match "^\\s-*'?{\\(.*\\)}\\s-*$" expr)
(let ((mlst (split-string (match-string 1 expr) "[{},]"))
mstr)
(while (setq mstr (pop mlst))
@@ -9755,7 +9760,10 @@ Inserts the list of signals found, using submodi to look up each port."
;; We intentionally ignore (non-escaped) signals with .s in them
;; this prevents AUTOWIRE etc from noticing hierarchical sigs.
(when port
- (cond ((looking-at "[^\n]*AUTONOHOOKUP"))
+ (cond ((and verilog-auto-ignore-concat
+ (looking-at "[({]"))
+ nil) ; {...} or (...) historically ignored with auto-ignore-concat
+ ((looking-at "[^\n]*AUTONOHOOKUP"))
((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)")
(verilog-read-sub-decls-sig
submoddecls par-values comment port
@@ -11436,7 +11444,7 @@ This repairs those mis-inserted by an AUTOARG."
(while (string-match
(concat "\\([[({:*/<>+-]\\)" ; - must be last
"(\\<\\([0-9A-Za-z_]+\\))"
- "\\([])}:*/<>+-]\\)")
+ "\\([])}:*/<>.+-]\\)")
out)
(setq out (replace-match "\\1\\2\\3" nil nil out)))
(while (string-match
@@ -11531,7 +11539,8 @@ This repairs those mis-inserted by an AUTOARG."
;;(verilog-simplify-range-expression "[(TEST[1])-1:0]")
;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2]
;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]")
-;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]")
+;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") ; "[WIDTH*2/8-1:0]"
+;;(verilog-simplify-range-expression "[(FOO).size:0]") ; "[FOO.size:0]"
(defun verilog-clog2 (value)
"Compute $clog2 - ceiling log2 of VALUE."
@@ -12247,18 +12256,12 @@ If PAR-VALUES replace final strings with these parameter values."
(vl-memory (verilog-sig-memory port-st))
(vl-mbits (if (verilog-sig-multidim port-st)
(verilog-sig-multidim-string port-st) ""))
- (vl-bits (if (or (eq verilog-auto-inst-vector t)
- (and (eq verilog-auto-inst-vector `unsigned)
- (not (verilog-sig-signed port-st)))
- (not (assoc port (verilog-decls-get-signals moddecls)))
- (not (equal (verilog-sig-bits port-st)
- (verilog-sig-bits
- (assoc port (verilog-decls-get-signals moddecls))))))
- (or (verilog-sig-bits port-st) "")
- ""))
+ (vl-bits (or (verilog-sig-bits port-st) ""))
(case-fold-search nil)
(check-values par-values)
- tpl-net dflt-bits)
+ auto-inst-vector
+ auto-inst-vector-tpl
+ tpl-net dflt-bits)
;; Replace parameters in bit-width
(when (and check-values
(not (equal vl-bits "")))
@@ -12281,6 +12284,16 @@ If PAR-VALUES replace final strings with these parameter values."
vl-mbits (verilog-simplify-range-expression vl-mbits)
vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory))
vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed
+ (setq auto-inst-vector
+ (if (or (eq verilog-auto-inst-vector t)
+ (and (eq verilog-auto-inst-vector `unsigned)
+ (not (verilog-sig-signed port-st)))
+ (not (assoc port (verilog-decls-get-signals moddecls)))
+ (not (equal (verilog-sig-bits port-st)
+ (verilog-sig-bits
+ (assoc port (verilog-decls-get-signals moddecls))))))
+ vl-bits
+ ""))
;; Default net value if not found
(setq dflt-bits (if (or (and (verilog-sig-bits port-st)
(verilog-sig-multidim port-st))
@@ -12290,7 +12303,7 @@ If PAR-VALUES replace final strings with these parameter values."
(if vl-memory "." "")
(if vl-memory vl-memory "")
"*/")
- (concat vl-bits))
+ (concat auto-inst-vector))
tpl-net (concat port
(if (and vl-modport
;; .modport cannot be added if attachment is
@@ -12329,10 +12342,21 @@ If PAR-VALUES replace final strings with these parameter values."
(if (numberp value) (setq value (number-to-string value)))
value))
(substring tpl-net (match-end 0))))))
+ ;; Get range based off template net
+ (setq auto-inst-vector-tpl
+ (if (or (eq verilog-auto-inst-vector t)
+ (and (eq verilog-auto-inst-vector `unsigned)
+ (not (verilog-sig-signed port-st)))
+ (not (assoc tpl-net (verilog-decls-get-signals moddecls)))
+ (not (equal (verilog-sig-bits port-st)
+ (verilog-sig-bits
+ (assoc tpl-net (verilog-decls-get-signals moddecls))))))
+ vl-bits
+ ""))
;; Replace @ and [] magic variables in final output
(setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net))
(setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net))
- (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
+ (setq tpl-net (verilog-string-replace-matches "\\[\\]" auto-inst-vector-tpl nil nil tpl-net)))
;; Insert it
(when (or tpl-ass (not verilog-auto-inst-template-required))
(verilog--auto-inst-first indent-pt section)
@@ -12502,7 +12526,7 @@ Typing \\[verilog-auto] will make this into:
endmodule
Where the list of inputs and outputs came from the inst module.
-
+
Exceptions:
Unless you are instantiating a module multiple times, or the module is
@@ -12527,7 +12551,7 @@ Exceptions:
// Outputs
.o (o[31:0]));
-
+
Templates:
For multiple instantiations based upon a single template, create a
@@ -12598,7 +12622,7 @@ Templates:
.ptl_bus (ptl_busnew[3:0]),
....
-
+
Multiple Module Templates:
The same template lines can be applied to multiple modules with
@@ -12613,7 +12637,7 @@ Multiple Module Templates:
*/
Note there is only one AUTO_TEMPLATE opening parenthesis.
-
+
@ Templates:
It is common to instantiate a cell multiple times, so templates make it
@@ -12678,7 +12702,7 @@ Multiple Module Templates:
.ptl_mapvalidx (BAR_ptl_mapvalid),
.ptl_mapvalidp1x (ptl_mapvalid_BAR));
-
+
Regexp Templates:
A template entry of the form
@@ -12702,7 +12726,7 @@ Regexp Templates:
subscript:
.\\(.*\\)_l (\\1_[]),
-
+
Lisp Templates:
First any regular expression template is expanded.
@@ -12747,7 +12771,7 @@ Lisp Templates:
After the evaluation is completed, @ substitution and [] substitution
occur.
-
+
Ignoring Hookup:
AUTOWIRE and related AUTOs will read the signals created by a template.
@@ -12756,7 +12780,7 @@ Ignoring Hookup:
.pci_req_l (pci_req_not_to_wire), //AUTONOHOOKUP
-
+
For more information see the \\[verilog-faq] and forums at URL
`https://www.veripool.org'."
(save-excursion
@@ -12910,7 +12934,7 @@ Typing \\[verilog-auto] will make this into:
endmodule
Where the list of parameter connections come from the inst module.
-
+
Templates:
You can customize the parameter connections using AUTO_TEMPLATEs,
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 060880d7cf2..144bfa944d3 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -457,7 +457,7 @@ If no file name at all is printed out, set both \"File Message\" entries to 0
\(a default file name message will be printed out instead, does not work in
XEmacs).
-A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
+A compiler is selected for syntax analysis (\\[vhdl-compile]) by
assigning its name to option `vhdl-compiler'.
Please send any missing or erroneous compiler properties to the maintainer for
@@ -1106,14 +1106,14 @@ For more information on format strings, see the documentation for the
(defcustom vhdl-modify-date-prefix-string "-- Last update: "
"Prefix string of modification date in VHDL file header.
If actualization of the modification date is called (menu,
-`\\[vhdl-template-modify]'), this string is searched and the rest
+\\[vhdl-template-modify]), this string is searched and the rest
of the line replaced by the current date."
:type 'string
:group 'vhdl-header)
(defcustom vhdl-modify-date-on-saving t
"Non-nil means update the modification date when the buffer is saved.
-Calls function `\\[vhdl-template-modify]').
+Calls function \\[vhdl-template-modify]).
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
\"Activate Options\"."
@@ -4469,7 +4469,7 @@ Usage:
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
+ tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to
tabs and vice versa.
Syntax-based indentation can be very slow in large files. Option
@@ -4780,7 +4780,7 @@ Usage:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
+ customization group `vhdl-highlight-faces' (\\[customize-group]). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
@@ -4840,14 +4840,14 @@ Usage:
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `\\[customize-option]'
- (`\\[customize-group]' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command \\[customize-option]
+ (\\[customize-group] for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`\\[vhdl-customize]' or menu)!
+ what other useful user options there are (\\[vhdl-customize] or menu)!
FILE EXTENSIONS:
@@ -4876,7 +4876,7 @@ Usage:
Maintenance:
------------
-To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
+To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
@@ -8398,6 +8398,44 @@ buffer."
(message "Updating sensitivity lists...done")))
(when noninteractive (save-buffer)))
+(defun vhdl--re2-region (beg-re end-re)
+ "Return a function searching for a region delimited by a pair of regexps.
+BEG-RE and END-RE are the regexps delimiting the region to search for."
+ (lambda (proc-end)
+ (when (vhdl-re-search-forward beg-re proc-end t)
+ (save-excursion
+ (vhdl-re-search-forward end-re proc-end t)))))
+
+(defconst vhdl--signal-regions-functions
+ (list
+ ;; right-hand side of signal/variable assignment
+ ;; (special case: "<=" is relational operator in a condition)
+ (vhdl--re2-region "[<:]="
+ ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>")
+ ;; if condition
+ (vhdl--re2-region "^\\s-*if\\>" "\\<then\\>")
+ ;; elsif condition
+ (vhdl--re2-region "\\<elsif\\>" "\\<then\\>")
+ ;; while loop condition
+ (vhdl--re2-region "^\\s-*while\\>" "\\<loop\\>")
+ ;; exit/next condition
+ (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";")
+ ;; assert condition
+ (vhdl--re2-region "\\<assert\\>" "\\(\\<report\\>\\|\\<severity\\>\\|;\\)")
+ ;; case expression
+ (vhdl--re2-region "^\\s-*case\\>" "\\<is\\>")
+ ;; parameter list of procedure call, array index
+ (lambda (proc-end)
+ (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
+ (forward-char -1)
+ (save-excursion
+ (forward-sexp)
+ (while (looking-at "(") (forward-sexp)) (point)))))
+ "Define syntactic regions where signals are read.
+Each function is called with one arg (a limit for the (forward) search) and
+should return either nil or the end position of the region (in which case
+point will be set to its beginning).")
+
(defun vhdl-update-sensitivity-list ()
"Update sensitivity list."
(let ((proc-beg (point))
@@ -8418,35 +8456,6 @@ buffer."
(let
;; scan for visible signals
((visible-list (vhdl-get-visible-signals))
- ;; define syntactic regions where signals are read
- (scan-regions-list
- `(;; right-hand side of signal/variable assignment
- ;; (special case: "<=" is relational operator in a condition)
- ((vhdl-re-search-forward "[<:]=" ,proc-end t)
- (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t))
- ;; if condition
- ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<then\\>" ,proc-end t))
- ;; elsif condition
- ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<then\\>" ,proc-end t))
- ;; while loop condition
- ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<loop\\>" ,proc-end t))
- ;; exit/next condition
- ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t)
- (vhdl-re-search-forward ";" ,proc-end t))
- ;; assert condition
- ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t)
- (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t))
- ;; case expression
- ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t)
- (vhdl-re-search-forward "\\<is\\>" ,proc-end t))
- ;; parameter list of procedure call, array index
- ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t)
- (1- (point)))
- (progn (backward-char) (forward-sexp)
- (while (looking-at "(") (forward-sexp)) (point)))))
name field read-list sens-list signal-list tmp-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
@@ -8475,11 +8484,9 @@ buffer."
(push (cons end (point)) seq-region-list)
(beginning-of-line)))
;; scan for signals read in process
- (while scan-regions-list
+ (dolist (scan-fun vhdl--signal-regions-functions)
(goto-char proc-mid)
- (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
- (setq end (eval (nth 1 (car scan-regions-list)))))
- (goto-char beg)
+ (while (setq end (funcall scan-fun proc-end))
(unless (or (vhdl-in-literal)
(and seq-region-list
(let ((tmp-list seq-region-list))
@@ -8518,8 +8525,7 @@ buffer."
(car tmp-list))
(setq read-list (delete (car tmp-list) read-list)))
(setq tmp-list (cdr tmp-list)))))
- (goto-char (match-end 1)))))
- (setq scan-regions-list (cdr scan-regions-list)))
+ (goto-char (match-end 1))))))
;; update sensitivity list
(goto-char sens-beg)
(if sens-end
@@ -14978,9 +14984,9 @@ otherwise use cached data."
(vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg
- package-alist ent-inst-list depth)
- "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST."
- (if (not (or ent-alist-arg conf-alist-arg package-alist))
+ pkg-alist ent-inst-list depth)
+ "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST."
+ (if (not (or ent-alist-arg conf-alist-arg pkg-alist))
(vhdl-speedbar-make-title-line "No VHDL design units!" depth)
(let ((ent-alist ent-alist-arg)
(conf-alist conf-alist-arg)
@@ -15010,15 +15016,15 @@ otherwise use cached data."
'vhdl-speedbar-configuration-face depth)
(setq conf-alist (cdr conf-alist)))
;; insert packages
- (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth))
- (while package-alist
- (setq pack-entry (car package-alist))
+ (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth))
+ (while pkg-alist
+ (setq pack-entry (car pkg-alist))
(vhdl-speedbar-make-pack-line
(nth 0 pack-entry) (nth 1 pack-entry)
(cons (nth 2 pack-entry) (nth 3 pack-entry))
(cons (nth 7 pack-entry) (nth 8 pack-entry))
depth)
- (setq package-alist (cdr package-alist))))))
+ (setq pkg-alist (cdr pkg-alist))))))
(declare-function speedbar-line-directory "speedbar" (&optional depth))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index bd68672f905..b36e13104e3 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -211,7 +211,7 @@ non-nil.")
(when which-function-mode
(unless (local-variable-p 'which-func-mode)
(setq which-func-mode (or (eq which-func-modes t)
- (member major-mode which-func-modes)))
+ (derived-mode-p which-func-modes)))
(setq which-func--use-mode-line
(member which-func-display '(mode mode-and-header)))
(setq which-func--use-header-line
@@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary."
(condition-case err
(if (and which-func-mode
- (not (member major-mode which-func-non-auto-modes))
+ (not (derived-mode-p which-func-non-auto-modes))
(or (null which-func-maxout)
(< buffer-saved-size which-func-maxout)
(= which-func-maxout 0)))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 717b837a2e5..755c3db04fd 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -2176,7 +2176,7 @@ Such as the current syntax table and the applied syntax properties."
(or
(buffer-modified-p buf)
(unless xref--hits-remote-id
- (not (verify-visited-file-modtime (current-buffer))))))
+ (not (verify-visited-file-modtime buf)))))
;; We can't use buffers whose contents diverge from disk (bug#54025).
(setq buf nil))
(setq xref--last-file-buffer (cons file buf))))
diff --git a/lisp/register.el b/lisp/register.el
index baad2c2a05d..822467a0d72 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -131,7 +131,12 @@ to the value of `register--read-with-preview-function'.")
(defcustom register-use-preview 'traditional
"Whether to show register preview when modifying registers.
-When set to `t', show a preview buffer with navigation and highlighting.
+When set to `t', show a preview buffer with navigation and
+highlighting.
+When set to \\='insist, behave as with `t', but allow exiting the
+minibuffer by pressing the register name a second time. E.g.,
+press \"a\" to select register \"a\", then press \"a\" again to
+exit the minibuffer.
When nil, show a preview buffer without navigation and highlighting, and
exit the minibuffer immediately after inserting response in minibuffer.
When set to \\='never, behave as with nil, but with no preview buffer at
@@ -141,6 +146,7 @@ according to `register-preview-delay'; this preserves the traditional
behavior of Emacs 29 and before."
:type '(choice
(const :tag "Use preview" t)
+ (const :tag "Use preview and exit by pressing register name" insist)
(const :tag "Use quick preview" nil)
(const :tag "Never use preview" never)
(const :tag "Basic preview like Emacs-29" traditional))
@@ -386,18 +392,21 @@ Format of each entry is controlled by the variable `register-preview-function'."
(setq register-preview-function (register--preview-function
register--read-with-preview-function)))
(when (or show-empty (consp register-alist))
- (with-current-buffer-window
- buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
- nil
- (with-current-buffer standard-output
- (setq cursor-in-non-selected-windows nil)
- (mapc (lambda (elem)
- (when (get-register (car elem))
- (insert (funcall register-preview-function elem))))
- register-alist)))))
+ (with-current-buffer-window buffer
+ register-preview-display-buffer-alist
+ nil
+ (with-current-buffer standard-output
+ (setq cursor-in-non-selected-windows nil)
+ (mapc (lambda (elem)
+ (when (get-register (car elem))
+ (insert (funcall register-preview-function elem))))
+ register-alist)))))
+
+(defcustom register-preview-display-buffer-alist '(display-buffer-at-bottom
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t)))
+ "Window configuration for the register preview buffer."
+ :type display-buffer--action-custom-type)
(defun register-preview-1 (buffer &optional show-empty types)
"Pop up a window showing the preview of registers in BUFFER.
@@ -415,9 +424,7 @@ Format of each entry is controlled by the variable `register-preview-function'."
(when (or show-empty (consp registers))
(with-current-buffer-window
buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
+ register-preview-display-buffer-alist
nil
(with-current-buffer standard-output
(setq cursor-in-non-selected-windows nil)
@@ -540,7 +547,12 @@ or \\='never."
(member new strs))
new old))
(delete-minibuffer-contents)
- (insert input)))
+ (insert input)
+ ;; Exit minibuffer on second hit
+ ;; when *-use-preview == insist.
+ (when (and (string= new old)
+ (eq register-use-preview 'insist))
+ (setq noconfirm t))))
(when (and smatch (not (string= input ""))
(not (member input strs)))
(setq input "")
@@ -550,6 +562,10 @@ or \\='never."
(setq pat input))))
(if (setq win (get-buffer-window buffer))
(with-selected-window win
+ (when noconfirm
+ ;; Happen only when
+ ;; *-use-preview == insist.
+ (exit-minibuffer))
(let ((ov (make-overlay
(point-min) (point-min)))
;; Allow upper-case and lower-case letters
diff --git a/lisp/replace.el b/lisp/replace.el
index fa460a16063..01a892bbba7 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1931,7 +1931,7 @@ See also `multi-occur'."
(lambda (boo)
(buffer-name (if (overlayp boo) (overlay-buffer boo) boo)))
active-bufs))
- (with-current-buffer (get-buffer buf-name)
+ (with-current-buffer buf-name
(rename-uniquely)))
;; Now find or create the output buffer.
@@ -2916,7 +2916,7 @@ characters."
;; If last typed key in previous call of multi-buffer perform-replace
;; was `automatic-all', don't ask more questions in next files
- (when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
+ (when (eq (lookup-key map (vector last-input-event) t) 'automatic-all)
(setq query-flag nil multi-buffer t))
(cond
@@ -3100,7 +3100,7 @@ characters."
;; read-event that clobbers the match data.
(set-match-data real-match-data)
(setq key (vector key))
- (setq def (lookup-key map key))
+ (setq def (lookup-key map key t))
;; Restore the match data while we process the command.
(cond ((eq def 'help)
(let ((display-buffer-overriding-action
diff --git a/lisp/server.el b/lisp/server.el
index f75e9cb4fe5..b65053267a6 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -729,7 +729,9 @@ the `server-process' variable."
(concat "Unable to start the Emacs server.\n"
(cadr err)
(substitute-command-keys
- "\nTo start the server in this Emacs process, stop the existing server or call `\\[server-force-delete]' to forcibly disconnect it."))
+ (concat "\nTo start the server in this Emacs process, stop "
+ "the existing server or call \\[server-force-delete] "
+ "to forcibly disconnect it.")))
:warning)
(setq leave-dead t)))
;; Now any previous server is properly stopped.
@@ -1437,7 +1439,11 @@ invocations of \"emacs\".")
;; including code that needs to wait.
(with-local-quit
(condition-case err
- (let ((buffers (server-visit-files files proc nowait)))
+ (let ((buffers (server-visit-files files proc nowait))
+ ;; On Android, the Emacs server generally can't provide
+ ;; feedback to the user except by means of dialog boxes,
+ ;; which are displayed in the GUI emacsclient wrapper.
+ (use-dialog-box-override (featurep 'android)))
(mapc 'funcall (nreverse commands))
(let ((server-eval-args-left (nreverse evalexprs)))
(while server-eval-args-left
diff --git a/lisp/shell.el b/lisp/shell.el
index c5cfbd985ed..cd49d289403 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -606,6 +606,9 @@ Shell buffers. It implements `shell-completion-execonly' for
(defvar sh-shell-file)
+(declare-function w32-application-type "w32proc.c"
+ (program) t)
+
(define-derived-mode shell-mode comint-mode "Shell"
"Major mode for interacting with an inferior shell.
\\<shell-mode-map>
@@ -754,6 +757,11 @@ command."
((string-equal shell "ksh") "echo $PWD ~-")
;; Bypass any aliases. TODO all shells could use this.
((string-equal shell "bash") "command dirs")
+ ((and (string-equal shell "bash.exe")
+ (eq system-type 'windows-nt)
+ (eq (w32-application-type (executable-find "bash.exe"))
+ 'msys))
+ "command pwd -W")
((string-equal shell "zsh") "dirs -l")
(t "dirs")))
;; Bypass a bug in certain versions of bash.
diff --git a/lisp/simple.el b/lisp/simple.el
index 4f6d2ee12c3..0645f18cc78 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2087,6 +2087,9 @@ of the prefix argument for `eval-expression' and
((= num -1) most-positive-fixnum)
(t eval-expression-print-maximum-character)))))
+(defun eval-expression--debug (err)
+ (funcall debugger 'error err :backtrace-base #'eval-expression--debug))
+
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-buffer.
(defun eval-expression (exp &optional insert-value no-truncate char-print-limit)
@@ -2120,23 +2123,17 @@ this command arranges for all errors to enter the debugger."
(cons (read--expression "Eval: ")
(eval-expression-get-print-arguments current-prefix-arg)))
- (let (result)
+ (let* (result
+ (runfun
+ (lambda ()
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp))
+ t))))))
(if (null eval-expression-debug-on-error)
- (setq result
- (values--store-value
- (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (setq result
- (values--store-value
- (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
+ (funcall runfun)
+ (handler-bind ((error #'eval-expression--debug))
+ (funcall runfun)))
(let ((print-length (unless no-truncate eval-expression-print-length))
(print-level (unless no-truncate eval-expression-print-level))
@@ -6422,7 +6419,7 @@ PROMPT is a string to prompt with."
0 (length s)
'(
keymap local-map action mouse-action
- button category help-args)
+ read-only button category help-args)
s)
s)
kill-ring))
@@ -9943,6 +9940,20 @@ Also see the `completion-auto-wrap' variable."
(interactive "p")
(next-completion (- n)))
+(defun completion--move-to-candidate-start ()
+ "If in a completion candidate, move point to its start."
+ (when (and (get-text-property (point) 'mouse-face)
+ (not (bobp))
+ (get-text-property (1- (point)) 'mouse-face))
+ (goto-char (previous-single-property-change (point) 'mouse-face))))
+
+(defun completion--move-to-candidate-end ()
+ "If in a completion candidate, move point to its end."
+ (when (and (get-text-property (point) 'mouse-face)
+ (not (eobp))
+ (get-text-property (1+ (point)) 'mouse-face))
+ (goto-char (or (next-single-property-change (point) 'mouse-face) (point-max)))))
+
(defun next-completion (n)
"Move to the next item in the completions buffer.
With prefix argument N, move N items (negative N means move
@@ -10032,9 +10043,7 @@ Also see the `completion-auto-wrap' variable."
(if (get-text-property (point) 'mouse-face)
;; If in a completion, move to the start of it.
- (when (and (not (bobp))
- (get-text-property (1- (point)) 'mouse-face))
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (completion--move-to-candidate-start)
;; Try to move to the previous completion.
(setq pos (previous-single-property-change (point) 'mouse-face))
(if pos
@@ -10049,10 +10058,11 @@ Also see the `completion-auto-wrap' variable."
(while (> n 0)
(setq found nil pos nil column (current-column) line (line-number-at-pos))
+ (completion--move-to-candidate-end)
(while (and (not found)
(eq (forward-line 1) 0)
(not (eobp))
- (eq (move-to-column column) column))
+ (move-to-column column))
(when (get-text-property (point) 'mouse-face)
(setq found t)))
(when (not found)
@@ -10073,9 +10083,10 @@ Also see the `completion-auto-wrap' variable."
(while (< n 0)
(setq found nil pos nil column (current-column) line (line-number-at-pos))
+ (completion--move-to-candidate-start)
(while (and (not found)
(eq (forward-line -1) 0)
- (eq (move-to-column column) column))
+ (move-to-column column))
(when (get-text-property (point) 'mouse-face)
(setq found t)))
(when (not found)
@@ -10287,6 +10298,8 @@ Called from `temp-buffer-show-hook'."
:version "22.1"
:group 'completion)
+(defvar minibuffer-visible-completions--always-bind)
+
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
@@ -10324,13 +10337,28 @@ Called from `temp-buffer-show-hook'."
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
- (insert (substitute-command-keys
- (if (display-mouse-p)
- "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n"
- "Type \\[minibuffer-choose-completion] on a completion to select it.\n")))
- (insert (substitute-command-keys
- "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \
+ (if minibuffer-visible-completions
+ (let ((helps
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (let ((minibuffer-visible-completions--always-bind t))
+ (list
+ (substitute-command-keys
+ (if (display-mouse-p)
+ "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n"
+ "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n"))
+ (substitute-command-keys
+ "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \
+\\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \
to move point between completions.\n\n"))))))
+ (dolist (help helps)
+ (insert help)))
+ (insert (substitute-command-keys
+ (if (display-mouse-p)
+ "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n"
+ "Type \\[minibuffer-choose-completion] on a completion to select it.\n")))
+ (insert (substitute-command-keys
+ "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \
+to move point between completions.\n\n")))))))
(add-hook 'completion-setup-hook #'completion-setup-function)
@@ -10833,6 +10861,87 @@ and setting it to nil."
(setq-local vis-mode-saved-buffer-invisibility-spec
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
+
+
+(defvar read-passwd--mode-line-buffer nil
+ "Buffer to modify `mode-line-format' for showing/hiding passwords.")
+
+(defvar read-passwd--mode-line-icon nil
+ "Propertized mode line icon for showing/hiding passwords.")
+
+(defun read-passwd-toggle-visibility ()
+ "Toggle minibuffer contents visibility.
+Adapt also mode line."
+ (interactive)
+ (setq read-passwd--hide-password (not read-passwd--hide-password))
+ (with-current-buffer read-passwd--mode-line-buffer
+ (setq read-passwd--mode-line-icon
+ `(:propertize
+ ,(if icon-preference
+ (icon-string
+ (if read-passwd--hide-password
+ 'read-passwd--show-password-icon
+ 'read-passwd--hide-password-icon))
+ "")
+ mouse-face mode-line-highlight
+ local-map
+ (keymap
+ (mode-line keymap (mouse-1 . read-passwd-toggle-visibility)))))
+ (force-mode-line-update))
+ (read-passwd--hide-password))
+
+(define-minor-mode read-passwd-mode
+ "Toggle visibility of password in minibuffer."
+ :group 'mode-line
+ :group 'minibuffer
+ :keymap read-passwd-map
+ :version "30.1"
+
+ (require 'icons)
+ ;; It would be preferable to use "šŸ‘" ("\N{EYE}"). However, there is
+ ;; no corresponding Unicode char with a slash. So we use symbols as
+ ;; fallback only, with "ā¦µ" ("\N{CIRCLE WITH HORIZONTAL BAR}") for
+ ;; hiding the password.
+ (define-icon read-passwd--show-password-icon nil
+ '((image "reveal.svg" "reveal.pbm" :height (0.8 . em))
+ (symbol "šŸ‘")
+ (text "<o>"))
+ "Mode line icon to show a hidden password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+ (define-icon read-passwd--hide-password-icon nil
+ '((image "conceal.svg" "conceal.pbm" :height (0.8 . em))
+ (symbol "ā¦µ")
+ (text "<\\>"))
+ "Mode line icon to hide a visible password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+
+ (setq read-passwd--hide-password nil
+ ;; Stolen from `eldoc-minibuffer-message'.
+ read-passwd--mode-line-buffer
+ (window-buffer
+ (or (window-in-direction 'above (minibuffer-window))
+ (minibuffer-selected-window)
+ (get-largest-window))))
+
+ (if read-passwd-mode
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Add `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format
+ (cons '(:eval read-passwd--mode-line-icon)
+ mode-line-format))))
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Remove `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format (cdr mode-line-format)))))
+
+ (when read-passwd-mode
+ (read-passwd-toggle-visibility)))
+
(defvar messages-buffer-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 1cb72dc23e6..2ed97986fe7 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate."
nil
-(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
+(eval-when-compile (require 'imenu))
(declare-function imenu--make-index-alist "imenu" (&optional no-error))
(defun speedbar-fetch-dynamic-imenu (file)
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
index 46e35ac18d8..efc5997fb5c 100644
--- a/lisp/sqlite.el
+++ b/lisp/sqlite.el
@@ -32,7 +32,8 @@
If BODY completes normally, commit the changes and return
the value of BODY.
If BODY signals an error, or transaction commit fails, roll
-back the transaction changes."
+back the transaction changes before allowing the signal to
+propagate."
(declare (indent 1) (debug (form body)))
(let ((db-var (gensym))
(func-var (gensym))
@@ -48,8 +49,8 @@ back the transaction changes."
(setq ,res-var (funcall ,func-var))
(setq ,commit-var (sqlite-commit ,db-var))
,res-var)
- (or ,commit-var (sqlite-rollback ,db-var))))
- (funcall ,func-var))))
+ (or ,commit-var (sqlite-rollback ,db-var)))
+ (funcall ,func-var)))))
(provide 'sqlite)
diff --git a/lisp/startup.el b/lisp/startup.el
index b0669af7e24..0f0195eba57 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -393,7 +393,7 @@ If this is nil, Emacs uses `system-name'."
"The email address of the current user.
This defaults to either: the value of EMAIL environment variable; or
user@host, using `user-login-name' and `mail-host-address' (or `system-name')."
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:set-after '(mail-host-address)
:type 'string
:group 'mail)
@@ -492,7 +492,7 @@ DIRS are relative."
(setq tail (cdr tail)))
;;Splice the new section in.
(when tail
- (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
+ (setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail))))))
;; The default location for XDG-convention Emacs init files.
(defconst startup--xdg-config-default "~/.config/emacs/")
@@ -556,6 +556,17 @@ the updated value."
(setq startup--original-eln-load-path
(copy-sequence native-comp-eln-load-path))))
+(defun startup--rescale-elt-match-p (font-pattern font-object)
+ "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'.
+FONT-OBJECT is a font-object that specifies a font to test.
+FONT-PATTERN is the car of an element of `face-font-rescale-alist',
+which can be either a regexp matching a font name or a font-spec."
+ (if (stringp font-pattern)
+ ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match.
+ (string-match-p font-pattern (font-xlfd-name font-object))
+ ;; FONT-PATTERN is a font-spec.
+ (font-match-p font-pattern font-object)))
+
(defvar android-fonts-enumerated nil
"Whether or not fonts have been enumerated already.
On Android, Emacs uses this variable internally at startup.")
@@ -816,8 +827,9 @@ It is the default value of the variable `top-level'."
(when (and (display-multi-font-p)
(not (eq face-font-rescale-alist
old-face-font-rescale-alist))
- (assoc (font-xlfd-name (face-attribute 'default :font))
- face-font-rescale-alist #'string-match-p))
+ (assoc (face-attribute 'default :font)
+ face-font-rescale-alist
+ #'startup--rescale-elt-match-p))
(set-face-attribute 'default nil :font (font-spec)))
;; Modify the initial frame based on what .emacs puts into
@@ -1019,6 +1031,9 @@ If STYLE is nil, display appropriately for the terminal."
(when standard-display-table
(aset standard-display-table char nil)))))))
+(defun startup--debug (err)
+ (funcall debugger 'error err :backtrace-base #'startup--debug))
+
(defun startup--load-user-init-file
(filename-function &optional alternate-filename-function load-defaults)
"Load a user init-file.
@@ -1032,88 +1047,79 @@ is non-nil.
This function sets `user-init-file' to the name of the loaded
init-file, or to a default value if loading is not possible."
- (let ((debug-on-error-from-init-file nil)
- (debug-on-error-should-be-set nil)
- (debug-on-error-initial
- (if (eq init-file-debug t)
- 'startup--witness ;Dummy but recognizable non-nil value.
- init-file-debug))
- (d-i-e-from-init-file nil)
- (d-i-e-initial
- ;; Use (startup--witness) instead of nil, so we can detect when the
- ;; init files set `debug-ignored-errors' to nil.
- (if init-file-debug '(startup--witness) debug-ignored-errors))
- (d-i-e-standard debug-ignored-errors)
- ;; The init file might contain byte-code with embedded NULs,
- ;; which can cause problems when read back, so disable nul
- ;; byte detection. (Bug#52554)
- (inhibit-null-byte-detection t))
- (let ((debug-on-error debug-on-error-initial)
- ;; If they specified --debug-init, enter the debugger
- ;; on any error whatsoever.
- (debug-ignored-errors d-i-e-initial))
+ ;; The init file might contain byte-code with embedded NULs,
+ ;; which can cause problems when read back, so disable nul
+ ;; byte detection. (Bug#52554)
+ (let ((inhibit-null-byte-detection t)
+ (body
+ (lambda ()
+ (when init-file-user
+ (let ((init-file-name (funcall filename-function)))
+
+ ;; If `user-init-file' is t, then `load' will store
+ ;; the name of the file that it loads into
+ ;; `user-init-file'.
+ (setq user-init-file t)
+ (when init-file-name
+ (load (if (equal (file-name-extension init-file-name)
+ "el")
+ (file-name-sans-extension init-file-name)
+ init-file-name)
+ 'noerror 'nomessage))
+
+ (when (and (eq user-init-file t) alternate-filename-function)
+ (let ((alt-file (funcall alternate-filename-function)))
+ (unless init-file-name
+ (setq init-file-name alt-file))
+ (and (equal (file-name-extension alt-file) "el")
+ (setq alt-file (file-name-sans-extension alt-file)))
+ (load alt-file 'noerror 'nomessage)))
+
+ ;; If we did not find the user's init file, set
+ ;; user-init-file conclusively. Don't let it be
+ ;; set from default.el.
+ (when (eq user-init-file t)
+ (setq user-init-file init-file-name)))
+
+ ;; If we loaded a compiled file, set `user-init-file' to
+ ;; the source version if that exists.
+ (if (equal (file-name-extension user-init-file) "elc")
+ (let* ((source (file-name-sans-extension user-init-file))
+ (alt (concat source ".el")))
+ (setq source (cond ((file-exists-p alt) alt)
+ ((file-exists-p source) source)
+ (t nil)))
+ (when source
+ (when (file-newer-than-file-p source user-init-file)
+ (message "Warning: %s is newer than %s"
+ source user-init-file)
+ (sit-for 1))
+ (setq user-init-file source)))
+ ;; Else, perhaps the user init file was compiled
+ (when (and (equal (file-name-extension user-init-file) "eln")
+ ;; The next test is for builds without native
+ ;; compilation support or builds with unexec.
+ (boundp 'comp-eln-to-el-h))
+ (if-let (source (gethash (file-name-nondirectory
+ user-init-file)
+ comp-eln-to-el-h))
+ ;; source exists or the .eln file would not load
+ (setq user-init-file source)
+ (message "Warning: unknown source file for init file %S"
+ user-init-file)
+ (sit-for 1))))
+
+ (when (and load-defaults
+ (not inhibit-default-init))
+ ;; Prevent default.el from changing the value of
+ ;; `inhibit-startup-screen'.
+ (let ((inhibit-startup-screen nil))
+ (load "default" 'noerror 'nomessage)))))))
+ (if (eq init-file-debug t)
+ (handler-bind ((error #'startup--debug))
+ (funcall body))
(condition-case-unless-debug error
- (when init-file-user
- (let ((init-file-name (funcall filename-function)))
-
- ;; If `user-init-file' is t, then `load' will store
- ;; the name of the file that it loads into
- ;; `user-init-file'.
- (setq user-init-file t)
- (when init-file-name
- (load (if (equal (file-name-extension init-file-name)
- "el")
- (file-name-sans-extension init-file-name)
- init-file-name)
- 'noerror 'nomessage))
-
- (when (and (eq user-init-file t) alternate-filename-function)
- (let ((alt-file (funcall alternate-filename-function)))
- (unless init-file-name
- (setq init-file-name alt-file))
- (and (equal (file-name-extension alt-file) "el")
- (setq alt-file (file-name-sans-extension alt-file)))
- (load alt-file 'noerror 'nomessage)))
-
- ;; If we did not find the user's init file, set
- ;; user-init-file conclusively. Don't let it be
- ;; set from default.el.
- (when (eq user-init-file t)
- (setq user-init-file init-file-name)))
-
- ;; If we loaded a compiled file, set `user-init-file' to
- ;; the source version if that exists.
- (if (equal (file-name-extension user-init-file) "elc")
- (let* ((source (file-name-sans-extension user-init-file))
- (alt (concat source ".el")))
- (setq source (cond ((file-exists-p alt) alt)
- ((file-exists-p source) source)
- (t nil)))
- (when source
- (when (file-newer-than-file-p source user-init-file)
- (message "Warning: %s is newer than %s"
- source user-init-file)
- (sit-for 1))
- (setq user-init-file source)))
- ;; Else, perhaps the user init file was compiled
- (when (and (equal (file-name-extension user-init-file) "eln")
- ;; The next test is for builds without native
- ;; compilation support or builds with unexec.
- (boundp 'comp-eln-to-el-h))
- (if-let (source (gethash (file-name-nondirectory user-init-file)
- comp-eln-to-el-h))
- ;; source exists or the .eln file would not load
- (setq user-init-file source)
- (message "Warning: unknown source file for init file %S"
- user-init-file)
- (sit-for 1))))
-
- (when (and load-defaults
- (not inhibit-default-init))
- ;; Prevent default.el from changing the value of
- ;; `inhibit-startup-screen'.
- (let ((inhibit-startup-screen nil))
- (load "default" 'noerror 'nomessage))))
+ (funcall body)
(error
(display-warning
'initialization
@@ -1128,28 +1134,7 @@ the `--debug-init' option to view a complete error backtrace."
(mapconcat (lambda (s) (prin1-to-string s t))
(cdr error) ", "))
:warning)
- (setq init-file-had-error t)))
-
- ;; If we can tell that the init file altered debug-on-error,
- ;; arrange to preserve the value that it set up.
- (unless (eq debug-ignored-errors d-i-e-initial)
- (if (memq 'startup--witness debug-ignored-errors)
- ;; The init file wants to add errors to the standard
- ;; value, so we need to emulate that.
- (setq d-i-e-from-init-file
- (list (append d-i-e-standard
- (remq 'startup--witness
- debug-ignored-errors))))
- ;; The init file _replaces_ the standard value.
- (setq d-i-e-from-init-file (list debug-ignored-errors))))
- (or (eq debug-on-error debug-on-error-initial)
- (setq debug-on-error-should-be-set t
- debug-on-error-from-init-file debug-on-error)))
-
- (when d-i-e-from-init-file
- (setq debug-ignored-errors (car d-i-e-from-init-file)))
- (when debug-on-error-should-be-set
- (setq debug-on-error debug-on-error-from-init-file))))
+ (setq init-file-had-error t))))))
(defvar lisp-directory nil
"Directory where Emacs's own *.el and *.elc Lisp files are installed.")
@@ -1445,7 +1430,7 @@ please check its value")
(error
(princ
(if (eq (car error) 'error)
- (apply 'concat (cdr error))
+ (apply #'concat (cdr error))
(if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s"
(nth 1 error)
@@ -1659,7 +1644,9 @@ Consider using a subdirectory instead, e.g.: %s"
(let ((dn (daemonp)))
(when dn
(when (stringp dn) (setq server-name dn))
- (server-start)
+ (condition-case err
+ (server-start)
+ (error (error "Unable to start daemon: %s; exiting" (error-message-string err))))
(if server-process
(daemon-initialized)
(if (stringp dn)
@@ -1790,7 +1777,7 @@ If this is nil, no message will be displayed."
"\n"))
"A list of texts to show in the middle part of splash screens.
Each element in the list should be a list of strings or pairs
-`:face FACE', like `fancy-splash-insert' accepts them.")
+`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.")
(defconst fancy-about-text
`((:face (variable-pitch font-lock-comment-face)
@@ -1883,7 +1870,7 @@ Each element in the list should be a list of strings or pairs
"\tDisplay the Emacs manual in Info mode"))
"A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
-`:face FACE', like `fancy-splash-insert' accepts them.")
+`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.")
(defgroup fancy-splash-screen ()
@@ -1902,10 +1889,10 @@ Each element in the list should be a list of strings or pairs
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
- (define-key map "\C-?" 'scroll-down-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map " " 'scroll-up-command)
- (define-key map "q" 'exit-splash-screen)
+ (define-key map "\C-?" #'scroll-down-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map " " #'scroll-up-command)
+ (define-key map "q" #'exit-splash-screen)
map)
"Keymap for splash screen buffer.")
@@ -2058,10 +2045,6 @@ a face or button specification."
(call-interactively
'recover-session)))
" to recover the files you were editing."))))
- ;; Insert the permissions notice if the user has yet to grant Emacs
- ;; storage permissions.
- (when (fboundp 'android-after-splash-screen)
- (funcall 'android-after-splash-screen t))
(when concise
(fancy-splash-insert
:face 'variable-pitch "\n"
@@ -2114,6 +2097,10 @@ splash screen in another window."
(make-local-variable 'startup-screen-inhibit-startup-screen)
(if pure-space-overflow
(insert pure-space-overflow-message))
+ ;; Insert the permissions notice if the user has yet to grant Emacs
+ ;; storage permissions.
+ (when (fboundp 'android-before-splash-screen)
+ (funcall 'android-before-splash-screen t))
(unless concise
(fancy-splash-head))
(dolist (text fancy-startup-text)
@@ -2220,7 +2207,10 @@ splash screen in another window."
(if pure-space-overflow
(insert pure-space-overflow-message))
-
+ ;; Insert the permissions notice if the user has yet to grant
+ ;; Emacs storage permissions.
+ (when (fboundp 'android-before-splash-screen)
+ (funcall 'android-before-splash-screen nil))
;; The convention for this piece of code is that
;; each piece of output starts with one or two newlines
;; and does not end with any newlines.
@@ -2262,12 +2252,6 @@ splash screen in another window."
(insert "\n\nIf an Emacs session crashed recently, "
"type M-x recover-session RET\nto recover"
" the files you were editing.\n"))
-
- ;; Insert the permissions notice if the user has yet to grant
- ;; Emacs storage permissions.
- (when (fboundp 'android-after-splash-screen)
- (funcall 'android-after-splash-screen nil))
-
(use-local-map splash-screen-keymap)
;; Display the input that we set up in the buffer.
@@ -2343,7 +2327,7 @@ To quit a partially entered command, type Control-g.\n")
;; If C-h can't be invoked, temporarily disable its
;; binding, so where-is uses alternative bindings.
(let ((map (make-sparse-keymap)))
- (define-key map [?\C-h] 'undefined)
+ (define-key map [?\C-h] #'undefined)
map))
minor-mode-overriding-map-alist)))
@@ -2535,8 +2519,8 @@ A fancy display is used on graphic displays, normal otherwise."
(fancy-about-screen)
(normal-splash-screen nil)))
-(defalias 'about-emacs 'display-about-screen)
-(defalias 'display-splash-screen 'display-startup-screen)
+(defalias 'about-emacs #'display-about-screen)
+(defalias 'display-splash-screen #'display-startup-screen)
;; This avoids byte-compiler warning in the unexec build.
(declare-function pdumper-stats "pdumper.c" ())
diff --git a/lisp/subr.el b/lisp/subr.el
index d2b8ea17f74..90dbfc75d52 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,7 +1,6 @@
;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2024 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -313,11 +312,20 @@ value of last one, or nil if there are none."
cond '(empty-body unless) t)))
(defsubst subr-primitive-p (object)
- "Return t if OBJECT is a built-in primitive function."
+ "Return t if OBJECT is a built-in primitive written in C.
+Such objects can be functions or special forms."
(declare (side-effect-free error-free))
(and (subrp object)
(not (subr-native-elisp-p object))))
+(defsubst primitive-function-p (object)
+ "Return t if OBJECT is a built-in primitive function.
+This excludes special forms, since they are not functions."
+ (declare (side-effect-free error-free))
+ (and (subrp object)
+ (not (or (subr-native-elisp-p object)
+ (eq (cdr (subr-arity object)) 'unevalled)))))
+
(defsubst xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
@@ -2023,6 +2031,8 @@ instead; it will indirectly limit the specpdl stack size as well.")
(defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation)
+(define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1")
+
;;;; Alternate names for functions - these are not being phased out.
@@ -2579,6 +2589,8 @@ Affects only hooks run in the current buffer."
(list binding binding))
((null (cdr binding))
(list (make-symbol "s") (car binding)))
+ ((eq '_ (car binding))
+ (list (make-symbol "s") (cadr binding)))
(t binding)))
(when (> (length binding) 2)
(signal 'error
@@ -2619,7 +2631,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form
(defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
-are non-nil, then the result is non-nil."
+are non-nil, then the result is the value of the last binding."
(declare (indent 1) (debug if-let*))
(let (res)
(if varlist
@@ -2632,7 +2644,8 @@ are non-nil, then the result is non-nil."
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
-THEN, otherwise the last form in ELSE.
+THEN, otherwise the value of the last form in ELSE, or nil if
+there are none.
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
SYMBOL to the value of VALUEFORM. An element can additionally be
@@ -2737,6 +2750,8 @@ By default we choose the head of the first list."
(defun derived-mode-all-parents (mode &optional known-children)
"Return all the parents of MODE, starting with MODE.
+This includes the parents set by `define-derived-mode' and additional
+ones set by `derived-mode-add-parents'.
The returned list is not fresh, don't modify it.
\n(fn MODE)" ;`known-children' is for internal use only.
;; Can't use `with-memoization' :-(
@@ -2785,7 +2800,9 @@ The returned list is not fresh, don't modify it.
(defun provided-mode-derived-p (mode &optional modes &rest old-modes)
"Non-nil if MODE is derived from a mode that is a member of the list MODES.
MODES can also be a single mode instead of a list.
-If you just want to check `major-mode', use `derived-mode-p'.
+This examines the parent modes set by `define-derived-mode' and also
+additional ones set by `derived-mode-add-parents'.
+If you just want to check the current `major-mode', use `derived-mode-p'.
We also still support the deprecated calling convention:
\(provided-mode-derived-p MODE &rest MODES)."
(declare (side-effect-free t)
@@ -2799,8 +2816,10 @@ We also still support the deprecated calling convention:
(car modes)))
(defun derived-mode-p (&optional modes &rest old-modes)
- "Non-nil if the current major mode is derived from one of MODES.
+ "Return non-nil if the current major mode is derived from one of MODES.
MODES should be a list of symbols or a single mode symbol instead of a list.
+This examines the parent modes set by `define-derived-mode' and also
+additional ones set by `derived-mode-add-parents'.
We also still support the deprecated calling convention:
\(derived-mode-p &rest MODES)."
(declare (side-effect-free t)
@@ -2820,7 +2839,8 @@ We also still support the deprecated calling convention:
(defun derived-mode-add-parents (mode extra-parents)
"Add EXTRA-PARENTS to the parents of MODE.
Declares the parents of MODE to be its main parent (as defined
-in `define-derived-mode') plus EXTRA-PARENTS."
+in `define-derived-mode') plus EXTRA-PARENTS, which should be a list
+of symbols."
(put mode 'derived-mode-extra-parents extra-parents)
(derived-mode--flush mode))
@@ -3095,7 +3115,7 @@ instead."
LIBRARY should be a relative file name of the library, a string.
It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is
nil (which is the default, see below).
-This command searches the directories in `load-path' like `\\[load-library]'
+This command searches the directories in `load-path' like \\[load-library]
to find the file that `\\[load-library] RET LIBRARY RET' would load.
Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
to the specified name LIBRARY.
@@ -3367,14 +3387,27 @@ with Emacs. Do not call it directly in your own packages."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+ (define-key map "\t" #'read-passwd-toggle-visibility)
map)
"Keymap used while reading passwords.")
-(defun read-password--hide-password ()
+(defvar read-passwd--hide-password t)
+
+(defun read-passwd--hide-password ()
+ "Make password in minibuffer hidden or visible."
(let ((beg (minibuffer-prompt-end)))
(dotimes (i (1+ (- (buffer-size) beg)))
- (put-text-property (+ i beg) (+ 1 i beg)
- 'display (string (or read-hide-char ?*))))))
+ (if read-passwd--hide-password
+ (put-text-property
+ (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*)))
+ (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display)))
+ (put-text-property
+ (+ i beg) (+ 1 i beg)
+ 'help-echo "C-u: Clear password\nTAB: Toggle password visibility"))))
+
+;; Actually in textconv.c.
+(defvar overriding-text-conversion-style)
+(declare-function set-text-conversion-style "textconv.c")
(defun read-passwd (prompt &optional confirm default)
"Read a password, prompting with PROMPT, and return it.
@@ -3412,21 +3445,27 @@ by doing (clear-string STRING)."
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
(setq-local inhibit--record-char t)
- (add-hook 'post-command-hook #'read-password--hide-password nil t))
+ (read-passwd-mode 1)
+ (add-hook 'post-command-hook #'read-passwd--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
- (read-hide-char (or read-hide-char ?*)))
+ (read-hide-char (or read-hide-char ?*))
+ (overriding-text-conversion-style 'password))
(read-string prompt nil t default)) ; t = "no history"
(when (buffer-live-p minibuf)
(with-current-buffer minibuf
+ (read-passwd-mode -1)
;; Not sure why but it seems that there might be cases where the
;; minibuffer is not always properly reset later on, so undo
;; whatever we've done here (bug#11392).
(remove-hook 'after-change-functions
- #'read-password--hide-password 'local)
+ #'read-passwd--hide-password 'local)
(kill-local-variable 'post-self-insert-hook)
;; And of course, don't keep the sensitive data around.
- (erase-buffer))))))))
+ (erase-buffer)
+ ;; Then restore the previous text conversion style.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style text-conversion-style)))))))))
(defvar read-number-history nil
"The default history for the `read-number' function.")
@@ -3532,11 +3571,6 @@ causes it to evaluate `help-form' and display the result."
(help-form-show)))
((memq char chars)
(setq done t))
- ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd macro and
- ;; there are no more events in the macro. Attempt to
- ;; get an event interactively.
- (setq executing-kbd-macro nil))
((not inhibit-keyboard-quit)
(cond
((and (null esc-flag) (eq char ?\e))
@@ -3718,10 +3752,10 @@ There is no need to explicitly add `help-char' to CHARS;
(this-command this-command)
(result (minibuffer-with-setup-hook
(lambda ()
+ (setq-local post-self-insert-hook nil)
(add-hook 'post-command-hook
(lambda ()
- ;; FIXME: Should we use `<='?
- (if (= (1+ (minibuffer-prompt-end))
+ (if (<= (1+ (minibuffer-prompt-end))
(point-max))
(exit-minibuffer)))
nil 'local))
@@ -3821,19 +3855,25 @@ confusing to some users.")
(defvar from--tty-menu-p nil
"Non-nil means the current command was invoked from a TTY menu.")
+
+(declare-function android-detect-keyboard "androidfns.c")
+
+(defvar use-dialog-box-override nil
+ "Whether `use-dialog-box-p' should always return t.")
+
(defun use-dialog-box-p ()
"Return non-nil if the current command should prompt the user via a dialog box."
- (and last-input-event ; not during startup
- (or (consp last-nonmenu-event) ; invoked by a mouse event
- (and (null last-nonmenu-event)
- (consp last-input-event))
- (featurep 'android) ; Prefer dialog boxes on Android.
- from--tty-menu-p) ; invoked via TTY menu
- use-dialog-box))
-
-;; Actually in textconv.c.
-(defvar overriding-text-conversion-style)
-(declare-function set-text-conversion-style "textconv.c")
+ (or use-dialog-box-override
+ (and last-input-event ; not during startup
+ (or (consp last-nonmenu-event) ; invoked by a mouse event
+ (and (null last-nonmenu-event)
+ (consp last-input-event))
+ (and (featurep 'android) ; Prefer dialog boxes on
+ ; Android.
+ (not (android-detect-keyboard))) ; If no keyboard is
+ ; connected.
+ from--tty-menu-p) ; invoked via TTY menu
+ use-dialog-box)))
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question.
@@ -4467,8 +4507,7 @@ Otherwise, return nil."
(defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
(declare (side-effect-free error-free))
- (if (and (symbolp object) (fboundp object))
- (setq object (indirect-function object)))
+ (if (symbolp object) (setq object (indirect-function object)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(defun plistp (object)
@@ -4490,7 +4529,8 @@ Otherwise, return nil."
Does not distinguish between functions implemented in machine code
or byte-code."
(declare (side-effect-free error-free))
- (or (subrp object) (byte-code-function-p object)))
+ (or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object)))))
+ (byte-code-function-p object)))
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
@@ -5007,7 +5047,7 @@ read-only, and scans it for function and variable names to make them into
clickable cross-references.
See the related form `with-temp-buffer-window'."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
`(let* ((,old-dir default-directory)
@@ -6727,6 +6767,8 @@ effectively rounded up."
(progress-reporter-update reporter (or current-value min-value))
reporter))
+(defalias 'progress-reporter-make #'make-progress-reporter)
+
(defun progress-reporter-force-update (reporter &optional value new-message suffix)
"Report progress of an operation in the echo area unconditionally.
@@ -7497,6 +7539,28 @@ predicate conditions in CONDITION."
(push buf bufs)))
bufs))
+(defmacro handler-bind (handlers &rest body)
+ "Setup error HANDLERS around execution of BODY.
+HANDLERS is a list of (CONDITIONS HANDLER) where
+CONDITIONS should be a list of condition names (symbols) or
+a single condition name, and HANDLER is a form whose evaluation
+returns a function.
+When an error is signaled during execution of BODY, if that
+error matches CONDITIONS, then the associated HANDLER
+function is called with the error object as argument.
+HANDLERs can either transfer the control via a non-local exit,
+or return normally. If a handler returns normally, the search for an
+error handler continues from where it left off."
+ ;; FIXME: Completion support as in `condition-case'?
+ (declare (indent 1) (debug ((&rest (sexp form)) body)))
+ (let ((args '()))
+ (dolist (cond+handler handlers)
+ (let ((handler (car (cdr cond+handler)))
+ (conds (car cond+handler)))
+ (push `',(ensure-list conds) args)
+ (push handler args)))
+ `(handler-bind-1 (lambda () ,@body) ,@(nreverse args))))
+
(defmacro with-memoization (place &rest code)
"Return the value of CODE and stash it in PLACE.
If PLACE's value is non-nil, then don't bother evaluating CODE
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 219f42848ef..fa22500a04e 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1302,7 +1302,7 @@ tab bar might wrap to the second line when it shouldn't.")
(ws . ,(window-state-get
(frame-root-window (or frame (selected-frame))) 'writable))
(wc . ,(current-window-configuration))
- (wc-point . ,(point-marker))
+ (wc-point . ,(copy-marker (window-point) window-point-insertion-type))
(wc-bl . ,bl)
(wc-bbl . ,bbl)
,@(when tab-bar-history-mode
@@ -1385,6 +1385,63 @@ inherits the current tab's `explicit-name' parameter."
tabs))))
+(defcustom tab-bar-tab-post-select-functions nil
+ "List of functions to call after selecting a tab.
+Two arguments are supplied: the previous tab that was selected before,
+and the newly selected tab."
+ :type '(repeat function)
+ :group 'tab-bar
+ :version "30.1")
+
+(defcustom tab-bar-select-restore-windows #'tab-bar-select-restore-windows
+ "Function called when selecting a tab to handle windows whose buffer was killed.
+When a tab-bar tab displays a window whose buffer was killed since
+this tab was last selected, this function determines what to do with
+that window. By default, either a random buffer is displayed instead of
+the killed buffer, or the window gets deleted. However, with the help
+of `window-restore-killed-buffer-windows' it's possible to handle such
+situations better by displaying an information about the killed buffer."
+ :type '(choice (const :tag "No special handling" nil)
+ (const :tag "Show placeholder buffers"
+ tab-bar-select-restore-windows)
+ (function :tag "Function"))
+ :group 'tab-bar
+ :version "30.1")
+
+(defun tab-bar-select-restore-windows (_frame windows _type)
+ "Display a placeholder buffer in the window whose buffer was killed.
+A button in the window allows to restore the killed buffer,
+if it was visiting a file."
+ (dolist (quad windows)
+ (when (window-live-p (nth 0 quad))
+ (let* ((window (nth 0 quad))
+ (old-buffer (nth 1 quad))
+ (file (when (bufferp old-buffer)
+ (buffer-file-name old-buffer)))
+ (name (or file
+ (and (bufferp old-buffer)
+ (fboundp 'buffer-last-name)
+ (buffer-last-name old-buffer))
+ old-buffer))
+ (new-buffer (generate-new-buffer
+ (format "*Old buffer %s*" name))))
+ (with-current-buffer new-buffer
+ (set-auto-mode)
+ (insert (format-message "This window displayed the %s `%s'.\n"
+ (if file "file" "buffer")
+ name))
+ (when file
+ (insert-button
+ "[Restore]" 'action
+ (lambda (_button)
+ (set-window-buffer window (find-file-noselect file))
+ (set-window-start window (nth 2 quad) t)
+ (set-window-point window (nth 3 quad))))
+ (insert "\n"))
+ (goto-char (point-min))
+ (setq buffer-read-only t)
+ (set-window-buffer window new-buffer))))))
+
(defvar tab-bar-minibuffer-restore-tab nil
"Tab number for `tab-bar-minibuffer-restore-tab'.")
@@ -1430,7 +1487,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
(let* ((from-tab (tab-bar--tab))
(to-tab (nth to-index tabs))
(wc (alist-get 'wc to-tab))
- (ws (alist-get 'ws to-tab)))
+ (ws (alist-get 'ws to-tab))
+ (window-restore-killed-buffer-windows
+ (or tab-bar-select-restore-windows
+ window-restore-killed-buffer-windows)))
;; During the same session, use window-configuration to switch
;; tabs, because window-configurations are more reliable
@@ -1455,13 +1515,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
;; set-window-configuration does not restore the value of
;; point in the current buffer, so restore it separately.
(when (and (markerp wc-point)
- (marker-buffer wc-point)
- ;; FIXME: After dired-revert, marker relocates to 1.
- ;; window-configuration restores point to global point
- ;; in this dired buffer, not to its window point,
- ;; but this is slightly better than 1.
- ;; Maybe better to save dired-filename in each window?
- (not (eq 1 (marker-position wc-point))))
+ (marker-buffer wc-point))
(goto-char wc-point))
(when wc-bl (set-frame-parameter nil 'buffer-list wc-bl))
@@ -1505,7 +1559,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
(tab-bar--current-tab-make (nth to-index tabs)))
(unless tab-bar-mode
- (message "Selected tab '%s'" (alist-get 'name to-tab))))
+ (message "Selected tab '%s'" (alist-get 'name to-tab)))
+
+ (run-hook-with-args 'tab-bar-tab-post-select-functions
+ from-tab to-tab))
(force-mode-line-update))))
diff --git a/lisp/tempo.el b/lisp/tempo.el
index df78690bd31..b7ad680c2a9 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -164,7 +164,7 @@ documentation for the function `tempo-complete-tag' for more info.
"Indicates if the tag collection needs to be rebuilt.")
(defvar-local tempo-marks nil
- "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
+ "A list of marks to jump to with \\[tempo-forward-mark] and \\[tempo-backward-mark].")
(defvar-local tempo-match-finder "\\b\\([[:word:]]+\\)\\="
"The regexp or function used to find the string to match against tags.
@@ -198,6 +198,10 @@ This is an abnormal hook where the functions are called with one argument
(defvar-local tempo-region-start (make-marker)
"Region start when inserting around the region.")
+;; Insertion by the template at the region start position should move
+;; the marker to preserve the original region contents.
+(set-marker-insertion-type tempo-region-start t)
+
(defvar-local tempo-region-stop (make-marker)
"Region stop when inserting around the region.")
@@ -333,7 +337,8 @@ possible."
(`(r> . ,rest) (if on-region
(progn
(goto-char tempo-region-stop)
- (indent-region (mark) (point) nil))
+ (indent-region tempo-region-start
+ tempo-region-stop))
(tempo-insert-prompt-compat rest)))
(`(s ,name) (tempo-insert-named name))
(`(l . ,rest) (dolist (elt rest) (tempo-insert elt on-region)))
@@ -344,7 +349,7 @@ possible."
('r> (if on-region
(progn
(goto-char tempo-region-stop)
- (indent-region (mark) (point) nil))
+ (indent-region tempo-region-start tempo-region-stop))
(tempo-insert-mark (point-marker))))
('> (indent-according-to-mode))
('& (if (not (or (= (current-column) 0)
@@ -577,7 +582,7 @@ TAG-LIST is a symbol whose variable value is a tag list created with
`tempo-add-tag'.
COMPLETION-FUNCTION is an obsolete option for specifying an optional
-function or string that is used by `\\[tempo-complete-tag]' to find a
+function or string that is used by \\[tempo-complete-tag] to find a
string to match the tag against. It has the same definition as the
variable `tempo-match-finder'. In this version, supplying a
COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
diff --git a/lisp/term.el b/lisp/term.el
index 1857c9ed9e3..c15f6cf2e9f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -658,7 +658,8 @@ executed once, when the buffer is created."
["Forward Output Group" term-next-prompt t]
["Kill Current Output Group" term-kill-output t]))
map)
- "Keymap for Term mode.")
+ "Keymap for \"line mode\" in Term mode. For custom keybindings purposes
+please note there is also `term-raw-map'")
(defvar term-escape-char nil
"Escape character for char sub-mode of term mode.
@@ -961,7 +962,9 @@ underlying shell."
(dotimes (key 21)
(keymap-set map (format "<f%d>" key) #'term-send-function-key)))
map)
- "Keyboard map for sending characters directly to the inferior process.")
+ "Keyboard map for sending characters directly to the inferior process.
+For custom keybindings purposes please note there is also
+`term-mode-map'")
(easy-menu-define term-terminal-menu
(list term-mode-map term-raw-map term-pager-break-map)
@@ -1109,7 +1112,7 @@ variable `term-input-autoexpand', and addition is controlled by the
variable `term-input-ignoredups'.
Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer. See variables `term-scroll-to-bottom-on-input',
+the end of the buffer. See variables `term-scroll-snap-to-bottom',
and `term-scroll-to-bottom-on-output'.
If you accidentally suspend your process, use \\[term-continue-subjob]
@@ -1122,6 +1125,10 @@ particular subprocesses. This can be done by setting the hooks
and the variable `term-prompt-regexp' to the appropriate regular
expression.
+If you define custom keybindings, make sure to assign them to the
+correct keymap (or to both): use `term-raw-map' in raw mode and
+`term-mode-map' in line mode.
+
Commands in raw mode:
\\{term-raw-map}
@@ -4342,7 +4349,7 @@ Typing SPC flushes the help buffer."
(display-completion-list (sort completions 'string-lessp)))
(message "Hit space to flush")
(let (key first)
- (if (with-current-buffer (get-buffer "*Completions*")
+ (if (with-current-buffer "*Completions*"
(setq key (read-key-sequence nil)
first (aref key 0))
(and (consp first)
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index 51163e5b9b2..6512ef81ff7 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -282,11 +282,12 @@ If it reflects the motion of an item above a frame, call
`dnd-handle-movement' to move the cursor or scroll the window
under the item pursuant to the pertinent user options.
-If it reflects dropped text, insert such text within window at
-the location of the drop.
+If it holds dropped text, insert such text within window at the
+location of the drop.
-If it reflects a list of URIs, then open each URI, converting
-content:// URIs into the special file names which represent them."
+If it holds a list of URIs, or file names, then open each URI or
+file name, converting content:// URIs into the special file
+names which represent them."
(interactive "e")
(let ((message (caddr event))
(posn (event-start event)))
@@ -304,18 +305,22 @@ content:// URIs into the special file names which represent them."
(new-uri-list nil)
(dnd-unescape-file-uris t))
(dolist (uri uri-list)
- (ignore-errors
- (let ((url (url-generic-parse-url uri)))
- (when (equal (url-type url) "content")
- ;; Replace URI with a matching /content file
- ;; name.
- (setq uri (format "file:/content/by-authority/%s%s"
- (url-host url)
- (url-filename url))
- ;; And guarantee that this file URI is not
- ;; subject to URI decoding, for it must be
- ;; transformed back into a content URI.
- dnd-unescape-file-uris nil))))
+ ;; If the URI is a preprepared file name, insert it directly.
+ (if (string-match-p "^/content/by-authority\\(-named\\)?/" uri)
+ (setq uri (concat "file:" uri)
+ dnd-unescape-file-uris nil)
+ (ignore-errors
+ (let ((url (url-generic-parse-url uri)))
+ (when (equal (url-type url) "content")
+ ;; Replace URI with a matching /content file
+ ;; name.
+ (setq uri (format "file:/content/by-authority/%s%s"
+ (url-host url)
+ (url-filename url))
+ ;; And guarantee that this file URI is not
+ ;; subject to URI decoding, for it must be
+ ;; transformed back into a content URI.
+ dnd-unescape-file-uris nil)))))
(push uri new-uri-list))
(dnd-handle-multiple-urls (posn-window posn)
new-uri-list
@@ -398,7 +403,7 @@ directory /content/storage.
(inhibit-read-only t))
(fill-region (point-min) (point-max))))))))
-(defun android-after-splash-screen (fancy-p)
+(defun android-before-splash-screen (fancy-p)
"Insert a brief notice on the absence of storage permissions.
If storage permissions are as yet denied to Emacs, insert a short
notice to that effect, followed by a button that enables the user
@@ -406,20 +411,20 @@ to grant such permissions.
FANCY-P non-nil means the notice will be displayed with faces, in
the style appropriate for its incorporation within the fancy splash
-screen display; see `francy-splash-insert'."
+screen display; see `fancy-splash-insert'."
(unless (android-external-storage-available-p)
(if fancy-p
(fancy-splash-insert
:face '(variable-pitch
font-lock-function-call-face)
- "\nPermissions necessary to access external storage directories have
-been denied. Click "
+ "Permissions necessary to access external storage directories have"
+ "\nbeen denied. Click "
:link '("here" android-display-storage-permission-popup)
- " to grant them.")
+ " to grant them.\n")
(insert
- "Permissions necessary to access external storage directories have been
-denied. ")
- (insert-button "Click here to grant them."
+ "Permissions necessary to access external storage directories"
+ "\nhave been denied. ")
+ (insert-button "Click here to grant them.\n"
'action #'android-display-storage-permission-popup
'follow-link t)
(newline))))
@@ -480,5 +485,138 @@ the UTF-8 coding system."
(concat locale-base locale-modifier)))
+;; Miscellaneous functions.
+
+(declare-function android-browse-url-internal "androidselect.c")
+
+(defun android-browse-url (url &optional send)
+ "Open URL in an external application.
+
+URL should be a URL-encoded URL with a scheme specified unless
+SEND is non-nil. Signal an error upon failure.
+
+If SEND is nil, start a program that is able to display the URL,
+such as a web browser. Otherwise, try to share URL using
+programs such as email clients.
+
+If URL is a file URI, convert it into a `content' address
+accessible to other programs."
+ (when-let* ((uri (url-generic-parse-url url))
+ (filename (url-filename uri))
+ ;; If `uri' is a file URI and the file resides in /content
+ ;; or /assets, copy it to a temporary file before
+ ;; providing it to other programs.
+ (replacement-url (and (string-match-p
+ "/\\(content\\|assets\\)[/$]"
+ filename)
+ (prog1 t
+ (copy-file
+ filename
+ (setq filename
+ (make-temp-file
+ "local"
+ nil
+ (let ((extension
+ (file-name-extension
+ filename)))
+ (if extension
+ (concat "."
+ extension)
+ nil))))
+ t))
+ (concat "file://" filename))))
+ (setq url replacement-url))
+ (android-browse-url-internal url send))
+
+
+;; Coding systems used by androidvfs.c.
+
+(define-ccl-program android-encode-jni
+ `(2 ((loop
+ (read r0)
+ (if (r0 < #x1) ; 0x0 is encoded specially in JNI environments.
+ ((write #xc0)
+ (write #x80))
+ ((if (r0 < #x80) ; ASCII
+ ((write r0))
+ (if (r0 < #x800) ; \u0080 - \u07ff
+ ((write ((r0 >> 6) | #xC0))
+ (write ((r0 & #x3F) | #x80)))
+ ;; \u0800 - \uFFFF
+ (if (r0 < #x10000)
+ ((write ((r0 >> 12) | #xE0))
+ (write (((r0 >> 6) & #x3F) | #x80))
+ (write ((r0 & #x3F) | #x80)))
+ ;; Supplementary characters must be converted into
+ ;; surrogate pairs before encoding.
+ (;; High surrogate
+ (r1 = ((((r0 - #x10000) >> 10) & #x3ff) + #xD800))
+ ;; Low surrogate.
+ (r2 = (((r0 - #x10000) & #x3ff) + #xDC00))
+ ;; Write both surrogate characters.
+ (write ((r1 >> 12) | #xE0))
+ (write (((r1 >> 6) & #x3F) | #x80))
+ (write ((r1 & #x3F) | #x80))
+ (write ((r2 >> 12) | #xE0))
+ (write (((r2 >> 6) & #x3F) | #x80))
+ (write ((r2 & #x3F) | #x80))))))))
+ (repeat))))
+ "Encode characters from the input buffer for Java virtual machines.")
+
+(define-ccl-program android-decode-jni
+ `(1 ((loop
+ ((read-if (r0 >= #x80) ; More than a one-byte sequence?
+ ((if (r0 < #xe0)
+ ;; Two-byte sequence; potentially a NULL
+ ;; character.
+ ((read r4)
+ (r4 &= #x3f)
+ (r0 = (((r0 & #x1f) << 6) | r4)))
+ (if (r0 < ?\xF0)
+ ;; Three-byte sequence, after which surrogate
+ ;; pairs should be processed.
+ ((read r4 r6)
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3f)
+ (r0 = ((((r0 & #xf) << 12) | r4) | r6)))
+ ;; Four-byte sequences are not valid under the
+ ;; JVM specification, but Android produces them
+ ;; when encoding Emoji characters for being
+ ;; supposedly less of a surprise to applications.
+ ;; This is obviously not true of programs written
+ ;; to the letter of the documentation, but 50
+ ;; million Frenchmen make a right (and this
+ ;; deviation from the norm is predictably absent
+ ;; from Android's documentation on the subject).
+ ((read r1 r4 r6)
+ (r1 = ((r1 & #x3f) << 12))
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3F)
+ (r0 = (((((r0 & #x07) << 18) | r1) | r4) | r6))))))))
+ (if ((r0 & #xf800) == #xd800)
+ ;; High surrogate.
+ ((read-if (r2 >= #xe0)
+ ((r0 = ((r0 & #x3ff) << 10))
+ (read r4 r6)
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3f)
+ (r1 = ((((r2 & #xf) << 12) | r4) | r6))
+ (r0 = (((r1 & #x3ff) | r0) + #xffff))))))
+ (write r0)
+ (repeat))))
+ "Decode JVM-encoded characters in the input buffer.")
+
+(define-coding-system 'android-jni
+ "CESU-8 based encoding for communication with the Android runtime."
+ :mnemonic ?J
+ :coding-type 'ccl
+ :eol-type 'unix
+ :ascii-compatible-p nil ; for \0 is encoded as a two-byte sequence.
+ :default-char ?\0
+ :charset-list '(unicode)
+ :ccl-decoder 'android-decode-jni
+ :ccl-encoder 'android-encode-jni)
+
+
(provide 'android-win)
;; android-win.el ends here.
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 02ad6b85c37..92d65c75816 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -47,7 +47,7 @@
;; This was copied from etc/rgb.txt, except that some values were changed
;; a bit to make them consistent with DOS console colors, and the RGB
-;; values were scaled up to 16 bits, as `tty-define-color' requires.
+;; values were scaled up to 16 bits, as `tty-color-define' requires.
;;;
;; The mapping between the 16 standard EGA/VGA colors and X color names
;; was done by running a Unix version of Emacs inside an X client and a
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index a8e2f03bd70..a6da34d6a41 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1012,7 +1012,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("volumes" "Total number of volumes of a multi-volume work")
("year" "Year of publication"))
"Alist of biblatex fields.
-It has the same format as `bibtex-BibTeX-entry-alist'."
+It has the same format as `bibtex-BibTeX-field-alist'."
:group 'bibtex
:version "28.1"
:type 'bibtex-field-alist)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 425f3ec8a30..f5a20e0ca0e 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1830,6 +1830,8 @@ can also be used to fill comments.
(add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode))))
+(derived-mode-add-parents 'css-ts-mode '(css-mode))
+
;;;###autoload
(define-derived-mode css-mode css-base-mode "CSS"
"Major mode to edit Cascading Style Sheets (CSS).
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index de59294e9f0..09d4e8a8d1a 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -288,6 +288,15 @@ If this variable is nil, all regions are treated as small."
"The key binding for flyspell auto correction."
:type 'key-sequence)
+(defcustom flyspell-check-changes nil
+ "If non-nil, spell-check only words that were edited.
+By default, this is nil, and Flyspell checks every word across which
+you move point, even if you haven't edited the word. Customizing this
+option to a non-nil value will not flag mis-spelled words across which
+you move point without editing them."
+ :type 'boolean
+ :version "30.1")
+
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
;;* ------------------------------------------------------------- */
@@ -610,7 +619,9 @@ are both non-nil."
(flyspell-accept-buffer-local-defs 'force)
(flyspell-delay-commands)
(flyspell-deplacement-commands)
- (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
+ (if flyspell-check-changes
+ (add-hook 'post-command-hook (function flyspell-check-changes) t t)
+ (add-hook 'post-command-hook (function flyspell-post-command-hook) t t))
(add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
(add-hook 'after-change-functions 'flyspell-after-change-function nil t)
(add-hook 'hack-local-variables-hook
@@ -709,6 +720,7 @@ has been used, the current word is not checked."
;;;###autoload
(defun flyspell--mode-off ()
"Turn Flyspell mode off."
+ (remove-hook 'post-command-hook (function flyspell-check-changes) t)
(remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
(remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
(remove-hook 'after-change-functions 'flyspell-after-change-function t)
@@ -990,6 +1002,23 @@ Mostly we check word delimiters."
(setq flyspell-changes (cdr flyspell-changes))))
(setq flyspell-previous-command command)))))
+(defun flyspell-check-changes ()
+ "Function to spell-check only edited words when point moves off the word.
+This is installed by flyspell as `post-command-hook' when the user
+option `flyspell-check-changes' is non-nil. It spell-checks a word
+on moving point from the word only if the word was edited before the move."
+ (when flyspell-mode
+ (with-local-quit
+ (when (consp flyspell-changes)
+ (let ((start (car (car flyspell-changes)))
+ (stop (cdr (car flyspell-changes)))
+ (word (save-excursion (flyspell-get-word))))
+ (unless (and word (<= (nth 1 word) start) (>= (nth 2 word) stop))
+ (save-excursion
+ (goto-char start)
+ (flyspell-word))
+ (setq flyspell-changes nil)))))))
+
;;*---------------------------------------------------------------------*/
;;* flyspell-notify-misspell ... */
;;*---------------------------------------------------------------------*/
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 301f3e8791c..235e1055fa9 100644
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -121,8 +121,21 @@ Return nil if there is no name or if NODE is not a defun node."
;; Imenu.
(setq-local treesit-simple-imenu-settings
'(("Element" "\\`tag_name\\'" nil nil)))
+
+ ;; Outline minor mode.
+ (setq-local treesit-outline-predicate "\\`element\\'")
+ ;; `html-ts-mode' inherits from `html-mode' that sets
+ ;; regexp-based outline variables. So need to restore
+ ;; the default values of outline variables to be able
+ ;; to use `treesit-outline-predicate' above.
+ (kill-local-variable 'outline-regexp)
+ (kill-local-variable 'outline-heading-end-regexp)
+ (kill-local-variable 'outline-level)
+
(treesit-major-mode-setup))
+(derived-mode-add-parents 'html-ts-mode '(html-mode))
+
(if (treesit-ready-p 'html)
(add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode)))
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index e8621ee0383..a5de354fc0a 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -159,21 +159,23 @@ point, respectively."
total before after)))
(defun page--what-page ()
- "Return a list of the page and line number of point."
+ "Return a list of the page and line number of point.
+The line number is relative to the start of the page."
(save-restriction
(widen)
(save-excursion
(let ((count 1)
+ (adjust (if (or (bolp) (looking-back page-delimiter nil)) 1 0))
(opoint (point)))
(goto-char (point-min))
(while (re-search-forward page-delimiter opoint t)
(when (= (match-beginning 0) (match-end 0))
(forward-char))
(setq count (1+ count)))
- (list count (line-number-at-pos opoint))))))
+ (list count (+ adjust (count-lines (point) opoint)))))))
(defun what-page ()
- "Print page and line number of point."
+ "Display the page number, and the line number within that page."
(interactive)
(apply #'message (cons "Page %d, line %d" (page--what-page))))
diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el
index 25c0b46cee9..d26eaec2111 100644
--- a/lisp/textmodes/pixel-fill.el
+++ b/lisp/textmodes/pixel-fill.el
@@ -73,39 +73,41 @@ lines that are visually wider than PIXEL-WIDTH.
If START isn't at the start of a line, the horizontal position of
START, converted to pixel units, will be used as the indentation
prefix on subsequent lines."
- (save-excursion
- (goto-char start)
- (let ((indentation
- (car (window-text-pixel-size nil (line-beginning-position)
- (point))))
- (newline-end nil))
- (when (> indentation pixel-width)
- (error "The indentation (%s) is wider than the fill width (%s)"
- indentation pixel-width))
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-max))
- (when (looking-back "\n[ \t]*" (point-min))
- (setq newline-end t))
- (goto-char (point-min))
- ;; First replace all whitespace with space.
- (while (re-search-forward "[ \t\n]+" nil t)
- (cond
- ((or (= (match-beginning 0) start)
- (= (match-end 0) end))
- (delete-region (match-beginning 0) (match-end 0)))
- ;; If there's just a single space here, don't replace.
- ((not (and (= (- (match-end 0) (match-beginning 0)) 1)
- (= (char-after (match-beginning 0)) ?\s)))
- (replace-match
- ;; We need to use a space that has an appropriate width.
- (propertize " " 'face
- (get-text-property (match-beginning 0) 'face))))))
- (goto-char start)
- (pixel-fill--fill-line pixel-width indentation)
- (goto-char (point-max))
- (when newline-end
- (insert "\n"))))))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (save-excursion
+ (goto-char start)
+ (let ((indentation
+ (car (window-text-pixel-size nil (line-beginning-position)
+ (point))))
+ (newline-end nil))
+ (when (> indentation pixel-width)
+ (error "The indentation (%s) is wider than the fill width (%s)"
+ indentation pixel-width))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-max))
+ (when (looking-back "\n[ \t]*" (point-min))
+ (setq newline-end t))
+ (goto-char (point-min))
+ ;; First replace all whitespace with space.
+ (while (re-search-forward "[ \t\n]+" nil t)
+ (cond
+ ((or (= (match-beginning 0) start)
+ (= (match-end 0) end))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; If there's just a single space here, don't replace.
+ ((not (and (= (- (match-end 0) (match-beginning 0)) 1)
+ (= (char-after (match-beginning 0)) ?\s)))
+ (replace-match
+ ;; We need to use a space that has an appropriate width.
+ (propertize " " 'face
+ (get-text-property (match-beginning 0) 'face))))))
+ (goto-char start)
+ (pixel-fill--fill-line pixel-width indentation)
+ (goto-char (point-max))
+ (when newline-end
+ (insert "\n")))))))
(defun pixel-fill--goto-pixel (width)
(vertical-motion (cons (/ width (frame-char-width)) 0)))
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index bb6b6ebda0f..63789e887e2 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -106,10 +106,10 @@ This is used to optimize refilling.")
;; FIXME: forward-paragraph seems to disregard `use-hard-newlines',
;; leading to excessive refilling and wrong choice of fill-prefix.
;; might be a bug in my paragraphs.el.
- (forward-paragraph)
+ (fill-forward-paragraph 1)
(skip-syntax-backward "-")
(let ((end (point))
- (beg (progn (backward-paragraph) (point)))
+ (beg (progn (fill-forward-paragraph -1) (point)))
(obeg (overlay-start refill-ignorable-overlay))
(oend (overlay-end refill-ignorable-overlay)))
(unless (> beg pos) ;Don't fill if point is outside the paragraph.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index a0bc5c11ece..791b10412c9 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience aliases.")
"ConTeXt bib module"
((?\C-m . "\\cite[%l]")
(?s . "\\cite[][%l]")
- (?n . "\\nocite[%l]")))
- )
+ (?n . "\\nocite[%l]"))))
"Builtin versions of the citation format.
The following conventions are valid for all alist entries:
-`?\C-m' should always point to a straight \\cite{%l} macro.
+`?\\C-m' should always point to a straight \\cite{%l} macro.
`?t' should point to a textual citation (citation as a noun).
`?p' should point to a parenthetical citation.")
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 2cd78943883..5fbff4ba888 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1147,14 +1147,14 @@ as well but give an additional message."
(unless (fboundp forwarder-function)
(defalias forwarder-function
(lambda ()
+ (:documentation
+ (format "Deprecated binding for %s, use \\[%s] instead."
+ def def))
(interactive)
(call-interactively def)
(message "[Deprecated use of key %s; use key %s instead]"
(key-description (this-command-keys))
- (key-description key)))
- ;; FIXME: In Emacs-25 we could use (:documentation ...) instead.
- (format "Deprecated binding for %s, use \\[%s] instead."
- def def)))
+ (key-description key)))))
(dolist (dep-key deprecated)
(define-key keymap dep-key forwarder-function)))))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 8968d8ec23b..02ee1242c72 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -511,17 +511,26 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; This would allow highlighting \newcommand\CMD but requires
;; adapting subgroup numbers below.
;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
- (inbraces-re (lambda (re)
- (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)")))
- (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)")))
- `( ;; Highlight $$math$$ and $math$.
+ (inbraces-re
+ (lambda (n) ;; Level of nesting of braces we should support.
+ (let ((re "[^}]"))
+ (dotimes (_ n)
+ (setq re
+ (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)")))
+ re)))
+ (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)")))
+ `(;; Verbatim-like args.
+ ;; Do it first, because we don't want to highlight them
+ ;; in comments (bug#68827), but we do want to highlight them
+ ;; in $math$.
+ (,(concat slash verbish opt arg) 3 'tex-verbatim keep)
+ ;; Highlight $$math$$ and $math$.
;; This is done at the very beginning so as to interact with the other
;; keywords in the same way as comments and strings.
(,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{"
- (funcall inbraces-re
- (concat "{" (funcall inbraces-re "{[^}]*}") "*}"))
+ (funcall inbraces-re 6)
"*}\\)+\\$?\\$")
- (0 'tex-math))
+ (0 'tex-math keep))
;; Heading args.
(,(concat slash headings "\\*?" opt arg)
;; If ARG ends up matching too much (if the {} don't match, e.g.)
@@ -543,8 +552,6 @@ An alternative value is \" . \", if you use a font with a narrow period."
(,(concat slash variables " *" arg) 2 font-lock-variable-name-face)
;; Include args.
(,(concat slash includes opt arg) 3 font-lock-builtin-face)
- ;; Verbatim-like args.
- (,(concat slash verbish opt arg) 3 'tex-verbatim t)
;; Definitions. I think.
("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
1 font-lock-function-name-face))))
@@ -602,14 +609,14 @@ An alternative value is \" . \", if you use a font with a narrow period."
(list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "Ā«") t)
"\\(\\(.\\|\n\\)+?\\)"
(regexp-opt `("''" "\">" "\"'" ">>" "Ā»") t))
- '(1 font-lock-keyword-face)
- '(2 font-lock-string-face)
- '(4 font-lock-keyword-face))
+ '(1 'font-lock-keyword-face)
+ '(2 'font-lock-string-face)
+ '(4 'font-lock-keyword-face))
;;
;; Command names, special and general.
(cons (concat slash specials-1) 'font-lock-warning-face)
(list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)")
- 1 'font-lock-warning-face)
+ '(1 'font-lock-warning-face))
(concat slash general)
;;
;; Font environments. It seems a bit dubious to use `bold' etc. faces
@@ -677,7 +684,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(eval-when-compile
(defconst tex-syntax-propertize-rules
(syntax-propertize-precompile-rules
- ("\\\\verb\\**\\([^a-z@*]\\)"
+ ("\\\\verb\\**\\([^a-z@*]\\)"
(1 (prog1 "\""
(tex-font-lock-verb
(match-beginning 0) (char-after (match-beginning 1))))))))
@@ -761,7 +768,7 @@ automatically inserts its partner."
(regexp-quote (buffer-substring arg-start arg-end)))
(text-clone-create arg-start arg-end))))))))
(scan-error nil)
- (error (message "Error in latex-env-before-change: %s" err)))))
+ (error (message "Error in latex-env-before-change: %S" err)))))
(defun tex-font-lock-unfontify-region (beg end)
(font-lock-default-unfontify-region beg end)
@@ -849,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter char."
(let ((char (nth 3 state)))
(cond
((not char)
- (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face))
+ (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face))
((eq char ?$) 'tex-math)
;; A \verb element.
(t 'tex-verbatim))))
@@ -1029,14 +1036,20 @@ says which mode to use."
;; `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))))))
+ (major-mode-remap mode))))))
-;; The following three autoloaded aliases appear to conflict with
-;; AUCTeX. We keep those confusing aliases for those users who may
-;; have files annotated with -*- LaTeX -*- (e.g. because they received
+;; Support 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 (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode))
+;;;###autoload (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode))
+;;;###autoload (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode))
+
+;; FIXME: These aliases conflict with AUCTeX, but we still need them
+;; because of packages out there which call these functions directly.
+;; They should be patched to use `major-mode-remap'.
+;; It would be nice to mark them obsolete somehow to encourage using
+;; something else, but the obsolete declaration would become invalid
+;; and confusing when AUCTeX *is* installed.
;;;###autoload (defalias 'TeX-mode #'tex-mode)
;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode)
;;;###autoload (defalias 'LaTeX-mode #'latex-mode)
@@ -1262,8 +1275,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(setq-local facemenu-end-add-face "}")
(setq-local facemenu-remove-face-function t)
(setq-local font-lock-defaults
- '((tex-font-lock-keywords tex-font-lock-keywords-1
- tex-font-lock-keywords-2 tex-font-lock-keywords-3)
+ '(( tex-font-lock-keywords tex-font-lock-keywords-1
+ tex-font-lock-keywords-2 tex-font-lock-keywords-3)
nil nil nil nil
;; Who ever uses that anyway ???
(font-lock-mark-block-function . mark-paragraph)
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 7d3b47a9c03..e8e1f4898ce 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -75,17 +75,25 @@
Many other modes, such as `mail-mode' and `outline-mode', inherit
all the commands defined in this map.")
-(defcustom text-mode-meta-tab-ispell-complete-word nil
- "Whether M-TAB invokes `ispell-complete-word' in Text mode.
+(defcustom text-mode-ispell-word-completion 'completion-at-point
+ "How Text mode provides Ispell word completion.
+
+By default, this option is set to `completion-at-point', which
+means that Text mode adds an Ispell word completion function to
+`completion-at-point-functions'. Any other non-nil value says to
+bind M-TAB directly to `ispell-complete-word' instead. If this
+is nil, Text mode neither binds M-TAB to `ispell-complete-word'
+nor does it extend `completion-at-point-functions'.
This user option only takes effect when you customize it in
Custom or with `setopt', not with `setq'."
:group 'text
- :type 'boolean
+ :type '(choice (const completion-at-point) boolean)
:version "30.1"
:set (lambda (sym val)
- (if (set sym val)
- (keymap-set text-mode-map "C-M-i" #'ispell-complete-word)
+ (if (and (set sym val)
+ (not (eq val 'completion-at-point)))
+ (keymap-set text-mode-map "C-M-i" #'ispell-complete-word)
(keymap-unset text-mode-map "C-M-i" t))))
(easy-menu-define text-mode-menu text-mode-map
@@ -144,7 +152,8 @@ Turning on Text mode runs the normal hook `text-mode-hook'."
;; Enable text conversion in this buffer.
(setq-local text-conversion-style t)
(add-hook 'context-menu-functions 'text-mode-context-menu 10 t)
- (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t))
+ (when (eq text-mode-ispell-word-completion 'completion-at-point)
+ (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t)))
(define-derived-mode paragraph-indent-text-mode text-mode "Parindent"
"Major mode for editing text, with leading spaces starting a paragraph.
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index 1ba410045f5..1b621032f8a 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -153,6 +153,8 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'toml-ts-mode '(toml-mode))
+
(if (treesit-ready-p 'toml)
(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)))
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el
index 2b57b384300..210835585fe 100644
--- a/lisp/textmodes/yaml-ts-mode.el
+++ b/lisp/textmodes/yaml-ts-mode.el
@@ -30,6 +30,9 @@
(require 'treesit)
(declare-function treesit-parser-create "treesit.c")
+(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-end "treesit.c")
+(declare-function treesit-node-type "treesit.c")
(defvar yaml-ts-mode--syntax-table
(let ((table (make-syntax-table)))
@@ -117,6 +120,27 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `yaml-ts-mode'.")
+(defun yaml-ts-mode--fill-paragraph (&optional justify)
+ "Fill paragraph.
+Behaves like `fill-paragraph', but respects block node
+boundaries. JUSTIFY is passed to `fill-paragraph'."
+ (interactive "*P")
+ (save-restriction
+ (widen)
+ (let ((node (treesit-node-at (point))))
+ (if (member (treesit-node-type node) '("block_scalar" "comment"))
+ (let* ((start (treesit-node-start node))
+ (end (treesit-node-end node))
+ (start-marker (point-marker))
+ (fill-paragraph-function nil))
+ (save-excursion
+ (goto-char start)
+ (forward-line)
+ (move-marker start-marker (point))
+ (narrow-to-region (point) end))
+ (fill-region start-marker end justify))
+ t))))
+
;;;###autoload
(define-derived-mode yaml-ts-mode text-mode "YAML"
"Major mode for editing YAML, powered by tree-sitter."
@@ -141,8 +165,12 @@
(constant escape-sequence number property)
(bracket delimiter error misc-punctuation)))
+ (setq-local fill-paragraph-function #'yaml-ts-mode--fill-paragraph)
+
(treesit-major-mode-setup)))
+(derived-mode-add-parents 'yaml-ts-mode '(yaml-mode))
+
(if (treesit-ready-p 'yaml)
(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 323d3d1cf6c..7896ad984df 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -619,36 +619,20 @@ point.
Optional argument DISTANCE limits search for REGEXP forward and
back from point."
- (save-excursion
- (let ((old-point (point))
- (forward-bound (and distance (+ (point) distance)))
- (backward-bound (and distance (- (point) distance)))
- match prev-pos new-pos)
- (and (looking-at regexp)
- (>= (match-end 0) old-point)
- (setq match (point)))
- ;; Search back repeatedly from end of next match.
- ;; This may fail if next match ends before this match does.
- (re-search-forward regexp forward-bound 'limit)
- (setq prev-pos (point))
- (while (and (setq new-pos (re-search-backward regexp backward-bound t))
- ;; Avoid inflooping with some regexps, such as "^",
- ;; matching which never moves point.
- (< new-pos prev-pos)
- (or (> (match-beginning 0) old-point)
- (and (looking-at regexp) ; Extend match-end past search start
- (>= (match-end 0) old-point)
- (setq match (point))))))
- (if (not match) nil
- (goto-char match)
- ;; Back up a char at a time in case search skipped
- ;; intermediate match straddling search start pos.
- (while (and (not (bobp))
- (progn (backward-char 1) (looking-at regexp))
- (>= (match-end 0) old-point)
- (setq match (point))))
- (goto-char match)
- (looking-at regexp)))))
+ (let* ((old (point))
+ (beg (if distance (max (point-min) (- old distance)) (point-min)))
+ (end (if distance (min (point-max) (+ old distance))))
+ prev match)
+ (save-excursion
+ (goto-char beg)
+ (while (and (setq prev (point)
+ match (re-search-forward regexp end t))
+ (< (match-end 0) old))
+ (goto-char (match-beginning 0))
+ ;; Avoid inflooping when `regexp' matches the empty string.
+ (unless (< prev (point)) (forward-char))))
+ (and match (<= (match-beginning 0) old (match-end 0)))))
+
;; Email addresses
(defvar thing-at-point-email-regexp
@@ -751,20 +735,33 @@ Signal an error if the entire string was not used."
(let ((thing (thing-at-point 'symbol)))
(if thing (intern thing))))
+(defvar thing-at-point-decimal-regexp
+ "-?[0-9]+\\.?[0-9]*"
+ "A regexp matching a decimal number.")
+
+(defvar thing-at-point-hexadecimal-regexp
+ "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)"
+ "A regexp matchin a hexadecimal number.")
+
;;;###autoload
(defun number-at-point ()
"Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
(cond
- ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500)
+ ((thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500)
(string-to-number
(buffer-substring (match-beginning 2) (match-end 2))
16))
- ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500)
+ ((thing-at-point-looking-at thing-at-point-decimal-regexp 500)
(string-to-number
(buffer-substring (match-beginning 0) (match-end 0))))))
+(put 'number 'bounds-of-thing-at-point
+ (lambda ()
+ (and (or (thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500)
+ (thing-at-point-looking-at thing-at-point-decimal-regexp 500))
+ (cons (match-beginning 0) (match-end 0)))))
(put 'number 'forward-op 'forward-word)
(put 'number 'thing-at-point 'number-at-point)
diff --git a/lisp/time.el b/lisp/time.el
index e561f36398c..a8d3ab9c813 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -589,7 +589,7 @@ See `world-clock'."
(defun world-clock ()
"Display a world clock buffer with times in various time zones.
The variable `world-clock-list' specifies which time zones to use.
-To turn off the world time display, go to the window and type `\\[quit-window]'."
+To turn off the world time display, go to the window and type \\[quit-window]."
(interactive)
(if-let ((buffer (get-buffer world-clock-buffer-name)))
(pop-to-buffer buffer)
@@ -611,7 +611,7 @@ To turn off the world time display, go to the window and type `\\[quit-window]'.
(defun world-clock-update (&optional _arg _noconfirm)
"Update the `world-clock' buffer."
(if (get-buffer world-clock-buffer-name)
- (with-current-buffer (get-buffer world-clock-buffer-name)
+ (with-current-buffer world-clock-buffer-name
(let ((op (point)))
(world-clock-display (time--display-world-list))
(goto-char op)))
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 4ca81fb01e0..96b61c7b229 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -165,6 +165,8 @@ color capability and based on the available image libraries."
base-keymap)
base-keymap)))
+;; This function should return binds even if images can not be
+;; displayed so the tool bar can still be displayed on terminals.
(defun tool-bar-make-keymap-1 (&optional map)
"Generate an actual keymap from `tool-bar-map', without caching.
MAP is either a keymap to use as a source for menu items, or nil,
@@ -180,15 +182,14 @@ in which case the value of `tool-bar-map' is used instead."
(consp image-exp)
(not (eq (car image-exp) 'image))
(fboundp (car image-exp)))
- (if (not (display-images-p))
- (setq bind nil)
- (let ((image (eval image-exp)))
- (unless (and image (image-mask-p image))
- (setq image (append image '(:mask heuristic))))
- (setq bind (copy-sequence bind)
- plist (nthcdr (if (consp (nth 4 bind)) 5 4)
- bind))
- (plist-put plist :image image))))
+ (let ((image (and (display-images-p)
+ (eval image-exp))))
+ (unless (and image (image-mask-p image))
+ (setq image (append image '(:mask heuristic))))
+ (setq bind (copy-sequence bind)
+ plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (plist-put plist :image image)))
bind))
(or map tool-bar-map)))
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index c2f8f8068d7..c8de1d8ee31 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar function.")
(defgroup touch-screen nil
"Interact with Emacs from touch screen devices."
:group 'mouse
- :version "30.0")
+ :version "30.1")
(defcustom touch-screen-display-keyboard nil
"If non-nil, always display the on screen keyboard.
@@ -1027,7 +1027,7 @@ POINT was initially placed upon, and pixel deltas describing how
much point has moved relative to its previous position in the X
and Y axes.
-If the fourth element of `touchscreen-current-tool' is `scroll',
+If the fourth element of `touch-screen-current-tool' is `scroll',
then generate a `touchscreen-scroll' event with the window that
POINT was initially placed upon, and pixel deltas describing how
much point has moved relative to its previous position in the X
diff --git a/lisp/transient.el b/lisp/transient.el
index f9060f5ba85..c3b9448e2c4 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -5,7 +5,7 @@
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; URL: https://github.com/magit/transient
;; Keywords: extensions
-;; Version: 0.5.2
+;; Version: 0.6.0
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -93,17 +93,20 @@ enclosed in a `progn' form. ELSE-FORMS may be empty."
then-form
(cons 'progn else-forms)))
-(defmacro transient--with-emergency-exit (&rest body)
+(defmacro transient--with-emergency-exit (id &rest body)
(declare (indent defun))
+ (unless (keywordp id)
+ (setq body (cons id body))
+ (setq id nil))
`(condition-case err
(let ((debugger #'transient--exit-and-debug))
,(macroexp-progn body))
((debug error)
- (transient--emergency-exit)
+ (transient--emergency-exit ,id)
(signal (car err) (cdr err)))))
(defun transient--exit-and-debug (&rest args)
- (transient--emergency-exit)
+ (transient--emergency-exit :debugger)
(apply #'debug args))
;;; Options
@@ -668,6 +671,7 @@ If `transient-save-history' is nil, then do nothing."
(incompatible :initarg :incompatible :initform nil)
(suffix-description :initarg :suffix-description)
(variable-pitch :initarg :variable-pitch :initform nil)
+ (column-widths :initarg :column-widths :initform nil)
(unwind-suffix :documentation "Internal use." :initform nil))
"Transient prefix command.
@@ -725,7 +729,8 @@ slot is non-nil."
:abstract t)
(defclass transient-suffix (transient-child)
- ((key :initarg :key)
+ ((definition :allocation :class :initform nil)
+ (key :initarg :key)
(command :initarg :command)
(transient :initarg :transient)
(format :initarg :format :initform " %k %d")
@@ -855,7 +860,6 @@ elements themselves.")
;;; Define
-;;;###autoload
(defmacro transient-define-prefix (name arglist &rest args)
"Define NAME as a transient prefix command.
@@ -947,7 +951,10 @@ ARGLIST. The infix arguments are usually accessed by using
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
(transient--expand-define-args args arglist)))
`(progn
- (defalias ',name (lambda ,arglist ,@body))
+ (defalias ',name
+ ,(if (and (not body) class (oref-default class definition))
+ `(oref-default ',class definition)
+ `(lambda ,arglist ,@body)))
(put ',name 'interactive-only t)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
@@ -998,7 +1005,7 @@ keyword.
`(progn
(defalias ',name #'transient--default-infix-command)
(put ',name 'interactive-only t)
- (put ',name 'command-modes (list 'not-a-mode))
+ (put ',name 'completion-predicate #'transient--suffix-only)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
(,(or class 'transient-switch) :command ',name ,@slots)))))
@@ -1014,21 +1021,39 @@ example, sets a variable, use `transient-define-infix' instead.
(defun transient--default-infix-command ()
;; Most infix commands are but an alias for this command.
- "Cannot show any documentation for this anonymous infix command.
+ "Cannot show any documentation for this transient infix command.
+
+When you request help for an infix command using `transient-help', that
+usually shows the respective man-page and tries to jump to the location
+where the respective argument is being described.
+
+If no man-page is specified for the containing transient menu, then the
+docstring is displayed instead, if any.
-This infix command was defined anonymously, i.e., it was define
-inside a call to `transient-define-prefix'.
+If the infix command doesn't have a docstring, as is the case here, then
+this docstring is displayed instead, because technically infix commands
+are aliases for `transient--default-infix-command'.
-When you request help for such an infix command, then we usually
-show the respective man-page and jump to the location where the
-respective argument is being described. This isn't possible in
-this case, because the `man-page' slot was not set in this case."
+`describe-function' also shows the docstring of the infix command,
+falling back to that of the same aliased command."
(interactive)
(let ((obj (transient-suffix-object)))
(transient-infix-set obj (transient-infix-read obj)))
(transient--show))
(put 'transient--default-infix-command 'interactive-only t)
-(put 'transient--default-infix-command 'command-modes (list 'not-a-mode))
+(put 'transient--default-infix-command 'completion-predicate
+ #'transient--suffix-only)
+
+(defun transient--find-function-advised-original (fn func)
+ "Return nil instead of `transient--default-infix-command'.
+When using `find-function' to jump to the definition of a transient
+infix command/argument, then we want to actually jump to that, not to
+the definition of `transient--default-infix-command', which all infix
+commands are aliases for."
+ (let ((val (funcall fn func)))
+ (and val (not (eq val 'transient--default-infix-command)) val)))
+(advice-add 'find-function-advised-original :around
+ #'transient--find-function-advised-original)
(eval-and-compile
(defun transient--expand-define-args (args &optional arglist)
@@ -1057,7 +1082,8 @@ this case, because the `man-page' slot was not set in this case."
args))))
(defun transient--parse-child (prefix spec)
- (cl-etypecase spec
+ (cl-typecase spec
+ (null (error "Invalid transient--parse-child spec: %s" spec))
(symbol (let ((value (symbol-value spec)))
(if (and (listp value)
(or (listp (car value))
@@ -1066,7 +1092,8 @@ this case, because the `man-page' slot was not set in this case."
(transient--parse-child prefix value))))
(vector (and-let* ((c (transient--parse-group prefix spec))) (list c)))
(list (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
- (string (list spec))))
+ (string (list spec))
+ (t (error "Invalid transient--parse-child spec: %s" spec))))
(defun transient--parse-group (prefix spec)
(setq spec (append spec nil))
@@ -1087,12 +1114,16 @@ this case, because the `man-page' slot was not set in this case."
(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 (or spec class (not (plist-get args :setup-children)))
+ (message "WARNING: %s: When %s is used, %s must also be specified"
+ 'transient-define-prefix :setup-children :class))
(list 'vector
(or level transient--default-child-level)
- (or class
- (if (vectorp car)
- (quote 'transient-columns)
- (quote 'transient-column)))
+ (cond (class)
+ ((or (vectorp car)
+ (and car (symbolp car)))
+ (quote 'transient-columns))
+ ((quote 'transient-column)))
(and args (cons 'list args))
(cons 'list
(cl-mapcan (lambda (s) (transient--parse-child prefix s))
@@ -1131,14 +1162,15 @@ this case, because the `man-page' slot was not set in this case."
(format "transient:%s:%s"
prefix
(let ((desc (plist-get args :description)))
- (if (and desc (or (stringp desc) (symbolp desc)))
+ (if (and (stringp desc)
+ (length< desc 16))
desc
(plist-get args :key)))))))
(setq args (plist-put
args :command
`(prog1 ',sym
(put ',sym 'interactive-only t)
- (put ',sym 'command-modes (list 'not-a-mode))
+ (put ',sym 'completion-predicate #'transient--suffix-only)
(defalias ',sym
,(if (eq (car-safe cmd) 'lambda)
cmd
@@ -1161,7 +1193,7 @@ this case, because the `man-page' slot was not set in this case."
args :command
`(prog1 ',sym
(put ',sym 'interactive-only t)
- (put ',sym 'command-modes (list 'not-a-mode))
+ (put ',sym 'completion-predicate #'transient--suffix-only)
(defalias ',sym #'transient--default-infix-command))))
(cond ((and car (not (keywordp car)))
(setq class 'transient-option)
@@ -1199,13 +1231,34 @@ this case, because the `man-page' slot was not set in this case."
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
(match-string 1 arg))))
+(defun transient-command-completion-not-suffix-only-p (symbol _buffer)
+ "Say whether SYMBOL should be offered as a completion.
+If the value of SYMBOL's `completion-predicate' property is
+`transient--suffix-only', then return nil, otherwise return t.
+This is the case when a command should only ever be used as a
+suffix of a transient prefix command (as opposed to bindings
+in regular keymaps or by using `execute-extended-command')."
+ (not (eq (get symbol 'completion-predicate) 'transient--suffix-only)))
+
+(defalias 'transient--suffix-only #'ignore
+ "Ignore ARGUMENTS, do nothing, and return nil.
+Also see `transient-command-completion-not-suffix-only-p'.
+Only use this alias as the value of the `completion-predicate'
+symbol property.")
+
+(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1
+ (not read-extended-command-predicate))
+ (setq read-extended-command-predicate
+ #'transient-command-completion-not-suffix-only-p))
+
(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 a group's `:setup-children' function."
- (eval (car (transient--parse-child prefix suffix))))
+ (cl-assert (and prefix (symbolp prefix)))
+ (eval (car (transient--parse-child prefix suffix)) t))
(defun transient-parse-suffixes (prefix suffixes)
"Parse SUFFIXES, to be added to PREFIX.
@@ -1213,6 +1266,7 @@ 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 a group's `:setup-children' function."
+ (cl-assert (and prefix (symbolp prefix)))
(mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
;;; Edit
@@ -1224,7 +1278,7 @@ Intended for use in a group's `:setup-children' function."
(string suffix)))
(mem (transient--layout-member loc prefix))
(elt (car mem)))
- (setq suf (eval suf))
+ (setq suf (eval suf t))
(cond
((not mem)
(message "Cannot insert %S into %s; %s not found"
@@ -1473,7 +1527,8 @@ drawing in the transient buffer.")
(defvar transient--pending-suffix nil
"The suffix that is currently being processed.
-This is bound while the suffix predicate is being evaluated.")
+This is bound while the suffix predicate is being evaluated,
+and while functions that return faces are being evaluated.")
(defvar transient--pending-group nil
"The group that is currently being processed.
@@ -1556,33 +1611,35 @@ probably use this instead:
(get COMMAND \\='transient--suffix)"
(when command
(cl-check-type command command))
- (if (or transient--prefix
- transient-current-prefix)
- (let ((suffixes
- (cl-remove-if-not
- (lambda (obj)
- (eq (oref obj command)
- (or command
- (if (eq this-command 'transient-set-level)
- ;; This is how it can look up for which
- ;; command it is setting the level.
- this-original-command
- this-command))))
- (or transient--suffixes
- transient-current-suffixes))))
- (or (and (cdr suffixes)
- (cl-find-if
- (lambda (obj)
- (equal (listify-key-sequence (transient--kbd (oref obj key)))
- (listify-key-sequence (this-command-keys))))
- suffixes))
- (car suffixes)))
- (and-let* ((obj (transient--suffix-prototype (or command this-command)))
+ (cond
+ (transient--pending-suffix)
+ ((or transient--prefix
+ transient-current-prefix)
+ (let ((suffixes
+ (cl-remove-if-not
+ (lambda (obj)
+ (eq (oref obj command)
+ (or command
+ (if (eq this-command 'transient-set-level)
+ ;; This is how it can look up for which
+ ;; command it is setting the level.
+ this-original-command
+ this-command))))
+ (or transient--suffixes
+ transient-current-suffixes))))
+ (or (and (cdr suffixes)
+ (cl-find-if
+ (lambda (obj)
+ (equal (listify-key-sequence (transient--kbd (oref obj key)))
+ (listify-key-sequence (this-command-keys))))
+ suffixes))
+ (car suffixes))))
+ ((and-let* ((obj (transient--suffix-prototype (or command this-command)))
(obj (clone obj)))
(progn ; work around debbugs#31840
(transient-init-scope obj)
(transient-init-value obj)
- obj))))
+ obj)))))
(defun transient--suffix-prototype (command)
(or (get command 'transient--suffix)
@@ -1679,7 +1736,8 @@ to `transient-predicate-map'. Also see `transient-base-map'."
"Hide common commands"
"Show common permanently")))
(list "C-x l" "Show/hide suffixes" #'transient-set-level)
- (list "C-x a" #'transient-toggle-level-limit))))))))
+ (list "C-x a" #'transient-toggle-level-limit)))))
+ t)))
(defvar-keymap transient-popup-navigation-map
:doc "One of the keymaps used when popup navigation is enabled.
@@ -1763,7 +1821,10 @@ of the corresponding object."
;; an unbound key, then Emacs calls the `undefined' command
;; but does not set `this-command', `this-original-command'
;; or `real-this-command' accordingly. Instead they are nil.
- "<nil>" #'transient--do-warn)
+ "<nil>" #'transient--do-warn
+ ;; Bound to the `mouse-movement' event, this command is similar
+ ;; to `ignore'.
+ "<ignore-preserving-kill-region>" #'transient--do-noop)
(defvar transient--transient-map nil)
(defvar transient--predicate-map nil)
@@ -1822,7 +1883,7 @@ of the corresponding object."
(defun transient--make-predicate-map ()
(let* ((default (transient--resolve-pre-command
(oref transient--prefix transient-suffix)))
- (return (and transient-current-prefix (eq default t)))
+ (return (and transient--stack (eq default t)))
(map (make-sparse-keymap)))
(set-keymap-parent map transient-predicate-map)
(when (or (and (slot-boundp transient--prefix 'transient-switch-frame)
@@ -1913,7 +1974,7 @@ the \"scope\" of the transient (see `transient-define-prefix').
This function is also called internally in which case LAYOUT and
EDIT may be non-nil."
(transient--debug 'setup)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :setup
(cond
((not name)
;; Switching between regular and edit mode.
@@ -2167,7 +2228,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--pre-command ()
(transient--debug 'pre-command)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :pre-command
;; The use of `overriding-terminal-local-map' does not prevent the
;; lookup of command remappings in the overridden maps, which can
;; lead to a suffix being remapped to a non-suffix. We have to undo
@@ -2229,14 +2290,14 @@ value. Otherwise return CHILDREN as is."
(when (window-live-p transient--window)
(let ((remain-in-minibuffer-window
(and (minibuffer-selected-window)
- (selected-window)))
- (buf (window-buffer transient--window)))
+ (selected-window))))
;; Only delete the window if it has never shown another buffer.
(unless (eq (car (window-parameter transient--window 'quit-restore))
'other)
(with-demoted-errors "Error while exiting transient: %S"
(delete-window transient--window)))
- (kill-buffer buf)
+ (when-let ((buffer (get-buffer transient--buffer-name)))
+ (kill-buffer buffer))
(when remain-in-minibuffer-window
(select-window remain-in-minibuffer-window)))))
@@ -2254,7 +2315,10 @@ value. Otherwise return CHILDREN as is."
((and transient--prefix transient--redisplay-key)
(setq transient--redisplay-key nil)
(when transient--showp
- (transient--show))))
+ (if-let ((win (minibuffer-selected-window)))
+ (with-selected-window win
+ (transient--show))
+ (transient--show)))))
(transient--pop-keymap 'transient--transient-map)
(transient--pop-keymap 'transient--redisplay-map)
(remove-hook 'pre-command-hook #'transient--pre-command)
@@ -2309,7 +2373,7 @@ value. Otherwise return CHILDREN as is."
(remove-hook 'minibuffer-exit-hook ,exit)))
,@body)))
-(static-if (>= emacs-major-version 30)
+(static-if (>= emacs-major-version 30) ;transient--wrap-command
(defun transient--wrap-command ()
(cl-assert
(>= emacs-major-version 30) nil
@@ -2317,27 +2381,31 @@ value. Otherwise return CHILDREN as is."
(letrec
((prefix transient--prefix)
(suffix this-command)
- (advice (lambda (fn &rest args)
- (interactive
- (lambda (spec)
- (let ((abort t))
- (unwind-protect
- (prog1 (advice-eval-interactive-spec spec)
- (setq abort nil))
- (when abort
- (when-let ((unwind (oref prefix unwind-suffix)))
- (transient--debug 'unwind-interactive)
- (funcall unwind suffix))
- (advice-remove suffix advice)
- (oset prefix unwind-suffix nil))))))
- (unwind-protect
- (apply fn args)
+ (advice
+ (lambda (fn &rest args)
+ (interactive
+ (lambda (spec)
+ (let ((abort t))
+ (unwind-protect
+ (prog1 (let ((debugger #'transient--exit-and-debug))
+ (advice-eval-interactive-spec spec))
+ (setq abort nil))
+ (when abort
(when-let ((unwind (oref prefix unwind-suffix)))
- (transient--debug 'unwind-command)
+ (transient--debug 'unwind-interactive)
(funcall unwind suffix))
(advice-remove suffix advice)
- (oset prefix unwind-suffix nil)))))
- (advice-add suffix :around advice '((depth . -99)))))
+ (oset prefix unwind-suffix nil))))))
+ (unwind-protect
+ (let ((debugger #'transient--exit-and-debug))
+ (apply fn args))
+ (when-let ((unwind (oref prefix unwind-suffix)))
+ (transient--debug 'unwind-command)
+ (funcall unwind suffix))
+ (advice-remove suffix advice)
+ (oset prefix unwind-suffix nil)))))
+ (when (symbolp this-command)
+ (advice-add suffix :around advice '((depth . -99))))))
(defun transient--wrap-command ()
(let* ((prefix transient--prefix)
@@ -2347,7 +2415,8 @@ value. Otherwise return CHILDREN as is."
(lambda (spec)
(let ((abort t))
(unwind-protect
- (prog1 (advice-eval-interactive-spec spec)
+ (prog1 (let ((debugger #'transient--exit-and-debug))
+ (advice-eval-interactive-spec spec))
(setq abort nil))
(when abort
(when-let ((unwind (oref prefix unwind-suffix)))
@@ -2358,7 +2427,8 @@ value. Otherwise return CHILDREN as is."
(advice-body
(lambda (fn &rest args)
(unwind-protect
- (apply fn args)
+ (let ((debugger #'transient--exit-and-debug))
+ (apply fn args))
(when-let ((unwind (oref prefix unwind-suffix)))
(transient--debug 'unwind-command)
(funcall unwind suffix))
@@ -2367,7 +2437,8 @@ value. Otherwise return CHILDREN as is."
(setq advice `(lambda (fn &rest args)
(interactive ,advice-interactive)
(apply ',advice-body fn args)))
- (advice-add suffix :around advice '((depth . -99))))))
+ (when (symbolp this-command)
+ (advice-add suffix :around advice '((depth . -99)))))))
(defun transient--premature-post-command ()
(and (equal (this-command-keys-vector) [])
@@ -2386,7 +2457,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--post-command ()
(unless (transient--premature-post-command)
(transient--debug 'post-command)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :post-command
(cond (transient--exitp (transient--post-exit))
;; If `this-command' is the current transient prefix, then we
;; have already taken care of updating the transient buffer...
@@ -2504,24 +2575,29 @@ value. Otherwise return CHILDREN as is."
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
- (or (and (symbolp this-command) this-command)
- (if (byte-code-function-p this-command)
- "#[...]"
- this-command))
+ (if (fboundp 'help-fns-function-name)
+ (help-fns-function-name this-command)
+ (if (byte-code-function-p this-command)
+ "#[...]"
+ this-command))
(key-description (this-command-keys-vector))
transient--exitp
- (cond ((stringp (car args))
+ (cond ((keywordp (car args))
+ (format ", from: %s"
+ (substring (symbol-name (car args)) 1)))
+ ((stringp (car args))
(concat ", " (apply #'format args)))
- (args
+ ((functionp (car args))
(concat ", " (apply (car args) (cdr args))))
("")))
(apply #'message arg args)))))
-(defun transient--emergency-exit ()
+(defun transient--emergency-exit (&optional id)
"Exit the current transient command after an error occurred.
When no transient is active (i.e., when `transient--prefix' is
-nil) then do nothing."
- (transient--debug 'emergency-exit)
+nil) then do nothing. Optional ID is a keyword identifying the
+exit."
+ (transient--debug 'emergency-exit id)
(when transient--prefix
(setq transient--stack nil)
(setq transient--exitp t)
@@ -2545,6 +2621,7 @@ nil) then do nothing."
(defun transient--get-pre-command (&optional cmd enforce-type)
(or (and (not (eq enforce-type 'non-suffix))
+ (symbolp cmd)
(lookup-key transient--predicate-map (vector cmd)))
(and (not (eq enforce-type 'suffix))
(transient--resolve-pre-command
@@ -2907,7 +2984,7 @@ transient is active."
(interactive)
(transient-set-value (transient-prefix-object)))
-(defalias 'transient-set-and-exit 'transient-set
+(defalias 'transient-set-and-exit #'transient-set
"Set active transient's value for this Emacs session and exit.")
(defun transient-save ()
@@ -2915,7 +2992,7 @@ transient is active."
(interactive)
(transient-save-value (transient-prefix-object)))
-(defalias 'transient-save-and-exit 'transient-save
+(defalias 'transient-save-and-exit #'transient-save
"Save active transient's value for this and future Emacs sessions and exit.")
(defun transient-reset ()
@@ -3088,14 +3165,14 @@ infix command determines what the new value should be, based
on the previous value.")
(cl-defmethod transient-infix-read :around ((obj transient-infix))
- "Refresh the transient buffer buffer calling the next method.
+ "Refresh the transient buffer and call the next method.
Also wrap `cl-call-next-method' with two macros:
- `transient--with-suspended-override' allows use of minibuffer.
- `transient--with-emergency-exit' arranges for the transient to
be exited in case of an error."
(transient--show)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :infix-read
(transient--with-suspended-override
(cl-call-next-method obj))))
@@ -3177,8 +3254,10 @@ The last value is \"don't use any of these switches\"."
"Elsewhere use the reader of the infix command COMMAND.
Use this if you want to share an infix's history with a regular
stand-alone command."
- (cl-letf (((symbol-function #'transient--show) #'ignore))
- (transient-infix-read (transient--suffix-prototype command))))
+ (if-let ((obj (transient--suffix-prototype command)))
+ (cl-letf (((symbol-function #'transient--show) #'ignore))
+ (transient-infix-read obj))
+ (error "Not a suffix command: `%s'" command)))
;;;; Readers
@@ -3355,7 +3434,7 @@ the set, saved or default value for PREFIX."
(transient--init-suffixes prefix)))))
(defun transient-get-value ()
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :get-value
(cl-mapcan (lambda (obj)
(and (or (not (slot-exists-p obj 'unsavable))
(not (oref obj unsavable)))
@@ -3566,7 +3645,7 @@ have a history of their own.")
(propertize "\n" 'face face 'line-height t))))
(defmacro transient-with-shadowed-buffer (&rest body)
- "While in the transient buffer, temporarily make the shadowed buffer current."
+ "While in the transient buffer, temporarly make the shadowed buffer current."
(declare (indent 0) (debug t))
`(with-current-buffer (or transient--shadowed-buffer (current-buffer))
,@body))
@@ -3621,7 +3700,8 @@ have a history of their own.")
(lambda (column)
(transient--maybe-pad-keys column group)
(transient-with-shadowed-buffer
- (let ((rows (mapcar #'transient-format (oref column suffixes))))
+ (let* ((transient--pending-group column)
+ (rows (mapcar #'transient-format (oref column suffixes))))
(when-let ((desc (transient-format-description column)))
(push desc rows))
(flatten-tree rows))))
@@ -3630,10 +3710,15 @@ have a history of their own.")
transient-align-variable-pitch))
(rs (apply #'max (mapcar #'length columns)))
(cs (length columns))
- (cw (mapcar (lambda (col)
- (apply #'max
- (mapcar (if vp #'transient--pixel-width #'length)
- col)))
+ (cw (mapcar (let ((widths (oref transient--prefix column-widths)))
+ (lambda (col)
+ (apply
+ #'max
+ (if-let ((min (pop widths)))
+ (if vp (* min (transient--pixel-width " ")) min)
+ 0)
+ (mapcar (if vp #'transient--pixel-width #'length)
+ col))))
columns))
(cc (transient--seq-reductions-from
(apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1)))
@@ -3909,7 +3994,10 @@ If the OBJ's `key' is currently unreachable, then apply the face
(face (slot-value obj slot)))
(if (and (not (facep face))
(functionp face))
- (funcall face)
+ (let ((transient--pending-suffix obj))
+ (if (= (car (func-arity face)) 1)
+ (funcall face obj)
+ (funcall face)))
face)))
(defun transient--key-face (&optional cmd enforce-type)
diff --git a/lisp/treesit.el b/lisp/treesit.el
index a68eed06e41..2b4893e6129 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it
returns that ancestor node. It returns nil if no ancestor
node was found that satisfies PRED.
-PRED should be a function that takes one argument, the node to
-examine, and returns a boolean value indicating whether that
-node is a match.
+PRED can be a predicate function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((node (if include-node node
(treesit-node-parent node))))
- (while (and node (not (funcall pred node)))
+ (while (and node (not (treesit-node-match-p node pred)))
(setq node (treesit-node-parent node)))
node))
@@ -364,11 +363,10 @@ no longer satisfies the predicate PRED; it returns the last
examined node that satisfies PRED. If no node satisfies PRED, it
returns nil.
-PRED should be a function that takes one argument, the node to
-examine, and returns a boolean value indicating whether that
-node is a match."
+PRED can be a predicate function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'."
(let ((last nil))
- (while (and node (funcall pred node))
+ (while (and node (treesit-node-match-p node pred))
(setq last node
node (treesit-node-parent node)))
last))
@@ -595,8 +593,8 @@ that encompasses the region between START and END."
(unless (and (consp range-offset)
(numberp (car range-offset))
(numberp (cdr range-offset)))
- (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset)))
- (setq offset range-offset)))
+ (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset)))
+ (setq offset range-offset)))
(query (if (functionp query)
(push (list query nil nil) result)
(when (null embed)
@@ -606,7 +604,7 @@ that encompasses the region between START and END."
(push (list (treesit-query-compile host query)
embed local offset)
result))
- (setq host nil embed nil offset nil))))
+ (setq host nil embed nil offset nil local nil))))
(nreverse result)))
(defun treesit--merge-ranges (old-ranges new-ranges start end)
@@ -655,37 +653,47 @@ those inside are kept."
if (<= start (car range) (cdr range) end)
collect range))
-(defun treesit-local-parsers-at (&optional pos language)
+(defun treesit-local-parsers-at (&optional pos language with-host)
"Return all the local parsers at POS.
POS defaults to point.
Local parsers are those which only parse a limited region marked
by an overlay with non-nil `treesit-parser' property.
-If LANGUAGE is non-nil, only return parsers for LANGUAGE."
+If LANGUAGE is non-nil, only return parsers for LANGUAGE.
+
+If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER)
+instead. HOST-PARSER is the host parser which created the local
+PARSER."
(let ((res nil))
(dolist (ov (overlays-at (or pos (point))))
- (when-let ((parser (overlay-get ov 'treesit-parser)))
+ (when-let ((parser (overlay-get ov 'treesit-parser))
+ (host-parser (overlay-get ov 'treesit-host-parser)))
(when (or (null language)
(eq (treesit-parser-language parser)
language))
- (push parser res))))
+ (push (if with-host (cons parser host-parser) parser) res))))
(nreverse res)))
-(defun treesit-local-parsers-on (&optional beg end language)
+(defun treesit-local-parsers-on (&optional beg end language with-host)
"Return all the local parsers between BEG END.
BEG and END default to the beginning and end of the buffer's
accessible portion.
Local parsers are those which have an `embedded' tag, and only parse
a limited region marked by an overlay with a non-nil `treesit-parser'
-property. If LANGUAGE is non-nil, only return parsers for LANGUAGE."
+property. If LANGUAGE is non-nil, only return parsers for LANGUAGE.
+
+If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER)
+instead. HOST-PARSER is the host parser which created the local
+PARSER."
(let ((res nil))
(dolist (ov (overlays-in (or beg (point-min)) (or end (point-max))))
- (when-let ((parser (overlay-get ov 'treesit-parser)))
+ (when-let ((parser (overlay-get ov 'treesit-parser))
+ (host-parser (overlay-get ov 'treesit-host-parser)))
(when (or (null language)
(eq (treesit-parser-language parser)
language))
- (push parser res))))
+ (push (if with-host (cons parser host-parser) parser) res))))
(nreverse res)))
(defun treesit--update-ranges-local
@@ -701,7 +709,8 @@ parser for EMBEDDED-LANG."
(treesit-parser-delete parser))))
;; Update range.
(let* ((host-lang (treesit-query-language query))
- (ranges (treesit-query-range host-lang query beg end)))
+ (host-parser (treesit-parser-create host-lang))
+ (ranges (treesit-query-range host-parser query beg end)))
(pcase-dolist (`(,beg . ,end) ranges)
(let ((has-parser nil))
(dolist (ov (overlays-in beg end))
@@ -719,6 +728,7 @@ parser for EMBEDDED-LANG."
embedded-lang nil t 'embedded))
(ov (make-overlay beg end nil nil t)))
(overlay-put ov 'treesit-parser embedded-parser)
+ (overlay-put ov 'treesit-host-parser host-parser)
(treesit-parser-set-included-ranges
embedded-parser `((,beg . ,end)))))))))
@@ -1372,7 +1382,15 @@ as comment due to incomplete parse tree."
;; `treesit-update-ranges' will force the host language's parser to
;; reparse and set correct ranges for embedded parsers. Then
;; `treesit-parser-root-node' will force those parsers to reparse.
- (treesit-update-ranges)
+ (let ((len (+ (* (window-body-height) (window-body-width)) 800)))
+ ;; FIXME: As a temporary fix, this prevents Emacs from updating
+ ;; every single local parsers in the buffer every time there's an
+ ;; edit. Moving forward, we need some way to properly track the
+ ;; regions which need update on parser ranges, like what jit-lock
+ ;; and syntax-ppss does.
+ (treesit-update-ranges
+ (max (point-min) (- (point) len))
+ (min (point-max) (+ (point) len))))
;; Force repase on _all_ the parsers might not be necessary, but
;; this is probably the most robust way.
(dolist (parser (treesit-parser-list))
@@ -1393,7 +1411,7 @@ START and END mark the current to-be-propertized region."
(if (and new-start (< new-start start))
(progn
(setq treesit--syntax-propertize-start nil)
- (cons new-start end))
+ (cons (max new-start (point-min)) end))
nil)))
;;; Indent
@@ -1665,7 +1683,7 @@ no-node
comment-end
- Matches if text after point matches `treesit-comment-end'.
+ Matches if text after point matches `comment-end-skip'.
catch-all
@@ -1800,11 +1818,17 @@ Return (ANCHOR . OFFSET). This function is used by
(forward-line 0)
(skip-chars-forward " \t")
(point)))
- (local-parsers (treesit-local-parsers-at bol))
+ (local-parsers (treesit-local-parsers-at bol nil t))
(smallest-node
- (cond ((null (treesit-parser-list)) nil)
- (local-parsers (treesit-node-at
- bol (car local-parsers)))
+ (cond ((car local-parsers)
+ (let ((local-parser (caar local-parsers))
+ (host-parser (cdar local-parsers)))
+ (if (eq (treesit-node-start
+ (treesit-parser-root-node local-parser))
+ bol)
+ (treesit-node-at bol host-parser)
+ (treesit-node-at bol local-parser))))
+ ((null (treesit-parser-list)) nil)
((eq 1 (length (treesit-parser-list nil nil t)))
(treesit-node-at bol))
((treesit-language-at bol)
@@ -2213,7 +2237,7 @@ for invalid node.
This is used by `treesit-beginning-of-defun' and friends.")
(defvar-local treesit-defun-tactic 'nested
- "Determines how does Emacs treat nested defuns.
+ "Determines how Emacs treats nested defuns.
If the value is `top-level', Emacs only moves across top-level
defuns, if the value is `nested', Emacs recognizes nested defuns.")
@@ -2229,9 +2253,8 @@ If the value is nil, no skipping is performed.")
(defvar-local treesit-defun-name-function nil
"A function that is called with a node and returns its defun name or nil.
If the node is a defun node, return the defun name, e.g., the
-function name of a function. If the node is not a defun node, or
-the defun node doesn't have a name, or the node is nil, return
-nil.")
+name of a function. If the node is not a defun node, or the
+defun node doesn't have a name, or the node is nil, return nil.")
(defvar-local treesit-add-log-defun-delimiter "."
"The delimiter used to connect several defun names.
@@ -2644,9 +2667,17 @@ function is called recursively."
(setq parent (treesit-node-top-level parent thing t)
prev nil
next nil))
- ;; If TACTIC is `restricted', the implementation is very simple.
+ ;; If TACTIC is `restricted', the implementation is simple.
+ ;; In principle we don't go to parent's beg/end for
+ ;; `restricted' tactic, but if the parent is a "leaf thing"
+ ;; (doesn't have any child "thing" inside it), then we can
+ ;; move to the beg/end of it (bug#68899).
(if (eq tactic 'restricted)
- (setq pos (funcall advance (if (> arg 0) next prev)))
+ (setq pos (funcall
+ advance
+ (cond ((and (null next) (null prev)) parent)
+ ((> arg 0) next)
+ (t prev))))
;; For `nested', it's a bit more work:
;; Move...
(if (> arg 0)
@@ -2696,12 +2727,12 @@ function is called recursively."
;; TODO: In corporate into thing-at-point.
(defun treesit-thing-at-point (thing tactic)
- "Return the THING at point or nil if none is found.
+ "Return the THING at point, or nil if none is found.
-THING can be a symbol, regexp, a predicate function, and more,
+THING can be a symbol, a regexp, a predicate function, and more;
see `treesit-thing-settings' for details.
-Return the top-level THING if TACTIC is `top-level', return the
+Return the top-level THING if TACTIC is `top-level'; return the
smallest enclosing THING as POS if TACTIC is `nested'."
(let ((node (treesit--thing-at (point) thing)))
@@ -2710,11 +2741,11 @@ smallest enclosing THING as POS if TACTIC is `nested'."
node)))
(defun treesit-defun-at-point ()
- "Return the defun node at point or nil if none is found.
+ "Return the defun node at point, or nil if none is found.
-Respects `treesit-defun-tactic': return the top-level defun if it
-is `top-level', return the immediate parent defun if it is
-`nested'.
+Respects `treesit-defun-tactic': returns the top-level defun if it
+is `top-level', otherwise return the immediate parent defun if it
+is `nested'.
Return nil if `treesit-defun-type-regexp' isn't set and `defun'
isn't defined in `treesit-thing-settings'."
@@ -2836,6 +2867,71 @@ ENTRY. MARKER marks the start of each tree-sitter node."
index))))
treesit-simple-imenu-settings)))
+;;; Outline minor mode
+
+(defvar-local treesit-outline-predicate nil
+ "Predicate used to find outline headings in the syntax tree.
+The predicate can be a function, a regexp matching node type,
+and more; see docstring of `treesit-thing-settings'.
+It matches the nodes located on lines with outline headings.
+Intended to be set by a major mode. When nil, the predicate
+is constructed from the value of `treesit-simple-imenu-settings'
+when a major mode sets it.")
+
+(defun treesit-outline-predicate--from-imenu (node)
+ ;; Return an outline searching predicate created from Imenu.
+ ;; Return the value suitable to set `treesit-outline-predicate'.
+ ;; Create this predicate from the value `treesit-simple-imenu-settings'
+ ;; that major modes set to find Imenu entries. The assumption here
+ ;; is that the positions of Imenu entries most of the time coincide
+ ;; with the lines of outline headings. When this assumption fails,
+ ;; you can directly set a proper value to `treesit-outline-predicate'.
+ (seq-some
+ (lambda (setting)
+ (and (string-match-p (nth 1 setting) (treesit-node-type node))
+ (or (null (nth 2 setting))
+ (funcall (nth 2 setting) node))))
+ treesit-simple-imenu-settings))
+
+(defun treesit-outline-search (&optional bound move backward looking-at)
+ "Search for the next outline heading in the syntax tree.
+See the descriptions of arguments in `outline-search-function'."
+ (if looking-at
+ (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate)
+ (treesit--thing-at (pos-bol) treesit-outline-predicate)))
+ (start (treesit-node-start node)))
+ (eq (pos-bol) (save-excursion (goto-char start) (pos-bol))))
+
+ (let* ((pos
+ ;; When function wants to find the current outline, point
+ ;; is at the beginning of the current line. When it wants
+ ;; to find the next outline, point is at the second column.
+ (if (eq (point) (pos-bol))
+ (if (bobp) (point) (1- (point)))
+ (pos-eol)))
+ (found (treesit--navigate-thing pos (if backward -1 1) 'beg
+ treesit-outline-predicate)))
+ (if found
+ (if (or (not bound) (if backward (>= found bound) (<= found bound)))
+ (progn
+ (goto-char found)
+ (goto-char (pos-bol))
+ (set-match-data (list (point) (pos-eol)))
+ t)
+ (when move (goto-char bound))
+ nil)
+ (when move (goto-char (or bound (if backward (point-min) (point-max)))))
+ nil))))
+
+(defun treesit-outline-level ()
+ "Return the depth of the current outline heading."
+ (let* ((node (treesit-node-at (point) nil t))
+ (level (if (treesit-node-match-p node treesit-outline-predicate)
+ 1 0)))
+ (while (setq node (treesit-parent-until node treesit-outline-predicate))
+ (setq level (1+ level)))
+ (if (zerop level) 1 level)))
+
;;; Activating tree-sitter
(defun treesit-ready-p (language &optional quiet)
@@ -2966,6 +3062,17 @@ before calling this function."
(setq-local imenu-create-index-function
#'treesit-simple-imenu))
+ ;; Outline minor mode.
+ (when (and (or treesit-outline-predicate treesit-simple-imenu-settings)
+ (not (seq-some #'local-variable-p
+ '(outline-search-function
+ outline-regexp outline-level))))
+ (unless treesit-outline-predicate
+ (setq treesit-outline-predicate
+ #'treesit-outline-predicate--from-imenu))
+ (setq-local outline-search-function #'treesit-outline-search
+ outline-level #'treesit-outline-level))
+
;; Remove existing local parsers.
(dolist (ov (overlays-in (point-min) (point-max)))
(when-let ((parser (overlay-get ov 'treesit-parser)))
@@ -3417,7 +3524,8 @@ The value should be an alist where each element has the form
(LANG . (URL REVISION SOURCE-DIR CC C++))
Only LANG and URL are mandatory. LANG is the language symbol.
-URL is the Git repository URL for the grammar.
+URL is the URL of the grammar's Git repository or a directory
+where the repository has been cloned.
REVISION is the Git tag or branch of the desired version,
defaulting to the latest default branch.
@@ -3551,6 +3659,26 @@ content as signal data, and erase buffer afterwards."
(buffer-string)))
(erase-buffer)))
+(defun treesit--git-checkout-branch (repo-dir revision)
+ "Checkout REVISION in a repo located in REPO-DIR."
+ (treesit--call-process-signal
+ "git" nil t nil "-C" repo-dir "checkout" revision))
+
+(defun treesit--git-clone-repo (url revision workdir)
+ "Clone repo pointed by URL at commit REVISION to WORKDIR.
+
+REVISION may be nil, in which case the cloned repo will be at its
+default branch."
+ (message "Cloning repository")
+ ;; git clone xxx --depth 1 --quiet [-b yyy] workdir
+ (if revision
+ (treesit--call-process-signal
+ "git" nil t nil "clone" url "--depth" "1" "--quiet"
+ "-b" revision workdir)
+ (treesit--call-process-signal
+ "git" nil t nil "clone" url "--depth" "1" "--quiet"
+ workdir)))
+
(defun treesit--install-language-grammar-1
(out-dir lang url &optional revision source-dir cc c++)
"Install and compile a tree-sitter language grammar library.
@@ -3564,8 +3692,12 @@ For LANG, URL, REVISION, SOURCE-DIR, GRAMMAR-DIR, CC, C++, see
`treesit-language-source-alist'. If anything goes wrong, this
function signals an error."
(let* ((lang (symbol-name lang))
+ (maybe-repo-dir (expand-file-name url))
+ (url-is-dir (file-accessible-directory-p maybe-repo-dir))
(default-directory (make-temp-file "treesit-workdir" t))
- (workdir (expand-file-name "repo"))
+ (workdir (if url-is-dir
+ maybe-repo-dir
+ (expand-file-name "repo")))
(source-dir (expand-file-name (or source-dir "src") workdir))
(cc (or cc (seq-find #'executable-find '("cc" "gcc" "c99"))
;; If no C compiler found, just use cc and let
@@ -3580,15 +3712,10 @@ function signals an error."
(lib-name (concat "libtree-sitter-" lang soext)))
(unwind-protect
(with-temp-buffer
- (message "Cloning repository")
- ;; git clone xxx --depth 1 --quiet [-b yyy] workdir
- (if revision
- (treesit--call-process-signal
- "git" nil t nil "clone" url "--depth" "1" "--quiet"
- "-b" revision workdir)
- (treesit--call-process-signal
- "git" nil t nil "clone" url "--depth" "1" "--quiet"
- workdir))
+ (if url-is-dir
+ (when revision
+ (treesit--git-checkout-branch workdir revision))
+ (treesit--git-clone-repo url revision workdir))
;; We need to go into the source directory because some
;; header files use relative path (#include "../xxx").
;; cd "${sourcedir}"
@@ -3635,7 +3762,9 @@ function signals an error."
;; Ignore errors, in case the old version is still used.
(ignore-errors (delete-file old-fname)))
(message "Library installed to %s/%s" out-dir lib-name))
- (when (file-exists-p workdir)
+ ;; Remove workdir if it's not a repo owned by user and we
+ ;; managed to create it in the first place.
+ (when (and (not url-is-dir) (file-exists-p workdir))
(delete-directory workdir t)))))
;;; Etc
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 0d27321cc47..ce6de2b3ee4 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -70,7 +70,7 @@ FILE can be created or overwritten."
;;;###autoload
(defun url-store-in-cache (&optional buff)
"Store buffer BUFF in the cache."
- (with-current-buffer (get-buffer (or buff (current-buffer)))
+ (with-current-buffer (or buff (current-buffer))
(let ((fname (url-cache-create-filename (url-view-url t))))
(if (url-cache-prepare fname)
(let ((coding-system-for-write 'binary))
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index 17a0318e652..d80037f8fe9 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,6 +1,6 @@
;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*-
-;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -52,12 +52,7 @@
;;;###autoload
(defun url-cid (url)
- (cond
- ((fboundp 'mm-get-content-id)
- ;; Using Pterodactyl Gnus or later
- (with-current-buffer (generate-new-buffer " *url-cid*")
- (url-cid-gnus (url-filename url))))
- (t
- (message "Unable to handle CID URL: %s" url))))
+ (with-current-buffer (generate-new-buffer " *url-cid*")
+ (url-cid-gnus (url-filename url))))
;;; url-cid.el ends here
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index d6a1d0eade8..184c1278072 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')."
;; Parsing routines
(defun url-http-clean-headers ()
- "Remove trailing \r from header lines.
+ "Remove trailing \\r from header lines.
This allows us to use `mail-fetch-field', etc.
Return the number of characters removed."
(let ((end (marker-position url-http-end-of-headers)))
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 1bdd5099637..6aaea606c27 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,6 +1,6 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
-;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -92,12 +92,8 @@
"'>" dn "</a>"))
(defun url-ldap-certificate-formatter (data)
- (condition-case ()
- (require 'ssl)
- (error nil))
- (let ((vals (if (fboundp 'ssl-certificate-information)
- (ssl-certificate-information data)
- (tls-certificate-information data))))
+ ;; FIXME: tls.el is obsolete.
+ (let ((vals (tls-certificate-information data)))
(if (not vals)
"<b>Unable to parse certificate</b>"
(concat "<table border=0>\n"
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index c2d347a1646..50293ab3f05 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,6 +1,6 @@
;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
-;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -28,12 +28,7 @@
(require 'url-util)
;;;###autoload
-(defun url-mail (&rest args)
- (interactive "P")
- (if (fboundp 'message-mail)
- (apply 'message-mail args)
- (or (apply 'mail args)
- (error "Mail aborted"))))
+(defalias 'url-mail #'message-mail)
(defun url-mail-goto-field (field)
(if (not field)
@@ -57,8 +52,6 @@
(save-excursion
(insert "\n"))))))
-(declare-function mail-send-and-exit "sendmail")
-
;;;###autoload
(defun url-mailto (url)
"Handle the mailto: URL syntax."
@@ -111,8 +104,6 @@
;; (setq func (intern-soft (concat "mail-" (caar args))))
(insert (mapconcat 'identity (cdar args) ", ")))
(setq args (cdr args)))
- ;; (url-mail-goto-field "User-Agent")
-;; (insert url-package-name "/" url-package-version " URL/" url-version)
(if (not url-request-data)
(progn
(set-buffer-modified-p nil)
@@ -128,8 +119,8 @@
(goto-char (point-max))
(insert url-request-data)
;; It seems Microsoft-ish to send without warning.
- ;; Fixme: presumably this should depend on a privacy setting.
- (if (y-or-n-p "Send this auto-generated mail? ")
+ ;; FIXME: presumably this should depend on a privacy setting.
+ (if (y-or-n-p "Send this auto-generated mail?")
(let ((buffer (current-buffer)))
(cond ((eq url-mail-command 'compose-mail)
(funcall (get mail-user-agent 'sendfunc) nil))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 28d1885387d..5f45b98c7a5 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -335,7 +335,7 @@ appropriate coding-system; see `decode-coding-string'."
str (substring str (match-end 0)))))
(concat tmp str)))
-(defconst url-unreserved-chars
+(defvar url-unreserved-chars
'(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el
index 025721746cc..6c7f8c0a1ea 100644
--- a/lisp/use-package/use-package-ensure-system-package.el
+++ b/lisp/use-package/use-package-ensure-system-package.el
@@ -5,7 +5,6 @@
;; Author: Justin Talbott <justin@waymondo.com>
;; Keywords: convenience, tools, extensions
;; URL: https://github.com/waymondo/use-package-ensure-system-package
-;; Version: 0.2
;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4"))
;; Filename: use-package-ensure-system-package.el
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 03efe0fdb31..66043059d14 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -240,6 +240,8 @@ The default \"-b\" means to ignore whitespace-only changes,
:help "Apply the current hunk to the source file and go to the next"]
["Test applying hunk" diff-test-hunk
:help "See whether it's possible to apply the current hunk"]
+ ["Apply all hunks" diff-apply-buffer
+ :help "Apply all hunks in the current diff buffer"]
["Apply diff with Ediff" diff-ediff-patch
:help "Call `ediff-patch-file' on the current buffer"]
["Create Change Log entries" diff-add-change-log-entries-other-window
@@ -517,8 +519,8 @@ use the face `diff-removed' for removed lines, and the face
("^Only in .*\n" . 'diff-nonexistent)
("^Binary files .* differ\n" . 'diff-file-header)
("^\\(#\\)\\(.*\\)"
- (1 font-lock-comment-delimiter-face)
- (2 font-lock-comment-face))
+ (1 'font-lock-comment-delimiter-face)
+ (2 'font-lock-comment-face))
("^diff: .*" (0 'diff-error))
("^[^-=+*!<>#].*\n" (0 'diff-context))
(,#'diff--font-lock-syntax)
@@ -944,7 +946,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")."
(when (and (string-match (concat
"\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n"
"\\1\\(.*\\)\\3\n"
- "\\(.*\\(\\2\\).*\\)\\'") str)
+ "\\(.*\\(\\2\\).*\\)\\'")
+ str)
(equal to (match-string 5 str)))
(concat (substring str (match-beginning 5) (match-beginning 6))
(match-string 4 str)
@@ -1616,7 +1619,7 @@ modified lines of the diff."
nil)))
(when (eq diff-buffer-type 'git)
(setq diff-outline-regexp
- (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)")))
+ (concat "\\(^diff --git.*\\|" diff-hunk-header-re "\\)")))
(setq-local outline-level #'diff--outline-level)
(setq-local outline-regexp diff-outline-regexp))
@@ -1999,7 +2002,7 @@ With a prefix argument, REVERSE the hunk."
(diff-find-source-location nil reverse)))
(cond
((null line-offset)
- (error "Can't find the text to patch"))
+ (user-error "Can't find the text to patch"))
((with-current-buffer buf
(and buffer-file-name
(backup-file-name-p buffer-file-name)
@@ -2008,7 +2011,7 @@ With a prefix argument, REVERSE the hunk."
(yes-or-no-p (format "Really apply this hunk to %s? "
(file-name-nondirectory
buffer-file-name)))))))
- (error "%s"
+ (user-error "%s"
(substitute-command-keys
(format "Use %s\\[diff-apply-hunk] to apply it to the other file"
(if (not reverse) "\\[universal-argument] ")))))
@@ -2275,6 +2278,24 @@ Return new point, if it was moved."
(end (progn (diff-end-of-hunk) (point))))
(diff--refine-hunk beg end)))))
+(defun diff--refine-propertize (beg end face)
+ (let ((ol (make-overlay beg end)))
+ (overlay-put ol 'diff-mode 'fine)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'face face)))
+
+(defcustom diff-refine-nonmodified nil
+ "If non-nil, also highlight the added/removed lines as \"refined\".
+The lines highlighted when this is non-nil are those that were
+added or removed in their entirety, as opposed to lines some
+parts of which were modified. The added lines are highlighted
+using the `diff-refine-added' face, while the removed lines are
+highlighted using the `diff-refine-removed' face.
+This is currently implemented only for diff formats supported
+by `diff-refine-hunk'."
+ :version "30.1"
+ :type 'boolean)
+
(defun diff--refine-hunk (start end)
(require 'smerge-mode)
(goto-char start)
@@ -2289,41 +2310,68 @@ Return new point, if it was moved."
(goto-char beg)
(pcase style
('unified
- (while (re-search-forward "^-" end t)
+ (while (re-search-forward "^[-+]" end t)
(let ((beg-del (progn (beginning-of-line) (point)))
beg-add end-add)
- (when (and (diff--forward-while-leading-char ?- end)
- ;; Allow for "\ No newline at end of file".
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq beg-add (point)))
- (diff--forward-while-leading-char ?+ end)
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq end-add (point))))
+ (cond
+ ((eq (char-after) ?+)
+ (diff--forward-while-leading-char ?+ end)
+ (when diff-refine-nonmodified
+ (diff--refine-propertize beg-del (point) 'diff-refine-added)))
+ ((and (diff--forward-while-leading-char ?- end)
+ ;; Allow for "\ No newline at end of file".
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq beg-add (point)))
+ (diff--forward-while-leading-char ?+ end)
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq end-add (point))))
(smerge-refine-regions beg-del beg-add beg-add end-add
- nil #'diff-refine-preproc props-r props-a)))))
+ nil #'diff-refine-preproc props-r props-a))
+ (t ;; If we're here, it's because
+ ;; (diff--forward-while-leading-char ?+ end) failed.
+ (when diff-refine-nonmodified
+ (diff--refine-propertize beg-del (point)
+ 'diff-refine-removed)))))))
('context
(let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (and middle
- (re-search-forward "^\\(?:!.*\n\\)+" middle t))
- (smerge-refine-regions (match-beginning 0) (match-end 0)
- (save-excursion
- (goto-char other)
- (re-search-forward "^\\(?:!.*\n\\)+" end)
- (setq other (match-end 0))
- (match-beginning 0))
- other
- (if diff-use-changed-face props-c)
- #'diff-refine-preproc
- (unless diff-use-changed-face props-r)
- (unless diff-use-changed-face props-a)))))
+ (when middle
+ (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (smerge-refine-regions (match-beginning 0) (match-end 0)
+ (save-excursion
+ (goto-char other)
+ (re-search-forward "^\\(?:!.*\n\\)+" end)
+ (setq other (match-end 0))
+ (match-beginning 0))
+ other
+ (if diff-use-changed-face props-c)
+ #'diff-refine-preproc
+ (unless diff-use-changed-face props-r)
+ (unless diff-use-changed-face props-a)))
+ (when diff-refine-nonmodified
+ (goto-char beg)
+ (while (re-search-forward "^\\(?:-.*\n\\)+" middle t)
+ (diff--refine-propertize (match-beginning 0)
+ (match-end 0)
+ 'diff-refine-removed))
+ (goto-char middle)
+ (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t)
+ (diff--refine-propertize (match-beginning 0)
+ (match-end 0)
+ 'diff-refine-added))))))
(_ ;; Normal diffs.
(let ((beg1 (1+ (point))))
- (when (re-search-forward "^---.*\n" end t)
+ (cond
+ ((re-search-forward "^---.*\n" end t)
;; It's a combined add&remove, so there's something to do.
(smerge-refine-regions beg1 (match-beginning 0)
(match-end 0) end
- nil #'diff-refine-preproc props-r props-a)))))))
+ nil #'diff-refine-preproc props-r props-a))
+ (diff-refine-nonmodified
+ (diff--refine-propertize
+ beg1 end
+ (if (eq (char-after beg1) ?<)
+ 'diff-refine-removed 'diff-refine-added)))))))))
(defun diff--iterate-hunks (max fun)
"Iterate over all hunks between point and MAX.
@@ -2817,6 +2865,57 @@ and the position in MAX."
(defvar-local diff--syntax-file-attributes nil)
(put 'diff--syntax-file-attributes 'permanent-local t)
+(defvar diff--cached-revision-buffers nil
+ "List of ((FILE . REVISION) . BUFFER) in MRU order.")
+
+(defvar diff--cache-clean-timer nil)
+(defconst diff--cache-clean-interval 3600) ; seconds
+
+(defun diff--cache-clean ()
+ "Discard the least recently used half of the cache."
+ (let ((n (/ (length diff--cached-revision-buffers) 2)))
+ (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers)))
+ (setq diff--cached-revision-buffers
+ (ntake n diff--cached-revision-buffers)))
+ (diff--cache-schedule-clean))
+
+(defun diff--cache-schedule-clean ()
+ (setq diff--cache-clean-timer
+ (and diff--cached-revision-buffers
+ (run-with-timer diff--cache-clean-interval nil
+ #'diff--cache-clean))))
+
+(defun diff--get-revision-properties (file revision text line-nb)
+ "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB."
+ (let* ((file-rev (cons file revision))
+ (entry (assoc file-rev diff--cached-revision-buffers))
+ (buffer (cdr entry)))
+ (if (buffer-live-p buffer)
+ (progn
+ ;; Don't re-initialize the buffer (which would throw
+ ;; away the previous fontification work).
+ (setq file nil)
+ (setq diff--cached-revision-buffers
+ (cons entry
+ (delq entry diff--cached-revision-buffers))))
+ ;; Cache miss: create a new entry.
+ (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*"
+ file revision)))
+ (condition-case nil
+ (vc-find-revision-no-save file revision diff-vc-backend buffer)
+ (error
+ (kill-buffer buffer)
+ (setq buffer nil))
+ (:success
+ (push (cons file-rev buffer)
+ diff--cached-revision-buffers))))
+ (when diff--cache-clean-timer
+ (cancel-timer diff--cache-clean-timer))
+ (diff--cache-schedule-clean)
+ (and buffer
+ (with-current-buffer buffer
+ (diff-syntax-fontify-props file text line-nb)))))
+
(defun diff-syntax-fontify-hunk (beg end old)
"Highlight source language syntax in diff hunk between BEG and END.
When OLD is non-nil, highlight the hunk from the old source."
@@ -2867,22 +2966,8 @@ When OLD is non-nil, highlight the hunk from the old source."
(insert-file-contents file)
(setq diff--syntax-file-attributes attrs)))
(diff-syntax-fontify-props file text line-nb)))))
- ;; Get properties from a cached revision
- (let* ((buffer-name (format " *diff-syntax:%s.~%s~*"
- file revision))
- (buffer (get-buffer buffer-name)))
- (if buffer
- ;; Don't re-initialize the buffer (which would throw
- ;; away the previous fontification work).
- (setq file nil)
- (setq buffer (ignore-errors
- (vc-find-revision-no-save
- file revision
- diff-vc-backend
- (get-buffer-create buffer-name)))))
- (when buffer
- (with-current-buffer buffer
- (diff-syntax-fontify-props file text line-nb))))))))
+ (diff--get-revision-properties file revision
+ text line-nb)))))
(let ((file (car (diff-hunk-file-names old))))
(cond
((and file diff-default-directory
@@ -3014,7 +3099,7 @@ hunk text is not found in the source file."
(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)))
+ (list backend (delete nil (nreverse files)) nil nil 'patch)))
(defun diff--filter-substring (str)
(when diff-font-lock-prettify
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 72867f14d2f..1f766eea455 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -575,19 +575,82 @@ the \\[vc-prefix-map] prefix for VC commands, for example).
"Insert FUNC-NAMES, following ChangeLog formatting."
(if (not func-names)
(insert ":")
+ ;; Insert a space unless this list of defun names is being
+ ;; inserted at the start of a line or after a space character.
(unless (or (memq (char-before) '(?\n ?\s))
(> (current-column) fill-column))
(insert " "))
- (cl-loop for first-fun = t then nil
- for def in func-names do
- (when (> (+ (current-column) (string-width def)) fill-column)
- (unless first-fun
- (insert ")"))
- (insert "\n"))
- (insert (if (memq (char-before) '(?\n ?\s))
- "(" ", ")
- def))
- (insert "):")))
+ (let ((inside-paren-pair nil)
+ (first-line t)
+ name)
+ ;; Now insert the functions names one by one, inserting newlines
+ ;; as appropriate.
+ (while func-names
+ (setq name (car func-names))
+ (setq func-names (cdr func-names))
+ ;; If inserting `name' after preexisting text in the first
+ ;; line would overflow the fill column, place it on its own
+ ;; line.
+ (if (and first-line
+ (> (current-column) 0)
+ (> (+ (current-column)
+ (string-width name)
+ ;; If this be the last name, the column must be
+ ;; followed by an extra colon character.
+ (if func-names 1 2))
+ fill-column))
+ (progn
+ (insert "\n")
+ ;; Iterate over this function name again.
+ (setq func-names (cons name func-names)))
+ (if inside-paren-pair
+ ;; If `name' is not the first item in a list of defuns
+ ;; and inserting it would overflow the fill column,
+ ;; start a new list of defuns on the next line.
+ (if (> (+ (current-column)
+ (string-width name)
+ ;; If this be the last name, the column must
+ ;; be followed by an extra colon character;
+ ;; however, there are two separator characters
+ ;; that will be deleted, so the number of
+ ;; columns to add to this in the case of
+ ;; `name' being final and in other cases are 0
+ ;; and 1 respectively.
+ (if func-names 0 1))
+ fill-column)
+ (progn
+ (delete-char -2)
+ (insert ")\n")
+ (setq inside-paren-pair nil
+ ;; Iterate over this function name again.
+ func-names (cons name func-names)))
+ ;; Insert this defun name with a separator attached.
+ (insert name ", "))
+ ;; Otherwise, decide whether to start a list of defuns or
+ ;; to insert `name' on its own line.
+ (if (> (+ (current-column)
+ (string-width name)
+ (if func-names 1 2)) ; The column number of
+ ; line after inserting
+ ; `name'...
+ fill-column)
+ ;; ...would leave insufficient space for any
+ ;; subsequent defun names so insert it on its own
+ ;; line.
+ (insert (if func-names
+ (format "(%s)\n" name)
+ (format "(%s):" name)))
+ ;; Insert a new defun list, unless `name' is the last
+ ;; function name.
+ (insert (if (not func-names)
+ (format "(%s):" name)
+ (setq inside-paren-pair t)
+ (format "(%s, " name))))))
+ (setq first-line nil))
+ ;; Close any open list of defuns.
+ (when inside-paren-pair
+ (delete-char -2)
+ (insert "):")))))
(defun log-edit-fill-entry (&optional justify)
"Like \\[fill-paragraph], but for filling ChangeLog-formatted entries.
@@ -595,32 +658,70 @@ Consecutive function entries without prose (i.e., lines of the
form \"(FUNCTION):\") will be combined into \"(FUNC1, FUNC2):\"
according to `fill-column'."
(save-excursion
- (pcase-let ((`(,beg ,end) (log-edit-changelog-paragraph)))
+ (let* ((range (log-edit-changelog-paragraph))
+ (beg (car range))
+ (end (cadr range)))
(if (= beg end)
;; Not a ChangeLog entry, fill as normal.
nil
- (cl-callf copy-marker end)
+ (setq end (copy-marker end))
(goto-char beg)
- (cl-loop
- for defuns-beg =
- (and (< beg end)
- (re-search-forward
- (concat "\\(?1:" change-log-unindented-file-names-re
- "\\)\\|^\\(?1:\\)[[:blank:]]*(")
- end t)
- (copy-marker (match-end 1)))
- ;; Fill prose between log entries.
- do (let ((fill-indent-according-to-mode t)
- (end (if defuns-beg (match-beginning 0) end))
- (beg (progn (goto-char beg) (line-beginning-position))))
- (when (<= (line-end-position) end)
- (fill-region beg end justify)))
- while defuns-beg
- for defuns = (progn (goto-char defuns-beg)
- (change-log-read-defuns end))
- do (progn (delete-region defuns-beg (point))
- (log-edit--insert-filled-defuns defuns)
- (setq beg (point))))
+ (let* ((defuns-beg nil)
+ (defuns nil))
+ (while
+ (progn
+ ;; Match a regexp against the next ChangeLog entry.
+ ;; `defuns-beg' will be the end of the file name,
+ ;; which marks the beginning of the list of defuns.
+ (setq defuns-beg
+ (and (< beg end)
+ (re-search-forward
+ (concat "\\(?1:"
+ change-log-unindented-file-names-re
+ "\\)\\|^\\(?1:\\)[[:blank:]]*(")
+ end t)
+ (copy-marker (match-end 1))))
+ ;; Fill the intervening prose between the end of the
+ ;; last match and the beginning of the current match.
+ (let ((fill-indent-according-to-mode t)
+ (end (if defuns-beg
+ (match-beginning 0) end))
+ (beg (progn (goto-char beg)
+ (line-beginning-position)))
+ space-beg space-end)
+ (when (<= (line-end-position) end)
+ ;; Replace space characters within parentheses
+ ;; that resemble ChangeLog defun names between BEG
+ ;; and END with non-breaking spaces to prevent
+ ;; them from being considered break points by
+ ;; `fill-region'.
+ (save-excursion
+ (goto-char beg)
+ (when (re-search-forward
+ "^[[:blank:]]*(.*\\([[:space:]]\\).*):"
+ end t)
+ (replace-regexp-in-region "[[:space:]]" "Ā "
+ (setq space-beg
+ (copy-marker
+ (match-beginning 0)))
+ (setq space-end
+ (copy-marker
+ (match-end 0))))))
+ (fill-region beg end justify))
+ ;; Restore the spaces replaced by NBSPs.
+ (when space-beg
+ (replace-string-in-region "Ā " " "
+ space-beg space-end)
+ (set-marker space-beg nil)
+ (set-marker space-end nil)))
+ defuns-beg)
+ (goto-char defuns-beg)
+ (setq defuns (change-log-read-defuns end))
+ (progn
+ (delete-region defuns-beg (point))
+ (log-edit--insert-filled-defuns defuns)
+ (setq beg (point))))
+ nil)
t))))
(defun log-edit-hide-buf (&optional buf where)
@@ -1288,3 +1389,7 @@ line of MSG."
(provide 'log-edit)
;;; log-edit.el ends here
+
+;; Local Variables:
+;; coding: utf-8-unix
+;; End:
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 52039f8da74..63b566b0afe 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -476,7 +476,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(concat "-j" first-revision)
(concat "-j" second-revision))
(vc-file-setprop file 'vc-state 'edited)
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
(if (re-search-forward "conflicts during merge" nil t)
(progn
@@ -495,7 +495,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(vc-cvs-command nil nil file "update")
;; Analyze the merge result reported by CVS, and set
;; file properties accordingly.
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
;; get new working revision
(if (re-search-forward
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index fed15ae2033..b23a5ca95a1 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -817,27 +817,31 @@ or an empty string if none."
cmds))
(defun vc-git-dir-extra-headers (dir)
- (let ((str (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "symbolic-ref" "HEAD"))))
+ (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
(stash-list (vc-git-stash-list))
(default-directory dir)
(in-progress (vc-git--cmds-in-progress))
- branch remote remote-url stash-button stash-string)
+ branch remote-url stash-button stash-string tracking-branch)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
(progn
(setq branch (match-string 2 str))
- (setq remote
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "branch." branch ".remote")))))
- (when (string-match "\\([^\n]+\\)" remote)
- (setq remote (match-string 1 remote)))
- (when (> (length remote) 0)
- (setq remote-url (vc-git-repository-url dir remote))))
- (setq branch "not (detached HEAD)"))
+ (let ((remote (vc-git--out-str
+ "config" (concat "branch." branch ".remote")))
+ (merge (vc-git--out-str
+ "config" (concat "branch." branch ".merge"))))
+ (when (string-match "\\([^\n]+\\)" remote)
+ (setq remote (match-string 1 remote)))
+ (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
+ (setq tracking-branch (match-string 2 merge)))
+ (pcase remote
+ ("."
+ (setq remote-url "none (tracking local branch)"))
+ ((pred (not string-empty-p))
+ (setq
+ remote-url (vc-git-repository-url dir remote)
+ tracking-branch (concat remote "/" tracking-branch))))))
+ (setq branch "none (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
(limit
@@ -890,6 +894,11 @@ or an empty string if none."
(propertize "Branch : " 'face 'vc-dir-header)
(propertize branch
'face 'vc-dir-header-value)
+ (when tracking-branch
+ (concat
+ "\n"
+ (propertize "Tracking : " 'face 'vc-dir-header)
+ (propertize tracking-branch 'face 'vc-dir-header-value)))
(when remote-url
(concat
"\n"
@@ -1411,9 +1420,16 @@ This prompts for a branch to merge from."
(vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-git-clone (remote directory rev)
- (if rev
- (vc-git--out-ok "clone" "--branch" rev remote directory)
+ "Attempt to clone REMOTE repository into DIRECTORY at revision REV."
+ (cond
+ ((null rev)
(vc-git--out-ok "clone" remote directory))
+ ((ignore-errors
+ (vc-git--out-ok "clone" "--branch" rev remote directory)))
+ ((vc-git--out-ok "clone" remote directory)
+ (let ((default-directory directory))
+ (vc-git--out-ok "checkout" rev)))
+ ((error "Failed to check out %s at %s" remote rev)))
directory)
;;; HISTORY FUNCTIONS
@@ -1982,6 +1998,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defvar compilation-environment)
;; Derived from `lgrep'.
+;;;###autoload
(defun vc-git-grep (regexp &optional files dir)
"Run git grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
@@ -2218,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes
(apply #'process-file vc-git-program nil buffer nil "--no-pager" command args)))
(defun vc-git--out-ok (command &rest args)
+ "Run `git COMMAND ARGS...' and insert standard output in current buffer.
+Return whether the process exited with status zero."
(zerop (apply #'vc-git--call '(t nil) command args)))
+(defun vc-git--out-str (command &rest args)
+ "Run `git COMMAND ARGS...' and return standard output as a string.
+The exit status is ignored."
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (apply #'vc-git--out-ok command args))))
+
(defun vc-git--run-command-string (file &rest args)
"Run a git command on FILE and return its output as string.
FILE can be nil."
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 1ef1388e21f..8f212e96933 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -185,8 +185,9 @@ revision number and lock status."
"Version Control minor mode.
This minor mode is automatically activated whenever you visit a file under
control of one of the revision control systems in `vc-handled-backends'.
-VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
-\\{vc-prefix-map}")
+VC commands are globally reachable under the prefix \\[vc-prefix-map]:
+\\{vc-prefix-map}"
+ nil)
(defmacro vc-error-occurred (&rest body)
`(condition-case nil (progn ,@body nil) (error t)))
@@ -197,7 +198,7 @@ VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
;; during any subsequent VC operations, and forget them when
;; the buffer is killed.
-(defvar vc-file-prop-obarray (make-vector 17 0)
+(defvar vc-file-prop-obarray (obarray-make 17)
"Obarray for per-file properties.")
(defvar vc-touched-properties nil)
@@ -325,30 +326,37 @@ This function performs the check each time it is called. To rely
on the result of a previous call, use `vc-backend' instead. If the
file was previously registered under a certain backend, then that
backend is tried first."
- (let (handler)
- (cond
- ((and (file-name-directory file)
- (string-match vc-ignore-dir-regexp (file-name-directory file)))
- nil)
- ((setq handler (find-file-name-handler file 'vc-registered))
- ;; handler should set vc-backend and return t if registered
- (funcall handler 'vc-registered file))
- (t
- ;; There is no file name handler.
- ;; Try vc-BACKEND-registered for each handled BACKEND.
- (catch 'found
- (let ((backend (vc-file-getprop file 'vc-backend)))
- (mapc
- (lambda (b)
- (and (vc-call-backend b 'registered file)
- (vc-file-setprop file 'vc-backend b)
- (throw 'found t)))
- (if (or (not backend) (eq backend 'none))
- vc-handled-backends
- (cons backend vc-handled-backends))))
- ;; File is not registered.
- (vc-file-setprop file 'vc-backend 'none)
- nil)))))
+ ;; Subprocesses (and with them, VC backends) can't run from /contents
+ ;; or /actions, which are fictions maintained by Emacs that do not
+ ;; exist in the filesystem.
+ (if (and (eq system-type 'android)
+ (string-match-p "/\\(content\\|assets\\)[/$]"
+ (expand-file-name file)))
+ nil
+ (let (handler)
+ (cond
+ ((and (file-name-directory file)
+ (string-match vc-ignore-dir-regexp (file-name-directory file)))
+ nil)
+ ((setq handler (find-file-name-handler file 'vc-registered))
+ ;; handler should set vc-backend and return t if registered
+ (funcall handler 'vc-registered file))
+ (t
+ ;; There is no file name handler.
+ ;; Try vc-BACKEND-registered for each handled BACKEND.
+ (catch 'found
+ (let ((backend (vc-file-getprop file 'vc-backend)))
+ (mapc
+ (lambda (b)
+ (and (vc-call-backend b 'registered file)
+ (vc-file-setprop file 'vc-backend b)
+ (throw 'found t)))
+ (if (or (not backend) (eq backend 'none))
+ vc-handled-backends
+ (cons backend vc-handled-backends))))
+ ;; File is not registered.
+ (vc-file-setprop file 'vc-backend 'none)
+ nil))))))
(defun vc-backend (file-or-list)
"Return the version control type of FILE-OR-LIST, nil if it's not registered.
@@ -356,15 +364,22 @@ If the argument is a list, the files must all have the same back end."
;; `file' can be nil in several places (typically due to the use of
;; code like (vc-backend buffer-file-name)).
(cond ((stringp file-or-list)
- (let ((property (vc-file-getprop file-or-list 'vc-backend)))
- ;; Note that internally, Emacs remembers unregistered
- ;; files by setting the property to `none'.
- (cond ((eq property 'none) nil)
- (property)
- ;; vc-registered sets the vc-backend property
- (t (if (vc-registered file-or-list)
- (vc-file-getprop file-or-list 'vc-backend)
- nil)))))
+ ;; Subprocesses (and with them, VC backends) can't run from
+ ;; /contents or /actions, which are fictions maintained by
+ ;; Emacs that do not exist in the filesystem.
+ (if (and (eq system-type 'android)
+ (string-match-p "/\\(content\\|assets\\)[/$]"
+ (expand-file-name file-or-list)))
+ nil
+ (let ((property (vc-file-getprop file-or-list 'vc-backend)))
+ ;; Note that internally, Emacs remembers unregistered
+ ;; files by setting the property to `none'.
+ (cond ((eq property 'none) nil)
+ (property)
+ ;; vc-registered sets the vc-backend property
+ (t (if (vc-registered file-or-list)
+ (vc-file-getprop file-or-list 'vc-backend)
+ nil))))))
((and file-or-list (listp file-or-list))
(vc-backend (car file-or-list)))
(t
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 1a43b440d18..33377ce1cc8 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1177,7 +1177,7 @@ variable `vc-rcs-release' is set to the returned value."
(or vc-rcs-release
(setq vc-rcs-release
(or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V"))
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1)))
'unknown))))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 96baa642b44..ae281e54519 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -436,7 +436,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(concat first-version ":" second-version)
first-version))
(vc-file-setprop file 'vc-state 'edited)
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
(if (looking-at "C ")
1 ; signal conflict
@@ -450,7 +450,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(vc-svn-command nil 0 file "update")
;; Analyze the merge result reported by SVN, and set
;; file properties accordingly.
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
;; get new working revision
(if (re-search-forward
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index b8cc44fc3dc..f26e5cc751d 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -935,7 +935,7 @@ is sensitive to blank lines."
(defun vc-clear-context ()
"Clear all cached file properties."
(interactive)
- (fillarray vc-file-prop-obarray 0))
+ (obarray-clear vc-file-prop-obarray))
(defmacro with-vc-properties (files form settings)
"Execute FORM, then maybe set per-file properties for FILES.
@@ -2703,20 +2703,22 @@ Not all VC backends support short logs!")
(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return)
"Insert at the end of the current buffer buttons to show more log entries.
In the new log, leave point at WORKING-REVISION (if non-nil).
-LIMIT is the current maximum number of entries shown. Does
-nothing if IS-START-REVISION is non-nil and LIMIT is 1, or if
-LIMIT is nil, or if PL-RETURN is `limit-unsupported'."
+LIMIT is the current maximum number of entries shown, or the
+revision (string) before which to stop. Does nothing if
+IS-START-REVISION is non-nil and LIMIT is 1, or if LIMIT is nil,
+or if PL-RETURN is `limit-unsupported'."
;; LIMIT=1 is set by vc-annotate-show-log-revision-at-line
;; or by vc-print-root-log with current-prefix-arg=1.
;; In either case only one revision is wanted, no buttons.
(when (and limit (not (eq 'limit-unsupported pl-return))
(not (and is-start-revision
- (= limit 1))))
+ (eql limit 1))))
(let ((entries 0))
(goto-char (point-min))
(while (re-search-forward log-view-message-re nil t)
(cl-incf entries))
- (if (< entries limit)
+ (if (or (stringp limit)
+ (< entries limit))
;; The log has been printed in full. Perhaps it started
;; with a copy or rename?
;; FIXME: We'd probably still want this button even when
@@ -2811,7 +2813,8 @@ button for. Same for CURRENT-REVISION. LIMIT means the usual."
Leave point at WORKING-REVISION, if it is non-nil.
If IS-START-REVISION is non-nil, start the log from WORKING-REVISION
\(not all backends support this); i.e., show only WORKING-REVISION and
-earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
+earlier revisions. Show up to LIMIT entries (nil means unlimited).
+LIMIT can also be a string, which means the revision before which to stop."
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
;; buffer can be accessed by the command.
@@ -3620,7 +3623,15 @@ revisions.
When invoked interactively in a Log View buffer with
marked revisions, use those."
(interactive
- (let ((revs (vc-prepare-patch-prompt-revisions)) to)
+ (let* ((revs (vc-prepare-patch-prompt-revisions))
+ (subject
+ (and (length= revs 1)
+ (plist-get
+ (vc-call-backend
+ (vc-responsible-backend default-directory)
+ 'prepare-patch (car revs))
+ :subject)))
+ to)
(require 'message)
(while (null (setq to (completing-read-multiple
(format-prompt
@@ -3633,10 +3644,9 @@ marked revisions, use those."
(sit-for blink-matching-delay))
(list (string-join to ", ")
(and (not vc-prepare-patches-separately)
- (read-string "Subject: " "[PATCH] " nil nil t))
+ (read-string "Subject: " (or 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)
@@ -3791,11 +3801,16 @@ to provide the `find-revision' operation instead."
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
(defun vc-clone (remote &optional backend directory rev)
- "Use BACKEND to clone REMOTE into DIRECTORY.
-If successful, returns the string with the directory of the
-checkout. If BACKEND is nil, iterate through every known backend
-in `vc-handled-backends' until one succeeds. If REV is non-nil,
-it indicates a specific revision to check out."
+ "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
+If successful, return the string with the directory of the checkout;
+otherwise return nil.
+REMOTE should be a string, the URL of the remote repository or the name
+of a directory (if the repository is local).
+If DIRECTORY is nil or omitted, it defaults to `default-directory'.
+If BACKEND is nil or omitted, the function iterates through every known
+backend in `vc-handled-backends' until one succeeds to clone REMOTE.
+If REV is non-nil, it indicates a specific revision to check out after
+cloning; the syntax of REV depends on what BACKEND accepts."
(setq directory (expand-file-name (or directory default-directory)))
(if backend
(progn
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index ec5adbd832c..15791285b13 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -433,7 +433,7 @@ Default is nil."
(defcustom vcursor-interpret-input nil
"If non-nil, input from the vcursor is treated as interactive input.
This will cause text insertion to be much slower. Note that no special
-interpretation of strings is done: \"\C-x\" is a string of four
+interpretation of strings is done: \"\\C-x\" is a string of four
characters. The default is simply to copy strings."
:type 'boolean
:version "20.3")
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
new file mode 100644
index 00000000000..d95cf4bb569
--- /dev/null
+++ b/lisp/visual-wrap.el
@@ -0,0 +1,204 @@
+;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix -*- lexical-binding: t -*-
+
+;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc.
+
+;; Author: Stephen Berman <stephen.berman@gmx.net>
+;; Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: convenience
+;; Package: emacs
+
+;; This file is part of GNU Emacs.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides the `visual-wrap-prefix-mode' minor mode
+;; which sets the wrap-prefix property on the fly so that
+;; single-long-line paragraphs get word-wrapped in a way similar to
+;; what you'd get with M-q using adaptive-fill-mode, but without
+;; actually changing the buffer's text.
+
+;;; Code:
+
+(defcustom visual-wrap-extra-indent 0
+ "Number of extra spaces to indent in `visual-wrap-prefix-mode'.
+
+`visual-wrap-prefix-mode' indents the visual lines to the level
+of the actual line plus `visual-wrap-extra-indent'. A negative
+value will do a relative de-indent.
+
+Examples:
+
+actual indent = 2
+extra indent = -1
+
+ Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
+ do eiusmod tempor incididunt ut labore et dolore magna
+ aliqua. Ut enim ad minim veniam, quis nostrud exercitation
+ ullamco laboris nisi ut aliquip ex ea commodo consequat.
+
+actual indent = 2
+extra indent = 2
+
+ Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
+ do eiusmod tempor incididunt ut labore et dolore magna
+ aliqua. Ut enim ad minim veniam, quis nostrud exercitation
+ ullamco laboris nisi ut aliquip ex ea commodo consequat."
+ :type 'integer
+ :safe 'integerp
+ :version "30.1"
+ :group 'visual-line)
+
+(defun visual-wrap--face-extend-p (face)
+ ;; Before Emacs 27, faces always extended beyond EOL, so we check
+ ;; for a non-default background instead.
+ (cond
+ ((listp face)
+ (plist-get face (if (fboundp 'face-extend-p) :extend :background)))
+ ((symbolp face)
+ (if (fboundp 'face-extend-p)
+ (face-extend-p face nil t)
+ (face-background face nil t)))))
+
+(defun visual-wrap--prefix-face (fcp _beg end)
+ ;; If the fill-context-prefix already specifies a face, just use that.
+ (cond ((get-text-property 0 'face fcp))
+ ;; Else, if the last character is a newline and has a face
+ ;; that extends beyond EOL, assume that this face spans the
+ ;; whole line and apply it to the prefix to preserve the
+ ;; "block" visual effect.
+ ;;
+ ;; NB: the face might not actually span the whole line: see
+ ;; for example removed lines in diff-mode, where the first
+ ;; character has the diff-indicator-removed face, while the
+ ;; rest of the line has the diff-removed face.
+ ((= (char-before end) ?\n)
+ (let ((eol-face (get-text-property (1- end) 'face)))
+ ;; `eol-face' can be a face, a "face value"
+ ;; (plist of face properties) or a list of one of those.
+ (if (or (not (consp eol-face)) (keywordp (car eol-face)))
+ ;; A single face.
+ (if (visual-wrap--face-extend-p eol-face) eol-face)
+ ;; A list of faces. Keep the ones that extend beyond EOL.
+ (delq nil (mapcar (lambda (f)
+ (if (visual-wrap--face-extend-p f) f))
+ eol-face)))))))
+
+(defun visual-wrap--prefix (fcp)
+ (let ((fcp-len (string-width fcp)))
+ (cond
+ ((= 0 visual-wrap-extra-indent)
+ fcp)
+ ((< 0 visual-wrap-extra-indent)
+ (concat fcp (make-string visual-wrap-extra-indent ?\s)))
+ ((< 0 (+ visual-wrap-extra-indent fcp-len))
+ (substring fcp
+ 0
+ (+ visual-wrap-extra-indent fcp-len)))
+ (t
+ ""))))
+
+(defun visual-wrap-fill-context-prefix (beg end)
+ "Compute visual wrap prefix from text between BEG and END.
+This is like `fill-context-prefix', but with prefix length adjusted
+by `visual-wrap-extra-indent'."
+ (let* ((fcp
+ ;; `fill-context-prefix' ignores prefixes that look like
+ ;; paragraph starts, in order to avoid inadvertently
+ ;; creating a new paragraph while filling, but here we're
+ ;; only dealing with single-line "paragraphs" and we don't
+ ;; actually modify the buffer, so this restriction doesn't
+ ;; make much sense (and is positively harmful in
+ ;; taskpaper-mode where paragraph-start matches everything).
+ (or (let ((paragraph-start regexp-unmatchable))
+ (fill-context-prefix beg end))
+ ;; Note: fill-context-prefix may return nil; See:
+ ;; http://article.gmane.org/gmane.emacs.devel/156285
+ ""))
+ (prefix (visual-wrap--prefix fcp))
+ (face (visual-wrap--prefix-face fcp beg end)))
+ (if face
+ (propertize prefix 'face face)
+ prefix)))
+
+(defun visual-wrap-prefix-function (beg end)
+ "Indent the region between BEG and END with visual filling."
+ ;; Any change at the beginning of a line might change its wrap
+ ;; prefix, which affects the whole line. So we need to "round-up"
+ ;; `end' to the nearest end of line. We do the same with `beg'
+ ;; although it's probably not needed.
+ (goto-char end)
+ (unless (bolp) (forward-line 1))
+ (setq end (point))
+ (goto-char beg)
+ (forward-line 0)
+ (setq beg (point))
+ (while (< (point) end)
+ (let ((lbp (point)))
+ (put-text-property
+ (point) (progn (search-forward "\n" end 'move) (point))
+ 'wrap-prefix
+ (let ((pfx (visual-wrap-fill-context-prefix
+ lbp (point))))
+ ;; Remove any `wrap-prefix' property that might have been
+ ;; added earlier. Otherwise, we end up with a string
+ ;; containing a `wrap-prefix' string containing a
+ ;; `wrap-prefix' string ...
+ (remove-text-properties
+ 0 (length pfx) '(wrap-prefix) pfx)
+ (let ((dp (get-text-property 0 'display pfx)))
+ (when (and dp (eq dp (get-text-property (1- lbp) 'display)))
+ ;; There's a `display' property which covers not just the
+ ;; prefix but also the previous newline. So it's not
+ ;; just making the prefix more pretty and could interfere
+ ;; or even defeat our efforts (e.g. it comes from
+ ;; `adaptive-fill-mode').
+ (remove-text-properties
+ 0 (length pfx) '(display) pfx)))
+ pfx))))
+ `(jit-lock-bounds ,beg . ,end))
+
+;;;###autoload
+(define-minor-mode visual-wrap-prefix-mode
+ "Display continuation lines with prefixes from surrounding context.
+To enable this minor mode across all buffers, enable
+`global-visual-wrap-prefix-mode'."
+ :lighter ""
+ :group 'visual-line
+ (if visual-wrap-prefix-mode
+ (progn
+ ;; HACK ATTACK! We want to run after font-lock (so our
+ ;; wrap-prefix includes the faces applied by font-lock), but
+ ;; jit-lock-register doesn't accept an `append' argument, so
+ ;; we add ourselves beforehand, to make sure we're at the end
+ ;; of the hook (bug#15155).
+ (add-hook 'jit-lock-functions
+ #'visual-wrap-prefix-function 'append t)
+ (jit-lock-register #'visual-wrap-prefix-function))
+ (jit-lock-unregister #'visual-wrap-prefix-function)
+ (with-silent-modifications
+ (save-restriction
+ (widen)
+ (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))
+
+;;;###autoload
+(define-globalized-minor-mode global-visual-wrap-prefix-mode
+ visual-wrap-prefix-mode visual-wrap-prefix-mode
+ :init-value nil
+ :group 'visual-line)
+
+(provide 'visual-wrap)
+;;; visual-wrap.el ends here
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 6f47e32beb5..15c1b83fcc1 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1774,10 +1774,10 @@ cleaning up these problems."
(when has-bogus
(goto-char (point-max))
(insert (substitute-command-keys
- " Type `\\[whitespace-cleanup]'")
+ " Type \\[whitespace-cleanup]")
" to cleanup the buffer.\n\n"
(substitute-command-keys
- " Type `\\[whitespace-cleanup-region]'")
+ " Type \\[whitespace-cleanup-region]")
" to cleanup a region.\n\n"))
(whitespace-display-window (current-buffer))))))
has-bogus)))
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index bb56f3f62fb..d4000187bd1 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -141,7 +141,7 @@ The following commands are available:
(setq key (nth 0 items)
value (nth 1 items)
printer (or (get key 'widget-keyword-printer)
- 'widget-browse-sexp)
+ #'widget-browse-sexp)
items (cdr (cdr items)))
(widget-insert "\n" (symbol-name key) "\n\t")
(funcall printer widget key value)
@@ -204,24 +204,10 @@ VALUE is assumed to be a list of widgets."
(defun widget-browse-sexp (_widget _key value)
"Insert description of WIDGET's KEY VALUE.
Nothing is assumed about value."
- (let ((pp (condition-case signal
- (pp-to-string value)
- (error (prin1-to-string signal)))))
- (when (string-match "\n\\'" pp)
- (setq pp (substring pp 0 (1- (length pp)))))
- (if (cond ((string-search "\n" pp)
- nil)
- ((> (length pp) (- (window-width) (current-column)))
- nil)
- (t t))
- (widget-insert pp)
- (widget-create 'push-button
- :tag "show"
- :action (lambda (widget &optional _event)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ (widget-get widget :value))))
- pp))))
+ (require 'pp)
+ (declare-function pp-insert-short-sexp "pp" (sexp &optional width))
+ (widget--allow-insertion
+ (pp-insert-short-sexp value)))
(defun widget-browse-sexps (widget key value)
"Insert description of WIDGET's KEY VALUE.
@@ -235,11 +221,11 @@ VALUE is assumed to be a list of widgets."
;;; Keyword Printers.
-(put :parent 'widget-keyword-printer 'widget-browse-widget)
-(put :children 'widget-keyword-printer 'widget-browse-widgets)
-(put :buttons 'widget-keyword-printer 'widget-browse-widgets)
-(put :button 'widget-keyword-printer 'widget-browse-widget)
-(put :args 'widget-keyword-printer 'widget-browse-sexps)
+(put :parent 'widget-keyword-printer #'widget-browse-widget)
+(put :children 'widget-keyword-printer #'widget-browse-widgets)
+(put :buttons 'widget-keyword-printer #'widget-browse-widgets)
+(put :button 'widget-keyword-printer #'widget-browse-widget)
+(put :args 'widget-keyword-printer #'widget-browse-sexps)
;;; Widget Minor Mode.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index cd06acd3f99..172da3db1e0 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,4 +1,4 @@
-;;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*-
+;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*-
;;
;; Copyright (C) 1996-1997, 1999-2024 Free Software Foundation, Inc.
;;
@@ -247,10 +247,10 @@ to evaluate to nil for the menu item to be meaningful."
(eq (car value) :radio))
(setq selected (cdr value))))
(setq plist (cddr plist)))
- (when (and (eval visible)
- (eval enable)
+ (when (and (eval visible t)
+ (eval enable t)
(or (not selected)
- (not (eval selected))))
+ (not (eval selected t))))
(push (cons (nth 1 def) ev) simplified)))))
extended)
(reverse simplified)))
@@ -317,7 +317,7 @@ in the key vector, as in the argument of `define-key'."
(when (keymapp items)
(setq items (widget--simplify-menu items)))
;; Read the choice of name from the minibuffer.
- (setq items (cl-remove-if 'stringp items))
+ (setq items (cl-remove-if #'stringp items))
(let ((val (completing-read (concat title ": ") items nil t)))
(if (stringp val)
(let ((try (try-completion val items)))
@@ -330,12 +330,11 @@ in the key vector, as in the argument of `define-key'."
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
(let ((next-digit ?0)
- alist choice some-choice-enabled value)
+ alist some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
- (while items
- (setq choice (pop items))
+ (dolist (choice items)
(when (consp choice)
(insert (format "%c = %s\n" next-digit (car choice)))
(push (cons next-digit (cdr choice)) alist)
@@ -510,14 +509,20 @@ With CHECK-AFTER non-nil, considers also the content after point, if needed."
;; indented it.
(not (eq (following-char) ?\s))))))
-(defmacro widget-specify-insert (&rest form)
- "Execute FORM without inheriting any text properties."
- (declare (debug (body)))
+(defmacro widget--allow-insertion (&rest forms)
+ "Run FORMS such that they can insert widgets in the current buffer."
+ (declare (debug t))
+ `(let ((inhibit-read-only t)
+ (inhibit-modification-hooks t)) ;; FIXME: Why? This is risky!
+ ,@forms))
+
+(defmacro widget-specify-insert (&rest forms)
+ "Execute FORMS without inheriting any text properties."
+ (declare (debug t))
`(save-restriction
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
+ (widget--allow-insertion
(narrow-to-region (point) (point))
- (prog1 (progn ,@form)
+ (prog1 (progn ,@forms)
(goto-char (point-max))))))
(defface widget-inactive
@@ -659,12 +664,9 @@ The current value is assumed to be VALUE, unless UNBOUND is non-nil."
(defun widget-get-sibling (widget)
"Get the item WIDGET is assumed to toggle.
This is only meaningful for radio buttons or checkboxes in a list."
- (let* ((children (widget-get (widget-get widget :parent) :children))
- child)
+ (let* ((children (widget-get (widget-get widget :parent) :children)))
(catch 'child
- (while children
- (setq child (car children)
- children (cdr children))
+ (dolist (child children)
(when (eq (widget-get child :button) widget)
(throw 'child child)))
nil)))
@@ -844,14 +846,14 @@ button is pressed or inactive, respectively. These are currently ignored."
(defun widget-create (type &rest args)
"Create widget of TYPE.
The optional ARGS are additional keyword arguments."
- (let ((widget (apply 'widget-convert type args)))
+ (let ((widget (apply #'widget-convert type args)))
(widget-apply widget :create)
widget))
(defun widget-create-child-and-convert (parent type &rest args)
"As part of the widget PARENT, create a child widget TYPE.
The child is converted, using the keyword arguments ARGS."
- (let ((widget (apply 'widget-convert type args)))
+ (let ((widget (apply #'widget-convert type args)))
(widget-put widget :parent parent)
(unless (widget-get widget :indent)
(widget-put widget :indent (+ (or (widget-get parent :indent) 0)
@@ -905,18 +907,19 @@ The optional ARGS are additional keyword arguments."
(keys args))
;; First set the :args keyword.
(while (cdr current) ;Look in the type.
- (if (and (keywordp (cadr current))
- ;; If the last element is a keyword,
- ;; it is still the :args element,
- ;; even though it is a keyword.
- (cddr current))
- (if (eq (cadr current) :args)
- ;; If :args is explicitly specified, obey it.
- (setq current nil)
- ;; Some other irrelevant keyword.
- (setq current (cdr (cdr current))))
- (setcdr current (list :args (cdr current)))
- (setq current nil)))
+ (setq current
+ (if (and (keywordp (cadr current))
+ ;; If the last element is a keyword,
+ ;; it is still the :args element,
+ ;; even though it is a keyword.
+ (cddr current))
+ (if (eq (cadr current) :args)
+ ;; If :args is explicitly specified, obey it.
+ nil
+ ;; Some other irrelevant keyword.
+ (cdr (cdr current)))
+ (setcdr current (list :args (cdr current)))
+ nil)))
(while (and args (not done)) ;Look in ARGS.
(cond ((eq (car args) :args)
;; Handle explicit specification of :args.
@@ -937,11 +940,9 @@ The optional ARGS are additional keyword arguments."
;; Finally set the keyword args.
(while keys
(let ((next (nth 0 keys)))
- (if (keywordp next)
- (progn
- (widget-put widget next (nth 1 keys))
- (setq keys (nthcdr 2 keys)))
- (setq keys nil))))
+ (setq keys (when (keywordp next)
+ (widget-put widget next (nth 1 keys))
+ (nthcdr 2 keys)))))
;; Convert the :value to internal format.
(if (widget-member widget :value)
(widget-put widget
@@ -954,9 +955,8 @@ The optional ARGS are additional keyword arguments."
;;;###autoload
(defun widget-insert (&rest args)
"Call `insert' with ARGS even if surrounding text is read only."
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
- (apply 'insert args)))
+ (widget--allow-insertion
+ (apply #'insert args)))
(defun widget-convert-text (type from to
&optional button-from button-to
@@ -967,7 +967,7 @@ and TO will be used as the widgets end points. If optional arguments
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
button end points.
Optional ARGS are extra keyword arguments for TYPE."
- (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
+ (let ((widget (apply #'widget-convert type :delete 'widget-leave-text args))
(from (copy-marker from))
(to (copy-marker to)))
(set-marker-insertion-type from t)
@@ -984,7 +984,7 @@ Optional ARGS are extra keyword arguments for TYPE.
No text will be inserted to the buffer, instead the text between FROM
and TO will be used as the widgets end points, as well as the widgets
button end points."
- (apply 'widget-convert-text type from to from to args))
+ (apply #'widget-convert-text type from to from to args))
(defun widget-leave-text (widget)
"Remove markers and overlays from WIDGET and its children."
@@ -1002,7 +1002,7 @@ button end points."
(delete-overlay doc))
(when field
(delete-overlay field))
- (mapc 'widget-leave-text (widget-get widget :children))))
+ (mapc #'widget-leave-text (widget-get widget :children))))
(defun widget-text (widget)
"Get the text representation of the widget."
@@ -1017,7 +1017,7 @@ button end points."
;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html
(define-obsolete-function-alias 'advertised-widget-backward
- 'widget-backward "23.2")
+ #'widget-backward "23.2")
;;;###autoload
(defvar widget-keymap
@@ -1043,13 +1043,13 @@ Note that such modes will need to require wid-edit.")
(defvar widget-field-keymap
(let ((map (copy-keymap widget-keymap)))
- (define-key map "\C-k" 'widget-kill-line)
- (define-key map "\M-\t" 'widget-complete)
- (define-key map "\C-m" 'widget-field-activate)
+ (define-key map "\C-k" #'widget-kill-line)
+ (define-key map "\M-\t" #'widget-complete)
+ (define-key map "\C-m" #'widget-field-activate)
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
- ;; (define-key map "\C-a" 'widget-beginning-of-line)
- (define-key map "\C-e" 'widget-end-of-line)
+ ;; (define-key map "\C-a" #'widget-beginning-of-line)
+ (define-key map "\C-e" #'widget-end-of-line)
map)
"Keymap used inside an editable field.")
@@ -1057,8 +1057,8 @@ Note that such modes will need to require wid-edit.")
(let ((map (copy-keymap widget-keymap)))
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
- ;; (define-key map "\C-a" 'widget-beginning-of-line)
- (define-key map "\C-e" 'widget-end-of-line)
+ ;; (define-key map "\C-a" #'widget-beginning-of-line)
+ (define-key map "\C-e" #'widget-end-of-line)
map)
"Keymap used inside a text field.")
@@ -1299,7 +1299,7 @@ With optional ARG, move across that many fields."
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
-(defalias 'widget-beginning-of-line 'beginning-of-line)
+(defalias 'widget-beginning-of-line #'beginning-of-line)
(defun widget-end-of-line ()
"Go to end of field or end of line, whichever is first.
@@ -1376,19 +1376,18 @@ When not inside a field, signal an error."
;;;###autoload
(defun widget-setup ()
"Setup current buffer so editing string widgets works."
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t)
- field)
- (while widget-field-new
- (setq field (car widget-field-new)
- widget-field-new (cdr widget-field-new)
- widget-field-list (cons field widget-field-list))
- (let ((from (car (widget-get field :field-overlay)))
- (to (cdr (widget-get field :field-overlay))))
- (widget-specify-field field
- (marker-position from) (marker-position to))
- (set-marker from nil)
- (set-marker to nil))))
+ (widget--allow-insertion
+ (let (field)
+ (while widget-field-new
+ (setq field (car widget-field-new)
+ widget-field-new (cdr widget-field-new)
+ widget-field-list (cons field widget-field-list))
+ (let ((from (car (widget-get field :field-overlay)))
+ (to (cdr (widget-get field :field-overlay))))
+ (widget-specify-field field
+ (marker-position from) (marker-position to))
+ (set-marker from nil)
+ (set-marker to nil)))))
(widget-clear-undo)
(widget-add-change))
@@ -1463,11 +1462,8 @@ When not inside a field, signal an error."
(defun widget-field-find (pos)
"Return the field at POS.
Unlike (get-char-property POS \\='field), this works with empty fields too."
- (let ((fields widget-field-list)
- field found)
- (while fields
- (setq field (car fields)
- fields (cdr fields))
+ (let (found)
+ (dolist (field widget-field-list)
(when (and (<= (widget-field-start field) pos)
(<= pos (widget-field-end field)))
(when found
@@ -1482,11 +1478,11 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(let ((from-field (widget-field-find from))
(to-field (widget-field-find to)))
(cond ((not (eq from-field to-field))
- (add-hook 'post-command-hook 'widget-add-change nil t)
+ (add-hook 'post-command-hook #'widget-add-change nil t)
(signal 'text-read-only
'("Change should be restricted to a single field")))
((null from-field)
- (add-hook 'post-command-hook 'widget-add-change nil t)
+ (add-hook 'post-command-hook #'widget-add-change nil t)
(signal 'text-read-only
'("Attempt to change text outside editable field")))
(widget-field-use-before-change
@@ -1494,9 +1490,9 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
from-field (list 'before-change from to)))))))
(defun widget-add-change ()
- (remove-hook 'post-command-hook 'widget-add-change t)
- (add-hook 'before-change-functions 'widget-before-change nil t)
- (add-hook 'after-change-functions 'widget-after-change nil t))
+ (remove-hook 'post-command-hook #'widget-add-change t)
+ (add-hook 'before-change-functions #'widget-before-change nil t)
+ (add-hook 'after-change-functions #'widget-after-change nil t))
(defun widget-after-change (from to _old)
"Adjust field size and text properties."
@@ -1516,12 +1512,12 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(insert-char ?\s (- (+ begin size) end))))
((> (- end begin) size)
;; Field too large and
- (if (or (< (point) (+ begin size))
- (> (point) end))
- ;; Point is outside extra space.
- (setq begin (+ begin size))
- ;; Point is within the extra space.
- (setq begin (point)))
+ (setq begin (if (or (< (point) (+ begin size))
+ (> (point) end))
+ ;; Point is outside extra space.
+ (+ begin size)
+ ;; Point is within the extra space.
+ (point)))
(save-excursion
(goto-char end)
(while (and (eq (preceding-char) ?\s)
@@ -1541,9 +1537,9 @@ Optional EVENT is the event that triggered the action."
(defun widget-children-value-delete (widget)
"Delete all :children and :buttons in WIDGET."
- (mapc 'widget-delete (widget-get widget :children))
+ (mapc #'widget-delete (widget-get widget :children))
(widget-put widget :children nil)
- (mapc 'widget-delete (widget-get widget :buttons))
+ (mapc #'widget-delete (widget-get widget :buttons))
(widget-put widget :buttons nil))
(defun widget-children-validate (widget)
@@ -1594,13 +1590,13 @@ The value of the :type attribute should be an unconverted widget type."
(defun widget-types-copy (widget)
"Copy :args as widget types in WIDGET."
- (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
+ (widget-put widget :args (mapcar #'widget-copy (widget-get widget :args)))
widget)
;; Made defsubst to speed up face editor creation.
(defsubst widget-types-convert-widget (widget)
"Convert :args as widget types in WIDGET."
- (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
+ (widget-put widget :args (mapcar #'widget-convert (widget-get widget :args)))
widget)
(defun widget-value-convert-widget (widget)
@@ -1655,17 +1651,18 @@ The value of the :type attribute should be an unconverted widget type."
(defun widget-default-completions (widget)
"Return completion data, like `completion-at-point-functions' would."
(let ((completions (widget-get widget :completions)))
- (if completions
- (list (widget-field-start widget)
- (max (point) (widget-field-text-end widget))
- completions)
- (if (widget-get widget :complete)
- (lambda () (widget-apply widget :complete))
- (if (widget-get widget :complete-function)
- (lambda ()
- (let ((widget--completing-widget widget))
- (call-interactively
- (widget-get widget :complete-function)))))))))
+ (cond
+ (completions
+ (list (widget-field-start widget)
+ (max (point) (widget-field-text-end widget))
+ completions))
+ ((widget-get widget :complete)
+ (lambda () (widget-apply widget :complete)))
+ ((widget-get widget :complete-function)
+ (lambda ()
+ (let ((widget--completing-widget widget))
+ (call-interactively
+ (widget-get widget :complete-function))))))))
(defun widget-default-create (widget)
"Create WIDGET at point in the current buffer."
@@ -1773,24 +1770,23 @@ The value of the :type attribute should be an unconverted widget type."
(inactive-overlay (widget-get widget :inactive))
(button-overlay (widget-get widget :button-overlay))
(sample-overlay (widget-get widget :sample-overlay))
- (doc-overlay (widget-get widget :doc-overlay))
- (inhibit-modification-hooks t)
- (inhibit-read-only t))
- (widget-apply widget :value-delete)
- (widget-children-value-delete widget)
- (when inactive-overlay
- (delete-overlay inactive-overlay))
- (when button-overlay
- (delete-overlay button-overlay))
- (when sample-overlay
- (delete-overlay sample-overlay))
- (when doc-overlay
- (delete-overlay doc-overlay))
- (when (< from to)
- ;; Kludge: this doesn't need to be true for empty formats.
- (delete-region from to))
- (set-marker from nil)
- (set-marker to nil))
+ (doc-overlay (widget-get widget :doc-overlay)))
+ (widget--allow-insertion
+ (widget-apply widget :value-delete)
+ (widget-children-value-delete widget)
+ (when inactive-overlay
+ (delete-overlay inactive-overlay))
+ (when button-overlay
+ (delete-overlay button-overlay))
+ (when sample-overlay
+ (delete-overlay sample-overlay))
+ (when doc-overlay
+ (delete-overlay doc-overlay))
+ (when (< from to)
+ ;; Kludge: this doesn't need to be true for empty formats.
+ (delete-region from to))
+ (set-marker from nil)
+ (set-marker to nil)))
(widget-clear-undo))
(defun widget-default-value-set (widget value)
@@ -1811,9 +1807,9 @@ The value of the :type attribute should be an unconverted widget type."
(widget-put widget :value value)
(widget-apply widget :create))
(if offset
- (if (< offset 0)
- (goto-char (+ (widget-get widget :to) offset 1))
- (goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
+ (goto-char (if (< offset 0)
+ (+ (widget-get widget :to) offset 1)
+ (min (+ from offset) (1- (widget-get widget :to))))))))
(defun widget-default-value-inline (widget)
"Wrap value in a list unless it is inline."
@@ -1976,8 +1972,8 @@ as the argument to `documentation-property'."
;; Only bind mouse-2, since mouse-1 will be translated accordingly to
;; the customization of `mouse-1-click-follows-link'.
(define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1]))
- (define-key map [down-mouse-2] 'widget-button-click)
- (define-key map [mouse-2] 'widget-button-click)
+ (define-key map [down-mouse-2] #'widget-button-click)
+ (define-key map [mouse-2] #'widget-button-click)
map)
"Keymap used inside a link widget.")
@@ -2325,13 +2321,10 @@ when he invoked the menu."
((and widget-choice-toggle
(= (length args) 2)
(memq old args))
- (if (eq old (nth 0 args))
- (nth 1 args)
- (nth 0 args)))
+ (nth (if (eq old (nth 0 args)) 1 0)
+ args))
(t
- (while args
- (setq current (car args)
- args (cdr args))
+ (dolist (current args)
(setq choices
(cons (cons (widget-apply current :menu-tag-get)
current)
@@ -2424,9 +2417,8 @@ when he invoked the menu."
(widget-toggle-action widget event)
(let ((sibling (widget-get-sibling widget)))
(when sibling
- (if (widget-value widget)
- (widget-apply sibling :activate)
- (widget-apply sibling :deactivate))
+ (widget-apply sibling
+ (if (widget-value widget) :activate :deactivate))
(widget-clear-undo))))
;;; The `checklist' Widget.
@@ -2475,7 +2467,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?b)
- (setq button (apply 'widget-create-child-and-convert
+ (setq button (apply #'widget-create-child-and-convert
widget 'checkbox
:value (not (null chosen))
button-args)))
@@ -2555,11 +2547,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-checklist-value-get (widget)
;; The values of all selected items.
- (let ((children (widget-get widget :children))
- child result)
- (while children
- (setq child (car children)
- children (cdr children))
+ (let (result)
+ (dolist (child (widget-get widget :children))
(if (widget-value (widget-get child :button))
(setq result (append result (widget-apply child :value-inline)))))
result))
@@ -2627,12 +2616,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-radio-value-create (widget)
;; Insert all values
- (let ((args (widget-get widget :args))
- arg)
- (while args
- (setq arg (car args)
- args (cdr args))
- (widget-radio-add-item widget arg))))
+ (dolist (arg (widget-get widget :args))
+ (widget-radio-add-item widget arg)))
(defun widget-radio-add-item (widget type)
"Add to radio widget WIDGET a new radio button item of type TYPE."
@@ -2659,7 +2644,7 @@ Return an alist of (TYPE MATCH)."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?b)
- (setq button (apply 'widget-create-child-and-convert
+ (setq button (apply #'widget-create-child-and-convert
widget 'radio-button
:value (not (null chosen))
button-args)))
@@ -2715,11 +2700,8 @@ Return an alist of (TYPE MATCH)."
;; We can't just delete and recreate a radio widget, since children
;; can be added after the original creation and won't be recreated
;; by `:create'.
- (let ((children (widget-get widget :children))
- current found)
- (while children
- (setq current (car children)
- children (cdr children))
+ (let (found)
+ (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button))
(match (and (not found)
(widget-apply current :match value))))
@@ -2746,13 +2728,9 @@ Return an alist of (TYPE MATCH)."
(defun widget-radio-action (widget child event)
;; Check if a radio button was pressed.
- (let ((children (widget-get widget :children))
- (buttons (widget-get widget :buttons))
- current)
+ (let ((buttons (widget-get widget :buttons)))
(when (memq child buttons)
- (while children
- (setq current (car children)
- children (cdr children))
+ (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button)))
(cond ((eq child button)
(widget-value-set button t)
@@ -2822,7 +2800,7 @@ Return an alist of (TYPE MATCH)."
(and (widget--should-indent-p)
(widget-get widget :indent)
(insert-char ?\s (widget-get widget :indent)))
- (apply 'widget-create-child-and-convert
+ (apply #'widget-create-child-and-convert
widget 'insert-button
(widget-get widget :append-button-args)))
(t
@@ -2842,9 +2820,9 @@ Return an alist of (TYPE MATCH)."
(if answer
(setq children (cons (widget-editable-list-entry-create
widget
- (if (widget-inline-p type t)
- (car answer)
- (car (car answer)))
+ (car (if (widget-inline-p type t)
+ answer
+ (car answer)))
t)
children)
value (cdr answer))
@@ -2853,8 +2831,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-editable-list-value-get (widget)
;; Get value of the child widget.
- (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline))
- (widget-get widget :children))))
+ (apply #'append (mapcar (lambda (child) (widget-apply child :value-inline))
+ (widget-get widget :children))))
(defun widget-editable-list-match (widget value)
;; Value must be a list and all the members must match the type.
@@ -2885,27 +2863,26 @@ The new widget gets inserted at the position of the BEFORE child."
(last-deleted (when-let ((lst (widget-get widget :last-deleted)))
(prog1
(pop lst)
- (widget-put widget :last-deleted lst))))
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (cond (before
- (goto-char (widget-get before :entry-from)))
- (t
- (goto-char (widget-get widget :value-pos))))
- (let ((child (widget-editable-list-entry-create
- widget (and last-deleted
- (widget-apply last-deleted
- :value-to-external
- (widget-get last-deleted :value)))
- last-deleted)))
- (when (< (widget-get child :entry-from) (widget-get widget :from))
- (set-marker (widget-get widget :from)
- (widget-get child :entry-from)))
- (if (eq (car children) before)
- (widget-put widget :children (cons child children))
- (while (not (eq (car (cdr children)) before))
- (setq children (cdr children)))
- (setcdr children (cons child (cdr children)))))))
+ (widget-put widget :last-deleted lst)))))
+ (widget--allow-insertion
+ (cond (before
+ (goto-char (widget-get before :entry-from)))
+ (t
+ (goto-char (widget-get widget :value-pos))))
+ (let ((child (widget-editable-list-entry-create
+ widget (and last-deleted
+ (widget-apply last-deleted
+ :value-to-external
+ (widget-get last-deleted :value)))
+ last-deleted)))
+ (when (< (widget-get child :entry-from) (widget-get widget :from))
+ (set-marker (widget-get widget :from)
+ (widget-get child :entry-from)))
+ (if (eq (car children) before)
+ (widget-put widget :children (cons child children))
+ (while (not (eq (car (cdr children)) before))
+ (setq children (cdr children)))
+ (setcdr children (cons child (cdr children))))))))
(widget-setup)
(widget-apply widget :notify widget))
@@ -2921,25 +2898,19 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(widget-put widget :last-deleted lst))
;; Delete child from list of children.
(save-excursion
- (let ((buttons (copy-sequence (widget-get widget :buttons)))
- button
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (while buttons
- (setq button (car buttons)
- buttons (cdr buttons))
- (when (eq (widget-get button :widget) child)
- (widget-put widget
- :buttons (delq button (widget-get widget :buttons)))
- (widget-delete button))))
+ (widget--allow-insertion
+ (dolist (button (copy-sequence (widget-get widget :buttons)))
+ (when (eq (widget-get button :widget) child)
+ (widget-put widget
+ :buttons (delq button (widget-get widget :buttons)))
+ (widget-delete button))))
(let ((entry-from (widget-get child :entry-from))
- (entry-to (widget-get child :entry-to))
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (widget-delete child)
- (delete-region entry-from entry-to)
- (set-marker entry-from nil)
- (set-marker entry-to nil))
+ (entry-to (widget-get child :entry-to)))
+ (widget--allow-insertion
+ (widget-delete child)
+ (delete-region entry-from entry-to)
+ (set-marker entry-from nil)
+ (set-marker entry-to nil)))
(widget-put widget :children (delq child (widget-get widget :children))))
(widget-setup)
(widget-apply widget :notify widget))
@@ -2962,19 +2933,17 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?i)
- (setq insert (apply 'widget-create-child-and-convert
+ (setq insert (apply #'widget-create-child-and-convert
widget 'insert-button
(widget-get widget :insert-button-args))))
((eq escape ?d)
- (setq delete (apply 'widget-create-child-and-convert
+ (setq delete (apply #'widget-create-child-and-convert
widget 'delete-button
(widget-get widget :delete-button-args))))
((eq escape ?v)
- (if conv
- (setq child (widget-create-child-value
- widget type value))
- (setq child (widget-create-child-value
- widget type (widget-default-get type)))))
+ (setq child (widget-create-child-value
+ widget type
+ (if conv value (widget-default-get type)))))
(t
(error "Unknown escape `%c'" escape)))))
(let ((buttons (widget-get widget :buttons)))
@@ -3014,13 +2983,10 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(defun widget-group-value-create (widget)
;; Create each component.
- (let ((args (widget-get widget :args))
- (value (widget-get widget :value))
- arg answer children)
- (while args
- (setq arg (car args)
- args (cdr args)
- answer (widget-match-inline arg value)
+ (let ((value (widget-get widget :value))
+ answer children)
+ (dolist (arg (widget-get widget :args))
+ (setq answer (widget-match-inline arg value)
value (cdr answer))
(and (widget--should-indent-p)
(widget-get widget :indent)
@@ -3036,7 +3002,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(defun widget-group-default-get (widget)
;; Get the default of the components.
- (mapcar 'widget-default-get (widget-get widget :args)))
+ (mapcar #'widget-default-get (widget-get widget :args)))
(defun widget-group-match (widget vals)
;; Match if the components match.
@@ -3094,20 +3060,20 @@ The following properties have special meanings for this widget:
"Display documentation for WIDGET's value. Ignore optional argument EVENT."
(let* ((string (widget-get widget :value))
(symbol (intern string)))
- (if (and (fboundp symbol) (boundp symbol))
- ;; If there are two doc strings, give the user a way to pick one.
- (apropos (concat "\\`" (regexp-quote string) "\\'"))
- (cond
- ((fboundp symbol)
- (describe-function symbol))
- ((facep symbol)
- (describe-face symbol))
- ((featurep symbol)
- (describe-package symbol))
- ((or (boundp symbol) (get symbol 'variable-documentation))
- (describe-variable symbol))
- (t
- (message "No documentation available for %s" symbol))))))
+ (cond
+ ((and (fboundp symbol) (boundp symbol))
+ ;; If there are two doc strings, give the user a way to pick one.
+ (apropos (concat "\\`" (regexp-quote string) "\\'")))
+ ((fboundp symbol)
+ (describe-function symbol))
+ ((facep symbol)
+ (describe-face symbol))
+ ((featurep symbol)
+ (describe-package symbol))
+ ((or (boundp symbol) (get symbol 'variable-documentation))
+ (describe-variable symbol))
+ (t
+ (message "No documentation available for %s" symbol)))))
(defcustom widget-documentation-links t
"Add hyperlinks to documentation strings when non-nil."
@@ -3240,7 +3206,7 @@ Optional ARGS specifies additional keyword arguments for the
(unless (or (numberp doc-indent) (null doc-indent))
(setq doc-indent 0))
(widget-put widget :buttons
- (cons (apply 'widget-create-child-and-convert
+ (cons (apply #'widget-create-child-and-convert
widget 'documentation-string
:indent doc-indent
(nconc args (list doc)))
@@ -3352,18 +3318,18 @@ It reads a file name from an editable text field."
(must-match (widget-get widget :must-match)))
(read-file-name (format-prompt prompt value) dir nil must-match file)))))
-;;;(defun widget-file-action (widget &optional event)
-;;; ;; Read a file name from the minibuffer.
-;;; (let* ((value (widget-value widget))
-;;; (dir (file-name-directory value))
-;;; (file (file-name-nondirectory value))
-;;; (menu-tag (widget-apply widget :menu-tag-get))
-;;; (must-match (widget-get widget :must-match))
-;;; (answer (read-file-name (format-prompt menu-tag value)
-;;; dir nil must-match file)))
-;;; (widget-value-set widget (abbreviate-file-name answer))
-;;; (widget-setup)
-;;; (widget-apply widget :notify widget event)))
+;;(defun widget-file-action (widget &optional event)
+;; ;; Read a file name from the minibuffer.
+;; (let* ((value (widget-value widget))
+;; (dir (file-name-directory value))
+;; (file (file-name-nondirectory value))
+;; (menu-tag (widget-apply widget :menu-tag-get))
+;; (must-match (widget-get widget :must-match))
+;; (answer (read-file-name (format-prompt menu-tag value)
+;; dir nil must-match file)))
+;; (widget-value-set widget (abbreviate-file-name answer))
+;; (widget-setup)
+;; (widget-apply widget :notify widget event)))
;; Fixme: use file-name-as-directory.
(define-widget 'directory 'file
@@ -3552,7 +3518,7 @@ It reads a directory name from an editable text field."
(if (stringp value)
(if (string-match "\\`[[:space:]]*\\'" value)
widget-key-sequence-default-value
- (read-kbd-macro value))
+ (key-parse value))
value))
@@ -3825,7 +3791,7 @@ or a list with the default value of each component of the list WIDGET."
:format "%{%t%}:\n%v"
:match 'widget-vector-match
:value-to-internal (lambda (_widget value) (append value nil))
- :value-to-external (lambda (_widget value) (apply 'vector value)))
+ :value-to-external (lambda (_widget value) (apply #'vector value)))
(defun widget-vector-match (widget value)
(and (vectorp value)
@@ -3840,7 +3806,7 @@ or a list with the default value of each component of the list WIDGET."
:value-to-internal (lambda (_widget value)
(list (car value) (cdr value)))
:value-to-external (lambda (_widget value)
- (apply 'cons value)))
+ (apply #'cons value)))
(defun widget-cons-match (widget value)
(and (consp value)
@@ -3927,7 +3893,7 @@ example:
(args (if options
(list `(checklist :inline t
:greedy t
- ,@(mapcar 'widget-plist-convert-option
+ ,@(mapcar #'widget-plist-convert-option
options))
other)
(list other))))
@@ -3940,9 +3906,7 @@ example:
(if (listp option)
(let ((key (nth 0 option)))
(setq value-type (nth 1 option))
- (if (listp key)
- (setq key-type key)
- (setq key-type `(const ,key))))
+ (setq key-type (if (listp key) key `(const ,key))))
(setq key-type `(const ,option)
value-type widget-plist-value-type))
`(group :format "Key: %v" :inline t ,key-type ,value-type)))
@@ -3972,7 +3936,7 @@ example:
(args (if options
(list `(checklist :inline t
:greedy t
- ,@(mapcar 'widget-alist-convert-option
+ ,@(mapcar #'widget-alist-convert-option
options))
other)
(list other))))
@@ -3985,9 +3949,7 @@ example:
(if (listp option)
(let ((key (nth 0 option)))
(setq value-type (nth 1 option))
- (if (listp key)
- (setq key-type key)
- (setq key-type `(const ,key))))
+ (setq key-type (if (listp key) key `(const ,key))))
(setq key-type `(const ,option)
value-type widget-alist-value-type))
`(cons :format "Key: %v" ,key-type ,value-type)))
@@ -4045,17 +4007,13 @@ current choice is inline."
((and widget-choice-toggle
(= (length args) 2)
(memq old args))
- (if (eq old (nth 0 args))
- (nth 1 args)
- (nth 0 args)))
+ (nth (if (eq old (nth 0 args)) 1 0)
+ args))
(t
- (while args
- (setq current (car args)
- args (cdr args))
- (setq choices
- (cons (cons (widget-apply current :menu-tag-get)
- current)
- choices)))
+ (dolist (current args)
+ (push (cons (widget-apply current :menu-tag-get)
+ current)
+ choices))
(let ((val (completing-read prompt choices nil t)))
(if (stringp val)
(let ((try (try-completion val choices)))
@@ -4206,7 +4164,7 @@ is inline."
(help-echo (and widget (widget-get widget :help-echo))))
(if (functionp help-echo)
(setq help-echo (funcall help-echo widget)))
- (if help-echo (message "%s" (eval help-echo)))))
+ (if help-echo (message "%s" (eval help-echo t)))))
(define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1")
(define-obsolete-function-alias 'widget-visibility-value-create
diff --git a/lisp/windmove.el b/lisp/windmove.el
index bc2beed5055..b4e77102abd 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -641,7 +641,7 @@ Default value of MODIFIERS is `shift-meta'."
(defun windmove-delete-in-direction (dir &optional arg)
"Delete the window at direction DIR.
-If prefix ARG is `\\[universal-argument]', also kill the buffer in that window.
+If prefix ARG is \\[universal-argument], also kill the buffer in that window.
With \\`M-0' prefix, delete the selected window and
select the window at direction DIR.
When `windmove-wrap-around' is non-nil, takes the window
diff --git a/lisp/window.el b/lisp/window.el
index e100f25526b..df55a7ca673 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6174,6 +6174,12 @@ value can be also stored on disk and read back in a new session."
(defvar window-state-put-stale-windows nil
"Helper variable for `window-state-put'.")
+(defvar window-state-put-kept-windows nil
+ "Helper variable for `window-state-put'.")
+
+(defvar window-state-put-selected-window nil
+ "Helper variable for `window-state-put'.")
+
(defun window--state-put-1 (state &optional window ignore totals pixelwise)
"Helper function for `window-state-put'."
(let ((type (car state)))
@@ -6278,9 +6284,11 @@ value can be also stored on disk and read back in a new session."
(set-window-parameter window (car parameter) (cdr parameter))))
;; Process buffer related state.
(when state
- (let ((buffer (get-buffer (car state)))
- (state (cdr state)))
- (if buffer
+ (let* ((old-buffer-or-name (car state))
+ (buffer (get-buffer old-buffer-or-name))
+ (state (cdr state))
+ (dedicated (cdr (assq 'dedicated state))))
+ (if (buffer-live-p buffer)
(with-current-buffer buffer
(set-window-buffer window buffer)
(set-window-hscroll window (cdr (assq 'hscroll state)))
@@ -6338,7 +6346,7 @@ value can be also stored on disk and read back in a new session."
window delta t ignore nil nil nil pixelwise))
(window-resize window delta t ignore pixelwise))))
;; Set dedicated status.
- (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+ (set-window-dedicated-p window dedicated)
;; Install positions (maybe we should do this after all
;; windows have been created and sized).
(ignore-errors
@@ -6348,7 +6356,18 @@ value can be also stored on disk and read back in a new session."
(set-window-point window (cdr (assq 'point state))))
;; Select window if it's the selected one.
(when (cdr (assq 'selected state))
- (select-window window))
+ ;; This used to call 'select-window' which, however,
+ ;; can be partially undone because the current buffer
+ ;; may subsequently change twice: When leaving the
+ ;; present 'with-current-buffer' and when leaving the
+ ;; containing 'with-temp-buffer' form (Bug#69093).
+ ;; 'window-state-put-selected-window' should now work
+ ;; around that bug but we leave this 'select-window'
+ ;; in since some code run before the part that fixed
+ ;; it might still refer to this window as the selected
+ ;; one.
+ (select-window window)
+ (setq window-state-put-selected-window window))
(set-window-next-buffers
window
(delq nil (mapcar (lambda (buffer)
@@ -6370,12 +6389,31 @@ value can be also stored on disk and read back in a new session."
(set-marker (make-marker) m2
buffer))))))
prev-buffers))))
- ;; We don't want to raise an error in case the buffer does
- ;; not exist anymore, so we switch to a previous one and
- ;; save the window with the intention of deleting it later
- ;; if possible.
- (switch-to-prev-buffer window)
- (push window window-state-put-stale-windows)))))))
+ (unless (window-minibuffer-p window)
+ ;; Preferably show a buffer previously shown in this
+ ;; window.
+ (switch-to-prev-buffer window)
+ (cond
+ ((functionp window-restore-killed-buffer-windows)
+ (let* ((start (cdr (assq 'start state)))
+ ;; Handle both - marker positions from writable
+ ;; states and markers from non-writable states.
+ (start-pos (if (markerp start)
+ (marker-last-position start)
+ start))
+ (point (cdr (assq 'point state)))
+ (point-pos (if (markerp point)
+ (marker-last-position point)
+ point)))
+ (push (list window old-buffer-or-name
+ start-pos point-pos dedicated nil)
+ window-state-put-kept-windows)))
+ ((or (and dedicated
+ (eq window-restore-killed-buffer-windows 'dedicated))
+ (memq window-restore-killed-buffer-windows '(nil delete)))
+ ;; Try to delete the window.
+ (push window window-state-put-stale-windows)))
+ (set-window-dedicated-p window nil))))))))
(defun window-state-put (state &optional window ignore)
"Put window state STATE into WINDOW.
@@ -6388,8 +6426,13 @@ If WINDOW is nil, create a new window before putting STATE into it.
Optional argument IGNORE non-nil means ignore minimum window
sizes and fixed size restrictions. IGNORE equal `safe' means
windows can get as small as `window-safe-min-height' and
-`window-safe-min-width'."
+`window-safe-min-width'.
+
+If this function tries to restore a non-minibuffer window whose buffer
+was killed since STATE was made, it will consult the variable
+`window-restore-killed-buffer-windows' on how to proceed."
(setq window-state-put-stale-windows nil)
+ (setq window-state-put-kept-windows nil)
;; When WINDOW is internal or nil, reduce it to a live one,
;; then create a new window on the same frame to put STATE into.
@@ -6482,6 +6525,7 @@ windows can get as small as `window-safe-min-height' and
(error "Window %s too small to accommodate state" window)
(setq state (cdr state))
(setq window-state-put-list nil)
+ (setq window-state-put-selected-window nil)
;; Work on the windows of a temporary buffer to make sure that
;; splitting proceeds regardless of any buffer local values of
;; `window-size-fixed'. Release that buffer after the buffers of
@@ -6490,14 +6534,20 @@ windows can get as small as `window-safe-min-height' and
(set-window-buffer window (current-buffer))
(window--state-put-1 state window nil totals pixelwise)
(window--state-put-2 ignore pixelwise))
+ (when (window-live-p window-state-put-selected-window)
+ (select-window window-state-put-selected-window))
(while window-state-put-stale-windows
(let ((window (pop window-state-put-stale-windows)))
- ;; Avoid that 'window-deletable-p' throws an error if window
+ ;; Avoid that 'window-deletable-p' throws an error if window
;; was already deleted when exiting 'with-temp-buffer' above
;; (Bug#54028).
(when (and (window-valid-p window)
(eq (window-deletable-p window) t))
(delete-window window))))
+ (when (functionp window-restore-killed-buffer-windows)
+ (funcall window-restore-killed-buffer-windows
+ frame window-state-put-kept-windows 'state)
+ (setq window-state-put-kept-windows nil))
(window--check frame))))
(defun window-state-buffers (state)
@@ -7798,6 +7848,14 @@ Action alist entries are:
and `preserve-size' are applied. The function is supposed
to fill the window body with some contents that might depend
on dimensions of the displayed window.
+ `post-command-select-window' -- A non-nil value means that after the
+ current command is executed and the hook `post-command-hook' is called,
+ the window displayed by this function will be selected. A nil value
+ means that if functions like `pop-to-buffer' selected another window,
+ at the end of this command that window will be deselected, and the
+ window that was selected before calling this function will remain
+ selected regardless of which windows were selected afterwards within
+ this command.
The entries `window-height', `window-width', `window-size' and
`preserve-size' are applied only when the window used for
@@ -7853,6 +7911,17 @@ specified by the ACTION argument."
(while (and functions (not window))
(setq window (funcall (car functions) buffer alist)
functions (cdr functions)))
+ (when-let ((select (assq 'post-command-select-window alist)))
+ (letrec ((old-selected-window (selected-window))
+ (postfun
+ (lambda ()
+ (if (cdr select)
+ (when (window-live-p window)
+ (select-window window))
+ (when (window-live-p old-selected-window)
+ (select-window old-selected-window)))
+ (remove-hook 'post-command-hook postfun))))
+ (add-hook 'post-command-hook postfun)))
(and (windowp window) window))))
(defun display-buffer-other-frame (buffer)
@@ -8599,14 +8668,14 @@ buffer. ALIST is a buffer display action alist as compiled by
use time is higher than this.
- `window-min-width' specifies a preferred minimum width in
- canonical frame columns. If it is the constant `full-width',
+ canonical frame columns. If it is the symbol `full-width',
prefer a full-width window.
- `window-min-height' specifies a preferred minimum height in
- canonical frame lines. If it is the constant `full-height',
+ canonical frame lines. If it is the symbol `full-height',
prefer a full-height window.
-If ALIST contains a non-nil `inhibit-same--window' entry, do not
+If ALIST contains a non-nil `inhibit-same-window' entry, do not
return the selected window."
(let ((windows
(window-list-1 nil 'nomini (cdr (assq 'lru-frames alist))))
@@ -8730,11 +8799,11 @@ Distinctive features are:
call.
`window-min-width' specifies a preferred minimum width in
- canonical frame columns. If it is the constant `full-width',
+ canonical frame columns. If it is the symbol `full-width',
prefer a full-width window.
`window-min-height' specifies a preferred minimum height in
- canonical frame lines. If it is the constant `full-height',
+ canonical frame lines. If it is the symbol `full-height',
prefer a full-height window.
- If the preceding steps fail, try to pop up a new window on the
@@ -10813,7 +10882,8 @@ Used in `repeat-mode'."
"^ f" #'tear-off-window
"^ t" #'tab-window-detach
"-" #'fit-window-to-buffer
- "0" #'delete-windows-on)
+ "0" #'delete-windows-on
+ "q" #'quit-window)
(define-key ctl-x-map "w" window-prefix-map)
(provide 'window)
diff --git a/lisp/winner.el b/lisp/winner.el
index 2aa59a86b25..19641a05bfc 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*, *Apropos*,
(setq winner-last-frames nil)
(setq winner-last-command this-command))
(dolist (frame winner-modified-list)
- (winner-insert-if-new frame))
+ (if (frame-live-p frame)
+ (winner-insert-if-new frame)))
(setq winner-modified-list nil)
(winner-remember)))
diff --git a/lisp/woman.el b/lisp/woman.el
index a9af46fa387..2357ba6b132 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -2566,7 +2566,8 @@ If DELETE is non-nil then delete from point."
;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*"
;; Interpret bogus `el \}' as `el \{',
;; especially for Tcl/Tk man pages:
- "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*")
+ "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*"
+ nil t)
(match-beginning 1))
(re-search-forward "\\\\}"))
(delete-region (if delete from (match-beginning 0)) (point))
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index cd00467f14f..081b8f32456 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -40,6 +40,8 @@
;;; Code:
+(require 'mwheel)
+
(defvar xterm-mouse-debug-buffer nil)
(defun xterm-mouse-translate (_event)
@@ -193,6 +195,12 @@ single byte."
(cons n c))
(cons (- (setq c (xterm-mouse--read-coordinate)) 32) c))))
+(defun xterm-mouse--button-p (event btn)
+ (and (symbolp event)
+ (string-prefix-p "mouse-" (symbol-name event))
+ (eq btn (car (read-from-string (symbol-name event)
+ (length "mouse-"))))))
+
;; XTerm reports mouse events as
;; <EVENT-CODE> <X> <Y> in default mode, and
;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
@@ -230,13 +238,22 @@ single byte."
;; Spurious release event without previous button-down
;; event: assume, that the last button was button 1.
(t 1)))
- (sym (if move 'mouse-movement
- (intern (concat (if ctrl "C-" "")
- (if meta "M-" "")
- (if shift "S-" "")
- (if down "down-" "")
- "mouse-"
- (number-to-string btn))))))
+ (sym
+ (if move 'mouse-movement
+ (intern
+ (concat
+ (if ctrl "C-" "")
+ (if meta "M-" "")
+ (if shift "S-" "")
+ (if down "down-" "")
+ (cond
+ ;; BEWARE: `mouse-wheel-UP-event' corresponds to
+ ;; `wheel-DOWN' events and vice versa!!
+ ((xterm-mouse--button-p mouse-wheel-down-event btn) "wheel-up")
+ ((xterm-mouse--button-p mouse-wheel-up-event btn) "wheel-down")
+ ((xterm-mouse--button-p mouse-wheel-left-event btn) "wheel-left")
+ ((xterm-mouse--button-p mouse-wheel-right-event btn) "wheel-right")
+ (t (format "mouse-%d" btn))))))))
(list sym (1- x) (1- y))))
(defun xterm-mouse--set-click-count (event click-count)
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index 3448c40bbd6..99c99d1b0fb 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,4 +1,4 @@
-# 00gnulib.m4 serial 8
+# 00gnulib.m4 serial 9
dnl Copyright (C) 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -49,14 +49,14 @@ dnl AC_REQUIRE([gl_COMPILER_CLANG])
[if test $gl_cv_compiler_clang = yes; then
dnl Test whether the compiler supports the option
dnl '-Werror=implicit-function-declaration'.
- save_ac_compile="$ac_compile"
+ saved_ac_compile="$ac_compile"
ac_compile="$ac_compile -Werror=implicit-function-declaration"
dnl Use _AC_COMPILE_IFELSE instead of AC_COMPILE_IFELSE, to avoid a
dnl warning "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS".
_AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])],
[gl_cv_compiler_check_decl_option='-Werror=implicit-function-declaration'],
[gl_cv_compiler_check_decl_option=none])
- ac_compile="$save_ac_compile"
+ ac_compile="$saved_ac_compile"
else
gl_cv_compiler_check_decl_option=none
fi
@@ -71,11 +71,11 @@ dnl Redefine _AC_CHECK_DECL_BODY so that it references ac_compile_for_check_decl
dnl instead of ac_compile. If, for whatever reason, the override of AC_PROG_CC
dnl in zzgnulib.m4 is inactive, use the original ac_compile.
m4_define([_AC_CHECK_DECL_BODY],
-[ ac_save_ac_compile="$ac_compile"
+[ ac_saved_ac_compile="$ac_compile"
if test -n "$ac_compile_for_check_decl"; then
ac_compile="$ac_compile_for_check_decl"
fi]
-m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_save_ac_compile"
+m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_saved_ac_compile"
])
# gl_00GNULIB
diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4
index aa7d0dac6da..0e9f9ba763a 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,4 +1,4 @@
-# absolute-header.m4 serial 17
+# absolute-header.m4 serial 18
dnl Copyright (C) 2006-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -66,7 +66,7 @@ AC_DEFUN([gl_ABSOLUTE_HEADER_ONE],
esac
changequote(,)
case "$host_os" in
- mingw*)
+ mingw* | windows*)
dnl For the sake of native Windows compilers (excluding gcc),
dnl treat backslash as a directory separator, like /.
dnl Actually, these compilers use a double-backslash as
diff --git a/m4/acl.m4 b/m4/acl.m4
index 199bf67cbc5..2050d108b0c 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,5 +1,5 @@
# acl.m4 - check for access control list (ACL) primitives
-# serial 29
+# serial 30
# Copyright (C) 2002, 2004-2024 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -27,7 +27,7 @@ AC_DEFUN_ONCE([gl_FUNC_ACL],
dnl On all platforms, the ACL related API is declared in <sys/acl.h>.
AC_CHECK_HEADERS([sys/acl.h])
if test $ac_cv_header_sys_acl_h = yes; then
- ac_save_LIBS=$LIBS
+ gl_saved_LIBS=$LIBS
dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, Mac OS X,
dnl IRIX, Tru64, Cygwin >= 2.5).
@@ -129,7 +129,7 @@ int type = ACL_TYPE_EXTENDED;]])],
fi
fi
- LIBS=$ac_save_LIBS
+ LIBS=$gl_saved_LIBS
fi
if test "$enable_acl$use_acl" = yes0; then
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 911a003a04f..90960215382 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,6 +1,6 @@
# alloca.m4 serial 21
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2024 Free Software Foundation,
+dnl 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.
diff --git a/m4/assert_h.m4 b/m4/assert_h.m4
index a73e45f0641..d3d4c42519f 100644
--- a/m4/assert_h.m4
+++ b/m4/assert_h.m4
@@ -9,10 +9,10 @@ dnl From Paul Eggert.
AC_DEFUN([gl_ASSERT_H],
[
AC_CACHE_CHECK([for static_assert], [gl_cv_static_assert],
- [gl_save_CFLAGS=$CFLAGS
+ [gl_saved_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"])
+ [*assert.h*], [CFLAGS="$gl_saved_CFLAGS -DINCLUDE_ASSERT_H"])
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
@@ -32,7 +32,7 @@ AC_DEFUN([gl_ASSERT_H],
]])],
[gl_cv_static_assert=$gl_working],
[gl_cv_static_assert=no])
- CFLAGS=$gl_save_CFLAGS
+ CFLAGS=$gl_saved_CFLAGS
test "$gl_cv_static_assert" != no && break
done])
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index a5831bb4b62..05dc6dd264d 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,4 +1,4 @@
-# canonicalize.m4 serial 38
+# canonicalize.m4 serial 39
dnl Copyright (C) 2003-2007, 2009-2024 Free Software Foundation, Inc.
@@ -66,8 +66,8 @@ AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
dnl available through the linker option '-loldnames'.
AC_REQUIRE([AC_CANONICAL_HOST])
case "$host_os" in
- mingw*) ;;
- *) AC_CHECK_FUNCS([getcwd]) ;;
+ mingw* | windows*) ;;
+ *) AC_CHECK_FUNCS([getcwd]) ;;
esac
AC_REQUIRE([gl_DOUBLE_SLASH_ROOT])
@@ -158,16 +158,16 @@ AC_DEFUN([gl_FUNC_REALPATH_WORKS],
esac
],
[case "$host_os" in
- # Guess yes on glibc systems.
- *-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;;
- # Guess 'nearly' on musl systems.
- *-musl*) gl_cv_func_realpath_works="guessing nearly" ;;
- # Guess no on Cygwin.
- cygwin*) gl_cv_func_realpath_works="guessing no" ;;
- # Guess no on native Windows.
- mingw*) gl_cv_func_realpath_works="guessing no" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;;
+ # Guess yes on glibc systems.
+ *-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;;
+ # Guess 'nearly' on musl systems.
+ *-musl*) gl_cv_func_realpath_works="guessing nearly" ;;
+ # Guess no on Cygwin.
+ cygwin*) gl_cv_func_realpath_works="guessing no" ;;
+ # Guess no on native Windows.
+ mingw* | windows*) gl_cv_func_realpath_works="guessing no" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;;
esac
])
rm -rf conftest.a conftest.l conftest.d
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
index 369e1412ec6..c016575c8ea 100644
--- a/m4/clock_time.m4
+++ b/m4/clock_time.m4
@@ -1,4 +1,4 @@
-# clock_time.m4 serial 13
+# clock_time.m4 serial 14
dnl Copyright (C) 2002-2006, 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -32,7 +32,7 @@ AC_DEFUN([gl_CLOCK_TIME],
CLOCK_TIME_LIB=
AC_SUBST([CLOCK_TIME_LIB])
case "$host_os" in
- mingw*)
+ mingw* | windows*)
ac_cv_func_clock_getres=no
ac_cv_func_clock_gettime=no
ac_cv_func_clock_settime=no
diff --git a/m4/codeset.m4 b/m4/codeset.m4
index 0b01779abc9..94dccce7775 100644
--- a/m4/codeset.m4
+++ b/m4/codeset.m4
@@ -1,6 +1,6 @@
# codeset.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2024 Free
-dnl Software Foundation, Inc.
+dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2024 Free Software
+dnl 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.
diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4
index e9198549510..443e598ba55 100644
--- a/m4/copy-file-range.m4
+++ b/m4/copy-file-range.m4
@@ -1,4 +1,4 @@
-# copy-file-range.m4
+# copy-file-range.m4 serial 5
dnl Copyright 2019-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -17,22 +17,33 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE],
dnl Programs that use copy_file_range must fall back on read+write
dnl anyway, and there's little point to substituting the Gnulib stub
dnl for a glibc stub.
- AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range],
- [AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <unistd.h>
- ]],
- [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned)
- = copy_file_range;
- return func (0, 0, 0, 0, 0, 0) & 127;
- ]])
- ],
- [gl_cv_func_copy_file_range=yes],
- [gl_cv_func_copy_file_range=no])
- ])
-
+ case "$host_os" in
+ *-gnu* | gnu*)
+ AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <unistd.h>
+ ]],
+ [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned)
+ = copy_file_range;
+ return func (0, 0, 0, 0, 0, 0) & 127;
+ ]])
+ ],
+ [gl_cv_func_copy_file_range=yes],
+ [gl_cv_func_copy_file_range=no])
+ ])
+ gl_cv_onwards_func_copy_file_range="$gl_cv_func_copy_file_range"
+ ;;
+ *)
+ gl_CHECK_FUNCS_ANDROID([copy_file_range], [[#include <unistd.h>]])
+ gl_cv_func_copy_file_range="$ac_cv_func_copy_file_range"
+ ;;
+ esac
if test "$gl_cv_func_copy_file_range" != yes; then
HAVE_COPY_FILE_RANGE=0
+ case "$gl_cv_onwards_func_copy_file_range" in
+ future*) REPLACE_COPY_FILE_RANGE=1 ;;
+ esac
else
AC_DEFINE([HAVE_COPY_FILE_RANGE], 1,
[Define to 1 if the function copy_file_range exists.])
diff --git a/m4/d-type.m4 b/m4/d-type.m4
index 13bab57a3a5..b06bca5a7dc 100644
--- a/m4/d-type.m4
+++ b/m4/d-type.m4
@@ -5,8 +5,7 @@ dnl
dnl Check whether struct dirent has a member named d_type.
dnl
-# Copyright (C) 1997, 1999-2004, 2006, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 1997, 1999-2004, 2006, 2009-2024 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/dirent_h.m4 b/m4/dirent_h.m4
index 1e55f025d28..3e3d967f499 100644
--- a/m4/dirent_h.m4
+++ b/m4/dirent_h.m4
@@ -1,4 +1,4 @@
-# dirent_h.m4 serial 20
+# dirent_h.m4 serial 22
dnl Copyright (C) 2008-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -32,14 +32,13 @@ AC_DEFUN_ONCE([gl_DIRENT_H],
dnl Determine whether <dirent.h> needs to override the DIR type.
AC_DEFUN_ONCE([gl_DIRENT_DIR],
[
- dnl Set DIR_HAS_FD_MEMBER if dirfd() works, i.e. not always returns -1,
- dnl or has the __KLIBC__ workaround as in lib/dirfd.c.
+ dnl Set DIR_HAS_FD_MEMBER if dirfd() works, i.e. not always returns -1.
dnl We could use the findings from gl_FUNC_DIRFD and gl_PREREQ_DIRFD, but
dnl it's simpler since we know the affected platforms.
AC_REQUIRE([AC_CANONICAL_HOST])
case "$host_os" in
- mingw*) DIR_HAS_FD_MEMBER=0 ;;
- *) DIR_HAS_FD_MEMBER=1 ;;
+ mingw* | windows* | os2*) DIR_HAS_FD_MEMBER=0 ;;
+ *) DIR_HAS_FD_MEMBER=1 ;;
esac
AC_SUBST([DIR_HAS_FD_MEMBER])
])
diff --git a/m4/dirfd.m4 b/m4/dirfd.m4
index 6578dc0232b..e58582e6145 100644
--- a/m4/dirfd.m4
+++ b/m4/dirfd.m4
@@ -1,4 +1,4 @@
-# serial 28 -*- Autoconf -*-
+# serial 30 -*- Autoconf -*-
dnl Find out how to get the file descriptor associated with an open DIR*.
@@ -40,15 +40,12 @@ AC_DEFUN([gl_FUNC_DIRFD],
HAVE_DIRFD=0
else
HAVE_DIRFD=1
- dnl Replace dirfd() on native Windows, to support fdopendir().
+ dnl Replace dirfd() on native Windows and OS/2 kLIBC,
+ dnl to support fdopendir().
AC_REQUIRE([gl_DIRENT_DIR])
if test $DIR_HAS_FD_MEMBER = 0; then
REPLACE_DIRFD=1
fi
- dnl OS/2 kLIBC dirfd() does not work.
- case "$host_os" in
- os2*) REPLACE_DIRFD=1 ;;
- esac
fi
])
@@ -58,7 +55,7 @@ AC_DEFUN([gl_PREREQ_DIRFD],
AC_CACHE_CHECK([how to get the file descriptor associated with an open DIR*],
[gl_cv_sys_dir_fd_member_name],
[
- dirfd_save_CFLAGS=$CFLAGS
+ gl_saved_CFLAGS=$CFLAGS
for ac_expr in d_fd dd_fd; do
CFLAGS="$CFLAGS -DDIR_FD_MEMBER_NAME=$ac_expr"
@@ -68,7 +65,7 @@ AC_DEFUN([gl_PREREQ_DIRFD],
[[DIR *dir_p = opendir("."); (void) dir_p->DIR_FD_MEMBER_NAME;]])],
[dir_fd_found=yes]
)
- CFLAGS=$dirfd_save_CFLAGS
+ CFLAGS=$gl_saved_CFLAGS
test "$dir_fd_found" = yes && break
done
test "$dir_fd_found" = yes || ac_expr=no_such_member
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index 1833ff0ec17..f6759b647a6 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,6 +1,5 @@
-#serial 27
-dnl Copyright (C) 2002, 2005, 2007, 2009-2024 Free Software Foundation,
-dnl Inc.
+#serial 28
+dnl Copyright (C) 2002, 2005, 2007, 2009-2024 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.
@@ -68,7 +67,7 @@ AC_DEFUN([gl_FUNC_DUP2],
],
[gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
[case "$host_os" in
- mingw*) # on this platform, dup2 always returns 0 for success
+ mingw* | windows*) # on this platform, dup2 always returns 0 for success
gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
gl_cv_func_dup2_works="guessing no" ;;
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index 3dd40f44b8b..b72317281b3 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,6 +1,5 @@
# filemode.m4 serial 9
-dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2024 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.
diff --git a/m4/fstatat.m4 b/m4/fstatat.m4
index 1b5e5f19276..c22569b7961 100644
--- a/m4/fstatat.m4
+++ b/m4/fstatat.m4
@@ -1,4 +1,4 @@
-# fstatat.m4 serial 4
+# fstatat.m4 serial 5
dnl Copyright (C) 2004-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -50,7 +50,7 @@ AC_DEFUN([gl_FUNC_FSTATAT],
esac
case $host_os in
- solaris*)
+ darwin* | solaris*)
REPLACE_FSTATAT=1 ;;
esac
diff --git a/m4/fsusage.m4 b/m4/fsusage.m4
index 9a81dabe34c..31d424c857d 100644
--- a/m4/fsusage.m4
+++ b/m4/fsusage.m4
@@ -1,8 +1,7 @@
# serial 35
# Obtaining file system usage information.
-# Copyright (C) 1997-1998, 2000-2001, 2003-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 1997-1998, 2000-2001, 2003-2024 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index 5062278b335..f6e0cbd3fce 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -1,10 +1,9 @@
-# serial 24
+# serial 25
dnl From Jim Meyering.
dnl A wrapper around AC_FUNC_GETGROUPS.
-# Copyright (C) 1996-1997, 1999-2004, 2008-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2004, 2008-2024 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -21,7 +20,7 @@ AC_DEFUN([AC_FUNC_GETGROUPS],
# If we don't yet have getgroups, see if it's in -lbsd.
# This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
- ac_save_LIBS=$LIBS
+ gl_saved_LIBS=$LIBS
if test $ac_cv_func_getgroups = no; then
AC_CHECK_LIB(bsd, getgroups, [GETGROUPS_LIB=-lbsd])
fi
@@ -57,7 +56,7 @@ AC_DEFUN([AC_FUNC_GETGROUPS],
[Define to 1 if your system has a working `getgroups' function.])
;;
esac
- LIBS=$ac_save_LIBS
+ LIBS=$gl_saved_LIBS
])# AC_FUNC_GETGROUPS
AC_DEFUN([gl_FUNC_GETGROUPS],
diff --git a/m4/getline.m4 b/m4/getline.m4
index d0e285dbc9f..1a7e89034bc 100644
--- a/m4/getline.m4
+++ b/m4/getline.m4
@@ -1,7 +1,7 @@
# getline.m4 serial 33
-dnl Copyright (C) 1998-2003, 2005-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 1998-2003, 2005-2007, 2009-2024 Free Software Foundation,
+dnl Inc.
dnl
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index d25a594b215..9d0236f77fe 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -1,13 +1,13 @@
# Check for getloadavg.
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2024 Free
-# Software Foundation, Inc.
+# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2024 Free Software
+# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-#serial 12
+#serial 13
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
@@ -20,7 +20,7 @@ AC_DEFUN([gl_GETLOADAVG],
# Persuade glibc <stdlib.h> to declare getloadavg().
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
-gl_save_LIBS=$LIBS
+gl_saved_LIBS=$LIBS
# getloadavg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
@@ -81,12 +81,12 @@ if test $ac_cv_func_getloadavg != yes; then
fi
fi
-if test "x$gl_save_LIBS" = x; then
+if test "x$gl_saved_LIBS" = x; then
GETLOADAVG_LIBS=$LIBS
else
- GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"`
+ GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_saved_LIBS!!"`
fi
-LIBS=$gl_save_LIBS
+LIBS=$gl_saved_LIBS
AC_SUBST([GETLOADAVG_LIBS])dnl
diff --git a/m4/getopt.m4 b/m4/getopt.m4
index cc0356390ba..be812d8459b 100644
--- a/m4/getopt.m4
+++ b/m4/getopt.m4
@@ -1,4 +1,4 @@
-# getopt.m4 serial 48
+# getopt.m4 serial 49
dnl Copyright (C) 2002-2006, 2008-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -197,8 +197,8 @@ main ()
fi
else
case "$host_os" in
- darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";;
- *) gl_cv_func_getopt_posix="guessing yes";;
+ darwin* | aix* | mingw* | windows*) gl_cv_func_getopt_posix="guessing no";;
+ *) gl_cv_func_getopt_posix="guessing yes";;
esac
fi
])
diff --git a/m4/getrandom.m4 b/m4/getrandom.m4
index 6ddaed2d569..55be445c31a 100644
--- a/m4/getrandom.m4
+++ b/m4/getrandom.m4
@@ -1,4 +1,4 @@
-# getrandom.m4 serial 11
+# getrandom.m4 serial 13
dnl Copyright 2020-2024 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,6 +9,8 @@ dnl Written by Paul Eggert.
AC_DEFUN([gl_FUNC_GETRANDOM],
[
AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+
gl_CHECK_FUNCS_ANDROID([getrandom],
[[/* Additional includes are needed before <sys/random.h> on uClibc
and Mac OS X. */
@@ -45,7 +47,7 @@ AC_DEFUN([gl_FUNC_GETRANDOM],
fi
case "$host_os" in
- mingw*)
+ mingw* | windows*)
AC_CHECK_HEADERS([bcrypt.h], [], [],
[[#include <windows.h>
]])
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index 61fdbb35d46..1ec018d5154 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,6 +1,5 @@
-# gettime.m4 serial 14
-dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation,
-dnl Inc.
+# gettime.m4 serial 15
+dnl Copyright (C) 2002, 2004-2006, 2009-2024 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.
@@ -65,5 +64,5 @@ AC_DEFUN([gl_GETTIME_RES],
dnl Prerequisites of lib/gettime-res.c.
AC_REQUIRE([gl_CLOCK_TIME])
AC_REQUIRE([gl_TIMESPEC])
- AC_CHECK_FUNCS_ONCE([timespec_getres])
+ gl_CHECK_FUNCS_ANDROID([timespec_getres], [[#include <time.h>]])
])
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index 6c2f8583603..35269914ced 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,7 +1,6 @@
-# serial 29
+# serial 30
-# Copyright (C) 2001-2003, 2005, 2007, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2024 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -58,7 +57,7 @@ int gettimeofday (struct timeval *restrict, struct timezone *restrict);
dnl On mingw, the original gettimeofday has only a precision of 15.6
dnl milliseconds. So override it.
case "$host_os" in
- mingw*) REPLACE_GETTIMEOFDAY=1 ;;
+ mingw* | windows*) REPLACE_GETTIMEOFDAY=1 ;;
esac
fi
AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone],
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index db0c8853d73..d8d0904f787 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 87
+# gnulib-common.m4 serial 92
dnl Copyright (C) 2007-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -76,48 +76,58 @@ AC_DEFUN([gl_COMMON_BODY], [
#endif])
AH_VERBATIM([attribute],
[/* Attributes. */
-#if (defined __has_attribute \
- && (!defined __clang_minor__ \
- || (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 5 <= __clang_major__)))
-# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
-#else
-# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
-# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
-# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
-# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
-# define _GL_ATTR_diagnose_if 0
-# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
-# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
-# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
-# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
-# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
-# ifdef _ICC
-# define _GL_ATTR_may_alias 0
+/* Define _GL_HAS_ATTRIBUTE only once, because on FreeBSD, with gcc < 5, if
+ <config.h> gets included once again after <sys/cdefs.h>, __has_attribute(x)
+ expands to 0 always, and redefining _GL_HAS_ATTRIBUTE would turn off all
+ attributes. */
+#ifndef _GL_HAS_ATTRIBUTE
+# if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || (defined __apple_build_version__ \
+ ? 7000000 <= __apple_build_version__ \
+ : 5 <= __clang_major__)))
+# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
# else
-# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
+# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
+# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
+# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_diagnose_if 0
+# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
+# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
+# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
+# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
+# ifdef _ICC
+# define _GL_ATTR_may_alias 0
+# else
+# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# endif
+# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
+# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
+# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
+# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
+# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
# endif
-# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
-# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
-# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
-# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
-# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
-# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
-# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
-# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
-# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
#endif
-/* Disable GCC -Wpedantic if using __has_c_attribute and this is not C23+. */
-#if (defined __has_c_attribute && _GL_GNUC_PREREQ (4, 6) \
- && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710)
-# pragma GCC diagnostic ignored "-Wpedantic"
+/* Use __has_c_attribute if available. However, do not use with
+ pre-C23 GCC, which can issue false positives if -Wpedantic. */
+#if (defined __has_c_attribute \
+ && ! (_GL_GNUC_PREREQ (4, 6) \
+ && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710))
+# define _GL_HAVE___HAS_C_ATTRIBUTE 1
+#else
+# define _GL_HAVE___HAS_C_ATTRIBUTE 0
#endif
/* Define if, in a function declaration, the attributes in bracket syntax
@@ -242,7 +252,7 @@ AC_DEFUN([gl_COMMON_BODY], [
in C++ also: namespace, class, template specialization. */
#ifndef _GL_ATTRIBUTE_DEPRECATED
# ifndef _GL_BRACKET_BEFORE_ATTRIBUTE
-# ifdef __has_c_attribute
+# if _GL_HAVE___HAS_C_ATTRIBUTE
# if __has_c_attribute (__deprecated__)
# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]]
# endif
@@ -291,7 +301,7 @@ AC_DEFUN([gl_COMMON_BODY], [
/* Applies to: Empty statement (;), inside a 'switch' statement. */
/* Always expands to something. */
#ifndef _GL_ATTRIBUTE_FALLTHROUGH
-# ifdef __has_c_attribute
+# if _GL_HAVE___HAS_C_ATTRIBUTE
# if __has_c_attribute (__fallthrough__)
# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]]
# endif
@@ -380,7 +390,7 @@ AC_DEFUN([gl_COMMON_BODY], [
# if !defined __apple_build_version__ && __clang_major__ >= 10
# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
# endif
-# elif defined __has_c_attribute
+# elif _GL_HAVE___HAS_C_ATTRIBUTE
# if __has_c_attribute (__maybe_unused__)
# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
# endif
@@ -411,7 +421,7 @@ AC_DEFUN([gl_COMMON_BODY], [
# if __clang_major__ >= 1000
# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
# endif
-# elif defined __has_c_attribute
+# elif _GL_HAVE___HAS_C_ATTRIBUTE
# if __has_c_attribute (__nodiscard__)
# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
# endif
@@ -466,11 +476,25 @@ AC_DEFUN([gl_COMMON_BODY], [
/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions.
*/
/* Applies to: functions. */
+/* After a function's parameter list, this attribute must come first, before
+ other attributes. */
#ifndef _GL_ATTRIBUTE_NOTHROW
-# if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus
-# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# if defined __cplusplus
+# if _GL_GNUC_PREREQ (2, 8) || __clang_major >= 4
+# if __cplusplus >= 201103L
+# define _GL_ATTRIBUTE_NOTHROW noexcept (true)
+# else
+# define _GL_ATTRIBUTE_NOTHROW throw ()
+# endif
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
# else
-# define _GL_ATTRIBUTE_NOTHROW
+# if _GL_HAS_ATTRIBUTE (nothrow)
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+# else
+# define _GL_ATTRIBUTE_NOTHROW
+# endif
# endif
#endif
@@ -1056,6 +1080,7 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS],
dnl -Wno-pedantic >= 4.8 >= 3.9
dnl -Wno-sign-compare >= 3 >= 3.9
dnl -Wno-sign-conversion >= 4.3 >= 3.9
+ dnl -Wno-tautological-out-of-range-compare - >= 3.9
dnl -Wno-type-limits >= 4.3 >= 3.9
dnl -Wno-undef >= 3 >= 3.9
dnl -Wno-unsuffixed-float-constants >= 4.5
@@ -1081,6 +1106,9 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS],
#if __GNUC__ + (__GNUC_MINOR__ >= 8) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3)
-Wno-pedantic
#endif
+ #if 3 < __clang_major__ + (9 <= __clang_minor__)
+ -Wno-tautological-constant-out-of-range-compare
+ #endif
#if __GNUC__ + (__GNUC_MINOR__ >= 3) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3)
-Wno-sign-conversion
-Wno-type-limits
@@ -1144,12 +1172,12 @@ AC_DEFUN([gl_PREPARE_CHECK_FUNCS_MACOS],
if test $gl_cv_compiler_clang = yes; then
dnl Test whether the compiler supports the option
dnl '-Werror=unguarded-availability-new'.
- save_ac_compile="$ac_compile"
+ saved_ac_compile="$ac_compile"
ac_compile="$ac_compile -Werror=unguarded-availability-new"
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])],
[gl_cv_compiler_check_future_option='-Werror=unguarded-availability-new'],
[gl_cv_compiler_check_future_option=none])
- ac_compile="$save_ac_compile"
+ ac_compile="$saved_ac_compile"
else
gl_cv_compiler_check_future_option=none
fi
@@ -1197,14 +1225,14 @@ AC_DEFUN([gl_CHECK_FUNCS_CASE_FOR_MACOS],
darwin*)
if test "x$gl_cv_compiler_check_future_option" != "xnone"; then
dnl Use a compile test, not a link test.
- save_ac_compile="$ac_compile"
+ saved_ac_compile="$ac_compile"
ac_compile="$ac_compile $gl_cv_compiler_check_future_option"
- save_ac_compile_for_check_decl="$ac_compile_for_check_decl"
+ saved_ac_compile_for_check_decl="$ac_compile_for_check_decl"
ac_compile_for_check_decl="$ac_compile_for_check_decl $gl_cv_compiler_check_future_option"
unset [ac_cv_have_decl_][$1]
AC_CHECK_DECL([$1], , , [$2])
- ac_compile="$save_ac_compile"
- ac_compile_for_check_decl="$save_ac_compile_for_check_decl"
+ ac_compile="$saved_ac_compile"
+ ac_compile_for_check_decl="$saved_ac_compile_for_check_decl"
[ac_cv_func_][$1]="$[ac_cv_have_decl_][$1]"
if test $[ac_cv_func_][$1] = yes; then
[gl_cv_onwards_func_][$1]=yes
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index f3ac7cc2409..d8b92e7b122 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -432,7 +432,8 @@ AC_DEFUN([gl_INIT],
])
gl_STRING_MODULE_INDICATOR([memrchr])
gl_FUNC_MEMSET_EXPLICIT
- gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], [test $HAVE_MEMSET_EXPLICIT = 0])
+ gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT],
+ [test $HAVE_MEMSET_EXPLICIT = 0 || test $REPLACE_MEMSET_EXPLICIT = 1])
AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [
gl_PREREQ_MEMSET_EXPLICIT
])
@@ -677,7 +678,7 @@ AC_DEFUN([gl_INIT],
if $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then :; else
AC_REQUIRE([AC_CANONICAL_HOST])
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true
- if case $host_os in mingw*) false;; *) :;; esac; then
+ if case $host_os in mingw* | windows*) false;; *) :;; esac; then
func_gl_gnulib_m4code_open
fi
fi
@@ -1005,13 +1006,13 @@ AC_DEFUN([gl_INIT],
if test $REPLACE_GETLINE = 1; then
func_gl_gnulib_m4code_getdelim
fi
- if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then
+ if case $host_os in mingw* | windows*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then
func_gl_gnulib_m4code_open
fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
- if case $host_os in mingw*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then
+ if case $host_os in mingw* | windows*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then
func_gl_gnulib_m4code_open
fi
if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
@@ -1023,7 +1024,7 @@ AC_DEFUN([gl_INIT],
if test $ac_use_included_regex = yes; then
func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c
fi
- if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
+ if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_strtoll
fi
if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then
@@ -1421,6 +1422,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/stdlib.in.h
lib/stpcpy.c
lib/str-two-way.h
+ lib/strftime.c
lib/strftime.h
lib/string.in.h
lib/strnlen.c
diff --git a/m4/group-member.m4 b/m4/group-member.m4
index e058ace62b9..60b3d526db2 100644
--- a/m4/group-member.m4
+++ b/m4/group-member.m4
@@ -1,7 +1,6 @@
# serial 14
-# Copyright (C) 1999-2001, 2003-2007, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 1999-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 8a1c52c8564..70cb746f435 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,4 +1,4 @@
-# include_next.m4 serial 26
+# include_next.m4 serial 27
dnl Copyright (C) 2006-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -74,17 +74,17 @@ EOF
#endif
#define DEFINED_IN_CONFTESTD2
EOF
- gl_save_CPPFLAGS="$CPPFLAGS"
- CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2"
+ gl_saved_CPPFLAGS="$CPPFLAGS"
+ CPPFLAGS="$gl_saved_CPPFLAGS -Iconftestd1b -Iconftestd2"
dnl We intentionally avoid using AC_LANG_SOURCE here.
AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[#include <conftest.h>]],
[gl_cv_have_include_next=yes],
- [CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2"
+ [CPPFLAGS="$gl_saved_CPPFLAGS -Iconftestd1a -Iconftestd2"
AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[#include <conftest.h>]],
[gl_cv_have_include_next=buggy],
[gl_cv_have_include_next=no])
])
- CPPFLAGS="$gl_save_CPPFLAGS"
+ CPPFLAGS="$gl_saved_CPPFLAGS"
rm -rf conftestd1a conftestd1b conftestd2
])
PRAGMA_SYSTEM_HEADER=
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index 2ac98cc8c93..cbe9bc1f63d 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -247,7 +247,7 @@ AC_DEFUN([_AC_SYS_LARGEFILE_PROBE],
AC_REQUIRE([AC_CANONICAL_HOST])
if test $ac_opt_found != yes; then
AS_CASE([$host_os],
- [mingw*],
+ [mingw* | windows*],
[ac_cv_sys_largefile_opts="supported through gnulib"
ac_opt_found=yes]
)
@@ -305,7 +305,7 @@ AC_DEFUN([gl_LARGEFILE],
[
AC_REQUIRE([AC_CANONICAL_HOST])
case "$host_os" in
- mingw*)
+ mingw* | windows*)
dnl Native Windows.
dnl mingw64 defines off_t to a 64-bit type already, if
dnl _FILE_OFFSET_BITS=64, which is ensured by AC_SYS_LARGEFILE.
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index d69b3b2182e..48cc8653fe6 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,4 +1,4 @@
-# serial 34
+# serial 36
# Copyright (C) 1997-2001, 2003-2024 Free Software Foundation, Inc.
#
@@ -18,7 +18,7 @@ AC_DEFUN([gl_FUNC_LSTAT],
if test $ac_cv_func_lstat = yes; then
AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
case $host_os,$gl_cv_func_lstat_dereferences_slashed_symlink in
- solaris* | *no)
+ darwin* | solaris* | *no)
REPLACE_LSTAT=1
;;
esac
@@ -62,7 +62,7 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
*-gnu* | gnu*)
# Guess yes on glibc systems.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
- mingw*)
+ mingw* | windows*)
# Guess no on native Windows.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
*)
diff --git a/m4/malloc.m4 b/m4/malloc.m4
index 770b1ba0ccd..635d6726b11 100644
--- a/m4/malloc.m4
+++ b/m4/malloc.m4
@@ -1,4 +1,4 @@
-# malloc.m4 serial 29
+# malloc.m4 serial 31
dnl Copyright (C) 2007, 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -16,7 +16,8 @@ AC_DEFUN([_AC_FUNC_MALLOC_IF],
[[#include <stdlib.h>
]],
[[void *p = malloc (0);
- int result = !p;
+ void * volatile vp = p;
+ int result = !vp;
free (p);
return result;]])
],
@@ -26,7 +27,7 @@ AC_DEFUN([_AC_FUNC_MALLOC_IF],
# Guess yes on platforms where we know the result.
*-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \
| gnu* | *-musl* | midipix* | midnightbsd* \
- | hpux* | solaris* | cygwin* | mingw* | msys* )
+ | hpux* | solaris* | cygwin* | mingw* | windows* | msys* )
ac_cv_func_malloc_0_nonnull="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
*) ac_cv_func_malloc_0_nonnull="$gl_cross_guess_normal" ;;
@@ -128,7 +129,7 @@ AC_DEFUN([gl_CHECK_MALLOC_POSIX],
dnl except on those platforms where we have seen 'test-malloc-gnu',
dnl 'test-realloc-gnu', 'test-calloc-gnu' fail.
case "$host_os" in
- mingw*)
+ mingw* | windows*)
gl_cv_func_malloc_posix=no ;;
irix* | solaris*)
dnl On IRIX 6.5, the three functions return NULL with errno unset
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 4d44f3aa34d..3c6795ceb28 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
-# manywarnings.m4 serial 24
+# manywarnings.m4 serial 25
dnl Copyright (C) 2008-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -52,7 +52,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
AC_CACHE_CHECK([whether -Wno-missing-field-initializers is needed],
[gl_cv_cc_nomfi_needed],
[gl_cv_cc_nomfi_needed=no
- gl_save_CFLAGS="$CFLAGS"
+ gl_saved_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -Wextra -Werror"
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
@@ -71,7 +71,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
[CFLAGS="$CFLAGS -Wno-missing-field-initializers"
AC_COMPILE_IFELSE([],
[gl_cv_cc_nomfi_needed=yes])])
- CFLAGS="$gl_save_CFLAGS"
+ CFLAGS="$gl_saved_CFLAGS"
])
dnl Next, check if -Werror -Wuninitialized is useful with the
@@ -79,13 +79,13 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)],
dnl has no effect if -O is not also used
AC_CACHE_CHECK([whether -Wuninitialized is supported],
[gl_cv_cc_uninitialized_supported],
- [gl_save_CFLAGS="$CFLAGS"
+ [gl_saved_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -Werror -Wuninitialized"
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[]], [[]])],
[gl_cv_cc_uninitialized_supported=yes],
[gl_cv_cc_uninitialized_supported=no])
- CFLAGS="$gl_save_CFLAGS"
+ CFLAGS="$gl_saved_CFLAGS"
])
])
diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4
index 375b3b4cda9..94ce05d1a6a 100644
--- a/m4/mempcpy.m4
+++ b/m4/mempcpy.m4
@@ -1,6 +1,6 @@
# mempcpy.m4 serial 14
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2024 Free Software Foundation,
+dnl 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.
diff --git a/m4/memrchr.m4 b/m4/memrchr.m4
index 21604f0ef94..b4ccdfa3c8d 100644
--- a/m4/memrchr.m4
+++ b/m4/memrchr.m4
@@ -1,6 +1,6 @@
# memrchr.m4 serial 11
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
+dnl 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.
diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4
index 6ac798d4557..19514ff917e 100644
--- a/m4/memset_explicit.m4
+++ b/m4/memset_explicit.m4
@@ -1,3 +1,4 @@
+# memset_explicit.m4 serial 2
dnl Copyright 2022-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -7,9 +8,12 @@ AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT],
[
AC_REQUIRE([gl_STRING_H_DEFAULTS])
- AC_CHECK_FUNCS_ONCE([memset_explicit])
+ gl_CHECK_FUNCS_ANDROID([memset_explicit], [[#include <string.h>]])
if test $ac_cv_func_memset_explicit = no; then
HAVE_MEMSET_EXPLICIT=0
+ case "$gl_cv_onwards_func_memset_explicit" in
+ future*) REPLACE_MEMSET_EXPLICIT=1 ;;
+ esac
fi
])
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index a4aeb9f76ba..0565e5e61fe 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,6 +1,6 @@
-# serial 38
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+# serial 39
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
+dnl 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.
@@ -264,9 +264,9 @@ main ()
[gl_cv_func_working_mktime=yes],
[gl_cv_func_working_mktime=no],
[case "$host_os" in
- # Guess no on native Windows.
- mingw*) gl_cv_func_working_mktime="guessing no" ;;
- *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;;
+ # Guess no on native Windows.
+ mingw* | windows*) gl_cv_func_working_mktime="guessing no" ;;
+ *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;;
esac
])
fi
@@ -287,7 +287,7 @@ AC_DEFUN([gl_FUNC_MKTIME],
with the algorithmic workarounds.])
fi
case "$host_os" in
- mingw*)
+ mingw* | windows*)
REPLACE_MKTIME=1
AC_DEFINE([NEED_MKTIME_WINDOWS], [1],
[Define if the compilation of mktime.c should define 'mktime'
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4
index ad3f68cb75b..ff730b676cd 100644
--- a/m4/nanosleep.m4
+++ b/m4/nanosleep.m4
@@ -1,4 +1,4 @@
-# serial 44
+# serial 47
dnl From Jim Meyering.
dnl Check for the nanosleep function.
@@ -21,7 +21,7 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
AC_CHECK_DECLS_ONCE([alarm])
- nanosleep_save_libs=$LIBS
+ gl_saved_LIBS=$LIBS
# Solaris 2.5.1 needs -lposix4 to get the nanosleep function.
# Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
@@ -116,11 +116,18 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
*) gl_cv_func_nanosleep=no ;;
esac],
[case "$host_os" in
- linux*) # Guess it halfway works when the kernel is Linux.
+ # Guess it halfway works when the kernel is Linux.
+ linux*)
gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;;
- mingw*) # Guess no on native Windows.
+ # Midipix generally emulates the Linux system calls,
+ # but here it handles large arguments correctly.
+ midipix*)
+ gl_cv_func_nanosleep='guessing yes' ;;
+ # Guess no on native Windows.
+ mingw* | windows*)
gl_cv_func_nanosleep='guessing no' ;;
- *) # If we don't know, obey --enable-cross-guesses.
+ # If we don't know, obey --enable-cross-guesses.
+ *)
gl_cv_func_nanosleep="$gl_cross_guess_normal" ;;
esac
])
@@ -140,7 +147,7 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
else
HAVE_NANOSLEEP=0
fi
- LIBS=$nanosleep_save_libs
+ LIBS=$gl_saved_LIBS
# For backward compatibility.
LIB_NANOSLEEP="$NANOSLEEP_LIB"
diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4
index aacb2ed048b..7012471e046 100644
--- a/m4/ndk-build.m4
+++ b/m4/ndk-build.m4
@@ -21,10 +21,6 @@ AC_ARG_WITH([ndk_path],
[AS_HELP_STRING([--with-ndk-path],
[find Android libraries in these directories])])
-AC_ARG_WITH([ndk_cxx_shared],
- [AS_HELP_STRING([--with-ndk-cxx-shared],
- [name of the C++ standard library included with the NDK])])
-
AC_ARG_WITH([ndk_cxx],
[AS_HELP_STRING([--with-ndk-cxx],
[name of the C++ compiler included with the NDK])])
@@ -59,6 +55,7 @@ ndk_DIR=$3
ndk_ANY_CXX=
ndk_BUILD_CFLAGS="$4"
ndk_working_cxx=no
+ndk_CXX_SHARED=
AS_CASE(["$ndk_ABI"],
[*arm64*], [ndk_ARCH=arm64],
@@ -149,7 +146,7 @@ ndk_resolve_import_module () {
for ndk_android_mk in $ndk_module_files; do
# Read this Android.mk file. Set NDK_ROOT to /tmp: the Android in
- # tree build system sets it to a meaning value, but build files
+ # tree build system sets it to a meaningful value, but build files
# just use it to test whether or not the NDK is being used.
ndk_commands=`ndk_run_test`
eval "$ndk_commands"
@@ -169,13 +166,14 @@ that could not be found in the list of directories specified in \
ndk_ANY_CXX=yes
fi
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but it was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \
+ && test -z "$ndk_CXX_LDFLAGS"],
+ [AC_MSG_ERROR([The module $1 requires a C++ standard library,
+but none were found.])])
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but a working C++ compiler was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"],
+ [AC_MSG_ERROR([The module [$]1 requires the C++ standard library,
+but a working C++ compiler was not found.])])
AC_MSG_RESULT([yes])
@@ -227,6 +225,88 @@ ndk_subst_cc_onto_cxx () {
done
}
+# ndk_subst_cflags_onto_cxx
+# ---------------------
+# Print any options in CFLAGS also suitable for a C++ compiler.
+
+ndk_subst_cflags_onto_cxx () {
+ ndk_flag=
+ for ndk_word in $CFLAGS; do
+ AS_IF([test "$ndk_flag" = "yes"],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=no],
+ [AS_CASE([$ndk_word],
+ [*-sysroot=*],
+ [AS_ECHO_N(["$ndk_word "])],
+ [*-isystem*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [*-I*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [*-sysroot*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [-D__ANDROID_API__*],
+ [AS_ECHO_N(["$ndk_word "])])])
+ done
+}
+
+# Detect the installation directory and type of the NDK being used.
+
+ndk_install_dir=
+ndk_toolchain_type=
+
+AC_MSG_CHECKING([for the directory where the NDK is installed])
+
+dnl If the install directory isn't available, repeat the search over
+dnl each entry in the programs directory.
+ndk_programs_dirs=`$CC -print-search-dirs | sed -n "s/^programs:[[\t ]]*=\?\(.*\)/\1/p"`
+ndk_save_IFS=$IFS; IFS=:
+for ndk_dir in $ndk_programs_dirs; do
+ if test -d "$ndk_dir"; then :; else
+ continue
+ fi
+ ndk_dir=`cd "$ndk_dir"; pwd`
+ while test "$ndk_dir" != "/" && test -z "$ndk_toolchain_type"; do
+ ndk_dir=`AS_DIRNAME([$ndk_dir])`
+ AS_IF([test -d "$ndk_dir/bin" && test -d "$ndk_dir/lib"],
+ [dnl The directory reached is most likely either the directory
+ dnl holding prebuilt binaries in a combined toolchain or the
+ dnl directory holding a standalone toolchain itself.
+ dnl
+ dnl Distinguish between the two by verifying the name of the
+ dnl parent directory (and its parent).
+ ndk_dir1=`AS_DIRNAME(["$ndk_dir"])`
+ ndk_basename=`AS_BASENAME(["$ndk_dir1"])`
+ AS_IF([test "$ndk_basename" = "prebuilt"],
+ [dnl Directories named "prebuilt" are exclusively present in
+ dnl combined toolchains, where they are children of the
+ dnl base directory or, in recent releases, a directory
+ dnl within the base directory. Continue searching for the
+ dnl base directory.
+ ndk_toolchain_type=combined
+ while test "$ndk_dir1" != "/"; do
+ AS_IF([test -d "$ndk_dir1/toolchains" \
+ && test -d "$ndk_dir1/sources"],
+ [ndk_install_dir=$ndk_dir1
+ break])
+ ndk_dir1=`AS_DIRNAME(["$ndk_dir1"])`
+ done],
+ [ndk_toolchain_type=standalone
+ ndk_install_dir=$ndk_dir])])
+ done
+ AS_IF([test -n "$ndk_toolchain_type"],
+ [break])
+done
+IFS=$ndk_save_IFS
+
+AS_IF([test -z "$ndk_install_dir"],
+ [AC_MSG_RESULT([unknown])
+ AC_MSG_WARN([The NDK installation directory could not be \
+derived from the compiler.])],
+ [AC_MSG_RESULT([$ndk_install_dir ($ndk_toolchain_type)])])
+
# Look for a suitable ar and ranlib in the same directory as the C
# compiler.
ndk_cc_firstword=`AS_ECHO(["$CC"]) | cut -d' ' -f1`
@@ -259,72 +339,8 @@ NDK_BUILD_NASM=
AS_IF([test "$ndk_ARCH" = "x86" || test "$ndk_ARCH" = "x86_64"],
[AC_CHECK_PROGS([NDK_BUILD_NASM], [nasm])])
-# Look for a file named ``libc++_shared.so'' in a subdirectory of
-# $ndk_where_cc if it was not specified.
-AC_MSG_CHECKING([for libc++_shared.so])
-
-ndk_where_toolchain=
-AS_IF([test -z "$with_ndk_cxx_shared" && test -n "$ndk_where_cc"],[
- # Find the NDK root directory. Go to $ndk_where_cc.
- SAVE_PWD=`pwd`
- cd `AS_DIRNAME(["$ndk_where_cc"])`
-
- # Now, keep moving backwards until pwd ends with ``toolchains''.
- while :; do
- if test "`pwd`" = "/"; then
- cd "$SAVE_PWD"
- break
- fi
-
- ndk_pwd=`pwd`
- if test "`AS_BASENAME([$ndk_pwd])`" = "toolchains"; then
- ndk_where_toolchain=$ndk_pwd
- cd "$SAVE_PWD"
- break
- fi
-
- cd ..
- done
-
- ndk_matching_libcxx_shared_so=
-
- # The toolchain directory should be in "$ndk_where_toolchain".
- AS_IF([test -n "$ndk_where_toolchain"],[
- # Now, look in the directory behind it.
- ndk_cxx_shared_so=`find "$ndk_where_toolchain" -name libc++_shared.so`
-
- # Look for one with the correct architecture.
- for ndk_candidate in $ndk_cxx_shared_so; do
- AS_CASE([$ndk_candidate],
- [*arm-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "arm"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*aarch64-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "arm64"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*i[[3-6]]86-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "x86"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*x86_64-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "x86_64"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])])
-
- AS_IF([test -n "$ndk_matching_libcxx_shared_so"],
- [with_ndk_cxx_shared=$ndk_matching_libcxx_shared_so])
- done])])
-
-AS_IF([test -z "$with_ndk_cxx_shared"],[AC_MSG_RESULT([no])
- AC_MSG_WARN([The C++ standard library could not be found. \
-If you try to build Emacs with a dependency that requires the C++ standard \
-library, Emacs will not build correctly, unless you manually specify the \
-name of an appropriate ``libc++_shared.so'' binary.])],
- [AC_MSG_RESULT([$with_ndk_cxx_shared])])
-
-ndk_CXX_SHARED=$with_ndk_cxx_shared
-
-# These variables have now been found. Now look for a C++ compiler.
-# Upon failure, pretend the C compiler is a C++ compiler and use that
-# instead.
+# Search for a C++ compiler. Upon failure, pretend the C compiler is a
+# C++ compiler and use that instead.
ndk_cc_name=`AS_BASENAME(["${ndk_cc_firstword}"])`
ndk_cxx_name=
@@ -338,8 +354,162 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx],
[], [`AS_DIRNAME(["$ndk_where_cc"])`:$PATH])
AS_IF([test -z "$CXX"], [CXX=`ndk_filter_cc_for_cxx`],
[CXX=`ndk_subst_cc_onto_cxx`])])
+
+# None of the C++ standard libraries installed with Android are
+# available to NDK programs, which are expected to select one of several
+# standard libraries distributed with the NDK. This library must be
+# extracted from the NDK by the program's build system and copied into
+# the application directory, and the build system is also expected to
+# provide the compiler with suitable options to enable it.
+#
+# Emacs, on recent releases of the NDK, prefers the libc++ library, the
+# most complete of the libraries available, when it detects the presence
+# of its headers and libraries in the compiler's search path. Next in
+# line are the several libraries located in a directory named `cxx-stl'
+# inside the NDK distribution, of which Emacs prefers, in this order,
+# the GNU libstdc++, stlport, gabi and the system C++ library. The
+# scope of the last two is confined to providing runtime support for
+# basic C++ operations, and is useless for compiling most C++
+# dependencies whose requirements go beyond such operations.
+#
+# The NDK comes in two forms. In a "combined toolchain", all C++
+# libraries are present in the NDK directory and the responsibility is
+# left to the build system to locate and select the best C++ library,
+# whereas in a "standalone toolchain" an STL will have already been
+# specified a C++ library, besides which no others will be present.
+#
+# Though Android.mk files are provided by the NDK for each such library,
+# Emacs cannot use any of these, both for lack of prebuilt support in
+# its ndk-build implementation, and since they are absent from combined
+# toolchains.
+
+ndk_CXX_SHARED=
+ndk_CXX_STL=
+ndk_CXX_LDFLAGS=
+
+AS_IF([test -n "$CXX" && test -n "$ndk_install_dir"],
+ [ndk_library_dirs=`$CXX -print-search-dirs \
+ | sed -n "s/^libraries:[[\t ]]*=\?\(.*\)/\1/p"`
+ AS_IF([test "$ndk_toolchain_type" = "standalone"],
+ [dnl With a standalone toolchain, just use the first C++ library
+ dnl present in the compiler's library search path, that being the
+ dnl only C++ library that will ever be present.
+ ndk_save_IFS=$IFS; IFS=:
+ for ndk_dir in $ndk_library_dirs; do
+ if test -d "$ndk_dir"; then :; else
+ continue
+ fi
+ ndk_dir=`cd "$ndk_dir"; pwd`
+ if test -f "$ndk_dir/libc++_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libc++_shared.so"
+ ndk_CXX_LDFLAGS=-lc++_shared; break
+ elif test -f "$ndk_dir/libgnustl_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libgnustl_shared.so"
+ ndk_CXX_LDFLAGS=-lgnustl_shared; break
+ elif test -f "$ndk_dir/libstlport_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libstlport_shared.so"
+ ndk_CXX_LDFLAGS=-lstlport_shared; break
+ fi
+ done
+ IFS=$ndk_save_IFS],
+ [dnl Otherwise, search for a suitable standard library
+ dnl in the order stated above.
+ dnl
+ dnl Detect if this compiler is configured to link against libc++ by
+ dnl default.
+ AC_MSG_CHECKING([whether compiler defaults to libc++])
+ cat <<_ACEOF >conftest.cc
+#include <string>
+#ifndef _LIBCPP_VERSION
+Not libc++!
+#endif /* _LIBCPP_VERSION */
+
+int
+main (void)
+{
+
+}
+_ACEOF
+ AS_IF([$CXX conftest.cc -o conftest.o >&AS_MESSAGE_LOG_FD 2>&1],
+ [dnl The compiler defaults to libc++.
+ AC_MSG_RESULT([yes])
+ ndk_save_IFS=$IFS; IFS=:
+ for ndk_dir in $ndk_library_dirs; do
+ if test -f "$ndk_dir/libc++_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libc++_shared.so"
+ ndk_CXX_LDFLAGS=-lc++_shared; break
+ fi
+ done
+ IFS=$ndk_save_IFS],
+ [dnl Search for gnustl, stlport, gabi, and failing that, system.
+ dnl The name of the gabi system root directory varies by GCC
+ dnl version.
+ AC_MSG_RESULT([no])
+ ndk_gcc_version=`($CXX -v 2>&1) \
+ | sed -n "s/^gcc version \([[0123456789]\+.[0123456789]\+]\).*/\1/p"`
+ cxx_stl="$ndk_install_dir/sources/cxx-stl"
+ ndk_cxx_stl_base="$cxx_stl/gnu-libstdc++/$ndk_gcc_version"
+ AS_IF([test -n "$ndk_gcc_version" \
+ && test -d "$ndk_cxx_stl_base/libs/$ndk_ABI"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lgnustl_shared"
+ ndk_CXX_LDFLAGS="$ndk_CXX_LDFLAGS -lsupc++"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include"
+ ndk_CXX_STL="$ndk_CXX_STL -isystem $ndk_cxx_stl_base/libs/$ndk_ABI/include"
+ ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libgnustl_shared.so"])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [dnl No STL was located or the library is not reachable.
+ dnl Search for alternatives.
+ ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/stlport"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lstlport_shared"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/stlport"
+ ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libstlport_shared.so"])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/gabi++"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lgabi++_shared"
+ ndk_CXX_STL="$ndk_CXX_STL -isystem $ndk_cxx_stl_base/include"
+ ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/lgabi++_shared.so"])])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/system"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lstdc++"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include"
+ dnl The "system" library is distributed with Android and
+ dnl need not be present in app packages.
+ ndk_CXX_SHARED=
+ dnl Done.
+ ])])])])
+ rm -f conftest.o])])
+
+AS_ECHO([])
+AS_ECHO(["C++ compiler configuration: "])
+AS_ECHO([])
+AS_ECHO(["Library includes : $ndk_CXX_STL"])
+AS_ECHO(["Linker options : $ndk_CXX_LDFLAGS"])
+AS_ECHO(["Library file (if any) : $ndk_CXX_SHARED"])
+AS_ECHO([])
])
+# ndk_LATE_EARLY
+# --------------
+# Call before ndk_LATE to establish certain variables in time for
+# ndk_LATE's C++ compiler detection.
+
+AC_DEFUN([ndk_LATE_EARLY],
+[ndk_save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS $ndk_CXX_LDFLAGS"
+ CXXFLAGS="$CXXFLAGS `ndk_subst_cflags_onto_cxx` $ndk_CXX_STL"])
+
# ndk_LATE
# --------
# Perform late initialization of the ndk-build system by checking for
@@ -347,17 +517,14 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx],
AC_DEFUN([ndk_LATE],
[dnl
-dnl This calls AC_REQUIRE([AC_PROG_CXX]), leading to configure looking
-dnl for a C++ compiler. However, the language is not restored
-dnl afterwards if not `$ndk_INITIALIZED'.
AS_IF([test "$ndk_INITIALIZED" = "yes"],[
- AS_IF([test -n "$CXX"], [AC_LANG_PUSH([C++])
+ AS_IF([test -n "$CXX"], [
+ AC_LANG_PUSH([C++])
AC_CHECK_HEADER([string], [ndk_working_cxx=yes],
- [AC_MSG_WARN([Your C++ compiler is not properly set up, and\
- the standard library headers could not be found.])])
+ [AC_MSG_WARN([Your C++ compiler is not properly configured, as \
+the standard library headers could not be found.])])
AC_LANG_POP([C++])])])
-dnl Thus, manually switch back to C here.
-AC_LANG([C])
+LDFLAGS="$ndk_save_LDFLAGS"
])
# ndk_SEARCH_MODULE(MODULE, NAME, ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND])
@@ -396,13 +563,14 @@ else
ndk_ANY_CXX=yes
fi
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"],
- [AC_MSG_ERROR([The module $1 requires the C++ standard library \
-(libc++_shared.so), but it was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \
+ && test -z "$ndk_CXX_LDFLAGS"],
+ [AC_MSG_ERROR([The module $1 requires a C++ standard library,
+but none were found.])])
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but a working C++ compiler was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"],
+ [AC_MSG_ERROR([The module [$]1 requires the C++ standard library,
+but a working C++ compiler was not found.])])
$2[]_CFLAGS="[$]$2[]_CFLAGS $module_cflags $module_includes"
$2[]_LIBS="[$]$2[]_LIBS $module_ldflags"
@@ -457,6 +625,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES],
NDK_BUILD_AR=$AR
NDK_BUILD_MODULES="$ndk_MODULES"
NDK_BUILD_CXX_SHARED="$ndk_CXX_SHARED"
+ NDK_BUILD_CXX_STL="$ndk_CXX_STL"
+ NDK_BUILD_CXX_LDFLAGS="$ndk_CXX_LDFLAGS"
NDK_BUILD_ANY_CXX_MODULE=$ndk_ANY_CXX
NDK_BUILD_CFLAGS="$ndk_BUILD_CFLAGS"
@@ -470,6 +640,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES],
AC_SUBST([NDK_BUILD_NASM])
AC_SUBST([NDK_BUILD_MODULES])
AC_SUBST([NDK_BUILD_CXX_SHARED])
+ AC_SUBST([NDK_BUILD_CXX_STL])
+ AC_SUBST([NDK_BUILD_CXX_LDFLAGS])
AC_SUBST([NDK_BUILD_ANY_CXX_MODULE])
AC_SUBST([NDK_BUILD_CFLAGS])
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index 01725b2a331..aa5d63a54b5 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,7 +1,6 @@
-# serial 37
+# serial 38
-# Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -17,7 +16,4 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME],
AC_REQUIRE([AC_STRUCT_TIMEZONE])
AC_REQUIRE([gl_TM_GMTOFF])
-
- AC_DEFINE([my_strftime], [nstrftime],
- [Define to the name of the strftime replacement function.])
])
diff --git a/m4/open.m4 b/m4/open.m4
index edbd8b93c83..91e5c31b59a 100644
--- a/m4/open.m4
+++ b/m4/open.m4
@@ -1,4 +1,4 @@
-# open.m4 serial 15
+# open.m4 serial 16
dnl Copyright (C) 2007-2024 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,7 @@ AC_DEFUN([gl_FUNC_OPEN],
AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([gl_PREPROC_O_CLOEXEC])
case "$host_os" in
- mingw* | pw*)
+ mingw* | windows* | pw*)
REPLACE_OPEN=1
;;
*)
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index b7ce9ff1468..a0fc296c9b2 100644
--- a/m4/pathmax.m4
+++ b/m4/pathmax.m4
@@ -1,6 +1,6 @@
# pathmax.m4 serial 11
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2024 Free Software Foundation,
+dnl 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.
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index 81be9611db2..cb2ee900313 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,4 +1,4 @@
-# pthread_sigmask.m4 serial 22
+# pthread_sigmask.m4 serial 23
dnl Copyright (C) 2011-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -47,7 +47,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
if test -n "$LIBMULTITHREAD"; then
AC_CACHE_CHECK([for pthread_sigmask in $LIBMULTITHREAD],
[gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD],
- [gl_save_LIBS="$LIBS"
+ [gl_saved_LIBS="$LIBS"
LIBS="$LIBS $LIBMULTITHREAD"
AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
@@ -58,7 +58,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
],
[gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes],
[gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no])
- LIBS="$gl_save_LIBS"
+ LIBS="$gl_saved_LIBS"
])
if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then
dnl pthread_sigmask is available with -pthread or -lpthread.
@@ -164,7 +164,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
AC_CACHE_CHECK([whether pthread_sigmask returns error numbers],
[gl_cv_func_pthread_sigmask_return_works],
[
- gl_save_LIBS="$LIBS"
+ gl_saved_LIBS="$LIBS"
LIBS="$LIBS $PTHREAD_SIGMASK_LIB"
AC_RUN_IFELSE(
[AC_LANG_SOURCE([[
@@ -188,7 +188,7 @@ int main ()
gl_cv_func_pthread_sigmask_return_works="guessing yes";;
esac
])
- LIBS="$gl_save_LIBS"
+ LIBS="$gl_saved_LIBS"
])
case "$gl_cv_func_pthread_sigmask_return_works" in
*no)
@@ -214,7 +214,7 @@ int main ()
[dnl Link against $LIBMULTITHREAD, not only $PTHREAD_SIGMASK_LIB.
dnl Otherwise we get a false positive on those platforms where
dnl $gl_cv_func_pthread_sigmask_in_libc_works is "no".
- gl_save_LIBS=$LIBS
+ gl_saved_LIBS=$LIBS
LIBS="$LIBS $LIBMULTITHREAD"])
AC_RUN_IFELSE(
[AC_LANG_SOURCE([[
@@ -258,7 +258,7 @@ int main ()
[:],
[gl_cv_func_pthread_sigmask_unblock_works=no],
[:])
- m4_ifdef([gl_][THREADLIB], [LIBS=$gl_save_LIBS])
+ m4_ifdef([gl_][THREADLIB], [LIBS=$gl_saved_LIBS])
])
case "$gl_cv_func_pthread_sigmask_unblock_works" in
*no)
diff --git a/m4/readutmp.m4 b/m4/readutmp.m4
index d458a8b554a..ec40019735f 100644
--- a/m4/readutmp.m4
+++ b/m4/readutmp.m4
@@ -1,4 +1,4 @@
-# readutmp.m4 serial 30
+# readutmp.m4 serial 31
dnl Copyright (C) 2002-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -18,7 +18,7 @@ AC_DEFUN([gl_READUTMP],
if test $ac_cv_header_systemd_sd_login_h = yes; then
AC_CACHE_CHECK([for libsystemd version >= 254],
[gl_cv_lib_readutmp_systemd],
- [gl_save_LIBS="$LIBS"
+ [gl_saved_LIBS="$LIBS"
LIBS="$LIBS -lsystemd"
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([[
@@ -31,7 +31,7 @@ AC_DEFUN([gl_READUTMP],
],
[gl_cv_lib_readutmp_systemd=yes],
[gl_cv_lib_readutmp_systemd=no])
- LIBS="$gl_save_LIBS"
+ LIBS="$gl_saved_LIBS"
])
if test $gl_cv_lib_readutmp_systemd = yes; then
AC_DEFINE([READUTMP_USE_SYSTEMD], [1],
diff --git a/m4/realloc.m4 b/m4/realloc.m4
index 7c769644a6e..a59af2807c9 100644
--- a/m4/realloc.m4
+++ b/m4/realloc.m4
@@ -1,4 +1,4 @@
-# realloc.m4 serial 27
+# realloc.m4 serial 29
dnl Copyright (C) 2007, 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -16,7 +16,8 @@ AC_DEFUN([_AC_FUNC_REALLOC_IF],
[[#include <stdlib.h>
]],
[[void *p = realloc (0, 0);
- int result = !p;
+ void * volatile vp = p;
+ int result = !vp;
free (p);
return result;]])
],
@@ -26,7 +27,7 @@ AC_DEFUN([_AC_FUNC_REALLOC_IF],
# Guess yes on platforms where we know the result.
*-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \
| gnu* | *-musl* | midipix* | midnightbsd* \
- | hpux* | solaris* | cygwin* | mingw* | msys* )
+ | hpux* | solaris* | cygwin* | mingw* | windows* | msys* )
ac_cv_func_realloc_0_nonnull="guessing yes" ;;
# If we don't know, obey --enable-cross-guesses.
*) ac_cv_func_realloc_0_nonnull="$gl_cross_guess_normal" ;;
diff --git a/m4/regex.m4 b/m4/regex.m4
index 7a43e1c9a26..3dfeabea057 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,4 +1,4 @@
-# serial 74
+# serial 75
# Copyright (C) 1996-2001, 2003-2024 Free Software Foundation, Inc.
#
@@ -327,10 +327,10 @@ AC_DEFUN([gl_REGEX],
[gl_cv_func_re_compile_pattern_working=yes],
[gl_cv_func_re_compile_pattern_working=no],
[case "$host_os" in
- # Guess no on native Windows.
- mingw*) gl_cv_func_re_compile_pattern_working="guessing no" ;;
- # Otherwise obey --enable-cross-guesses.
- *) gl_cv_func_re_compile_pattern_working="$gl_cross_guess_normal" ;;
+ # Guess no on native Windows.
+ mingw* | windows*) gl_cv_func_re_compile_pattern_working="guessing no" ;;
+ # Otherwise obey --enable-cross-guesses.
+ *) gl_cv_func_re_compile_pattern_working="$gl_cross_guess_normal" ;;
esac
])
])
diff --git a/m4/sig2str.m4 b/m4/sig2str.m4
index 2cb77c58a46..ab3786b8954 100644
--- a/m4/sig2str.m4
+++ b/m4/sig2str.m4
@@ -1,6 +1,5 @@
# serial 7
-dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2024 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.
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index 65c96fcf56b..25b28d77e4e 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,6 +1,5 @@
# ssize_t.m4 serial 6
-dnl Copyright (C) 2001-2003, 2006, 2010-2024 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-2024 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.
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
index 7535a4c7e5c..8bec2f5f815 100644
--- a/m4/stat-time.m4
+++ b/m4/stat-time.m4
@@ -1,7 +1,7 @@
# Checks for stat-related time functions.
-# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2024 Free
-# Software Foundation, Inc.
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2024 Free Software
+# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index 2683fae7daf..e3c1e609236 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -13,10 +13,10 @@ AC_DEFUN([gl_ALIGNASOF],
[
AC_CACHE_CHECK([for alignas and alignof],
[gl_cv_header_working_stdalign_h],
- [gl_save_CFLAGS=$CFLAGS
+ [gl_saved_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"])
+ [*stdalign.h*], [CFLAGS="$gl_saved_CFLAGS -DINCLUDE_STDALIGN_H"])
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[[#include <stdint.h>
@@ -56,7 +56,7 @@ AC_DEFUN([gl_ALIGNASOF],
[gl_cv_header_working_stdalign_h=$gl_working],
[gl_cv_header_working_stdalign_h=no])
- CFLAGS=$gl_save_CFLAGS
+ CFLAGS=$gl_saved_CFLAGS
test "$gl_cv_header_working_stdalign_h" != no && break
done])
@@ -112,7 +112,11 @@ AC_DEFUN([gl_ALIGNASOF],
# define _Alignof(type) alignof (type)
# else
template <class __t> struct __alignof_helper { char __a; __t __b; };
-# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+# if (defined __GNUC__ && 4 <= __GNUC__) || defined __clang__
+# define _Alignof(type) __builtin_offsetof (__alignof_helper<type>, __b)
+# else
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+# endif
# define _GL_STDALIGN_NEEDS_STDDEF 1
# endif
# else
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 8c0d430c042..4aa250827cc 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 62
+# stdint.m4 serial 63
dnl Copyright (C) 2001-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -286,10 +286,10 @@ static const char *macro_values[] =
[gl_cv_header_working_stdint_h=yes],
[],
[case "$host_os" in
- # Guess yes on native Windows.
- mingw*) gl_cv_header_working_stdint_h="guessing yes" ;;
- # In general, assume it works.
- *) gl_cv_header_working_stdint_h="guessing yes" ;;
+ # Guess yes on native Windows.
+ mingw* | windows*) gl_cv_header_working_stdint_h="guessing yes" ;;
+ # In general, assume it works.
+ *) gl_cv_header_working_stdint_h="guessing yes" ;;
esac
])
])
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index bd6ef381c69..92e67a74bb5 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,4 +1,4 @@
-# stdlib_h.m4 serial 75
+# stdlib_h.m4 serial 76
dnl Copyright (C) 2007-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -134,6 +134,7 @@ AC_DEFUN([gl_STDLIB_H_REQUIRE_DEFAULTS],
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_PTSNAME_R])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_PUTENV])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_QSORT_R])
+ gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RAND])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RANDOM])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RANDOM_R])
gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_REALLOCARRAY])
@@ -237,6 +238,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R])
REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV])
REPLACE_QSORT_R=0; AC_SUBST([REPLACE_QSORT_R])
+ REPLACE_RAND=0; AC_SUBST([REPLACE_RAND])
REPLACE_RANDOM=0; AC_SUBST([REPLACE_RANDOM])
REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R])
REPLACE_REALLOC_FOR_REALLOC_GNU=0; AC_SUBST([REPLACE_REALLOC_FOR_REALLOC_GNU])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 3cbcbc74873..9ea748cc774 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -5,7 +5,7 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 37
+# serial 39
# Written by Paul Eggert.
@@ -132,6 +132,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS],
REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR])
REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM])
REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY])
+ REPLACE_MEMSET_EXPLICIT=0; AC_SUBST([REPLACE_MEMSET_EXPLICIT])
REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY])
REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY])
REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL])
@@ -146,5 +147,6 @@ AC_DEFUN([gl_STRING_H_DEFAULTS],
REPLACE_STRERROR_R=0; AC_SUBST([REPLACE_STRERROR_R])
REPLACE_STRERRORNAME_NP=0; AC_SUBST([REPLACE_STRERRORNAME_NP])
REPLACE_STRSIGNAL=0; AC_SUBST([REPLACE_STRSIGNAL])
+ REPLACE_STRVERSCMP=0; AC_SUBST([REPLACE_STRVERSCMP])
UNDEFINE_STRTOK_R=0; AC_SUBST([UNDEFINE_STRTOK_R])
])
diff --git a/m4/strnlen.m4 b/m4/strnlen.m4
index 16b351a3d41..3eac8e629d7 100644
--- a/m4/strnlen.m4
+++ b/m4/strnlen.m4
@@ -1,6 +1,6 @@
# strnlen.m4 serial 14
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software
-dnl Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation,
+dnl 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.
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index 0708d7e1ce8..b58fa48ff6e 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,6 +1,5 @@
-# strtoimax.m4 serial 16
-dnl Copyright (C) 2002-2004, 2006, 2009-2024 Free Software Foundation,
-dnl Inc.
+# strtoimax.m4 serial 17
+dnl Copyright (C) 2002-2004, 2006, 2009-2024 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.
@@ -62,12 +61,12 @@ int main ()
[gl_cv_func_strtoimax=yes],
[gl_cv_func_strtoimax=no],
[case "$host_os" in
- # Guess no on AIX 5.
- aix5*) gl_cv_func_strtoimax="guessing no" ;;
- # Guess yes on native Windows.
- mingw*) gl_cv_func_strtoimax="guessing yes" ;;
- # Guess yes otherwise.
- *) gl_cv_func_strtoimax="guessing yes" ;;
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes on native Windows.
+ mingw* | windows*) gl_cv_func_strtoimax="guessing yes" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
esac
])
])
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
index 5ba266f7687..130b9094d88 100644
--- a/m4/strtoll.m4
+++ b/m4/strtoll.m4
@@ -1,6 +1,5 @@
-# strtoll.m4 serial 11
-dnl Copyright (C) 2002, 2004, 2006, 2008-2024 Free Software Foundation,
-dnl Inc.
+# strtoll.m4 serial 12
+dnl Copyright (C) 2002, 2004, 2006, 2008-2024 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.
@@ -45,7 +44,7 @@ AC_DEFUN([gl_FUNC_STRTOLL],
[gl_cv_func_strtoll_works=no],
[case "$host_os" in
# Guess no on native Windows.
- mingw*) gl_cv_func_strtoll_works="guessing no" ;;
+ mingw* | windows*) gl_cv_func_strtoll_works="guessing no" ;;
# Guess no on glibc systems.
*-gnu* | gnu*) gl_cv_func_strtoll_works="guessing no" ;;
# Guess no on musl systems.
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 07f82cdfaeb..32fade0f401 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,9 +1,8 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc.
-# serial 24
+# serial 25
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -176,5 +175,6 @@ AC_DEFUN([gl_TIME_H_DEFAULTS],
REPLACE_TIME=0; AC_SUBST([REPLACE_TIME])
REPLACE_TIMEGM=0; AC_SUBST([REPLACE_TIMEGM])
REPLACE_TIMESPEC_GET=0; AC_SUBST([REPLACE_TIMESPEC_GET])
+ REPLACE_TIMESPEC_GETRES=0; AC_SUBST([REPLACE_TIMESPEC_GETRES])
REPLACE_TZSET=0; AC_SUBST([REPLACE_TZSET])
])
diff --git a/m4/timespec.m4 b/m4/timespec.m4
index 0a1c90e550c..59a0db9966e 100644
--- a/m4/timespec.m4
+++ b/m4/timespec.m4
@@ -1,7 +1,6 @@
#serial 15
-# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software
-# Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 3a1cacaef55..e078bd617a7 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,4 @@
-# unistd_h.m4 serial 94
+# unistd_h.m4 serial 95
dnl Copyright (C) 2006-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -234,6 +234,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_EXECVP=0; AC_SUBST([REPLACE_EXECVP])
REPLACE_EXECVPE=0; AC_SUBST([REPLACE_EXECVPE])
REPLACE_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT])
+ REPLACE_FCHDIR=0; AC_SUBST([REPLACE_FCHDIR])
REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT])
REPLACE_FDATASYNC=0; AC_SUBST([REPLACE_FDATASYNC])
REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index af03e6b52be..0f5bfd4c843 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -3,7 +3,7 @@ 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 serial 15
+dnl serial 16
AC_DEFUN([gl_UTIMENS],
[
@@ -36,12 +36,13 @@ AC_DEFUN([gl_UTIMENS],
[gl_cv_func_futimesat_works=yes],
[gl_cv_func_futimesat_works=no],
[case "$host_os" in
- # Guess yes on Linux systems.
- linux-* | linux) gl_cv_func_futimesat_works="guessing yes" ;;
- # Guess yes on glibc systems.
- *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;;
+ # Guess yes on Linux systems
+ # and on systems that emulate the Linux system calls.
+ linux* | midipix*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;;
esac
])
rm -f conftest.file])
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index e595b333d17..4af7f6f81c8 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,4 +1,4 @@
-# serial 11
+# serial 12
# See if we need to provide utimensat replacement.
dnl Copyright (C) 2009-2024 Free Software Foundation, Inc.
@@ -83,6 +83,9 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
# Guess yes on Linux or glibc systems.
linux-* | linux | *-gnu* | gnu*)
gl_cv_func_utimensat_works="guessing yes" ;;
+ # Guess yes on systems that emulate the Linux system calls.
+ midipix*)
+ gl_cv_func_utimensat_works="guessing yes" ;;
# Guess 'nearly' on AIX.
aix*)
gl_cv_func_utimensat_works="guessing nearly" ;;
diff --git a/m4/utimes.m4 b/m4/utimes.m4
index 040b1af8050..05b23cbb736 100644
--- a/m4/utimes.m4
+++ b/m4/utimes.m4
@@ -1,5 +1,5 @@
# Detect some bugs in glibc's implementation of utimes.
-# serial 8
+# serial 9
dnl Copyright (C) 2003-2005, 2009-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
@@ -144,11 +144,11 @@ main ()
[gl_cv_func_working_utimes=yes],
[gl_cv_func_working_utimes=no],
[case "$host_os" in
- # Guess yes on musl systems.
- *-musl*) gl_cv_func_working_utimes="guessing yes" ;;
- # Guess no on native Windows.
- mingw*) gl_cv_func_working_utimes="guessing no" ;;
- *) gl_cv_func_working_utimes="$gl_cross_guess_normal" ;;
+ # Guess yes on musl systems.
+ *-musl*) gl_cv_func_working_utimes="guessing yes" ;;
+ # Guess no on native Windows.
+ mingw* | windows*) gl_cv_func_working_utimes="guessing no" ;;
+ *) gl_cv_func_working_utimes="$gl_cross_guess_normal" ;;
esac
])
])
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index 6c97ef194e4..d487636aa36 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,4 +1,4 @@
-# warnings.m4 serial 19
+# warnings.m4 serial 20
dnl Copyright (C) 2008-2024 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -26,13 +26,13 @@ case $gl_positive in
esac
m4_pushdef([gl_Positive], [$gl_positive])])dnl
AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], [gl_Warn], [
- gl_save_compiler_FLAGS="$gl_Flags"
+ gl_saved_compiler_FLAGS="$gl_Flags"
AS_VAR_APPEND(m4_defn([gl_Flags]),
[" $gl_unknown_warnings_are_errors ]m4_defn([gl_Positive])["])
AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([[]])])],
[AS_VAR_SET([gl_Warn], [yes])],
[AS_VAR_SET([gl_Warn], [no])])
- gl_Flags="$gl_save_compiler_FLAGS"
+ gl_Flags="$gl_saved_compiler_FLAGS"
])
AS_VAR_IF(gl_Warn, [yes], [$2], [$3])
m4_popdef([gl_Positive])dnl
diff --git a/make-dist b/make-dist
index 91639652350..c8b0fcf4f24 100755
--- a/make-dist
+++ b/make-dist
@@ -358,6 +358,8 @@ possibly_non_vc_files="
admin/charsets/jisx2131-filter
src/config.in
exec/configure exec/config.h.in
+ exec/config.sub exec/config.guess
+ exec/install-sh
leim/small-ja-dic-option
"$(
find admin doc etc lisp \
diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp
index f644e9ce965..d43fbef4672 100644
--- a/msdos/sedleim.inp
+++ b/msdos/sedleim.inp
@@ -41,3 +41,7 @@ RUN_EMACS = ${EMACS} -batch --no-site-file --no-site-lisp
/^MKDIR_P *=/s,@MKDIR_P@,gmkdir -p,
/^\${leimdir}\/quail \${leimdir}\/ja-dic: *$/s|\${leimdir}/|$(rel_leimdir)\\|
+
+# Should an option to enable this be provided by config.bat?
+/^SMALL_JA_DIC *=/s/@SMALL_JA_DIC@//
+/^small-ja-dic-option: /s|../config.status||
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c
index 0500b653bb2..c012151cf96 100644
--- a/nt/cmdproxy.c
+++ b/nt/cmdproxy.c
@@ -38,6 +38,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <string.h> /* strlen */
#include <ctype.h> /* isspace, isalpha */
+/* UCRT has a C99-compatible snprintf, and _snprintf is defined inline
+ in stdio.h, which we don't want to include here. Since the
+ differences in behavior between snprintf and _snprintf don't matter
+ in this file, we take the easy way out. */
+#ifdef _UCRT
+# define _snprintf snprintf
+#endif
+
/* We don't want to include stdio.h because we are already duplicating
lots of it here */
extern int _snprintf (char *buffer, size_t count, const char *format, ...);
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 5b1c2c88ba5..048f812724a 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -46,6 +46,7 @@ OMIT_GNULIB_MODULE_allocator = true
OMIT_GNULIB_MODULE_at-internal = true
OMIT_GNULIB_MODULE_canonicalize-lgpl = true
OMIT_GNULIB_MODULE_careadlinkat = true
+OMIT_GNULIB_MODULE_copy-file-range = true
OMIT_GNULIB_MODULE_dirent = true
OMIT_GNULIB_MODULE_dirfd = true
OMIT_GNULIB_MODULE_fchmodat = true
diff --git a/src/.gdbinit b/src/.gdbinit
index bc6cad0560e..6c4dda67f06 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -15,6 +15,10 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+# If you don't want messages from GDB to interfere with ordinary editing
+# whenever it creates a subprocess, uncomment the following line.
+### set print inferior-events off
+
# Force loading of symbols, enough to give us VALBITS etc.
set $dummy = main + 8
# With some compilers, we need this to give us struct Lisp_Symbol etc.:
diff --git a/src/alloc.c b/src/alloc.c
index 53ba85d88b7..2ffd2415447 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -359,8 +359,16 @@ static struct gcstat
object_ct total_floats, total_free_floats;
object_ct total_intervals, total_free_intervals;
object_ct total_buffers;
+
+ /* Size of the ancillary arrays of live hash-table and obarray objects.
+ The objects themselves are not included (counted as vectors above). */
+ byte_ct total_hash_table_bytes;
} gcstat;
+/* Total size of ancillary arrays of all allocated hash-table and obarray
+ objects, both dead and alive. This number is always kept up-to-date. */
+static ptrdiff_t hash_table_allocated_bytes = 0;
+
/* Points to memory space allocated as "spare", to be freed if we run
out of memory. We keep one large block, four cons-blocks, and
two string blocks. */
@@ -1458,9 +1466,9 @@ static INTERVAL interval_free_list;
__asan_unpoison_memory_region ((b)->intervals, \
sizeof ((b)->intervals))
# define ASAN_POISON_INTERVAL(i) \
- __asan_poison_memory_region ((i), sizeof (*(i)))
+ __asan_poison_memory_region (i, sizeof *(i))
# define ASAN_UNPOISON_INTERVAL(i) \
- __asan_unpoison_memory_region ((i), sizeof (*(i)))
+ __asan_unpoison_memory_region (i, sizeof *(i))
#else
# define ASAN_POISON_INTERVAL_BLOCK(b) ((void) 0)
# define ASAN_UNPOISON_INTERVAL_BLOCK(b) ((void) 0)
@@ -1744,25 +1752,25 @@ init_strings (void)
*/
# define ASAN_PREPARE_DEAD_SDATA(s, size) \
do { \
- __asan_poison_memory_region ((s), sdata_size ((size))); \
- __asan_unpoison_memory_region (&(((s))->string), \
+ __asan_poison_memory_region (s, sdata_size (size)); \
+ __asan_unpoison_memory_region (&(s)->string, \
sizeof (struct Lisp_String *)); \
- __asan_unpoison_memory_region (&SDATA_NBYTES ((s)), \
- sizeof (SDATA_NBYTES ((s)))); \
+ __asan_unpoison_memory_region (&SDATA_NBYTES (s), \
+ sizeof SDATA_NBYTES (s)); \
} while (false)
/* Prepare s for storing string data for NBYTES bytes. */
# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) \
- __asan_unpoison_memory_region ((s), sdata_size ((nbytes)))
+ __asan_unpoison_memory_region (s, sdata_size (nbytes))
# define ASAN_POISON_SBLOCK_DATA(b, size) \
- __asan_poison_memory_region ((b)->data, (size))
+ __asan_poison_memory_region ((b)->data, size)
# define ASAN_POISON_STRING_BLOCK(b) \
__asan_poison_memory_region ((b)->strings, STRING_BLOCK_SIZE)
# define ASAN_UNPOISON_STRING_BLOCK(b) \
__asan_unpoison_memory_region ((b)->strings, STRING_BLOCK_SIZE)
# define ASAN_POISON_STRING(s) \
- __asan_poison_memory_region ((s), sizeof (*(s)))
+ __asan_poison_memory_region (s, sizeof *(s))
# define ASAN_UNPOISON_STRING(s) \
- __asan_unpoison_memory_region ((s), sizeof (*(s)))
+ __asan_unpoison_memory_region (s, sizeof *(s))
#else
# define ASAN_PREPARE_DEAD_SDATA(s, size) ((void) 0)
# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) ((void) 0)
@@ -2683,13 +2691,13 @@ struct float_block
};
#define XFLOAT_MARKED_P(fptr) \
- GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+ GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr))
#define XFLOAT_MARK(fptr) \
- SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+ SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr))
#define XFLOAT_UNMARK(fptr) \
- UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+ UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr))
#if GC_ASAN_POISON_OBJECTS
# define ASAN_POISON_FLOAT_BLOCK(fblk) \
@@ -2699,9 +2707,9 @@ struct float_block
__asan_unpoison_memory_region ((fblk)->floats, \
sizeof ((fblk)->floats))
# define ASAN_POISON_FLOAT(p) \
- __asan_poison_memory_region ((p), sizeof (struct Lisp_Float))
+ __asan_poison_memory_region (p, sizeof (struct Lisp_Float))
# define ASAN_UNPOISON_FLOAT(p) \
- __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Float))
+ __asan_unpoison_memory_region (p, sizeof (struct Lisp_Float))
#else
# define ASAN_POISON_FLOAT_BLOCK(fblk) ((void) 0)
# define ASAN_UNPOISON_FLOAT_BLOCK(fblk) ((void) 0)
@@ -2795,13 +2803,13 @@ struct cons_block
};
#define XCONS_MARKED_P(fptr) \
- GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+ GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr))
#define XMARK_CONS(fptr) \
- SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+ SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr))
#define XUNMARK_CONS(fptr) \
- UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+ UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr))
/* Minimum number of bytes of consing since GC before next GC,
when memory is full. */
@@ -2824,9 +2832,9 @@ static struct Lisp_Cons *cons_free_list;
# define ASAN_POISON_CONS_BLOCK(b) \
__asan_poison_memory_region ((b)->conses, sizeof ((b)->conses))
# define ASAN_POISON_CONS(p) \
- __asan_poison_memory_region ((p), sizeof (struct Lisp_Cons))
+ __asan_poison_memory_region (p, sizeof (struct Lisp_Cons))
# define ASAN_UNPOISON_CONS(p) \
- __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Cons))
+ __asan_unpoison_memory_region (p, sizeof (struct Lisp_Cons))
#else
# define ASAN_POISON_CONS_BLOCK(b) ((void) 0)
# define ASAN_POISON_CONS(p) ((void) 0)
@@ -3144,11 +3152,11 @@ Lisp_Object zero_vector;
#if GC_ASAN_POISON_OBJECTS
# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) \
- __asan_poison_memory_region ((v)->contents, (bytes))
+ __asan_poison_memory_region ((v)->contents, bytes)
# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) \
- __asan_unpoison_memory_region ((v)->contents, (bytes))
+ __asan_unpoison_memory_region ((v)->contents, bytes)
# define ASAN_UNPOISON_VECTOR_BLOCK(b) \
- __asan_unpoison_memory_region ((b)->data, sizeof ((b)->data))
+ __asan_unpoison_memory_region ((b)->data, sizeof (b)->data)
#else
# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) ((void) 0)
# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) ((void) 0)
@@ -3430,6 +3438,32 @@ cleanup_vector (struct Lisp_Vector *vector)
}
#endif
break;
+ case PVEC_HASH_TABLE:
+ {
+ struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table);
+ if (h->table_size > 0)
+ {
+ eassert (h->index_bits > 0);
+ xfree (h->index);
+ xfree (h->key_and_value);
+ xfree (h->next);
+ xfree (h->hash);
+ ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value
+ + sizeof *h->hash
+ + sizeof *h->next)
+ + hash_table_index_size (h) * sizeof *h->index);
+ hash_table_allocated_bytes -= bytes;
+ }
+ }
+ break;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray);
+ xfree (o->buckets);
+ ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets;
+ hash_table_allocated_bytes -= bytes;
+ }
+ break;
/* Keep the switch exhaustive. */
case PVEC_NORMAL_VECTOR:
case PVEC_FREE:
@@ -3440,7 +3474,6 @@ cleanup_vector (struct Lisp_Vector *vector)
case PVEC_WINDOW:
case PVEC_BOOL_VECTOR:
case PVEC_BUFFER:
- case PVEC_HASH_TABLE:
case PVEC_TERMINAL:
case PVEC_WINDOW_CONFIGURATION:
case PVEC_OTHER:
@@ -3554,6 +3587,8 @@ sweep_vectors (void)
lisp_free (lv);
}
}
+
+ gcstat.total_hash_table_bytes = hash_table_allocated_bytes;
}
/* Maximum number of elements in a vector. This is a macro so that it
@@ -3860,9 +3895,9 @@ struct symbol_block
# define ASAN_UNPOISON_SYMBOL_BLOCK(s) \
__asan_unpoison_memory_region ((s)->symbols, sizeof ((s)->symbols))
# define ASAN_POISON_SYMBOL(sym) \
- __asan_poison_memory_region ((sym), sizeof (*(sym)))
+ __asan_poison_memory_region (sym, sizeof *(sym))
# define ASAN_UNPOISON_SYMBOL(sym) \
- __asan_unpoison_memory_region ((sym), sizeof (*(sym)))
+ __asan_unpoison_memory_region (sym, sizeof *(sym))
#else
# define ASAN_POISON_SYMBOL_BLOCK(s) ((void) 0)
@@ -5606,6 +5641,29 @@ valid_lisp_object_p (Lisp_Object obj)
return 0;
}
+/* Like xmalloc, but makes allocation count toward the total consing
+ and hash table or obarray usage.
+ Return NULL for a zero-sized allocation. */
+void *
+hash_table_alloc_bytes (ptrdiff_t nbytes)
+{
+ if (nbytes == 0)
+ return NULL;
+ tally_consing (nbytes);
+ hash_table_allocated_bytes += nbytes;
+ return xmalloc (nbytes);
+}
+
+/* Like xfree, but makes allocation count toward the total consing. */
+void
+hash_table_free_bytes (void *p, ptrdiff_t nbytes)
+{
+ tally_consing (-nbytes);
+ hash_table_allocated_bytes -= nbytes;
+ xfree (p);
+}
+
+
/***********************************************************************
Pure Storage Management
***********************************************************************/
@@ -5887,30 +5945,35 @@ make_pure_vector (ptrdiff_t len)
static struct Lisp_Hash_Table *
purecopy_hash_table (struct Lisp_Hash_Table *table)
{
- eassert (NILP (table->weak));
+ eassert (table->weakness == Weak_None);
eassert (table->purecopy);
struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
- struct hash_table_test pure_test = table->test;
-
- /* Purecopy the hash table test. */
- pure_test.name = purecopy (table->test.name);
- pure_test.user_hash_function = purecopy (table->test.user_hash_function);
- pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
-
- pure->header = table->header;
- pure->weak = purecopy (Qnil);
- pure->hash = purecopy (table->hash);
- pure->next = purecopy (table->next);
- pure->index = purecopy (table->index);
- pure->count = table->count;
- pure->next_free = table->next_free;
- pure->purecopy = table->purecopy;
- eassert (!pure->mutable);
- pure->rehash_threshold = table->rehash_threshold;
- pure->rehash_size = table->rehash_size;
- pure->key_and_value = purecopy (table->key_and_value);
- pure->test = pure_test;
+ *pure = *table;
+ pure->mutable = false;
+
+ if (table->table_size > 0)
+ {
+ ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash;
+ pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash);
+ memcpy (pure->hash, table->hash, hash_bytes);
+
+ ptrdiff_t next_bytes = table->table_size * sizeof *table->next;
+ pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next);
+ memcpy (pure->next, table->next, next_bytes);
+
+ ptrdiff_t nvalues = table->table_size * 2;
+ ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value;
+ pure->key_and_value = pure_alloc (kv_bytes,
+ -(int)sizeof *table->key_and_value);
+ for (ptrdiff_t i = 0; i < nvalues; i++)
+ pure->key_and_value[i] = purecopy (table->key_and_value[i]);
+
+ ptrdiff_t index_bytes = hash_table_index_size (table)
+ * sizeof *table->index;
+ pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index);
+ memcpy (pure->index, table->index, index_bytes);
+ }
return pure;
}
@@ -5970,7 +6033,7 @@ purecopy (Lisp_Object obj)
/* Do not purify hash tables which haven't been defined with
:purecopy as non-nil or are weak - they aren't guaranteed to
not change. */
- if (!NILP (table->weak) || !table->purecopy)
+ if (table->weakness != Weak_None || !table->purecopy)
{
/* Instead, add the hash table to the list of pinned objects,
so that it will be marked during GC. */
@@ -5981,8 +6044,7 @@ purecopy (Lisp_Object obj)
return obj; /* Don't hash cons it. */
}
- struct Lisp_Hash_Table *h = purecopy_hash_table (table);
- XSET_HASH_TABLE (obj, h);
+ obj = make_lisp_hash_table (purecopy_hash_table (table));
}
else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj))
{
@@ -6094,6 +6156,7 @@ total_bytes_of_live_objects (void)
tot += object_bytes (gcstat.total_floats, sizeof (struct Lisp_Float));
tot += object_bytes (gcstat.total_intervals, sizeof (struct interval));
tot += object_bytes (gcstat.total_strings, sizeof (struct Lisp_String));
+ tot += gcstat.total_hash_table_bytes;
return tot;
}
@@ -6238,11 +6301,10 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym)
intptr_t symoffset;
symoffset = (intptr_t) sym;
- INT_SUBTRACT_WRAPV (symoffset, (intptr_t) &lispsym,
- &symoffset);
+ ckd_sub (&symoffset, symoffset, (intptr_t) &lispsym);
{
- Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
+ Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Symbol, symoffset);
return a;
}
}
@@ -6541,6 +6603,9 @@ garbage_collect (void)
mark_terminals ();
mark_kboards ();
mark_threads ();
+ mark_charset ();
+ mark_composite ();
+ mark_profiler ();
#ifdef HAVE_PGTK
mark_pgtkterm ();
#endif
@@ -6572,6 +6637,7 @@ garbage_collect (void)
#ifdef HAVE_NS
mark_nsterm ();
#endif
+ mark_fns ();
/* Everything is now marked, except for the data in font caches,
undo lists, and finalizers. The first two are compacted by
@@ -7236,26 +7302,32 @@ process_mark_stack (ptrdiff_t base_sp)
case PVEC_HASH_TABLE:
{
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr;
- ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
set_vector_marked (ptr);
- mark_stack_push_values (ptr->contents, size);
- mark_stack_push_value (h->test.name);
- mark_stack_push_value (h->test.user_hash_function);
- mark_stack_push_value (h->test.user_cmp_function);
- if (NILP (h->weak))
- mark_stack_push_value (h->key_and_value);
+ if (h->weakness == Weak_None)
+ /* The values pushed here may include
+ HASH_UNUSED_ENTRY_KEY, which this function must
+ cope with. */
+ mark_stack_push_values (h->key_and_value,
+ 2 * h->table_size);
else
{
- /* For weak tables, mark only the vector and not its
+ /* For weak tables, don't mark the
contents --- that's what makes it weak. */
eassert (h->next_weak == NULL);
h->next_weak = weak_hash_tables;
weak_hash_tables = h;
- set_vector_marked (XVECTOR (h->key_and_value));
}
break;
}
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr;
+ set_vector_marked (ptr);
+ mark_stack_push_values (o->buckets, obarray_size (o));
+ break;
+ }
+
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
mark_char_table (ptr, (enum pvec_type) pvectype);
@@ -7387,14 +7459,19 @@ process_mark_stack (ptrdiff_t base_sp)
}
case Lisp_Float:
- CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT);
- /* Do not mark floats stored in a dump image: these floats are
- "cold" and do not have mark bits. */
- if (pdumper_object_p (XFLOAT (obj)))
- eassert (pdumper_cold_object_p (XFLOAT (obj)));
- else if (!XFLOAT_MARKED_P (XFLOAT (obj)))
- XFLOAT_MARK (XFLOAT (obj));
- break;
+ {
+ struct Lisp_Float *f = XFLOAT (obj);
+ if (!f)
+ break; /* for HASH_UNUSED_ENTRY_KEY */
+ CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT);
+ /* Do not mark floats stored in a dump image: these floats are
+ "cold" and do not have mark bits. */
+ if (pdumper_object_p (f))
+ eassert (pdumper_cold_object_p (f));
+ else if (!XFLOAT_MARKED_P (f))
+ XFLOAT_MARK (f);
+ break;
+ }
case_Lisp_Int:
break;
diff --git a/src/android.c b/src/android.c
index 757f256c188..dcd5c6d99c7 100644
--- a/src/android.c
+++ b/src/android.c
@@ -40,6 +40,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <sys/param.h>
#include <sys/stat.h>
+#include <sys/select.h>
/* Old NDK versions lack MIN and MAX. */
#include <minmax.h>
@@ -111,6 +112,9 @@ struct android_emacs_window
jmethodID set_dont_focus_on_map;
jmethodID define_cursor;
jmethodID damage_rect;
+ jmethodID recreate_activity;
+ jmethodID clear_window;
+ jmethodID clear_area;
};
struct android_emacs_cursor
@@ -119,6 +123,12 @@ struct android_emacs_cursor
jmethodID constructor;
};
+struct android_key_character_map
+{
+ jclass class;
+ jmethodID get_dead_char;
+};
+
/* The API level of the current device. */
static int android_api_level;
@@ -151,6 +161,13 @@ static char *android_files_dir;
/* The Java environment being used for the main thread. */
JNIEnv *android_java_env;
+#ifdef THREADS_ENABLED
+
+/* The Java VM new threads attach to. */
+JavaVM *android_jvm;
+
+#endif /* THREADS_ENABLED */
+
/* The EmacsGC class. */
static jclass emacs_gc_class;
@@ -192,6 +209,9 @@ static struct android_emacs_window window_class;
/* Various methods associated with the EmacsCursor class. */
static struct android_emacs_cursor cursor_class;
+/* Various methods associated with the KeyCharacterMap class. */
+static struct android_key_character_map key_character_map_class;
+
/* The time at which Emacs was installed, which also supplies the
mtime of asset files. */
struct timespec emacs_installation_time;
@@ -495,6 +515,9 @@ android_handle_sigusr1 (int sig, siginfo_t *siginfo, void *arg)
This should ideally be defined further down. */
static sem_t android_query_sem;
+/* ID of the Emacs thread. */
+static pthread_t main_thread_id;
+
/* Set up the global event queue by initializing the mutex and two
condition variables, and the linked list of events. This must be
called before starting the Emacs thread. Also, initialize the
@@ -530,6 +553,8 @@ android_init_events (void)
event_queue.events.next = &event_queue.events;
event_queue.events.last = &event_queue.events;
+ main_thread_id = pthread_self ();
+
#if __ANDROID_API__ >= 16
/* Before starting the select thread, make sure the disposition for
@@ -578,10 +603,6 @@ android_pending (void)
return i;
}
-/* Forward declaration. */
-
-static void android_check_query (void);
-
/* Wait for events to become available synchronously. Return once an
event arrives. Also, reply to the UI thread whenever it requires a
response. */
@@ -731,6 +752,12 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds,
static char byte;
#endif
+#ifdef THREADS_ENABLED
+ if (!pthread_equal (pthread_self (), main_thread_id))
+ return pselect (nfds, readfds, writefds, exceptfds, timeout,
+ NULL);
+#endif /* THREADS_ENABLED */
+
/* Since Emacs is reading keyboard input again, signify that queries
from input methods are no longer ``urgent''. */
@@ -744,6 +771,19 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds,
if (event_queue.num_events)
{
+ /* Zero READFDS, WRITEFDS and EXCEPTFDS, lest the caller
+ mistakenly interpret this return value as indicating that an
+ inotify file descriptor is readable, and try to poll an
+ unready one. */
+
+ if (readfds)
+ FD_ZERO (readfds);
+
+ if (writefds)
+ FD_ZERO (writefds);
+
+ if (exceptfds)
+ FD_ZERO (exceptfds);
pthread_mutex_unlock (&event_queue.mutex);
return 1;
}
@@ -823,9 +863,11 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds,
if (nfds_return < 0)
errno = EINTR;
+#ifndef THREADS_ENABLED
/* Now check for and run anything the UI thread wants to run in the
main thread. */
android_check_query ();
+#endif /* THREADS_ENABLED */
return nfds_return;
}
@@ -1301,12 +1343,17 @@ NATIVE_NAME (setEmacsParams) (JNIEnv *env, jobject object,
const char *java_string;
struct stat statb;
+#ifdef THREADS_ENABLED
+ /* Save the Java VM. */
+ if ((*env)->GetJavaVM (env, &android_jvm))
+ emacs_abort ();
+#endif /* THREADS_ENABLED */
+
/* Set the Android API level early, as it is used by
`android_vfs_init'. */
android_api_level = api_level;
/* This function should only be called from the main thread. */
-
android_pixel_density_x = pixel_density_x;
android_pixel_density_y = pixel_density_y;
android_scaled_pixel_density = scaled_density;
@@ -1569,16 +1616,13 @@ android_init_emacs_service (void)
FIND_METHOD (draw_point, "drawPoint",
"(Lorg/gnu/emacs/EmacsDrawable;"
"Lorg/gnu/emacs/EmacsGC;II)V");
- FIND_METHOD (clear_window, "clearWindow",
- "(Lorg/gnu/emacs/EmacsWindow;)V");
- FIND_METHOD (clear_area, "clearArea",
- "(Lorg/gnu/emacs/EmacsWindow;IIII)V");
FIND_METHOD (ring_bell, "ringBell", "(I)V");
FIND_METHOD (query_tree, "queryTree",
"(Lorg/gnu/emacs/EmacsWindow;)[S");
FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I");
FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I");
FIND_METHOD (detect_mouse, "detectMouse", "()Z");
+ FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z");
FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;");
FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)"
"Ljava/lang/String;");
@@ -1644,6 +1688,8 @@ android_init_emacs_service (void)
"externalStorageAvailable", "()Z");
FIND_METHOD (request_storage_access,
"requestStorageAccess", "()V");
+ FIND_METHOD (cancel_notification,
+ "cancelNotification", "(Ljava/lang/String;)V");
#undef FIND_METHOD
}
@@ -1789,12 +1835,14 @@ android_init_emacs_window (void)
FIND_METHOD (set_dont_accept_focus, "setDontAcceptFocus", "(Z)V");
FIND_METHOD (define_cursor, "defineCursor",
"(Lorg/gnu/emacs/EmacsCursor;)V");
-
/* In spite of the declaration of this function being located within
EmacsDrawable, the ID of the `damage_rect' method is retrieved
from EmacsWindow, which avoids virtual function dispatch within
android_damage_window. */
FIND_METHOD (damage_rect, "damageRect", "(IIII)V");
+ FIND_METHOD (recreate_activity, "recreateActivity", "()V");
+ FIND_METHOD (clear_window, "clearWindow", "()V");
+ FIND_METHOD (clear_area, "clearArea", "(IIII)V");
#undef FIND_METHOD
}
@@ -1828,6 +1876,32 @@ android_init_emacs_cursor (void)
#undef FIND_METHOD
}
+static void
+android_init_key_character_map (void)
+{
+ jclass old;
+
+ key_character_map_class.class
+ = (*android_java_env)->FindClass (android_java_env,
+ "android/view/KeyCharacterMap");
+ eassert (key_character_map_class.class);
+
+ old = key_character_map_class.class;
+ key_character_map_class.class
+ = (jclass) (*android_java_env)->NewGlobalRef (android_java_env,
+ (jobject) old);
+ ANDROID_DELETE_LOCAL_REF (old);
+
+ if (!key_character_map_class.class)
+ emacs_abort ();
+
+ key_character_map_class.get_dead_char
+ = (*android_java_env)->GetStaticMethodID (android_java_env,
+ key_character_map_class.class,
+ "getDeadChar", "(II)I");
+ eassert (key_character_map_class.get_dead_char);
+}
+
JNIEXPORT void JNICALL
NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv,
jobject dump_file_object)
@@ -1876,6 +1950,7 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv,
android_init_emacs_drawable ();
android_init_emacs_window ();
android_init_emacs_cursor ();
+ android_init_key_character_map ();
/* Set HOME to the app data directory. */
setenv ("HOME", android_files_dir, 1);
@@ -2384,7 +2459,7 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
jshort window, jint x, jint y)
{
@@ -2404,7 +2479,7 @@ NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
jshort window, jint x, jint y,
jstring string)
@@ -2441,7 +2516,7 @@ NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
jshort window, jint x, jint y,
jstring string)
@@ -2478,10 +2553,91 @@ NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
return event_serial;
}
+JNIEXPORT jlong JNICALL
+NATIVE_NAME (sendNotificationDeleted) (JNIEnv *env, jobject object,
+ jstring tag)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const char *characters;
+
+ event.notification.type = ANDROID_NOTIFICATION_DELETED;
+ event.notification.serial = ++event_serial;
+ event.notification.window = ANDROID_NONE;
+
+ /* TAG is guaranteed to be an ASCII string, of which the JNI character
+ encoding is a superset. */
+ characters = (*env)->GetStringUTFChars (env, tag, NULL);
+ if (!characters)
+ return 0;
+
+ event.notification.tag = strdup (characters);
+ (*env)->ReleaseStringUTFChars (env, tag, characters);
+ if (!event.notification.tag)
+ return 0;
+
+ event.notification.action = NULL;
+ event.notification.length = 0;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
+JNIEXPORT jlong JNICALL
+NATIVE_NAME (sendNotificationAction) (JNIEnv *env, jobject object,
+ jstring tag, jstring action)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const void *characters;
+ jsize length;
+ uint16_t *buffer;
+
+ event.notification.type = ANDROID_NOTIFICATION_ACTION;
+ event.notification.serial = ++event_serial;
+ event.notification.window = ANDROID_NONE;
+
+ /* TAG is guaranteed to be an ASCII string, of which the JNI character
+ encoding is a superset. */
+ characters = (*env)->GetStringUTFChars (env, tag, NULL);
+ if (!characters)
+ return 0;
+
+ event.notification.tag = strdup (characters);
+ (*env)->ReleaseStringUTFChars (env, tag, characters);
+ if (!event.notification.tag)
+ return 0;
+
+ length = (*env)->GetStringLength (env, action);
+ buffer = malloc (length * sizeof *buffer);
+ characters = (*env)->GetStringChars (env, action, NULL);
+
+ if (!characters)
+ {
+ /* The JVM has run out of memory; return and let the out of memory
+ error take its course. */
+ xfree (event.notification.tag);
+ return 0;
+ }
+
+ memcpy (buffer, characters, length * sizeof *buffer);
+ (*env)->ReleaseStringChars (env, action, characters);
+
+ event.notification.action = buffer;
+ event.notification.length = length;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
/* Yes, android_pass_multimedia_buttons_to_system is being
read from the UI thread. */
return !android_pass_multimedia_buttons_to_system;
@@ -2490,6 +2646,8 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
return !android_intercept_control_space;
}
@@ -2593,6 +2751,8 @@ JNIEXPORT void JNICALL
NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object,
jobject bitmap)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
void *data;
/* Lock and unlock the bitmap. This calls
@@ -2646,6 +2806,8 @@ NATIVE_NAME (answerQuerySpin) (JNIEnv *env, jobject object)
JNIEXPORT void JNICALL
NATIVE_NAME (setupSystemThread) (void)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
sigset_t sigset;
/* Block everything except for SIGSEGV and SIGBUS; those two are
@@ -3394,10 +3556,9 @@ android_clear_window (android_window handle)
window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
- emacs_service,
- service_class.class,
- service_class.clear_window,
- window);
+ window,
+ window_class.class,
+ window_class.clear_window);
android_exception_check ();
}
@@ -3949,10 +4110,10 @@ android_blit_copy (int src_x, int src_y, int width, int height,
/* Turn both into offsets. */
- if (INT_MULTIPLY_WRAPV (temp, pixel, &offset)
- || INT_MULTIPLY_WRAPV (i, mask_info->stride, &offset1)
- || INT_ADD_WRAPV (offset, offset1, &offset)
- || INT_ADD_WRAPV ((uintptr_t) mask, offset, &start))
+ if (ckd_mul (&offset, temp, pixel)
+ || ckd_mul (&offset1, i, mask_info->stride)
+ || ckd_add (&offset, offset, offset1)
+ || ckd_add (&start, (uintptr_t) mask, offset))
return;
if (height <= 0)
@@ -4257,10 +4418,10 @@ android_blit_xor (int src_x, int src_y, int width, int height,
/* Turn both into offsets. */
- if (INT_MULTIPLY_WRAPV (temp, pixel, &offset)
- || INT_MULTIPLY_WRAPV (i, mask_info->stride, &offset1)
- || INT_ADD_WRAPV (offset, offset1, &offset)
- || INT_ADD_WRAPV ((uintptr_t) mask, offset, &start))
+ if (ckd_mul (&offset, temp, pixel)
+ || ckd_mul (&offset1, i, mask_info->stride)
+ || ckd_add (&offset, offset, offset1)
+ || ckd_add (&start, (uintptr_t) mask, offset))
return;
mask = mask_current = (unsigned char *) start;
@@ -4708,10 +4869,10 @@ android_clear_area (android_window handle, int x, int y,
window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
- emacs_service,
- service_class.class,
- service_class.clear_area,
- window, (jint) x, (jint) y,
+ window,
+ window_class.class,
+ window_class.clear_area,
+ (jint) x, (jint) y,
(jint) width, (jint) height);
}
@@ -4885,9 +5046,9 @@ android_get_image (android_drawable handle,
if (bitmap_info.format != ANDROID_BITMAP_FORMAT_A_8)
{
- if (INT_MULTIPLY_WRAPV ((size_t) bitmap_info.stride,
- (size_t) bitmap_info.height,
- &byte_size))
+ if (ckd_mul (&byte_size,
+ (size_t) bitmap_info.stride,
+ (size_t) bitmap_info.height))
{
ANDROID_DELETE_LOCAL_REF (bitmap);
memory_full (0);
@@ -5332,11 +5493,51 @@ android_translate_coordinates (android_window src, int x,
ANDROID_DELETE_LOCAL_REF (coordinates);
}
+/* Return the character produced by combining the diacritic character
+ DCHAR with the key-producing character C in *VALUE. Value is 1 if
+ there is no character for this combination, 0 otherwise. */
+
+static int
+android_get_dead_char (unsigned int dchar, unsigned int c,
+ unsigned int *value)
+{
+ jmethodID method;
+ jclass class;
+ jint result;
+
+ /* Call getDeadChar. */
+ class = key_character_map_class.class;
+ method = key_character_map_class.get_dead_char;
+ result = (*android_java_env)->CallStaticIntMethod (android_java_env,
+ class, method,
+ (jint) dchar,
+ (jint) c);
+
+ if (result)
+ {
+ *value = result;
+ return 0;
+ }
+
+ return 1;
+}
+
+/* Return a Unicode string in BUFFER_RETURN, a buffer of size
+ WCHARS_BUFFER, from the key press event EVENT, much like
+ XmbLookupString. If EVENT represents a key press without a
+ corresponding Unicode character, return its keysym in *KEYSYM_RETURN.
+ Return the action taken in *STATUS_RETURN.
+
+ COMPOSE_STATUS, if non-NULL, should point to a structure for
+ temporary information to be stored in during dead key
+ composition. */
+
int
android_wc_lookup_string (android_key_pressed_event *event,
wchar_t *buffer_return, int wchars_buffer,
int *keysym_return,
- enum android_lookup_status *status_return)
+ enum android_lookup_status *status_return,
+ struct android_compose_status *compose_status)
{
enum android_lookup_status status;
int rc;
@@ -5345,6 +5546,7 @@ android_wc_lookup_string (android_key_pressed_event *event,
jsize size;
size_t i;
JNIEnv *env;
+ unsigned int unicode_char;
env = android_java_env;
status = ANDROID_LOOKUP_NONE;
@@ -5358,6 +5560,13 @@ android_wc_lookup_string (android_key_pressed_event *event,
{
if (event->unicode_char)
{
+ /* KeyCharacterMap.COMBINING_ACCENT. */
+ if ((event->unicode_char & 0x80000000) && compose_status)
+ goto dead_key;
+
+ /* Remove combining accent bits. */
+ unicode_char = event->unicode_char & ~0x80000000;
+
if (wchars_buffer < 1)
{
*status_return = ANDROID_BUFFER_OVERFLOW;
@@ -5365,7 +5574,31 @@ android_wc_lookup_string (android_key_pressed_event *event,
}
else
{
- buffer_return[0] = event->unicode_char;
+ /* If COMPOSE_STATUS holds a diacritic mark unicode_char
+ ought to be combined with, and this combination is
+ valid, return the result alone with no keysym. */
+
+ if (compose_status
+ && compose_status->chars_matched
+ && !android_get_dead_char (compose_status->accent,
+ unicode_char,
+ &unicode_char))
+ {
+ buffer_return[0] = unicode_char;
+ *status_return = ANDROID_LOOKUP_CHARS;
+ compose_status->chars_matched = 0;
+ return 1;
+ }
+ else if (compose_status && compose_status->chars_matched)
+ {
+ /* If the combination is valid the compose status must
+ be reset and no character returned. */
+ compose_status->chars_matched = 0;
+ status = ANDROID_LOOKUP_NONE;
+ return 0;
+ }
+
+ buffer_return[0] = unicode_char;
status = ANDROID_LOOKUP_CHARS;
rc = 1;
}
@@ -5381,8 +5614,14 @@ android_wc_lookup_string (android_key_pressed_event *event,
rc = 0;
}
+ /* Terminate any ongoing character composition after a key is
+ registered. */
+ if (compose_status
+ /* Provided that a modifier key is not the key being
+ depressed. */
+ && !ANDROID_IS_MODIFIER_KEY (event->keycode))
+ compose_status->chars_matched = 0;
*status_return = status;
-
return rc;
}
@@ -5438,6 +5677,15 @@ android_wc_lookup_string (android_key_pressed_event *event,
*status_return = status;
return rc;
+
+ dead_key:
+ /* event->unicode_char is a dead key, which are diacritic marks that
+ should not be directly inserted but instead be combined with a
+ subsequent character before insertion. */
+ *status_return = ANDROID_LOOKUP_NONE;
+ compose_status->chars_matched = 1;
+ compose_status->accent = event->unicode_char & ~0x80000000;
+ return 0;
}
@@ -5612,6 +5860,21 @@ android_detect_mouse (void)
return rc;
}
+bool
+android_detect_keyboard (void)
+{
+ bool rc;
+ jmethodID method;
+
+ method = service_class.detect_keyboard;
+ rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method);
+ android_exception_check ();
+ return rc;
+}
+
void
android_set_dont_focus_on_map (android_window handle,
bool no_focus_on_map)
@@ -5995,7 +6258,7 @@ android_build_jstring (const char *text)
is created. */
#if __GNUC__ >= 3
-#define likely(cond) __builtin_expect ((cond), 1)
+#define likely(cond) __builtin_expect (cond, 1)
#else /* __GNUC__ < 3 */
#define likely(cond) (cond)
#endif /* __GNUC__ >= 3 */
@@ -6128,6 +6391,82 @@ android_exception_check_4 (jobject object, jobject object1,
memory_full (0);
}
+/* Like android_exception_check_4, except it takes more than four local
+ reference arguments. */
+
+void
+android_exception_check_5 (jobject object, jobject object1,
+ jobject object2, jobject object3,
+ jobject object4)
+{
+ if (likely (!(*android_java_env)->ExceptionCheck (android_java_env)))
+ return;
+
+ __android_log_print (ANDROID_LOG_WARN, __func__,
+ "Possible out of memory error. "
+ " The Java exception follows: ");
+ /* Describe exactly what went wrong. */
+ (*android_java_env)->ExceptionDescribe (android_java_env);
+ (*android_java_env)->ExceptionClear (android_java_env);
+
+ if (object)
+ ANDROID_DELETE_LOCAL_REF (object);
+
+ if (object1)
+ ANDROID_DELETE_LOCAL_REF (object1);
+
+ if (object2)
+ ANDROID_DELETE_LOCAL_REF (object2);
+
+ if (object3)
+ ANDROID_DELETE_LOCAL_REF (object3);
+
+ if (object4)
+ ANDROID_DELETE_LOCAL_REF (object4);
+
+ memory_full (0);
+}
+
+
+/* Like android_exception_check_5, except it takes more than five local
+ reference arguments. */
+
+void
+android_exception_check_6 (jobject object, jobject object1,
+ jobject object2, jobject object3,
+ jobject object4, jobject object5)
+{
+ if (likely (!(*android_java_env)->ExceptionCheck (android_java_env)))
+ return;
+
+ __android_log_print (ANDROID_LOG_WARN, __func__,
+ "Possible out of memory error. "
+ " The Java exception follows: ");
+ /* Describe exactly what went wrong. */
+ (*android_java_env)->ExceptionDescribe (android_java_env);
+ (*android_java_env)->ExceptionClear (android_java_env);
+
+ if (object)
+ ANDROID_DELETE_LOCAL_REF (object);
+
+ if (object1)
+ ANDROID_DELETE_LOCAL_REF (object1);
+
+ if (object2)
+ ANDROID_DELETE_LOCAL_REF (object2);
+
+ if (object3)
+ ANDROID_DELETE_LOCAL_REF (object3);
+
+ if (object4)
+ ANDROID_DELETE_LOCAL_REF (object4);
+
+ if (object5)
+ ANDROID_DELETE_LOCAL_REF (object5);
+
+ memory_full (0);
+}
+
/* Check for JNI problems based on the value of OBJECT.
Signal out of memory if OBJECT is NULL. OBJECT1 means the
@@ -6625,6 +6964,24 @@ android_request_storage_access (void)
android_exception_check ();
}
+/* Recreate the activity to which WINDOW is attached to debug graphics
+ code executed in response to window attachment. */
+
+void
+android_recreate_activity (android_window window)
+{
+ jobject object;
+ jmethodID method;
+
+ object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW);
+ method = window_class.recreate_activity;
+
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, object,
+ window_class.class,
+ method);
+ android_exception_check ();
+}
+
/* The thread from which a query against a thread is currently being
@@ -6669,7 +7026,7 @@ static void *android_query_context;
/* Run any function that the UI thread has asked to run, and then
signal its completion. */
-static void
+void
android_check_query (void)
{
void (*proc) (void *);
diff --git a/src/android.h b/src/android.h
index 1059933d339..2ca3d7e1446 100644
--- a/src/android.h
+++ b/src/android.h
@@ -24,6 +24,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
a table of function pointers. */
#ifndef _ANDROID_H_
+#define _ANDROID_H_
+
#ifndef ANDROID_STUBIFY
#include <jni.h>
#include <pwd.h>
@@ -103,6 +105,7 @@ extern int android_get_screen_height (void);
extern int android_get_mm_width (void);
extern int android_get_mm_height (void);
extern bool android_detect_mouse (void);
+extern bool android_detect_keyboard (void);
extern void android_set_dont_focus_on_map (android_window, bool);
extern void android_set_dont_accept_focus (android_window, bool);
@@ -115,6 +118,10 @@ extern void android_exception_check_1 (jobject);
extern void android_exception_check_2 (jobject, jobject);
extern void android_exception_check_3 (jobject, jobject, jobject);
extern void android_exception_check_4 (jobject, jobject, jobject, jobject);
+extern void android_exception_check_5 (jobject, jobject, jobject, jobject,
+ jobject);
+extern void android_exception_check_6 (jobject, jobject, jobject, jobject,
+ jobject, jobject);
extern void android_exception_check_nonnull (void *, jobject);
extern void android_exception_check_nonnull_1 (void *, jobject, jobject);
@@ -225,6 +232,7 @@ extern void android_display_toast (const char *);
/* Event loop functions. */
+extern void android_check_query (void);
extern void android_check_query_urgent (void);
extern int android_run_in_emacs_thread (void (*) (void *), void *);
extern void android_write_event (union android_event *);
@@ -265,6 +273,7 @@ struct android_emacs_service
jmethodID get_screen_width;
jmethodID get_screen_height;
jmethodID detect_mouse;
+ jmethodID detect_keyboard;
jmethodID name_keysym;
jmethodID browse_url;
jmethodID restart_emacs;
@@ -293,10 +302,18 @@ struct android_emacs_service
jmethodID valid_authority;
jmethodID external_storage_available;
jmethodID request_storage_access;
+ jmethodID cancel_notification;
};
extern JNIEnv *android_java_env;
+#ifdef THREADS_ENABLED
+extern JavaVM *android_jvm;
+#endif /* THREADS_ENABLED */
+
+/* The Java String class. */
+extern jclass java_string_class;
+
/* The EmacsService object. */
extern jobject emacs_service;
@@ -309,7 +326,7 @@ extern struct timespec emacs_installation_time;
#define ANDROID_DELETE_LOCAL_REF(ref) \
((*android_java_env)->DeleteLocalRef (android_java_env, \
- (ref)))
+ ref))
#define NATIVE_NAME(name) Java_org_gnu_emacs_EmacsNative_##name
diff --git a/src/androidfns.c b/src/androidfns.c
index bf8ab5b45cc..83cf81c1f07 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -1931,9 +1931,6 @@ android_create_tip_frame (struct android_display_info *dpyinfo,
image_cache_refcount
= FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
-#ifdef GLYPH_DEBUG
- dpyinfo_refcount = dpyinfo->reference_count;
-#endif /* GLYPH_DEBUG */
gui_default_parameter (f, parms, Qfont_backend, Qnil,
"fontBackend", "FontBackend", RES_TYPE_STRING);
@@ -2290,6 +2287,57 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
goto start_timer;
}
+ else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ tip_last_parms. This may destruct tip_last_parms which,
+ however, will be recreated below. */
+ for (tail = parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = CAR (elt);
+ /* The left, top, right and bottom parameters are handled
+ by compute_tip_xy so they can be ignored here. */
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop)
+ && !EQ (parm, Qright) && !EQ (parm, Qbottom))
+ {
+ last = Fassq (parm, tip_last_parms);
+ if (NILP (Fequal (CDR (elt), CDR (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
+ }
+ else
+ tip_last_parms
+ = call2 (Qassq_delete_all, parm, tip_last_parms);
+ }
+
+ /* Now check if every parameter in what is left of
+ tip_last_parms with a non-nil value has an association in
+ PARMS. */
+ for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = CAR (elt);
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright)
+ && !EQ (parm, Qbottom) && !NILP (CDR (elt)))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ }
+
+ android_hide_tip (delete);
+ }
else
android_hide_tip (true);
}
@@ -2456,7 +2504,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
#endif /* 0 */
return Qnil;
#else /* !ANDROID_STUBIFY */
- return android_hide_tip (true);
+ return android_hide_tip (!tooltip_reuse_hidden_frame);
#endif /* ANDROID_STUBIFY */
}
@@ -2479,6 +2527,25 @@ there is no mouse. */)
#endif
}
+DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard,
+ Sandroid_detect_keyboard, 0, 0, 0,
+ doc: /* Return whether a keyboard is connected.
+Return non-nil if a key is connected to this computer, or nil
+if there is no keyboard. */)
+ (void)
+{
+#ifndef ANDROID_STUBIFY
+ /* If no display connection is present, just return nil. */
+
+ if (!android_init_gui)
+ return Qnil;
+
+ return android_detect_keyboard () ? Qt : Qnil;
+#else /* ANDROID_STUBIFY */
+ return Qt;
+#endif /* ANDROID_STUBIFY */
+}
+
DEFUN ("android-toggle-on-screen-keyboard",
Fandroid_toggle_on_screen_keyboard,
Sandroid_toggle_on_screen_keyboard, 2, 2, 0,
@@ -3167,6 +3234,24 @@ android_set_preeditarea (struct window *w, int x, int y)
y + w->phys_cursor_height);
}
+
+
+/* Debugging. */
+
+DEFUN ("android-recreate-activity", Fandroid_recreate_activity,
+ Sandroid_recreate_activity, 0, 0, "",
+ doc: /* Recreate the activity attached to the current frame.
+This function exists for debugging purposes and is of no interest to
+users. */)
+ (void)
+{
+ struct frame *f;
+
+ f = decode_window_system_frame (Qnil);
+ android_recreate_activity (FRAME_ANDROID_WINDOW (f));
+ return Qnil;
+}
+
#endif /* !ANDROID_STUBIFY */
@@ -3182,6 +3267,10 @@ syms_of_androidfns_for_pdumper (void)
jstring string;
Lisp_Object language, country, script, variant;
const char *data;
+ FILE *fd;
+ char *line;
+ size_t size;
+ long pid;
/* Find the Locale class. */
@@ -3309,9 +3398,9 @@ syms_of_androidfns_for_pdumper (void)
string, data);
}
}
- }
- ANDROID_DELETE_LOCAL_REF (string);
+ ANDROID_DELETE_LOCAL_REF (string);
+ }
/* And variant. */
@@ -3352,6 +3441,35 @@ syms_of_androidfns_for_pdumper (void)
/* Set Vandroid_os_language. */
Vandroid_os_language = list4 (language, country, script, variant);
+
+ /* Detect whether Emacs is running under libloader.so or another
+ process tracing mechanism, and disable `android_use_exec_loader' if
+ so, leaving subprocesses started by Emacs to the care of that
+ loader instance. */
+
+ if (android_get_current_api_level () >= 29) /* Q */
+ {
+ fd = fopen ("/proc/self/status", "r");
+ if (!fd)
+ return;
+
+ line = NULL;
+ while (getline (&line, &size, fd) != -1)
+ {
+ if (strncmp (line, "TracerPid:", sizeof "TracerPid:" - 1))
+ continue;
+
+ pid = atol (line + sizeof "TracerPid:" - 1);
+
+ if (pid)
+ android_use_exec_loader = false;
+
+ break;
+ }
+
+ free (line);
+ fclose (fd);
+ }
}
#endif /* ANDROID_STUBIFY */
@@ -3545,6 +3663,7 @@ language to be US English if LANGUAGE is empty. */);
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
defsubr (&Sandroid_detect_mouse);
+ defsubr (&Sandroid_detect_keyboard);
defsubr (&Sandroid_toggle_on_screen_keyboard);
defsubr (&Sx_server_vendor);
defsubr (&Sx_server_version);
@@ -3553,6 +3672,7 @@ language to be US English if LANGUAGE is empty. */);
defsubr (&Sandroid_request_directory_access);
defsubr (&Sandroid_external_storage_available_p);
defsubr (&Sandroid_request_storage_access);
+ defsubr (&Sandroid_recreate_activity);
tip_timer = Qnil;
staticpro (&tip_timer);
diff --git a/src/androidgui.h b/src/androidgui.h
index 69efd393d55..f941c7cc577 100644
--- a/src/androidgui.h
+++ b/src/androidgui.h
@@ -251,6 +251,8 @@ enum android_event_type
ANDROID_DND_DRAG_EVENT,
ANDROID_DND_URI_EVENT,
ANDROID_DND_TEXT_EVENT,
+ ANDROID_NOTIFICATION_DELETED,
+ ANDROID_NOTIFICATION_ACTION,
};
struct android_any_event
@@ -535,6 +537,29 @@ struct android_dnd_event
size_t length;
};
+struct android_notification_event
+{
+ /* Type of the event. */
+ enum android_event_type type;
+
+ /* The event serial. */
+ unsigned long serial;
+
+ /* The window that gave rise to the event (None). */
+ android_window window;
+
+ /* The identifier of the notification whose status changed.
+ Must be deallocated with `free'. */
+ char *tag;
+
+ /* The action that was activated, if any. Must be deallocated with
+ `free'. */
+ unsigned short *action;
+
+ /* Length of that data. */
+ size_t length;
+};
+
union android_event
{
enum android_event_type type;
@@ -571,6 +596,10 @@ union android_event
protocol, whereas there exist several competing X protocols
implemented in terms of X client messages. */
struct android_dnd_event dnd;
+
+ /* X provides no equivalent interface for displaying
+ notifications. */
+ struct android_notification_event notification;
};
enum
@@ -589,9 +618,10 @@ enum android_lookup_status
enum android_ic_mode
{
- ANDROID_IC_MODE_NULL = 0,
- ANDROID_IC_MODE_ACTION = 1,
- ANDROID_IC_MODE_TEXT = 2,
+ ANDROID_IC_MODE_NULL = 0,
+ ANDROID_IC_MODE_ACTION = 1,
+ ANDROID_IC_MODE_TEXT = 2,
+ ANDROID_IC_MODE_PASSWORD = 3,
};
enum android_stack_mode
@@ -612,6 +642,15 @@ struct android_window_changes
enum android_stack_mode stack_mode;
};
+struct android_compose_status
+{
+ /* Accent character to be combined with another. */
+ unsigned int accent;
+
+ /* Number of characters matched. */
+ int chars_matched;
+};
+
extern int android_pending (void);
extern void android_next_event (union android_event *);
extern bool android_check_if_event (union android_event *,
@@ -707,7 +746,9 @@ extern void android_translate_coordinates (android_window, int,
int, int *, int *);
extern int android_wc_lookup_string (android_key_pressed_event *,
wchar_t *, int, int *,
- enum android_lookup_status *);
+ enum android_lookup_status *,
+ struct android_compose_status *);
+extern void android_recreate_activity (android_window);
extern void android_update_ic (android_window, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern void android_reset_ic (android_window, enum android_ic_mode);
diff --git a/src/androidmenu.c b/src/androidmenu.c
index 1728ae81e42..362d500ac1a 100644
--- a/src/androidmenu.c
+++ b/src/androidmenu.c
@@ -437,7 +437,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags,
/* Compute the item ID. This is the index of value.
Make sure it doesn't overflow. */
- if (!INT_ADD_OK (0, i + MENU_ITEMS_ITEM_VALUE, &item_id))
+ if (ckd_add (&item_id, i + MENU_ITEMS_ITEM_VALUE, 0))
memory_full (i + MENU_ITEMS_ITEM_VALUE * sizeof (Lisp_Object));
/* Add this menu item with the appropriate state. */
diff --git a/src/androidselect.c b/src/androidselect.c
index 3ba3058aeb9..2f6114d0fcb 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "android.h"
#include "androidterm.h"
+#include "termhooks.h"
/* Selection support on Android is confined to copying and pasting of
plain text and MIME data from the clipboard. There is no primary
@@ -237,15 +238,21 @@ DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p,
return rc ? Qt : Qnil;
}
-DEFUN ("android-browse-url", Fandroid_browse_url,
- Sandroid_browse_url, 1, 2, 0,
- doc: /* Open URL in an external application. URL should be a
-URL-encoded URL with a scheme specified unless SEND is non-nil.
-Signal an error upon failure.
+DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal,
+ Sandroid_browse_url_internal, 1, 2, 0,
+ doc: /* Open URL in an external application.
+
+URL should be a URL-encoded URL with a scheme specified unless SEND is
+non-nil. Signal an error upon failure.
If SEND is nil, start a program that is able to display the URL, such
as a web browser. Otherwise, try to share URL using programs such as
-email clients. */)
+email clients.
+
+If URL is a file URI, convert it into a `content' address accessible to
+other programs. Files inside the /content or /assets directories cannot
+be opened through such addresses, which this function does not provide
+for. Use `android-browse-url' instead. */)
(Lisp_Object url, Lisp_Object send)
{
Lisp_Object value;
@@ -446,7 +453,7 @@ does not have any corresponding data. In that case, use
{
rc = emacs_read_quit (fd, start, BUFSIZ);
- if (!INT_ADD_OK (rc, length, &length)
+ if (ckd_add (&length, length, rc)
|| PTRDIFF_MAX - length < BUFSIZ)
memory_full (PTRDIFF_MAX);
@@ -484,6 +491,9 @@ struct android_emacs_desktop_notification
/* Methods provided by the EmacsDesktopNotification class. */
static struct android_emacs_desktop_notification notification_class;
+/* Hash table pairing notification identifiers with callbacks. */
+static Lisp_Object notification_table;
+
/* Initialize virtual function IDs and class pointers tied to the
EmacsDesktopNotification class. */
@@ -515,7 +525,8 @@ android_init_emacs_desktop_notification (void)
FIND_METHOD (init, "<init>", "(Ljava/lang/String;"
"Ljava/lang/String;Ljava/lang/String;"
- "Ljava/lang/String;II)V");
+ "Ljava/lang/String;II[Ljava/lang/String;"
+ "[Ljava/lang/String;J)V");
FIND_METHOD (display, "display", "()V");
#undef FIND_METHOD
}
@@ -556,25 +567,34 @@ android_locate_icon (const char *name)
}
/* Display a desktop notification with the provided TITLE, BODY,
- REPLACES_ID, GROUP, ICON, and URGENCY. Return an identifier for
- the resulting notification. */
+ REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, TIMEOUT, RESIDENT,
+ ACTION_CB and CLOSE_CB. Return an identifier for the resulting
+ notification. */
static intmax_t
android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
Lisp_Object replaces_id,
Lisp_Object group, Lisp_Object icon,
- Lisp_Object urgency)
+ Lisp_Object urgency, Lisp_Object actions,
+ Lisp_Object timeout, Lisp_Object resident,
+ Lisp_Object action_cb, Lisp_Object close_cb)
{
static intmax_t counter;
intmax_t id;
jstring title1, body1, group1, identifier1;
jint type, icon1;
jobject notification;
+ jobjectArray action_keys, action_titles;
char identifier[INT_STRLEN_BOUND (int)
+ INT_STRLEN_BOUND (long int)
+ INT_STRLEN_BOUND (intmax_t)
+ sizeof "..."];
struct timespec boot_time;
+ Lisp_Object key, value, tem;
+ jint nitems, i;
+ jstring item;
+ Lisp_Object length;
+ jlong timeout_val;
if (EQ (urgency, Qlow))
type = 2; /* IMPORTANCE_LOW */
@@ -585,10 +605,50 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
else
signal_error ("Invalid notification importance given", urgency);
+ /* Decode the timeout. */
+
+ timeout_val = 0;
+
+ if (!NILP (timeout))
+ {
+ CHECK_INTEGER (timeout);
+
+ if (!integer_to_intmax (timeout, &id)
+ || id > TYPE_MAXIMUM (jlong)
+ || id < TYPE_MINIMUM (jlong))
+ signal_error ("Invalid timeout", timeout);
+
+ if (id > 0)
+ timeout_val = id;
+ }
+
+ nitems = 0;
+
+ /* If ACTIONS is provided, split it into two arrays of Java strings
+ holding keys and titles. */
+
+ if (!NILP (actions))
+ {
+ /* Count the number of items to be inserted. */
+
+ length = Flength (actions);
+ if (!TYPE_RANGED_FIXNUMP (jint, length))
+ error ("Action list too long");
+ nitems = XFIXNAT (length);
+ if (nitems & 1)
+ error ("Length of action list is invalid");
+ nitems /= 2;
+
+ /* Verify that the list consists exclusively of strings. */
+ tem = actions;
+ FOR_EACH_TAIL (tem)
+ CHECK_STRING (XCAR (tem));
+ }
+
if (NILP (replaces_id))
{
/* Generate a new identifier. */
- INT_ADD_WRAPV (counter, 1, &counter);
+ ckd_add (&counter, counter, 1);
id = counter;
}
else
@@ -620,20 +680,71 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
= (*android_java_env)->NewStringUTF (android_java_env, identifier);
android_exception_check_3 (title1, body1, group1);
+ /* Create the arrays for action identifiers and titles if
+ provided. */
+
+ if (nitems)
+ {
+ action_keys = (*android_java_env)->NewObjectArray (android_java_env,
+ nitems,
+ java_string_class,
+ NULL);
+ android_exception_check_4 (title, body1, group1, identifier1);
+ action_titles = (*android_java_env)->NewObjectArray (android_java_env,
+ nitems,
+ java_string_class,
+ NULL);
+ android_exception_check_5 (title, body1, group1, identifier1,
+ action_keys);
+
+ for (i = 0; i < nitems; ++i)
+ {
+ key = XCAR (actions);
+ value = XCAR (XCDR (actions));
+ actions = XCDR (XCDR (actions));
+
+ /* Create a string for this action. */
+ item = android_build_string (key, body1, group1, identifier1,
+ action_keys, action_titles, NULL);
+ (*android_java_env)->SetObjectArrayElement (android_java_env,
+ action_keys, i,
+ item);
+ ANDROID_DELETE_LOCAL_REF (item);
+
+ /* Create a string for this title. */
+ item = android_build_string (value, body1, group1, identifier1,
+ action_keys, action_titles, NULL);
+ (*android_java_env)->SetObjectArrayElement (android_java_env,
+ action_titles, i,
+ item);
+ ANDROID_DELETE_LOCAL_REF (item);
+ }
+ }
+ else
+ {
+ action_keys = NULL;
+ action_titles = NULL;
+ }
+
/* Create the notification. */
notification
= (*android_java_env)->NewObject (android_java_env,
notification_class.class,
notification_class.init,
title1, body1, group1,
- identifier1, icon1, type);
- android_exception_check_4 (title1, body1, group1, identifier1);
+ identifier1, icon1, type,
+ action_keys, action_titles,
+ timeout_val);
+ android_exception_check_6 (title1, body1, group1, identifier1,
+ action_titles, action_keys);
/* Delete unused local references. */
ANDROID_DELETE_LOCAL_REF (title1);
ANDROID_DELETE_LOCAL_REF (body1);
ANDROID_DELETE_LOCAL_REF (group1);
ANDROID_DELETE_LOCAL_REF (identifier1);
+ ANDROID_DELETE_LOCAL_REF (action_keys);
+ ANDROID_DELETE_LOCAL_REF (action_titles);
/* Display the notification. */
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -643,6 +754,13 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
android_exception_check_1 (notification);
ANDROID_DELETE_LOCAL_REF (notification);
+ /* If callbacks are provided, save them into notification_table. */
+
+ if (!NILP (action_cb) || !NILP (close_cb) || !NILP (resident))
+ Fputhash (build_string (identifier), list3 (action_cb, close_cb,
+ resident),
+ notification_table);
+
/* Return the ID. */
return id;
}
@@ -653,21 +771,46 @@ DEFUN ("android-notifications-notify", Fandroid_notifications_notify,
ARGS must contain keywords followed by values. Each of the following
keywords is understood:
- :title The notification title.
- :body The notification body.
- :replaces-id The ID of a previous notification to supersede.
- :group The notification group, or nil.
- :urgency One of the symbols `low', `normal' or `critical',
- defining the importance of the notification group.
- :icon The name of a drawable resource to display as the
- notification's icon.
-
-The notification group is ignored on Android 7.1 and earlier versions
-of Android. Outside such older systems, it identifies a category that
-will be displayed in the system Settings menu, and the urgency
-provided always extends to affect all notifications displayed within
-that category. If the group is not provided, it defaults to the
-string "Desktop Notifications".
+ :title The notification title.
+ :body The notification body.
+ :replaces-id The ID of a previous notification to supersede.
+ :group The notification group, or nil.
+ :urgency One of the symbols `low', `normal' or `critical',
+ defining the importance of the notification group.
+ :icon The name of a drawable resource to display as the
+ notification's icon.
+ :actions A list of actions of the form:
+ (KEY TITLE KEY TITLE ...)
+ where KEY and TITLE are both strings.
+ The action for which CALLBACK is called when the
+ notification itself is selected is named "default",
+ its existence is implied, and its TITLE is ignored.
+ No more than three actions defined here will be
+ displayed, not counting any with "default" as its
+ key.
+ :timeout Number of miliseconds from the display of the
+ notification at which it will be automatically
+ dismissed, or a value of zero or smaller if it
+ is to remain until user action is taken to dismiss
+ it.
+ :resident When set the notification will not be automatically
+ dismissed when it or an action is selected.
+ :on-action Function to call when an action is invoked.
+ The notification id and the key of the action are
+ provided as arguments to the function.
+ :on-close Function to call if the notification is dismissed,
+ with the notification id and the symbol `undefined'
+ for arguments.
+
+The notification group and timeout are ignored on Android 7.1 and
+earlier versions of Android. On more recent versions, the group
+identifies a category that will be displayed in the system Settings
+menu, and the urgency provided always extends to affect all
+notifications displayed within that category, though it may be ignored
+if higher than any previously-specified urgency or if the user have
+already configured a different urgency for this category from Settings.
+If the group is not provided, it defaults to the string "Desktop
+Notifications" with the urgency suffixed.
Each caller should strive to provide one unchanging combination of
notification group and urgency for each kind of notification it sends,
@@ -677,8 +820,11 @@ first notification sent to its notification group.
The provided icon should be the name of a "drawable resource" present
within the "android.R.drawable" class designating an icon with a
-transparent background. If no icon is provided (or the icon is absent
-from this system), it defaults to "ic_dialog_alert".
+transparent background. Should no icon be provided (or the icon is
+absent from this system), it defaults to "ic_dialog_alert".
+
+Actions specified with :actions cannot be displayed on Android 4.0 and
+earlier versions of the system.
When the system is running Android 13 or later, notifications sent
will be silently disregarded unless permission to display
@@ -693,16 +839,18 @@ this function.
usage: (android-notifications-notify &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object title, body, replaces_id, group, urgency;
+ Lisp_Object title, body, replaces_id, group, urgency, timeout, resident;
Lisp_Object icon;
- Lisp_Object key, value;
+ Lisp_Object key, value, actions, action_cb, close_cb;
ptrdiff_t i;
+ AUTO_STRING (default_icon, "ic_dialog_alert");
if (!android_init_gui)
error ("No Android display connection!");
/* Clear each variable above. */
- title = body = replaces_id = group = icon = urgency = Qnil;
+ title = body = replaces_id = group = icon = urgency = actions = Qnil;
+ timeout = resident = action_cb = close_cb = Qnil;
/* If NARGS is odd, error. */
@@ -728,6 +876,16 @@ usage: (android-notifications-notify &rest ARGS) */)
urgency = value;
else if (EQ (key, QCicon))
icon = value;
+ else if (EQ (key, QCactions))
+ actions = value;
+ else if (EQ (key, QCtimeout))
+ timeout = value;
+ else if (EQ (key, QCresident))
+ resident = value;
+ else if (EQ (key, QCon_action))
+ action_cb = value;
+ else if (EQ (key, QCon_close))
+ close_cb = value;
}
/* Demand at least TITLE and BODY be present. */
@@ -744,15 +902,94 @@ usage: (android-notifications-notify &rest ARGS) */)
urgency = Qlow;
if (NILP (group))
- group = build_string ("Desktop Notifications");
+ {
+ AUTO_STRING (format, "Desktop Notifications (%s importance)");
+ group = CALLN (Fformat, format, urgency);
+ }
if (NILP (icon))
- icon = build_string ("ic_dialog_alert");
+ icon = default_icon;
else
CHECK_STRING (icon);
return make_int (android_notifications_notify_1 (title, body, replaces_id,
- group, icon, urgency));
+ group, icon, urgency,
+ actions, timeout, resident,
+ action_cb, close_cb));
+}
+
+/* Run callbacks in response to a notification being deleted.
+ Save any input generated for the keyboard within *IE.
+ EVENT should be the notification deletion event. */
+
+void
+android_notification_deleted (struct android_notification_event *event,
+ struct input_event *ie)
+{
+ Lisp_Object item, tag;
+ intmax_t id;
+
+ tag = build_string (event->tag);
+ item = Fgethash (tag, notification_table, Qnil);
+
+ if (!NILP (item))
+ Fremhash (tag, notification_table);
+
+ if (CONSP (item) && FUNCTIONP (XCAR (XCDR (item)))
+ && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0)
+ {
+ ie->kind = NOTIFICATION_EVENT;
+ ie->arg = list3 (XCAR (XCDR (item)), make_int (id),
+ Qundefined);
+ }
+}
+
+/* Run callbacks in response to one of a notification's actions being
+ invoked, saving any input generated for the keyboard within *IE.
+ EVENT should be the notification deletion event, and ACTION the
+ action key. */
+
+void
+android_notification_action (struct android_notification_event *event,
+ struct input_event *ie, Lisp_Object action)
+{
+ Lisp_Object item, tag;
+ intmax_t id;
+ jstring tag_object;
+ jmethodID method;
+
+ tag = build_string (event->tag);
+ item = Fgethash (tag, notification_table, Qnil);
+
+ if (CONSP (item) && FUNCTIONP (XCAR (item))
+ && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0)
+ {
+ ie->kind = NOTIFICATION_EVENT;
+ ie->arg = list3 (XCAR (item), make_int (id), action);
+ }
+
+ /* Test whether ITEM is resident. Non-resident notifications must be
+ removed when activated. */
+
+ if (!CONSP (item) || NILP (XCAR (XCDR (XCDR (item)))))
+ {
+ method = service_class.cancel_notification;
+ tag_object
+ = (*android_java_env)->NewStringUTF (android_java_env,
+ event->tag);
+ android_exception_check ();
+
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method, tag_object);
+ android_exception_check_1 (tag_object);
+ ANDROID_DELETE_LOCAL_REF (tag_object);
+
+ /* Remove the notification from the callback table. */
+ if (!NILP (item))
+ Fremhash (tag, notification_table);
+ }
}
@@ -794,6 +1031,11 @@ syms_of_androidselect (void)
DEFSYM (QCgroup, ":group");
DEFSYM (QCurgency, ":urgency");
DEFSYM (QCicon, ":icon");
+ DEFSYM (QCactions, ":actions");
+ DEFSYM (QCtimeout, ":timeout");
+ DEFSYM (QCresident, ":resident");
+ DEFSYM (QCon_action, ":on-action");
+ DEFSYM (QCon_close, ":on-close");
DEFSYM (Qlow, "low");
DEFSYM (Qnormal, "normal");
@@ -803,9 +1045,12 @@ syms_of_androidselect (void)
defsubr (&Sandroid_set_clipboard);
defsubr (&Sandroid_get_clipboard);
defsubr (&Sandroid_clipboard_exists_p);
- defsubr (&Sandroid_browse_url);
+ defsubr (&Sandroid_browse_url_internal);
defsubr (&Sandroid_get_clipboard_targets);
defsubr (&Sandroid_get_clipboard_data);
defsubr (&Sandroid_notifications_notify);
+
+ notification_table = CALLN (Fmake_hash_table, QCtest, Qequal);
+ staticpro (&notification_table);
}
diff --git a/src/androidterm.c b/src/androidterm.c
index 2e4ee64f390..c920375fdbe 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -361,22 +361,52 @@ static int
android_android_to_emacs_modifiers (struct android_display_info *dpyinfo,
int state)
{
- return (((state & ANDROID_CONTROL_MASK) ? ctrl_modifier : 0)
- | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0)
- | ((state & ANDROID_ALT_MASK) ? meta_modifier : 0)
- | ((state & ANDROID_SUPER_MASK) ? super_modifier : 0)
- | ((state & ANDROID_META_MASK) ? alt_modifier : 0));
+ int mod_ctrl = ctrl_modifier;
+ int mod_meta = meta_modifier;
+ int mod_alt = alt_modifier;
+ int mod_super = super_modifier;
+ Lisp_Object tem;
+
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX;
+
+ return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0)
+ | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0)
+ | ((state & ANDROID_ALT_MASK) ? mod_meta : 0)
+ | ((state & ANDROID_SUPER_MASK) ? mod_super : 0)
+ | ((state & ANDROID_META_MASK) ? mod_alt : 0));
}
static int
android_emacs_to_android_modifiers (struct android_display_info *dpyinfo,
intmax_t state)
{
- return (((state & ctrl_modifier) ? ANDROID_CONTROL_MASK : 0)
- | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0)
- | ((state & meta_modifier) ? ANDROID_ALT_MASK : 0)
- | ((state & super_modifier) ? ANDROID_SUPER_MASK : 0)
- | ((state & alt_modifier) ? ANDROID_META_MASK : 0));
+ EMACS_INT mod_ctrl = ctrl_modifier;
+ EMACS_INT mod_meta = meta_modifier;
+ EMACS_INT mod_alt = alt_modifier;
+ EMACS_INT mod_super = super_modifier;
+ Lisp_Object tem;
+
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem);
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem);
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem);
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_super = XFIXNUM (tem);
+
+ return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0)
+ | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0)
+ | ((state & mod_meta) ? ANDROID_ALT_MASK : 0)
+ | ((state & mod_super) ? ANDROID_SUPER_MASK : 0)
+ | ((state & mod_alt) ? ANDROID_META_MASK : 0));
}
static void android_frame_rehighlight (struct android_display_info *);
@@ -495,8 +525,8 @@ android_note_mouse_movement (struct frame *frame,
/* Has the mouse moved off the glyph it was on at the last sighting? */
r = &dpyinfo->last_mouse_glyph;
if (frame != dpyinfo->last_mouse_glyph_frame
- || event->x < r->x || event->x >= r->x + r->width
- || event->y < r->y || event->y >= r->y + r->height)
+ || event->x < r->x || event->x >= r->x + (int) r->width
+ || event->y < r->y || event->y >= r->y + (int) r->height)
{
frame->mouse_moved = true;
note_mouse_highlight (frame, event->x, event->y);
@@ -619,7 +649,7 @@ android_decode_utf16 (unsigned short *utf16, size_t n)
struct coding_system coding;
ptrdiff_t size;
- if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size))
+ if (ckd_mul (&size, n, sizeof *utf16))
return Qnil;
/* Set up the coding system. Decoding a UTF-16 string (with no BOM)
@@ -811,6 +841,7 @@ handle_one_android_event (struct android_display_info *dpyinfo,
int keysym;
ptrdiff_t nchars, i;
struct window *w;
+ static struct android_compose_status compose_status;
/* It is okay for this to not resemble handle_one_xevent so much.
Differences in event handling code are much less nasty than
@@ -938,15 +969,23 @@ handle_one_android_event (struct android_display_info *dpyinfo,
sure it is processed before any subsequent edits. */
textconv_barrier (f, event->xkey.counter);
- wchar_t copy_buffer[129];
+ wchar_t copy_buffer[512];
wchar_t *copy_bufptr = copy_buffer;
- int copy_bufsiz = 128 * sizeof (wchar_t);
+ int copy_bufsiz = 512;
event->xkey.state
|= android_emacs_to_android_modifiers (dpyinfo,
extra_keyboard_modifiers);
modifiers = event->xkey.state;
+ /* In case Meta is ComposeCharacter, clear its status. According
+ to Markus Ehrnsperger
+ Markus.Ehrnsperger@lehrstuhl-bross.physik.uni-muenchen.de this
+ enables ComposeCharacter to work whether or not it is combined
+ with Meta. */
+ if (modifiers & ANDROID_ALT_MASK)
+ memset (&compose_status, 0, sizeof (compose_status));
+
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, any);
inev.ie.modifiers
@@ -960,7 +999,8 @@ handle_one_android_event (struct android_display_info *dpyinfo,
nchars = android_wc_lookup_string (&event->xkey, copy_bufptr,
copy_bufsiz, &keysym,
- &status_return);
+ &status_return,
+ &compose_status);
/* android_lookup_string can't be called twice, so there's no
way to recover from buffer overflow. */
@@ -1000,6 +1040,13 @@ handle_one_android_event (struct android_display_info *dpyinfo,
}
}
+ /* If a compose sequence is in progress, we break here.
+ Otherwise, chars_matched is always 0. */
+ if (compose_status.chars_matched > 0 && nchars == 0)
+ break;
+
+ memset (&compose_status, 0, sizeof (compose_status));
+
if (nchars == 1 && copy_bufptr[0] >= 32)
{
/* Deal with characters. */
@@ -1744,6 +1791,26 @@ handle_one_android_event (struct android_display_info *dpyinfo,
free (event->dnd.uri_or_string);
goto OTHER;
+ case ANDROID_NOTIFICATION_DELETED:
+ case ANDROID_NOTIFICATION_ACTION:
+
+ if (event->notification.type == ANDROID_NOTIFICATION_DELETED)
+ android_notification_deleted (&event->notification, &inev.ie);
+ else
+ {
+ Lisp_Object action;
+
+ action = android_decode_utf16 (event->notification.action,
+ event->notification.length);
+ android_notification_action (&event->notification, &inev.ie,
+ action);
+ }
+
+ /* Free dynamically allocated data. */
+ free (event->notification.tag);
+ free (event->notification.action);
+ goto OTHER;
+
default:
goto OTHER;
}
@@ -4723,7 +4790,7 @@ android_sync_edit (void)
/* Return a copy of the specified Java string and its length in
*LENGTH. Use the JNI environment ENV. Value is NULL if copying
- *the string fails. */
+ the string fails. */
static unsigned short *
android_copy_java_string (JNIEnv *env, jstring string, size_t *length)
@@ -5010,7 +5077,7 @@ android_text_to_string (JNIEnv *env, char *buffer, ptrdiff_t n,
{
/* This buffer holds no multibyte characters. */
- if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size))
+ if (ckd_mul (&size, n, sizeof *utf16))
return NULL;
utf16 = malloc (size);
@@ -5033,7 +5100,7 @@ android_text_to_string (JNIEnv *env, char *buffer, ptrdiff_t n,
/* Allocate enough to hold N characters. */
- if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size))
+ if (ckd_mul (&size, n, sizeof *utf16))
return NULL;
utf16 = malloc (size);
@@ -6209,6 +6276,8 @@ android_reset_conversion (struct frame *f)
if (NILP (style) || conversion_disabled_p ())
mode = ANDROID_IC_MODE_NULL;
+ else if (EQ (style, Qpassword))
+ mode = ANDROID_IC_MODE_PASSWORD;
else if (EQ (style, Qaction) || EQ (f->selected_window,
f->minibuffer_window))
mode = ANDROID_IC_MODE_ACTION;
@@ -6633,6 +6702,26 @@ Emacs is running on. */);
doc: /* Name of the developer of the running version of Android. */);
Vandroid_build_manufacturer = Qnil;
+ DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_ctrl_keysym = Qnil;
+
+ DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_alt_keysym = Qnil;
+
+ DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_hyper_keysym = Qnil;
+
+ DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_meta_keysym = Qnil;
+
+ DEFVAR_LISP ("x-super-keysym", Vx_super_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_super_keysym = Qnil;
+
/* Only defined so loadup.el loads scroll-bar.el. */
DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
doc: /* SKIP: real doc in xterm.c. */);
@@ -6646,6 +6735,17 @@ Emacs is running on. */);
/* Symbols defined for DND events. */
DEFSYM (Quri, "uri");
DEFSYM (Qtext, "text");
+
+ /* Symbols defined for modifier value reassignment. */
+ DEFSYM (Qmodifier_value, "modifier-value");
+ DEFSYM (Qctrl, "ctrl");
+ Fput (Qctrl, Qmodifier_value, make_fixnum (ctrl_modifier));
+ DEFSYM (Qalt, "alt");
+ Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier));
+ DEFSYM (Qmeta, "meta");
+ Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier));
+ DEFSYM (Qsuper, "super");
+ Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier));
}
void
diff --git a/src/androidterm.h b/src/androidterm.h
index 7568055a20b..fd4cc99f641 100644
--- a/src/androidterm.h
+++ b/src/androidterm.h
@@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "character.h"
#include "dispextern.h"
#include "font.h"
+#include "termhooks.h"
struct android_bitmap_record
{
@@ -298,8 +299,8 @@ enum
code after any drawing command, but code can be run whenever
someone asks for the handle necessary to draw. */
#define FRAME_ANDROID_DRAWABLE(f) \
- (((f))->output_data.android->need_buffer_flip = true, \
- FRAME_ANDROID_WINDOW ((f)))
+ ((f)->output_data.android->need_buffer_flip = true, \
+ FRAME_ANDROID_WINDOW (f))
/* Return whether or not the frame F has been completely drawn. Used
while handling async input. */
@@ -460,13 +461,21 @@ extern void sfntfont_android_shrink_scanline_buffer (void);
extern void init_sfntfont_android (void);
extern void syms_of_sfntfont_android (void);
-/* Defined in androidselect.c */
+/* Defined in androidselect.c. */
#ifndef ANDROID_STUBIFY
+extern void android_notification_deleted (struct android_notification_event *,
+ struct input_event *);
+extern void android_notification_action (struct android_notification_event *,
+ struct input_event *, Lisp_Object);
+
extern void init_androidselect (void);
extern void syms_of_androidselect (void);
+/* Defined in androidvfs.c. */
+extern void syms_of_androidvfs (void);
+
#endif
diff --git a/src/androidvfs.c b/src/androidvfs.c
index 3377683c84f..a9035ae53c6 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -33,12 +33,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <sys/mman.h>
#include <stat-time.h>
+#include <md5.h>
#include <linux/ashmem.h>
#include "android.h"
+#include "androidterm.h"
#include "systime.h"
#include "blockinput.h"
+#include "coding.h"
#if __ANDROID_API__ >= 9
#include <android/asset_manager.h>
@@ -247,14 +250,21 @@ struct android_special_vnode
/* Function called to create the initial vnode from the rest of the
component. */
struct android_vnode *(*initial) (char *, size_t);
+
+ /* If non-nil, an encoding system into which file name buffers are to
+ be re-encoded before being handed to VFS functions. */
+ Lisp_Object special_coding_system;
};
+verify (NIL_IS_ZERO); /* special_coding_system above. */
+
enum android_vnode_type
{
ANDROID_VNODE_UNIX,
ANDROID_VNODE_AFS,
ANDROID_VNODE_CONTENT,
ANDROID_VNODE_CONTENT_AUTHORITY,
+ ANDROID_VNODE_CONTENT_AUTHORITY_NAMED,
ANDROID_VNODE_SAF_ROOT,
ANDROID_VNODE_SAF_TREE,
ANDROID_VNODE_SAF_FILE,
@@ -292,7 +302,7 @@ struct android_parcel_file_descriptor_class
};
/* The java.lang.String class. */
-static jclass java_string_class;
+jclass java_string_class;
/* Fields and methods associated with the Cursor class. */
static struct android_cursor_class cursor_class;
@@ -1018,8 +1028,8 @@ android_extract_long (char *pointer)
static const char *
android_scan_directory_tree (char *file, size_t *limit_return)
{
- char *token, *saveptr, *copy, *copy1, *start, *max, *limit;
- size_t token_length, ntokens, i;
+ char *token, *saveptr, *copy, *start, *max, *limit;
+ size_t token_length, ntokens, i, len;
char *tokens[10];
USE_SAFE_ALLOCA;
@@ -1031,11 +1041,14 @@ android_scan_directory_tree (char *file, size_t *limit_return)
limit = (char *) directory_tree + directory_tree_size;
/* Now, split `file' into tokens, with the delimiter being the file
- name separator. Look for the file and seek past it. */
+ name separator. Look for the file and seek past it. Create a copy
+ of FILE for the enjoyment of `strtok_r'. */
ntokens = 0;
saveptr = NULL;
- copy = copy1 = xstrdup (file);
+ len = strlen (file) + 1;
+ copy = SAFE_ALLOCA (len);
+ memcpy (copy, file, len);
memset (tokens, 0, sizeof tokens);
while ((token = strtok_r (copy, "/", &saveptr)))
@@ -1044,19 +1057,14 @@ android_scan_directory_tree (char *file, size_t *limit_return)
/* Make sure ntokens is within bounds. */
if (ntokens == ARRAYELTS (tokens))
- {
- xfree (copy1);
- goto fail;
- }
+ goto fail;
- tokens[ntokens] = SAFE_ALLOCA (strlen (token) + 1);
- memcpy (tokens[ntokens], token, strlen (token) + 1);
+ len = strlen (token) + 1;
+ tokens[ntokens] = SAFE_ALLOCA (len);
+ memcpy (tokens[ntokens], token, len);
ntokens++;
}
- /* Free the copy created for strtok_r. */
- xfree (copy1);
-
/* If there are no tokens, just return the start of the directory
tree. */
@@ -2388,8 +2396,8 @@ android_afs_opendir (struct android_vnode *vnode)
and as such can be exactly one byte past directory_tree. */
if (dir->asset_limit > directory_tree + directory_tree_size)
{
- xfree (dir);
xfree (dir->asset_file);
+ xfree (dir);
errno = EACCES;
return NULL;
}
@@ -2437,6 +2445,7 @@ struct android_content_vdir
};
static struct android_vnode *android_authority_initial (char *, size_t);
+static struct android_vnode *android_authority_initial_name (char *, size_t);
static struct android_vnode *android_saf_root_initial (char *, size_t);
/* Content provider meta-interface. This implements a vnode at
@@ -2447,9 +2456,9 @@ static struct android_vnode *android_saf_root_initial (char *, size_t);
a list of each directory tree Emacs has been granted permanent
access to through the Storage Access Framework.
- /content/by-authority exists on Android 4.4 and later; it contains
- no directories, but provides a `name' function that converts
- children into content URIs. */
+ /content/by-authority and /content/by-authority-named exists on
+ Android 4.4 and later; it contains no directories, but provides a
+ `name' function that converts children into content URIs. */
static struct android_vnode *android_content_name (struct android_vnode *,
char *, size_t);
@@ -2492,7 +2501,7 @@ static struct android_vops content_vfs_ops =
static const char *content_directory_contents[] =
{
- "storage", "by-authority",
+ "storage", "by-authority", "by-authority-named",
};
/* Chain consisting of all open content directory streams. */
@@ -2510,8 +2519,9 @@ android_content_name (struct android_vnode *vnode, char *name,
int api;
static struct android_special_vnode content_vnodes[] = {
- { "storage", 7, android_saf_root_initial, },
- { "by-authority", 12, android_authority_initial, },
+ { "storage", 7, android_saf_root_initial, },
+ { "by-authority", 12, android_authority_initial, },
+ { "by-authority-named", 18, android_authority_initial_name, },
};
/* Canonicalize NAME. */
@@ -2553,7 +2563,7 @@ android_content_name (struct android_vnode *vnode, char *name,
call its root lookup function with the rest of NAME there. */
if (api < 19)
- i = 2;
+ i = 3;
else if (api < 21)
i = 1;
else
@@ -2857,18 +2867,59 @@ android_content_initial (char *name, size_t length)
+#ifdef __clang__
+#pragma clang diagnostic push
+#pragma clang diagnostic ignored "-Wmissing-prototypes"
+#else /* GNUC */
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+#endif /* __clang__ */
+
/* Content URI management functions. */
+JNIEXPORT jstring JNICALL
+NATIVE_NAME (displayNameHash) (JNIEnv *env, jobject object,
+ jbyteArray display_name)
+{
+ char checksum[9], block[MD5_DIGEST_SIZE];
+ jbyte *data;
+
+ data = (*env)->GetByteArrayElements (env, display_name, NULL);
+ if (!data)
+ return NULL;
+
+ /* Hash the buffer. */
+ md5_buffer ((char *) data, (*env)->GetArrayLength (env, display_name),
+ block);
+ (*env)->ReleaseByteArrayElements (env, display_name, data, JNI_ABORT);
+
+ /* Generate the digest string. */
+ hexbuf_digest (checksum, (char *) block, 4);
+ checksum[8] = '\0';
+ return (*env)->NewStringUTF (env, checksum);
+}
+
+#ifdef __clang__
+#pragma clang diagnostic pop
+#else /* GNUC */
+#pragma GCC diagnostic pop
+#endif /* __clang__ */
+
/* Return the content URI corresponding to a `/content/by-authority'
file name, or NULL if it is invalid for some reason. FILENAME
should be relative to /content/by-authority, with no leading
- directory separator character. */
+ directory separator character.
+
+ WITH_CHECKSUM should be true if FILENAME contains a display name and
+ a checksum for that display name. */
static char *
-android_get_content_name (const char *filename)
+android_get_content_name (const char *filename, bool with_checksum)
{
char *fill, *buffer;
size_t length;
+ char checksum[9], new_checksum[9], block[MD5_DIGEST_SIZE];
+ const char *p2, *p1;
/* Make sure FILENAME isn't obviously invalid: it must contain an
authority name and a file name component. */
@@ -2890,11 +2941,55 @@ android_get_content_name (const char *filename)
return NULL;
}
+ if (!with_checksum)
+ goto no_checksum;
+
+ /* Content file names hold two components providing a display name and
+ a short checksum that protects against files being opened under
+ display names besides those provided in the content file name at
+ the time of generation. */
+
+ p1 = strrchr (filename, '/'); /* Display name. */
+ p2 = memrchr (filename, '/', p1 - filename); /* Start of checksum. */
+
+ /* If the name be excessively short or the checksum of an invalid
+ length, return. */
+ if (!p2 || (p1 - p2) != 9)
+ {
+ errno = ENOENT;
+ return NULL;
+ }
+
+ /* Copy the checksum into CHECKSUM. */
+ memcpy (checksum, p2 + 1, 8);
+ new_checksum[8] = checksum[8] = '\0';
+
+ /* Hash this string and store 8 bytes of the resulting digest into
+ new_checksum. */
+ md5_buffer (p1 + 1, strlen (p1 + 1), block);
+ hexbuf_digest (new_checksum, (char *) block, 4);
+
+ /* Compare both checksums. */
+ if (strcmp (new_checksum, checksum))
+ {
+ errno = ENOENT;
+ return NULL;
+ }
+
+ /* Remove the checksum and file display name from the URI. */
+ length = p2 - filename;
+
+ no_checksum:
+ if (length > INT_MAX)
+ {
+ errno = ENOMEM;
+ return NULL;
+ }
+
/* Prefix FILENAME with content:// and return the buffer containing
that URI. */
-
- buffer = xmalloc (sizeof "content://" + length);
- sprintf (buffer, "content://%s", filename);
+ buffer = xmalloc (sizeof "content://" + length + 1);
+ sprintf (buffer, "content://%.*s", (int) length, filename);
return buffer;
}
@@ -2934,7 +3029,7 @@ android_check_content_access (const char *uri, int mode)
/* Content authority-based vnode implementation.
- /contents/by-authority is a simple vnode implementation that converts
+ /content/by-authority is a simple vnode implementation that converts
components to content:// URIs.
It does not canonicalize file names by removing parent directory
@@ -3041,7 +3136,14 @@ android_authority_name (struct android_vnode *vnode, char *name,
if (android_verify_jni_string (name))
goto no_entry;
- uri_name = android_get_content_name (name);
+ if (vp->vnode.type == ANDROID_VNODE_CONTENT_AUTHORITY_NAMED)
+ /* This indicates that the two trailing components of NAME
+ provide a checksum and a file display name, to be verified,
+ then excluded from the content URI. */
+ uri_name = android_get_content_name (name, true);
+ else
+ uri_name = android_get_content_name (name, false);
+
if (!uri_name)
goto error;
@@ -3335,6 +3437,32 @@ android_authority_initial (char *name, size_t length)
return android_authority_name (&temp.vnode, name, length);
}
+/* Find the vnode designated by NAME relative to the root of the
+ by-authority-named directory.
+
+ If NAME is empty or a single leading separator character, return
+ a vnode representing the by-authority directory itself.
+
+ Otherwise, represent the remainder of NAME as a URI (without
+ normalizing it) and return a vnode corresponding to that.
+
+ Value may also be NULL with errno set if the designated vnode is
+ not available, such as when Android windowing has not been
+ initialized. */
+
+static struct android_vnode *
+android_authority_initial_name (char *name, size_t length)
+{
+ struct android_authority_vnode temp;
+
+ temp.vnode.ops = &authority_vfs_ops;
+ temp.vnode.type = ANDROID_VNODE_CONTENT_AUTHORITY_NAMED;
+ temp.vnode.flags = 0;
+ temp.uri = NULL;
+
+ return android_authority_name (&temp.vnode, name, length);
+}
+
/* SAF ``root'' vnode implementation.
@@ -3747,7 +3875,8 @@ android_saf_root_readdir (struct android_vdir *vdir)
NULL);
android_exception_check_nonnull ((void *) chars, string);
- /* Figure out how large it is, and then resize dirent to fit. */
+ /* Figure out how large it is, and then resize dirent to fit--this
+ string is always ASCII. */
length = strlen (chars) + 1;
size = offsetof (struct dirent, d_name) + length;
dirent = xrealloc (dirent, size);
@@ -5359,6 +5488,7 @@ android_saf_tree_readdir (struct android_vdir *vdir)
jmethodID method;
size_t length, size;
const char *chars;
+ struct coding_system coding;
dir = (struct android_saf_tree_vdir *) vdir;
@@ -5406,9 +5536,24 @@ android_saf_tree_readdir (struct android_vdir *vdir)
NULL);
android_exception_check_nonnull ((void *) chars, d_name);
- /* Figure out how large it is, and then resize dirent to fit. */
- length = strlen (chars) + 1;
- size = offsetof (struct dirent, d_name) + length;
+ /* Decode this JNI string into utf-8-emacs; see
+ android_vfs_convert_name for considerations regarding coding
+ systems. */
+ length = strlen (chars);
+ setup_coding_system (Qandroid_jni, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ coding.source = (const unsigned char *) chars;
+ coding.dst_bytes = 0;
+ coding.destination = NULL;
+ decode_coding_object (&coding, Qnil, 0, 0, length, length, Qnil);
+
+ /* Release the string data and the local reference to STRING. */
+ (*android_java_env)->ReleaseStringUTFChars (android_java_env,
+ (jstring) d_name,
+ chars);
+
+ /* Resize dirent to accommodate the decoded text. */
+ size = offsetof (struct dirent, d_name) + 1 + coding.produced;
dirent = xrealloc (dirent, size);
/* Clear dirent. */
@@ -5420,12 +5565,12 @@ android_saf_tree_readdir (struct android_vdir *vdir)
dirent->d_off = 0;
dirent->d_reclen = size;
dirent->d_type = d_type ? DT_DIR : DT_UNKNOWN;
- strcpy (dirent->d_name, chars);
+ memcpy (dirent->d_name, coding.destination, coding.produced);
+ dirent->d_name[coding.produced] = '\0';
+
+ /* Free the coding system destination buffer. */
+ xfree (coding.destination);
- /* Release the string data and the local reference to STRING. */
- (*android_java_env)->ReleaseStringUTFChars (android_java_env,
- (jstring) d_name,
- chars);
ANDROID_DELETE_LOCAL_REF (d_name);
return dirent;
}
@@ -5547,8 +5692,8 @@ android_saf_tree_opendir (struct android_vnode *vnode)
if (!cursor)
{
- xfree (dir);
xfree (dir->name);
+ xfree (dir);
return NULL;
}
@@ -6319,6 +6464,8 @@ static sem_t saf_completion_sem;
JNIEXPORT jint JNICALL
NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
while (sem_wait (&saf_completion_sem) < 0)
{
if (input_blocked_p ())
@@ -6340,6 +6487,8 @@ NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object)
JNIEXPORT void JNICALL
NATIVE_NAME (safSync) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
while (sem_wait (&saf_completion_sem) < 0)
process_pending_signals ();
}
@@ -6347,12 +6496,16 @@ NATIVE_NAME (safSync) (JNIEnv *env, jobject object)
JNIEXPORT void JNICALL
NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
sem_post (&saf_completion_sem);
}
JNIEXPORT jboolean JNICALL
NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd)
{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
if (ftruncate (fd, 0) < 0)
return false;
@@ -6403,9 +6556,31 @@ static struct android_vops root_vfs_ops =
static struct android_special_vnode special_vnodes[] =
{
{ "assets", 6, android_afs_initial, },
- { "content", 7, android_content_initial, },
+ { "content", 7, android_content_initial,
+ LISPSYM_INITIALLY (Qandroid_jni), },
};
+/* Convert the file name NAME from Emacs's internal character encoding
+ to CODING, and return a Lisp string with the data so produced.
+
+ Calling this function creates an implicit assumption that
+ file-name-coding-system is compatible with utf-8-emacs, which is not
+ unacceptable as users with cause to modify file-name-coding-system
+ should be aware and prepared for consequences towards files stored on
+ different filesystems, including virtual ones. */
+
+static Lisp_Object
+android_vfs_convert_name (const char *name, Lisp_Object coding)
+{
+ Lisp_Object name1;
+
+ /* Convert the contents of the buffer after BUFFER_END from the file
+ name coding system to special->special_coding_system. */
+ name1 = build_string (name);
+ name1 = code_convert_string (name1, coding, Qt, true, true, true);
+ return name1;
+}
+
static struct android_vnode *
android_root_name (struct android_vnode *vnode, char *name,
size_t length)
@@ -6413,6 +6588,8 @@ android_root_name (struct android_vnode *vnode, char *name,
char *component_end;
struct android_special_vnode *special;
size_t i;
+ Lisp_Object file_name;
+ struct android_vnode *vp;
/* Skip any leading separator in NAME. */
@@ -6439,8 +6616,29 @@ android_root_name (struct android_vnode *vnode, char *name,
if (component_end - name == special->length
&& !memcmp (special->name, name, special->length))
- return (*special->initial) (component_end,
- length - special->length);
+ {
+ if (!NILP (special->special_coding_system))
+ {
+ USE_SAFE_ALLOCA;
+
+ file_name
+ = android_vfs_convert_name (component_end,
+ special->special_coding_system);
+
+ /* Allocate a buffer and copy file_name into the same. */
+ length = SBYTES (file_name) + 1;
+ name = SAFE_ALLOCA (length);
+
+ /* Copy the trailing NULL byte also. */
+ memcpy (name, SDATA (file_name), length);
+ vp = (*special->initial) (name, length - 1);
+ SAFE_FREE ();
+ return vp;
+ }
+
+ return (*special->initial) (component_end,
+ length - special->length);
+ }
/* Detect the case where a special is named with a trailing
directory separator. */
@@ -6448,9 +6646,30 @@ android_root_name (struct android_vnode *vnode, char *name,
if (component_end - name == special->length + 1
&& !memcmp (special->name, name, special->length)
&& name[special->length] == '/')
- /* Make sure to include the directory separator. */
- return (*special->initial) (component_end - 1,
- length - special->length);
+ {
+ if (!NILP (special->special_coding_system))
+ {
+ USE_SAFE_ALLOCA;
+
+ file_name
+ = android_vfs_convert_name (component_end - 1,
+ special->special_coding_system);
+
+ /* Allocate a buffer and copy file_name into the same. */
+ length = SBYTES (file_name) + 1;
+ name = SAFE_ALLOCA (length);
+
+ /* Copy the trailing NULL byte also. */
+ memcpy (name, SDATA (file_name), length);
+ vp = (*special->initial) (name, length - 1);
+ SAFE_FREE ();
+ return vp;
+ }
+
+ /* Make sure to include the directory separator. */
+ return (*special->initial) (component_end - 1,
+ length - special->length);
+ }
}
/* Otherwise, continue searching for a vnode normally. */
@@ -6461,8 +6680,9 @@ android_root_name (struct android_vnode *vnode, char *name,
/* File system lookup. */
-/* Look up the vnode that designates NAME, a file name that is at
- least N bytes.
+/* Look up the vnode that designates NAME, a file name that is at least
+ N bytes, converting between different file name coding systems as
+ necessary.
NAME may be either an absolute file name or a name relative to the
current working directory. It must not be longer than EMACS_PATH_MAX
@@ -7477,3 +7697,11 @@ android_closedir (struct android_vdir *dirp)
{
return (*dirp->closedir) (dirp);
}
+
+
+
+void
+syms_of_androidvfs (void)
+{
+ DEFSYM (Qandroid_jni, "android-jni");
+}
diff --git a/src/bidi.c b/src/bidi.c
index 93bb061ac32..bdf60001781 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -420,7 +420,7 @@ bidi_paired_bracket_type (int c)
static void
bidi_set_sos_type (struct bidi_it *bidi_it, int level_before, int level_after)
{
- int higher_level = (level_before > level_after ? level_before : level_after);
+ int higher_level = max (level_before, level_after);
/* FIXME: should the default sos direction be user selectable? */
bidi_it->sos = ((higher_level & 1) != 0 ? R2L : L2R); /* X10 */
@@ -754,6 +754,19 @@ bidi_cache_find_level_change (int level, int dir, bool before)
return -1;
}
+/* Find the previous character position where LEVEL changes to a lower
+ one. Return -1 if not found (which really shouldn't happen if this
+ function is called on a backward scan). */
+ptrdiff_t
+bidi_level_start (int level)
+{
+ ptrdiff_t slot = bidi_cache_find_level_change (level, -1, true);
+
+ if (slot >= 0)
+ return bidi_cache[slot].charpos;
+ return -1;
+}
+
static void
bidi_cache_ensure_space (ptrdiff_t idx)
{
@@ -2908,7 +2921,6 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
}
else if (bidi_it->bracket_pairing_pos != eob)
{
- eassert (bidi_it->resolved_level == -1);
/* If the cached state shows an increase of embedding level due
to an isolate initiator, we need to update the 1st cached
state of the next run of the current isolating sequence with
@@ -2917,6 +2929,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
if (bidi_it->level_stack[bidi_it->stack_idx].level > prev_level
&& ISOLATE_STATUS (bidi_it, bidi_it->stack_idx))
{
+ eassert (bidi_it->resolved_level == -1);
bidi_record_type_for_neutral (&prev_for_neutral, prev_level, 0);
bidi_record_type_for_neutral (&next_for_neutral, prev_level, 1);
}
@@ -2931,6 +2944,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it)
}
else if (bidi_it->bracket_pairing_pos == -1)
{
+ eassert (bidi_it->resolved_level == -1);
/* Higher levels were not BPA-resolved yet, even if
cached by bidi_find_bracket_pairs. Force application
of BPA to the new level now. */
diff --git a/src/buffer.c b/src/buffer.c
index 352aca8ddfd..291c7d3f911 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -327,6 +327,11 @@ bset_name (struct buffer *b, Lisp_Object val)
b->name_ = val;
}
static void
+bset_last_name (struct buffer *b, Lisp_Object val)
+{
+ b->last_name_ = val;
+}
+static void
bset_overwrite_mode (struct buffer *b, Lisp_Object val)
{
b->overwrite_mode_ = val;
@@ -647,6 +652,7 @@ even if it is dead. The return value is never nil. */)
name = Fcopy_sequence (buffer_or_name);
set_string_intervals (name, NULL);
bset_name (b, name);
+ bset_last_name (b, name);
b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
@@ -796,14 +802,20 @@ DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
BASE-BUFFER should be a live buffer, or the name of an existing buffer.
NAME should be a string which is not the name of an existing buffer.
+
+Interactively, prompt for BASE-BUFFER (offering the current buffer as
+the default), and for NAME (offering as default the name of a recently
+used buffer).
+
Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
such as major and minor modes, in the indirect buffer.
-
CLONE nil means the indirect buffer's state is reset to default values.
If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer
does not run the hooks `kill-buffer-hook',
-`kill-buffer-query-functions', and `buffer-list-update-hook'. */)
+`kill-buffer-query-functions', and `buffer-list-update-hook'.
+
+Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */)
(Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone,
Lisp_Object inhibit_buffer_hooks)
{
@@ -860,6 +872,7 @@ does not run the hooks `kill-buffer-hook',
name = Fcopy_sequence (name);
set_string_intervals (name, NULL);
bset_name (b, name);
+ bset_last_name (b, name);
/* An indirect buffer shares undo list of its base (Bug#18180). */
bset_undo_list (b, BVAR (b->base_buffer, undo_list));
@@ -1276,6 +1289,17 @@ Return nil if BUFFER has been killed. */)
return BVAR (decode_buffer (buffer), name);
}
+DEFUN ("buffer-last-name", Fbuffer_last_name, Sbuffer_last_name, 0, 1, 0,
+ doc: /* Return last name of BUFFER, as a string.
+BUFFER defaults to the current buffer.
+
+This is the name BUFFER had before the last time it was renamed or
+immediately before it was killed. */)
+ (Lisp_Object buffer)
+{
+ return BVAR (decode_buffer (buffer), last_name);
+}
+
DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
doc: /* Return name of file BUFFER is visiting, or nil if none.
No argument or nil as argument means use the current buffer. */)
@@ -1646,6 +1670,7 @@ This does not change the name of the visited file (if any). */)
(register Lisp_Object newname, Lisp_Object unique)
{
register Lisp_Object tem, buf;
+ Lisp_Object oldname = BVAR (current_buffer, name);
Lisp_Object requestedname = newname;
CHECK_STRING (newname);
@@ -1663,12 +1688,12 @@ This does not change the name of the visited file (if any). */)
if (NILP (unique) && XBUFFER (tem) == current_buffer)
return BVAR (current_buffer, name);
if (!NILP (unique))
- newname = Fgenerate_new_buffer_name (newname,
- BVAR (current_buffer, name));
+ newname = Fgenerate_new_buffer_name (newname, oldname);
else
error ("Buffer name `%s' is in use", SDATA (newname));
}
+ bset_last_name (current_buffer, oldname);
bset_name (current_buffer, newname);
/* Catch redisplay's attention. Unless we do this, the mode lines for
@@ -1965,8 +1990,16 @@ cleaning up all windows currently displaying the buffer to be killed. */)
Lisp_Object tail, other;
FOR_EACH_LIVE_BUFFER (tail, other)
- if (XBUFFER (other)->base_buffer == b)
- Fkill_buffer (other);
+ {
+ struct buffer *obuf = XBUFFER (other);
+ if (obuf->base_buffer == b)
+ {
+ Fkill_buffer (other);
+ if (BUFFER_LIVE_P (obuf))
+ error ("Unable to kill buffer whose indirect buffer `%s' cannot be killed",
+ SDATA (BVAR (obuf, name)));
+ }
+ }
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
@@ -2081,6 +2114,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
This gets rid of them for certain. */
reset_buffer_local_variables (b, 1);
+ bset_last_name (b, BVAR (b, name));
bset_name (b, Qnil);
block_input ();
@@ -3002,7 +3036,7 @@ the normal hook `change-major-mode-hook'. */)
But still return the total number of overlays.
*/
-ptrdiff_t
+static ptrdiff_t
overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend,
Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
bool empty, bool trailing,
@@ -3125,56 +3159,38 @@ mouse_face_overlay_overlaps (Lisp_Object 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];
- USE_SAFE_ALLOCA;
+ Lisp_Object tem;
+ struct itree_node *node;
- size = ARRAYELTS (vbuf);
- v = vbuf;
- n = overlays_in (start, end, 0, &v, &size, true, false, NULL);
- if (n > size)
+ ITREE_FOREACH (node, current_buffer->overlays,
+ start, min (end, ZV) + 1,
+ ASCENDING)
{
- SAFE_NALLOCA (v, 1, n);
- overlays_in (start, end, 0, &v, &n, true, false, NULL);
+ if (node->begin < end && node->end > start
+ && node->begin < node->end
+ && !EQ (node->data, overlay)
+ && (tem = Foverlay_get (overlay, Qmouse_face),
+ !NILP (tem)))
+ return true;
}
-
- for (i = 0; i < n; ++i)
- if (!EQ (v[i], overlay)
- && (tem = Foverlay_get (overlay, Qmouse_face),
- !NILP (tem)))
- break;
-
- SAFE_FREE ();
- return i < n;
+ return false;
}
/* Return the value of the 'display-line-numbers-disable' property at
EOB, if there's an overlay at ZV with a non-nil value of that property. */
-Lisp_Object
+bool
disable_line_numbers_overlay_at_eob (void)
{
- ptrdiff_t n, i, size;
- Lisp_Object *v, tem = Qnil;
- Lisp_Object vbuf[10];
- USE_SAFE_ALLOCA;
+ Lisp_Object tem = Qnil;
+ struct itree_node *node;
- size = ARRAYELTS (vbuf);
- v = vbuf;
- n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL);
- if (n > size)
+ ITREE_FOREACH (node, current_buffer->overlays, ZV, ZV, ASCENDING)
{
- SAFE_NALLOCA (v, 1, n);
- overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL);
+ if ((tem = Foverlay_get (node->data, Qdisplay_line_numbers_disable),
+ !NILP (tem)))
+ return true;
}
-
- for (i = 0; i < n; ++i)
- if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
- !NILP (tem)))
- break;
-
- SAFE_FREE ();
- return tem;
+ return false;
}
@@ -4670,6 +4686,7 @@ init_buffer_once (void)
/* These used to be stuck at 0 by default, but now that the all-zero value
means Qnil, we have to initialize them explicitly. */
bset_name (&buffer_local_flags, make_fixnum (0));
+ bset_last_name (&buffer_local_flags, make_fixnum (0));
bset_mark (&buffer_local_flags, make_fixnum (0));
bset_local_var_alist (&buffer_local_flags, make_fixnum (0));
bset_keymap (&buffer_local_flags, make_fixnum (0));
@@ -5883,10 +5900,20 @@ Use Custom to set this variable and update the display. */);
text_conversion_style),
Qnil,
doc: /* How the on screen keyboard's input method should insert in this buffer.
-When nil, the input method will be disabled and an ordinary keyboard
+
+If nil, the input method will be disabled and an ordinary keyboard
will be displayed in its place.
-When the symbol `action', the input method will insert text directly, but
-will send `return' key events instead of inserting new line characters.
+
+If the value is the symbol `action', the input method will insert text
+directly, but will send `return' key events instead of inserting new
+line characters.
+
+If the value is the symbol `password', an input method capable of ASCII
+input will be enabled, and will not save the entered text where it will
+be retrieved for text suggestions or other features not suitable for
+handling sensitive information, in addition to reporting `return' as
+when `action'.
+
Any other value means that the input method will insert text directly.
If you need to make non-buffer local changes to this variable, use
@@ -5894,7 +5921,7 @@ If you need to make non-buffer local changes to this variable, use
This variable does not take immediate effect when set; rather, it
takes effect upon the next redisplay after the selected window or
-buffer changes. */);
+its buffer changes. */);
DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
doc: /* List of functions called with no args to query before killing a buffer.
@@ -6030,6 +6057,7 @@ There is no reason to change that value except for debugging purposes. */);
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);
defsubr (&Sbuffer_name);
+ defsubr (&Sbuffer_last_name);
defsubr (&Sbuffer_file_name);
defsubr (&Sbuffer_base_buffer);
defsubr (&Sbuffer_local_value);
diff --git a/src/buffer.h b/src/buffer.h
index 80edfdcbc22..bbe1aeff668 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -216,7 +216,7 @@ extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos);
/* Return the byte at byte position N.
Do not check that the position is in range. */
-#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
+#define FETCH_BYTE(n) (*BYTE_POS_ADDR (n))
/* Define the actual buffer data structures. */
@@ -309,6 +309,9 @@ struct buffer
/* The name of this buffer. */
Lisp_Object name_;
+ /* The last name of this buffer before it was renamed or killed. */
+ Lisp_Object last_name_;
+
/* The name of the file visited in this buffer, or nil. */
Lisp_Object filename_;
@@ -1174,8 +1177,6 @@ extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
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 *);
diff --git a/src/bytecode.c b/src/bytecode.c
index e989e5fadf0..8d7240b9966 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -625,9 +625,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
varref:
{
Lisp_Object v1 = vectorp[op], v2;
- if (!SYMBOLP (v1)
- || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
- || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound)))
+ if (!BARE_SYMBOL_P (v1)
+ || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
+ || (v2 = XBARE_SYMBOL (v1)->u.s.val.value,
+ BASE_EQ (v2, Qunbound)))
v2 = Fsymbol_value (v1);
PUSH (v2);
NEXT;
@@ -699,11 +700,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
Lisp_Object val = POP;
/* Inline the most common case. */
- if (SYMBOLP (sym)
+ if (BARE_SYMBOL_P (sym)
&& !BASE_EQ (val, Qunbound)
- && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL
- && !SYMBOL_TRAPPED_WRITE_P (sym))
- SET_SYMBOL_VAL (XSYMBOL (sym), val);
+ && XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL
+ && !XBARE_SYMBOL (sym)->u.s.trapped_write)
+ SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val);
else
set_internal (sym, val, Qnil, SET_INTERNAL_SET);
}
@@ -790,24 +791,22 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
do_debug_on_call (Qlambda, count1);
Lisp_Object original_fun = call_fun;
- if (SYMBOLP (call_fun))
- call_fun = XSYMBOL (call_fun)->u.s.function;
- Lisp_Object template;
- Lisp_Object bytecode;
- if (COMPILEDP (call_fun)
- /* Lexical binding only. */
- && (template = AREF (call_fun, COMPILED_ARGLIST),
- FIXNUMP (template))
- /* No autoloads. */
- && (bytecode = AREF (call_fun, COMPILED_BYTECODE),
- !CONSP (bytecode)))
+ /* Calls to symbols-with-pos don't need to be on the fast path. */
+ if (BARE_SYMBOL_P (call_fun))
+ call_fun = XBARE_SYMBOL (call_fun)->u.s.function;
+ if (COMPILEDP (call_fun))
{
- fun = call_fun;
- bytestr = bytecode;
- args_template = XFIXNUM (template);
- nargs = call_nargs;
- args = call_args;
- goto setup_frame;
+ Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST);
+ if (FIXNUMP (template))
+ {
+ /* Fast path for lexbound functions. */
+ fun = call_fun;
+ bytestr = AREF (call_fun, COMPILED_BYTECODE),
+ args_template = XFIXNUM (template);
+ nargs = call_nargs;
+ args = call_args;
+ goto setup_frame;
+ }
}
Lisp_Object val;
@@ -1738,28 +1737,29 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table))
emacs_abort ();
Lisp_Object v1 = POP;
- ptrdiff_t i;
struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
-
- /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
- here. */
- if (h->count <= 5 && !h->test.cmpfn)
- { /* Do a linear search if there are not many cases
- FIXME: 5 is arbitrarily chosen. */
- for (i = h->count; 0 <= --i; )
- if (EQ (v1, HASH_KEY (h, i)))
- break;
+ /* Do a linear search if there are few cases and the test is `eq'.
+ (The table is assumed to be sized exactly; all entries are
+ consecutive at the beginning.)
+ FIXME: 5 is arbitrarily chosen. */
+ if (h->count <= 5 && !h->test->cmpfn && !symbols_with_pos_enabled)
+ {
+ eassume (h->count >= 2);
+ for (ptrdiff_t i = h->count - 1; i >= 0; i--)
+ if (BASE_EQ (v1, HASH_KEY (h, i)))
+ {
+ op = XFIXNUM (HASH_VALUE (h, i));
+ goto op_branch;
+ }
}
else
- i = hash_lookup (h, v1, NULL);
-
- if (i >= 0)
{
- Lisp_Object val = HASH_VALUE (h, i);
- if (BYTE_CODE_SAFE && !FIXNUMP (val))
- emacs_abort ();
- op = XFIXNUM (val);
- goto op_branch;
+ ptrdiff_t i = hash_lookup (h, v1);
+ if (i >= 0)
+ {
+ op = XFIXNUM (HASH_VALUE (h, i));
+ goto op_branch;
+ }
}
}
NEXT;
diff --git a/src/category.c b/src/category.c
index b539bad31eb..498b6a2a1c9 100644
--- a/src/category.c
+++ b/src/category.c
@@ -51,12 +51,10 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
if (NILP (XCHAR_TABLE (table)->extras[1]))
set_char_table_extras
(table, 1,
- make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
- DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
- Qnil, false));
+ make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false));
struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h, category_set, &hash);
+ hash_hash_t hash;
+ ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash);
if (i >= 0)
return HASH_KEY (h, i);
hash_put (h, category_set, Qnil, hash);
diff --git a/src/ccl.c b/src/ccl.c
index 1d3ad010382..8bb8a78fe3d 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -35,11 +35,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "keyboard.h"
-/* Avoid GCC 12 bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105784>. */
-#if GNUC_PREREQ (12, 0, 0)
-# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value"
-#endif
-
/* Table of registered CCL programs. Each element is a vector of
NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the
name of the program, CCL_PROG (vector) is the compiled code of the
@@ -51,7 +46,7 @@ static Lisp_Object Vccl_program_table;
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
- (XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, (id)))))
+ XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, id)))
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
@@ -609,7 +604,7 @@ while (0)
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579
which causes GCC to mistakenly complain about
popping the mapping stack. */
-#if GNUC_PREREQ (13, 0, 0)
+#if __GNUC__ == 13
# pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds"
#endif
@@ -627,7 +622,7 @@ do \
{ \
struct ccl_program called_ccl; \
if (stack_idx >= 256 \
- || ! setup_ccl_program (&called_ccl, (symbol))) \
+ || ! setup_ccl_program (&called_ccl, symbol)) \
{ \
if (stack_idx > 0) \
{ \
@@ -818,7 +813,7 @@ while (0)
#define CCL_DECODE_CHAR(id, code) \
((id) == 0 ? (code) \
- : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code))))
+ : (charset = CHARSET_FROM_ID (id), DECODE_CHAR (charset, code)))
/* Encode character C by some of charsets in CHARSET_LIST. Set ID to
the id of the used charset, ENCODED to the result of encoding.
@@ -828,9 +823,9 @@ while (0)
do { \
unsigned ncode; \
\
- charset = char_charset ((c), (charset_list), &ncode); \
+ charset = char_charset (c, charset_list, &ncode); \
if (! charset && ! NILP (charset_list)) \
- charset = char_charset ((c), Qnil, &ncode); \
+ charset = char_charset (c, Qnil, &ncode); \
if (charset) \
{ \
(id) = CHARSET_ID (charset); \
@@ -873,7 +868,7 @@ static struct ccl_prog_stack ccl_prog_stack_struct[256];
static inline Lisp_Object
GET_TRANSLATION_TABLE (int id)
{
- return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]);
+ return XCDR (AREF (Vtranslation_table_vector, id));
}
void
@@ -1380,7 +1375,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
eop = (FIXNUM_OVERFLOW_P (reg[RRR])
? -1
- : hash_lookup (h, make_fixnum (reg[RRR]), NULL));
+ : hash_lookup (h, make_fixnum (reg[RRR])));
if (eop >= 0)
{
Lisp_Object opl;
@@ -1409,7 +1404,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
eop = (FIXNUM_OVERFLOW_P (i)
? -1
- : hash_lookup (h, make_fixnum (i), NULL));
+ : hash_lookup (h, make_fixnum (i)));
if (eop >= 0)
{
Lisp_Object opl;
diff --git a/src/ccl.h b/src/ccl.h
index 8eb9d7eb2e8..b8bdcad4c32 100644
--- a/src/ccl.h
+++ b/src/ccl.h
@@ -82,7 +82,7 @@ extern void ccl_driver (struct ccl_program *, int *, int *, int, int,
#define CHECK_CCL_PROGRAM(x) \
do { \
if (NILP (Fccl_program_p (x))) \
- wrong_type_argument (Qcclp, (x)); \
+ wrong_type_argument (Qcclp, x); \
} while (false);
#endif /* EMACS_CCL_H */
diff --git a/src/charset.c b/src/charset.c
index 3aa105e57bd..4bacc011e85 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -850,7 +850,6 @@ usage: (define-charset-internal ...) */)
/* Charset attr vector. */
Lisp_Object attrs;
Lisp_Object val;
- Lisp_Object hash_code;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table);
int i, j;
struct charset charset;
@@ -1108,18 +1107,19 @@ usage: (define-charset-internal ...) */)
CHECK_LIST (args[charset_arg_plist]);
ASET (attrs, charset_plist, args[charset_arg_plist]);
- charset.hash_index = hash_lookup (hash_table, args[charset_arg_name],
- &hash_code);
- if (charset.hash_index >= 0)
+ hash_hash_t hash_code;
+ ptrdiff_t hash_index
+ = hash_lookup_get_hash (hash_table, args[charset_arg_name],
+ &hash_code);
+ if (hash_index >= 0)
{
- new_definition_p = 0;
+ new_definition_p = false;
id = XFIXNAT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
- set_hash_value_slot (hash_table, charset.hash_index, attrs);
+ set_hash_value_slot (hash_table, hash_index, attrs);
}
else
{
- charset.hash_index = hash_put (hash_table, args[charset_arg_name], attrs,
- hash_code);
+ hash_put (hash_table, args[charset_arg_name], attrs, hash_code);
if (charset_table_used == charset_table_size)
{
/* Ensure that charset IDs fit into 'int' as well as into the
@@ -1150,6 +1150,7 @@ usage: (define-charset-internal ...) */)
ASET (attrs, charset_id, make_fixnum (id));
charset.id = id;
+ charset.attributes = attrs;
charset_table[id] = charset;
if (charset.method == CHARSET_METHOD_MAP)
@@ -1790,7 +1791,7 @@ encode_char (struct charset *charset, int c)
return CHARSET_INVALID_CODE (charset);
}
- if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map)
+ if (! CHARSET_FAST_MAP_REF (c, charset->fast_map)
|| c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset))
return CHARSET_INVALID_CODE (charset);
@@ -2269,6 +2270,15 @@ See also `charset-priority-list' and `set-charset-priority'. */)
return charsets;
}
+/* Not strictly necessary, because all charset attributes are also
+ reachable from `Vcharset_hash_table`. */
+void
+mark_charset (void)
+{
+ for (int i = 0; i < charset_table_used; i++)
+ mark_object (charset_table[i].attributes);
+}
+
void
init_charset (void)
diff --git a/src/charset.h b/src/charset.h
index 1743eb4c909..1edb4a248ac 100644
--- a/src/charset.h
+++ b/src/charset.h
@@ -150,8 +150,7 @@ struct charset
/* Index to charset_table. */
int id;
- /* Index to Vcharset_hash_table. */
- ptrdiff_t hash_index;
+ Lisp_Object attributes;
/* Dimension of the charset: 1, 2, 3, or 4. */
int dimension;
@@ -267,18 +266,18 @@ extern int emacs_mule_charset[256];
/* Return the attribute vector of charset whose symbol is SYMBOL. */
#define CHARSET_SYMBOL_ATTRIBUTES(symbol) \
- Fgethash ((symbol), Vcharset_hash_table, Qnil)
-
-#define CHARSET_ATTR_ID(attrs) AREF ((attrs), charset_id)
-#define CHARSET_ATTR_NAME(attrs) AREF ((attrs), charset_name)
-#define CHARSET_ATTR_PLIST(attrs) AREF ((attrs), charset_plist)
-#define CHARSET_ATTR_MAP(attrs) AREF ((attrs), charset_map)
-#define CHARSET_ATTR_DECODER(attrs) AREF ((attrs), charset_decoder)
-#define CHARSET_ATTR_ENCODER(attrs) AREF ((attrs), charset_encoder)
-#define CHARSET_ATTR_SUBSET(attrs) AREF ((attrs), charset_subset)
-#define CHARSET_ATTR_SUPERSET(attrs) AREF ((attrs), charset_superset)
-#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF ((attrs), charset_unify_map)
-#define CHARSET_ATTR_DEUNIFIER(attrs) AREF ((attrs), charset_deunifier)
+ Fgethash (symbol, Vcharset_hash_table, Qnil)
+
+#define CHARSET_ATTR_ID(attrs) AREF (attrs, charset_id)
+#define CHARSET_ATTR_NAME(attrs) AREF (attrs, charset_name)
+#define CHARSET_ATTR_PLIST(attrs) AREF (attrs, charset_plist)
+#define CHARSET_ATTR_MAP(attrs) AREF (attrs, charset_map)
+#define CHARSET_ATTR_DECODER(attrs) AREF (attrs, charset_decoder)
+#define CHARSET_ATTR_ENCODER(attrs) AREF (attrs, charset_encoder)
+#define CHARSET_ATTR_SUBSET(attrs) AREF (attrs, charset_subset)
+#define CHARSET_ATTR_SUPERSET(attrs) AREF (attrs, charset_superset)
+#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF (attrs, charset_unify_map)
+#define CHARSET_ATTR_DEUNIFIER(attrs) AREF (attrs, charset_deunifier)
#define CHARSET_SYMBOL_ID(symbol) \
CHARSET_ATTR_ID (CHARSET_SYMBOL_ATTRIBUTES (symbol))
@@ -286,14 +285,12 @@ extern int emacs_mule_charset[256];
/* Return an index to Vcharset_hash_table of the charset whose symbol
is SYMBOL. */
#define CHARSET_SYMBOL_HASH_INDEX(symbol) \
- hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol, NULL)
+ hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol)
/* Return the attribute vector of CHARSET. */
-#define CHARSET_ATTRIBUTES(charset) \
- (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index))
+#define CHARSET_ATTRIBUTES(charset) (charset)->attributes
#define CHARSET_ID(charset) ((charset)->id)
-#define CHARSET_HASH_INDEX(charset) ((charset)->hash_index)
#define CHARSET_DIMENSION(charset) ((charset)->dimension)
#define CHARSET_CODE_SPACE(charset) ((charset)->code_space)
#define CHARSET_CODE_LINEAR_P(charset) ((charset)->code_linear_p)
@@ -314,21 +311,21 @@ extern int emacs_mule_charset[256];
#define CHARSET_UNIFIED_P(charset) ((charset)->unified_p)
#define CHARSET_NAME(charset) \
- (CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset))
#define CHARSET_MAP(charset) \
- (CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset))
#define CHARSET_DECODER(charset) \
- (CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset))
#define CHARSET_ENCODER(charset) \
- (CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset))
#define CHARSET_SUBSET(charset) \
- (CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset))
#define CHARSET_SUPERSET(charset) \
- (CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset))
#define CHARSET_UNIFY_MAP(charset) \
- (CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset))
#define CHARSET_DEUNIFIER(charset) \
- (CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset)))
+ CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset))
INLINE void
set_charset_attr (struct charset *charset, enum charset_attr_index idx,
@@ -345,7 +342,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx,
#define CHECK_CHARSET(x) \
do { \
if (! SYMBOLP (x) || CHARSET_SYMBOL_HASH_INDEX (x) < 0) \
- wrong_type_argument (Qcharsetp, (x)); \
+ wrong_type_argument (Qcharsetp, x); \
} while (false)
@@ -356,7 +353,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx,
ptrdiff_t idx; \
\
if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \
- wrong_type_argument (Qcharsetp, (x)); \
+ wrong_type_argument (Qcharsetp, x); \
id = XFIXNUM (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \
charset_id)); \
} while (false)
@@ -367,7 +364,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx,
#define CHECK_CHARSET_GET_ATTR(x, attr) \
do { \
if (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \
- wrong_type_argument (Qcharsetp, (x)); \
+ wrong_type_argument (Qcharsetp, x); \
} while (false)
@@ -383,7 +380,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx,
contains the character C. */
#define CHAR_CHARSET(c) \
((c) < 0x80 ? CHARSET_FROM_ID (charset_ascii) \
- : char_charset ((c), Qnil, NULL))
+ : char_charset (c, Qnil, NULL))
#if false
/* Char-table of charset-sets. Each element is a bool vector indexed
@@ -410,18 +407,18 @@ extern Lisp_Object Vchar_charset_set;
: ((code) < (charset)->min_code || (code) > (charset)->max_code) \
? -1 \
: (charset)->unified_p \
- ? decode_char ((charset), (code)) \
+ ? decode_char (charset, code) \
: (charset)->method == CHARSET_METHOD_OFFSET \
? ((charset)->code_linear_p \
? (int) ((code) - (charset)->min_code) + (charset)->code_offset \
- : decode_char ((charset), (code))) \
+ : decode_char (charset, code)) \
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->code_linear_p \
&& VECTORP (CHARSET_DECODER (charset))) \
? XFIXNUM (AREF (CHARSET_DECODER (charset), \
(code) - (charset)->min_code)) \
- : decode_char ((charset), (code))) \
- : decode_char ((charset), (code)))
+ : decode_char (charset, code)) \
+ : decode_char (charset, code))
extern Lisp_Object charset_work;
@@ -462,7 +459,7 @@ extern bool charset_map_loaded;
/* Set CHARSET to the charset highest priority of C, CODE to the
code-point of C in CHARSET. */
#define SPLIT_CHAR(c, charset, code) \
- ((charset) = char_charset ((c), Qnil, &(code)))
+ ((charset) = char_charset (c, Qnil, &(code)))
#define ISO_MAX_DIMENSION 3
@@ -501,15 +498,15 @@ extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
|| ((CHARSET_UNIFIED_P (charset) \
|| (charset)->method == CHARSET_METHOD_SUBSET \
|| (charset)->method == CHARSET_METHOD_SUPERSET) \
- ? encode_char ((charset), (c)) != (charset)->invalid_code \
- : (CHARSET_FAST_MAP_REF ((c), (charset)->fast_map) \
+ ? encode_char (charset, c) != (charset)->invalid_code \
+ : (CHARSET_FAST_MAP_REF (c, (charset)->fast_map) \
&& ((charset)->method == CHARSET_METHOD_OFFSET \
? (c) >= (charset)->min_char && (c) <= (charset)->max_char \
: ((charset)->method == CHARSET_METHOD_MAP \
&& (charset)->compact_codes_p \
&& CHAR_TABLE_P (CHARSET_ENCODER (charset))) \
- ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c))) \
- : encode_char ((charset), (c)) != (charset)->invalid_code))))
+ ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), c)) \
+ : encode_char (charset, c) != (charset)->invalid_code))))
/* Special macros for emacs-mule encoding. */
diff --git a/src/coding.c b/src/coding.c
index 219e3554c18..c51ceb95475 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -314,9 +314,9 @@ static Lisp_Object Vbig5_coding_system;
/* ISO2022 section */
#define CODING_ISO_INITIAL(coding, reg) \
- (XFIXNUM (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
- coding_attr_iso_initial), \
- reg)))
+ XFIXNUM (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
+ coding_attr_iso_initial), \
+ reg))
#define CODING_ISO_REQUEST(coding, charset_id) \
@@ -466,7 +466,7 @@ enum iso_code_class_type
#define CODING_CCL_ENCODER(coding) \
AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
#define CODING_CCL_VALIDS(coding) \
- (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
+ SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids))
/* Index for each coding category in `coding_categories' */
@@ -614,10 +614,11 @@ inhibit_flag (int encoded_flag, bool var)
static bool
growable_destination (struct coding_system *coding)
{
- return STRINGP (coding->dst_object) || BUFFERP (coding->dst_object);
+ return (STRINGP (coding->dst_object)
+ || BUFFERP (coding->dst_object)
+ || NILP (coding->dst_object));
}
-
/* Safely get one byte from the source text pointed by SRC which ends
at SRC_END, and set C to that byte. If there are not enough bytes
in the source, it jumps to 'no_more_source'. If MULTIBYTEP,
@@ -4198,12 +4199,12 @@ decode_coding_iso_2022 (struct coding_system *coding)
#define ENCODE_ISO_CHARACTER(charset, c) \
do { \
unsigned code; \
- CODING_ENCODE_CHAR (coding, dst, dst_end, (charset), (c), code); \
+ CODING_ENCODE_CHAR (coding, dst, dst_end, charset, c, code); \
\
if (CHARSET_DIMENSION (charset) == 1) \
- ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \
+ ENCODE_ISO_CHARACTER_DIMENSION1 (charset, code); \
else \
- ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \
+ ENCODE_ISO_CHARACTER_DIMENSION2 (charset, code >> 8, code & 0xFF); \
} while (0)
@@ -5488,7 +5489,7 @@ decode_coding_charset (struct coding_system *coding)
{
int c;
Lisp_Object val;
- struct charset *charset;
+ struct charset *charset UNINIT;
int dim;
int len = 1;
unsigned code;
@@ -7005,7 +7006,6 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end, ptrdiff_t *nchars)
return Qnil;
}
-
static int
produce_chars (struct coding_system *coding, Lisp_Object translation_table,
bool last_block)
@@ -7063,7 +7063,10 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
|| ckd_add (&dst_size, dst_size, buf_end - buf))
memory_full (SIZE_MAX);
dst = alloc_destination (coding, dst_size, dst);
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ /* Input and output are not C buffers, which are safe to
+ assume to be different. */
+ && !NILP (coding->src_object))
{
coding_set_source (coding);
dst_end = (((unsigned char *) coding->source)
@@ -7098,7 +7101,10 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
const unsigned char *src = coding->source;
const unsigned char *src_end = src + coding->consumed;
- if (EQ (coding->dst_object, coding->src_object))
+ if (EQ (coding->dst_object, coding->src_object)
+ /* Input and output are not C buffers, which are safe to
+ assume to be different. */
+ && !NILP (coding->src_object))
{
eassert (growable_destination (coding));
dst_end = (unsigned char *) src;
@@ -7119,7 +7125,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
if (dst == dst_end)
{
eassert (growable_destination (coding));
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
if (dst == dst_end)
{
@@ -7131,7 +7138,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
coding_set_source (coding);
src = coding->source + offset;
src_end = coding->source + coding->consumed;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
}
}
@@ -7150,14 +7158,16 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
if (dst >= dst_end - 1)
{
eassert (growable_destination (coding));
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
if (dst >= dst_end - 1)
{
ptrdiff_t offset = src - coding->source;
ptrdiff_t more_bytes;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
more_bytes = ((src_end - src) / 2) + 2;
else
more_bytes = src_end - src + 2;
@@ -7166,7 +7176,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
coding_set_source (coding);
src = coding->source + offset;
src_end = coding->source + coding->consumed;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
}
}
@@ -7175,7 +7186,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
}
else
{
- if (!EQ (coding->src_object, coding->dst_object))
+ if (!(EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object)))
{
ptrdiff_t require = coding->src_bytes - coding->dst_bytes;
@@ -7658,8 +7670,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
if (pos == stop_charset)
buf = handle_charset_annotation (pos, end_pos, coding,
buf, &stop_charset);
- stop = (stop_composition < stop_charset
- ? stop_composition : stop_charset);
+ stop = min (stop_composition, stop_charset);
}
if (! multibytep)
diff --git a/src/coding.h b/src/coding.h
index e9b72403c6b..8905e36838d 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -166,35 +166,35 @@ enum coding_attr_index
/* Return the name of a coding system specified by ID. */
#define CODING_ID_NAME(id) \
- (HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id))
+ HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id)
/* Return the attribute vector of a coding system specified by ID. */
#define CODING_ID_ATTRS(id) \
- (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0))
+ AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0)
/* Return the list of aliases of a coding system specified by ID. */
#define CODING_ID_ALIASES(id) \
- (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1))
+ AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1)
/* Return the eol-type of a coding system specified by ID. */
#define CODING_ID_EOL_TYPE(id) \
- (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2))
+ AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2)
/* Return the spec vector of CODING_SYSTEM_SYMBOL. */
#define CODING_SYSTEM_SPEC(coding_system_symbol) \
- (Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil))
+ Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil)
/* Return the ID of CODING_SYSTEM_SYMBOL. */
#define CODING_SYSTEM_ID(coding_system_symbol) \
hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \
- coding_system_symbol, NULL)
+ coding_system_symbol)
/* Return true if CODING_SYSTEM_SYMBOL is a coding system. */
@@ -209,7 +209,7 @@ enum coding_attr_index
do { \
if (CODING_SYSTEM_ID (x) < 0 \
&& NILP (Fcheck_coding_system (x))) \
- wrong_type_argument (Qcoding_system_p, (x)); \
+ wrong_type_argument (Qcoding_system_p, x); \
} while (false)
@@ -225,7 +225,7 @@ enum coding_attr_index
spec = CODING_SYSTEM_SPEC (x); \
} \
if (NILP (spec)) \
- wrong_type_argument (Qcoding_system_p, (x)); \
+ wrong_type_argument (Qcoding_system_p, x); \
} while (false)
@@ -242,7 +242,7 @@ enum coding_attr_index
id = CODING_SYSTEM_ID (x); \
} \
if (id < 0) \
- wrong_type_argument (Qcoding_system_p, (x)); \
+ wrong_type_argument (Qcoding_system_p, x); \
} while (false)
@@ -745,10 +745,9 @@ extern Lisp_Object from_unicode_buffer (const wchar_t *wstr);
#define decode_coding_c_string(coding, src, bytes, dst_object) \
do { \
- (coding)->source = (src); \
- (coding)->src_chars = (coding)->src_bytes = (bytes); \
- decode_coding_object ((coding), Qnil, 0, 0, (bytes), (bytes), \
- (dst_object)); \
+ (coding)->source = src; \
+ (coding)->src_chars = (coding)->src_bytes = bytes; \
+ decode_coding_object (coding, Qnil, 0, 0, bytes, bytes, dst_object); \
} while (false)
diff --git a/src/comp.c b/src/comp.c
index 6cb35a8619a..99f51e07048 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -469,7 +469,7 @@ load_gccjit_if_necessary (bool mandatory)
/* Increase this number to force a new Vcomp_abi_hash to be generated. */
-#define ABI_VERSION "5"
+#define ABI_VERSION "6"
/* Length of the hashes used for eln file naming. */
#define HASH_LENGTH 8
@@ -502,11 +502,9 @@ load_gccjit_if_necessary (bool mandatory)
#define THIRD(x) \
XCAR (XCDR (XCDR (x)))
-#if 0 /* unused for now */
/* Like call0 but stringify and intern. */
#define CALL0I(fun) \
CALLN (Ffuncall, intern_c_string (STR (fun)))
-#endif
/* Like call1 but stringify and intern. */
#define CALL1I(fun, arg) \
@@ -522,7 +520,7 @@ load_gccjit_if_necessary (bool mandatory)
#define DECL_BLOCK(name, func) \
gcc_jit_block *(name) = \
- gcc_jit_function_new_block ((func), STR (name))
+ gcc_jit_function_new_block (func, STR (name))
#ifndef WINDOWSNT
# ifdef HAVE__SETJMP
@@ -702,6 +700,8 @@ static void helper_save_restriction (void);
static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type);
static struct Lisp_Symbol_With_Pos *
helper_GET_SYMBOL_WITH_POSITION (Lisp_Object);
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object, Lisp_Object);
/* Note: helper_link_table must match the list created by
`declare_runtime_imported_funcs'. */
@@ -714,6 +714,7 @@ static void *helper_link_table[] =
helper_unbind_n,
helper_save_restriction,
helper_GET_SYMBOL_WITH_POSITION,
+ helper_sanitizer_assert,
record_unwind_current_buffer,
set_internal,
helper_unwind_protect,
@@ -2442,7 +2443,7 @@ emit_limple_insn (Lisp_Object insn)
{
Lisp_Object arg1 = arg[1];
- if (EQ (Ftype_of (arg1), Qcomp_mvar))
+ if (EQ (Fcl_type_of (arg1), Qcomp_mvar))
res = emit_mvar_rval (arg1);
else if (EQ (FIRST (arg1), Qcall))
res = emit_limple_call (XCDR (arg1));
@@ -2975,6 +2976,10 @@ declare_runtime_imported_funcs (void)
ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION, comp.lisp_symbol_with_position_ptr_type,
1, args);
+ args[0] = comp.lisp_obj_type;
+ args[1] = comp.lisp_obj_type;
+ ADD_IMPORTED (helper_sanitizer_assert, comp.lisp_obj_type, 2, args);
+
ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL);
args[0] = args[1] = args[2] = comp.lisp_obj_type;
@@ -4330,11 +4335,10 @@ compile_function (Lisp_Object func)
declare_block (Qentry);
Lisp_Object blocks = CALL1I (comp-func-blocks, func);
struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ DOHASH_SAFE (ht, i)
{
Lisp_Object block_name = HASH_KEY (ht, i);
- if (!EQ (block_name, Qentry)
- && !BASE_EQ (block_name, Qunbound))
+ if (!EQ (block_name, Qentry))
declare_block (block_name);
}
@@ -4344,24 +4348,21 @@ compile_function (Lisp_Object func)
gcc_jit_lvalue_as_rvalue (comp.func_relocs));
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ DOHASH_SAFE (ht, i)
{
Lisp_Object block_name = HASH_KEY (ht, i);
- if (!BASE_EQ (block_name, Qunbound))
+ Lisp_Object block = HASH_VALUE (ht, i);
+ Lisp_Object insns = CALL1I (comp-block-insns, block);
+ if (NILP (block) || NILP (insns))
+ xsignal1 (Qnative_ice,
+ build_string ("basic block is missing or empty"));
+
+ comp.block = retrive_block (block_name);
+ while (CONSP (insns))
{
- Lisp_Object block = HASH_VALUE (ht, i);
- Lisp_Object insns = CALL1I (comp-block-insns, block);
- if (NILP (block) || NILP (insns))
- xsignal1 (Qnative_ice,
- build_string ("basic block is missing or empty"));
-
- comp.block = retrive_block (block_name);
- while (CONSP (insns))
- {
- Lisp_Object insn = XCAR (insns);
- emit_limple_insn (insn);
- insns = XCDR (insns);
- }
+ Lisp_Object insn = XCAR (insns);
+ emit_limple_insn (insn);
+ insns = XCDR (insns);
}
}
const char *err = gcc_jit_context_get_first_error (comp.ctxt);
@@ -4623,6 +4624,8 @@ Return t on success. */)
emit_simple_limple_call_void_ret);
register_emitter (Qhelper_save_restriction,
emit_simple_limple_call_void_ret);
+ register_emitter (Qhelper_sanitizer_assert,
+ emit_simple_limple_call_lisp_ret);
/* Inliners. */
register_emitter (Qadd1, emit_add1);
register_emitter (Qsub1, emit_sub1);
@@ -4863,8 +4866,8 @@ add_compiler_options (void)
#endif
}
-DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
- Scomp__compile_ctxt_to_file,
+DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0,
+ Scomp__compile_ctxt_to_file0,
1, 1, 0,
doc: /* Compile the current context as native code to file FILENAME. */)
(Lisp_Object filename)
@@ -4965,14 +4968,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
struct Lisp_Hash_Table *func_h =
XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt));
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
- if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound))
- declare_function (HASH_VALUE (func_h, i));
+ DOHASH_SAFE (func_h, i)
+ declare_function (HASH_VALUE (func_h, i));
/* Compile all functions. Can't be done before because the
relocation structs has to be already defined. */
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
- if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound))
- compile_function (HASH_VALUE (func_h, i));
+ DOHASH_SAFE (func_h, i)
+ compile_function (HASH_VALUE (func_h, i));
/* Work around bug#46495 (GCC PR99126). */
#if defined (WIDE_EMACS_INT) \
@@ -5088,6 +5089,21 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
}
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object val, Lisp_Object type)
+{
+ if (!comp_sanitizer_active
+ || !NILP ((CALL2I (cl-typep, val, type))))
+ return Qnil;
+
+ AUTO_STRING (format, "Comp sanitizer FAIL for %s with type %s");
+ CALLN (Fmessage, format, val, type);
+ CALL0I (backtrace);
+ xsignal2 (Qcomp_sanitizer_error, val, type);
+
+ return Qnil;
+}
+
/* `native-comp-eln-load-path' clean-up support code. */
@@ -5715,6 +5731,7 @@ natively-compiled one. */);
DEFSYM (Qhelper_unbind_n, "helper_unbind_n");
DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect");
DEFSYM (Qhelper_save_restriction, "helper_save_restriction");
+ DEFSYM (Qhelper_sanitizer_assert, "helper_sanitizer_assert");
/* Inliners. */
DEFSYM (Qadd1, "1+");
DEFSYM (Qsub1, "1-");
@@ -5785,6 +5802,12 @@ natively-compiled one. */);
build_pure_c_string ("eln file inconsistent with current runtime "
"configuration, please recompile"));
+ DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error");
+ Fput (Qcomp_sanitizer_error, Qerror_conditions,
+ pure_list (Qcomp_sanitizer_error, Qerror));
+ Fput (Qcomp_sanitizer_error, Qerror_message,
+ build_pure_c_string ("Native code sanitizer runtime error"));
+
DEFSYM (Qnative__compile_async, "native--compile-async");
defsubr (&Scomp__subr_signature);
@@ -5795,7 +5818,7 @@ natively-compiled one. */);
defsubr (&Scomp__install_trampoline);
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
- defsubr (&Scomp__compile_ctxt_to_file);
+ defsubr (&Scomp__compile_ctxt_to_file0);
defsubr (&Scomp_libgccjit_version);
defsubr (&Scomp__register_lambda);
defsubr (&Scomp__register_subr);
@@ -5907,6 +5930,14 @@ subr-name -> arity
For internal use. */);
Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+ DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active,
+ doc: /* If non-nil, enable runtime execution of native-compiler sanitizer.
+For this to be effective, Lisp code must be compiled
+with `comp-sanitizer-emit' non-nil.
+This is intended to be used only for development and
+verification of the native compiler. */);
+ comp_sanitizer_active = false;
+
Fprovide (intern_c_string ("native-compile"), Qnil);
#endif /* #ifdef HAVE_NATIVE_COMP */
diff --git a/src/composite.c b/src/composite.c
index 91836fa2a8f..e89d923168a 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -166,7 +166,7 @@ ptrdiff_t
get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
Lisp_Object prop, Lisp_Object string)
{
- Lisp_Object id, length, components, key, *key_contents, hash_code;
+ Lisp_Object id, length, components, key, *key_contents;
ptrdiff_t glyph_len;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
ptrdiff_t hash_index;
@@ -240,7 +240,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
else
goto invalid_composition;
- hash_index = hash_lookup (hash_table, key, &hash_code);
+ hash_hash_t hash_code;
+ hash_index = hash_lookup_get_hash (hash_table, key, &hash_code);
if (hash_index >= 0)
{
/* We have already registered the same composition. Change PROP
@@ -320,7 +321,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
cmp = xmalloc (sizeof *cmp);
cmp->method = method;
- cmp->hash_index = hash_index;
+ cmp->key = key;
cmp->glyph_len = glyph_len;
cmp->offsets = xnmalloc (glyph_len, 2 * sizeof *cmp->offsets);
cmp->font = NULL;
@@ -642,10 +643,7 @@ static Lisp_Object gstring_hash_table;
Lisp_Object
composition_gstring_lookup_cache (Lisp_Object header)
{
- struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- ptrdiff_t i = hash_lookup (h, header, NULL);
-
- return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
+ return Fgethash (header, gstring_hash_table, Qnil);
}
Lisp_Object
@@ -653,7 +651,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
Lisp_Object header = LGSTRING_HEADER (gstring);
- Lisp_Object hash = h->test.hashfn (header, h);
+ EMACS_UINT hash = hash_from_key (h, header);
if (len < 0)
{
ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring);
@@ -675,7 +673,7 @@ Lisp_Object
composition_gstring_from_id (ptrdiff_t id)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
-
+ /* FIXME: The stability of this value depends on the hash table internals! */
return HASH_VALUE (h, id);
}
@@ -686,18 +684,9 @@ composition_gstring_cache_clear_font (Lisp_Object font_object)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- Lisp_Object k = HASH_KEY (h, i);
-
- if (!BASE_EQ (k, Qunbound))
- {
- Lisp_Object gstring = HASH_VALUE (h, i);
-
- if (EQ (LGSTRING_FONT (gstring), font_object))
- hash_remove_from_table (h, k);
- }
- }
+ DOHASH (h, k, gstring)
+ if (EQ (LGSTRING_FONT (gstring), font_object))
+ hash_remove_from_table (h, k);
}
DEFUN ("clear-composition-cache", Fclear_composition_cache,
@@ -1158,12 +1147,12 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
}
else if (charpos > endpos)
{
- /* Search backward for a pattern that may be composed and the
- position of (possibly) the last character of the match is
+ /* Search backward for a pattern that may be composed such that
+ the position of (possibly) the last character of the match is
closest to (but not after) START. The reason for the last
- character is that set_iterator_to_next works in reverse order,
- and thus we must stop at the last character for composition
- check. */
+ character is that set_iterator_to_next works in reverse
+ order, and thus we must stop at the last character for
+ composition check. */
unsigned char *p;
int len;
/* Limit byte position used in fast_looking_at. This is the
@@ -1176,6 +1165,22 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
p = SDATA (string) + bytepos;
c = string_char_and_length (p, &len);
limit = bytepos + len;
+ /* The algorithmic idea behind the loop below is somewhat tricky
+ and subtle. Keep in mind that any arbitrarily long sequence
+ of composable characters can potentially be composed to end
+ at or before START. So the fact that we find a character C
+ before START that can be composed with several following
+ characters does not mean we can exit the loop, because some
+ character before C could also be composed, yielding a longer
+ composed sequence which ends closer to START. And since a
+ composition can be arbitrarily long, it is very important to
+ know where to stop the search back, because the default --
+ BEGV -- could be VERY far away. Since searching back is only
+ needed when delivering bidirectional text reordered for
+ display, and since no character composition can ever cross
+ into another embedding level, the search could end when it
+ gets to the end of the current embedding level, but this
+ limit should be imposed by the caller. */
while (char_composable_p (c))
{
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
@@ -2159,6 +2164,16 @@ of the way buffer text is examined for matching one of the rules. */)
}
+/* Not strictly necessary, because all those "keys" are also
+ reachable from `composition_hash_table`. */
+void
+mark_composite (void)
+{
+ for (int i = 0; i < n_compositions; i++)
+ mark_object (composition_table[i]->key);
+}
+
+
void
syms_of_composite (void)
{
diff --git a/src/composite.h b/src/composite.h
index c99888ccec2..4b412cea696 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -84,23 +84,20 @@ composition_registered_p (Lisp_Object prop)
? XCDR (XCDR (XCDR (prop))) \
: CONSP (prop) ? XCDR (prop) : Qnil)
+#define COMPOSITION_KEY(cmp) (cmp)->key
+
/* Return the Nth glyph of composition specified by CMP. CMP is a
pointer to `struct composition'. */
#define COMPOSITION_GLYPH(cmp, n) \
- XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
- ->key_and_value) \
- ->contents[cmp->hash_index * 2]) \
- ->contents[cmp->method == COMPOSITION_WITH_RULE_ALTCHARS \
- ? (n) * 2 : (n)])
+ XFIXNUM (AREF (COMPOSITION_KEY (cmp), \
+ (cmp)->method == COMPOSITION_WITH_RULE_ALTCHARS \
+ ? (n) * 2 : (n)))
/* Return the encoded composition rule to compose the Nth glyph of
rule-base composition specified by CMP. CMP is a pointer to
`struct composition'. */
-#define COMPOSITION_RULE(cmp, n) \
- XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
- ->key_and_value) \
- ->contents[cmp->hash_index * 2]) \
- ->contents[(n) * 2 - 1])
+#define COMPOSITION_RULE(cmp, n) \
+ XFIXNUM (AREF (COMPOSITION_KEY (cmp), (n) * 2 - 1))
/* Decode encoded composition rule RULE_CODE into GREF (global
reference point code), NREF (new ref. point code). Don't check RULE_CODE;
@@ -165,8 +162,8 @@ struct composition {
/* Method of the composition. */
enum composition_method method;
- /* Index to the composition hash table. */
- ptrdiff_t hash_index;
+ /* The key under which it's found in the composition hash table. */
+ Lisp_Object key;
/* For which font we have calculated the remaining members. The
actual type is device dependent. */
@@ -202,6 +199,7 @@ extern bool find_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *,
extern void update_compositions (ptrdiff_t, ptrdiff_t, int);
extern void make_composition_value_copy (Lisp_Object);
extern void syms_of_composite (void);
+extern void mark_composite (void);
extern void compose_text (ptrdiff_t, ptrdiff_t, Lisp_Object, Lisp_Object,
Lisp_Object);
@@ -262,8 +260,8 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop)
#define LGSTRING_CHAR(lgs, i) AREF (LGSTRING_HEADER (lgs), (i) + 1)
#define LGSTRING_CHAR_LEN(lgs) (ASIZE (LGSTRING_HEADER (lgs)) - 1)
-#define LGSTRING_SET_FONT(lgs, val) ASET (LGSTRING_HEADER (lgs), 0, (val))
-#define LGSTRING_SET_CHAR(lgs, i, c) ASET (LGSTRING_HEADER (lgs), (i) + 1, (c))
+#define LGSTRING_SET_FONT(lgs, val) ASET (LGSTRING_HEADER (lgs), 0, val)
+#define LGSTRING_SET_CHAR(lgs, i, c) ASET (LGSTRING_HEADER (lgs), (i) + 1, c)
#define LGSTRING_ID(lgs) AREF (lgs, 1)
#define LGSTRING_SET_ID(lgs, id) ASET (lgs, 1, id)
@@ -272,9 +270,9 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop)
LGSTRING can hold. This is NOT the actual number of valid LGLYPHs;
to find the latter, walk the glyphs returned by LGSTRING_GLYPH
until the first one that is nil. */
-#define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2)
-#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2)
-#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val))
+#define LGSTRING_GLYPH_LEN(lgs) (ASIZE (lgs) - 2)
+#define LGSTRING_GLYPH(lgs, idx) AREF (lgs, (idx) + 2)
+#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET (lgs, (idx) + 2, val)
INLINE Lisp_Object *
lgstring_glyph_addr (Lisp_Object lgs, ptrdiff_t idx)
{
@@ -300,33 +298,33 @@ enum lglyph_indices
contributed to the glyph (since there isn't a 1:1 correspondence
between composed characters and the font glyphs). */
#define LGLYPH_NEW() make_nil_vector (LGLYPH_SIZE)
-#define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM))
-#define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO))
-#define LGLYPH_CHAR(g) XFIXNUM (AREF ((g), LGLYPH_IX_CHAR))
+#define LGLYPH_FROM(g) XFIXNUM (AREF (g, LGLYPH_IX_FROM))
+#define LGLYPH_TO(g) XFIXNUM (AREF (g, LGLYPH_IX_TO))
+#define LGLYPH_CHAR(g) XFIXNUM (AREF (g, LGLYPH_IX_CHAR))
#define LGLYPH_CODE(g) \
- (NILP (AREF ((g), LGLYPH_IX_CODE)) \
+ (NILP (AREF (g, LGLYPH_IX_CODE)) \
? FONT_INVALID_CODE \
: cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned)))
-#define LGLYPH_WIDTH(g) XFIXNUM (AREF ((g), LGLYPH_IX_WIDTH))
-#define LGLYPH_LBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_LBEARING))
-#define LGLYPH_RBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_RBEARING))
-#define LGLYPH_ASCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_ASCENT))
-#define LGLYPH_DESCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_DESCENT))
-#define LGLYPH_ADJUSTMENT(g) AREF ((g), LGLYPH_IX_ADJUSTMENT)
-#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_fixnum (val))
-#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_fixnum (val))
-#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_fixnum (val))
+#define LGLYPH_WIDTH(g) XFIXNUM (AREF (g, LGLYPH_IX_WIDTH))
+#define LGLYPH_LBEARING(g) XFIXNUM (AREF (g, LGLYPH_IX_LBEARING))
+#define LGLYPH_RBEARING(g) XFIXNUM (AREF (g, LGLYPH_IX_RBEARING))
+#define LGLYPH_ASCENT(g) XFIXNUM (AREF (g, LGLYPH_IX_ASCENT))
+#define LGLYPH_DESCENT(g) XFIXNUM (AREF (g, LGLYPH_IX_DESCENT))
+#define LGLYPH_ADJUSTMENT(g) AREF (g, LGLYPH_IX_ADJUSTMENT)
+#define LGLYPH_SET_FROM(g, val) ASET (g, LGLYPH_IX_FROM, make_fixnum (val))
+#define LGLYPH_SET_TO(g, val) ASET (g, LGLYPH_IX_TO, make_fixnum (val))
+#define LGLYPH_SET_CHAR(g, val) ASET (g, LGLYPH_IX_CHAR, make_fixnum (val))
/* Callers must assure that VAL is not negative! */
#define LGLYPH_SET_CODE(g, val) \
ASET (g, LGLYPH_IX_CODE, \
val == FONT_INVALID_CODE ? Qnil : INT_TO_INTEGER (val))
-#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val))
-#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum (val))
-#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_fixnum (val))
-#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_fixnum (val))
-#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_fixnum (val))
-#define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), LGLYPH_IX_ADJUSTMENT, (val))
+#define LGLYPH_SET_WIDTH(g, val) ASET (g, LGLYPH_IX_WIDTH, make_fixnum (val))
+#define LGLYPH_SET_LBEARING(g, val) ASET (g, LGLYPH_IX_LBEARING, make_fixnum (val))
+#define LGLYPH_SET_RBEARING(g, val) ASET (g, LGLYPH_IX_RBEARING, make_fixnum (val))
+#define LGLYPH_SET_ASCENT(g, val) ASET (g, LGLYPH_IX_ASCENT, make_fixnum (val))
+#define LGLYPH_SET_DESCENT(g, val) ASET (g, LGLYPH_IX_DESCENT, make_fixnum (val))
+#define LGLYPH_SET_ADJUSTMENT(g, val) ASET (g, LGLYPH_IX_ADJUSTMENT, val)
#define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \
? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0)
diff --git a/src/conf_post.h b/src/conf_post.h
index 7701bcf40b2..f2353803074 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -178,8 +178,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
/* Things that lib/reg* wants. */
-#define mbrtowc(pwc, s, n, ps) mbtowc ((pwc), (s), (n))
-#define wcrtomb(s, wc, ps) wctomb ((s), (wc))
+#define mbrtowc(pwc, s, n, ps) mbtowc (pwc, s, n)
+#define wcrtomb(s, wc, ps) wctomb (s, wc)
#define btowc(b) ((wchar_t) (b))
#define towupper(chr) toupper (chr)
#define towlower(chr) tolower (chr)
@@ -317,7 +317,7 @@ extern int emacs_setenv_TZ (char const *);
type _GL_ATTRIBUTE_MAY_ALIAS *name = (type *) (addr)
#if 3 <= __GNUC__
-# define ATTRIBUTE_SECTION(name) __attribute__((section (name)))
+# define ATTRIBUTE_SECTION(name) __attribute__ ((section (name)))
#else
# define ATTRIBUTE_SECTION(name)
#endif
@@ -471,3 +471,7 @@ extern int emacs_setenv_TZ (char const *);
#undef MB_CUR_MAX
#define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX
#endif /* REPLACEMENT_MB_CUR_MAX */
+
+/* Emacs does not need glibc strftime behavior for AM and PM
+ indicators. */
+#define REQUIRE_GNUISH_STRFTIME_AM_PM false
diff --git a/src/data.c b/src/data.c
index 0c47750cb75..c4b9cff8ae0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <math.h>
#include <stdio.h>
-#include <byteswap.h>
#include <count-one-bits.h>
#include <count-trailing-zeros.h>
#include <intprops.h>
@@ -193,16 +192,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0,
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
doc: /* Return a symbol representing the type of OBJECT.
The symbol returned names the object's basic type;
-for example, (type-of 1) returns `integer'. */)
+for example, (type-of 1) returns `integer'.
+Contrary to `cl-type-of', the returned type is not always the most
+precise type possible, because instead this function tries to preserve
+compatibility with the return value of previous Emacs versions. */)
+ (Lisp_Object object)
+{
+ return SYMBOLP (object) ? Qsymbol
+ : INTEGERP (object) ? Qinteger
+ : SUBRP (object) ? Qsubr
+ : Fcl_type_of (object);
+}
+
+DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
+ doc: /* Return a symbol representing the type of OBJECT.
+The returned symbol names the most specific possible type of the object.
+for example, (cl-type-of nil) returns `null'.
+The specific type returned may change depending on Emacs versions,
+so we recommend you use `cl-typep', `cl-typecase', or other predicates
+rather than compare the return value of this function against
+a fixed set of types. */)
(Lisp_Object object)
{
switch (XTYPE (object))
{
case_Lisp_Int:
- return Qinteger;
+ return Qfixnum;
case Lisp_Symbol:
- return Qsymbol;
+ return NILP (object) ? Qnull
+ : EQ (object, Qt) ? Qboolean
+ : Qsymbol;
case Lisp_String:
return Qstring;
@@ -211,11 +231,11 @@ for example, (type-of 1) returns `integer'. */)
return Qcons;
case Lisp_Vectorlike:
- /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */
+ /* WARNING!! Keep 'cl--type-hierarchy' in sync with this code!! */
switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
{
case PVEC_NORMAL_VECTOR: return Qvector;
- case PVEC_BIGNUM: return Qinteger;
+ case PVEC_BIGNUM: return Qbignum;
case PVEC_MARKER: return Qmarker;
case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos;
case PVEC_OVERLAY: return Qoverlay;
@@ -224,13 +244,17 @@ for example, (type-of 1) returns `integer'. */)
case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
case PVEC_PROCESS: return Qprocess;
case PVEC_WINDOW: return Qwindow;
- case PVEC_SUBR: return Qsubr;
+ case PVEC_SUBR:
+ return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
+ : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
+ : Qprimitive_function;
case PVEC_COMPILED: return Qcompiled_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
+ case PVEC_OBARRAY: return Qobarray;
case PVEC_FONT:
if (FONT_SPEC_P (object))
return Qfont_spec;
@@ -338,7 +362,8 @@ DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0,
}
DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a symbol together with position. */
+ doc: /* Return t if OBJECT is a symbol together with position.
+Ignore `symbols-with-pos-enabled'. */
attributes: const)
(Lisp_Object object)
{
@@ -788,55 +813,54 @@ Doing that might make Emacs dysfunctional, and might even crash Emacs. */)
}
DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
- doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */)
+ doc: /* Extract, if need be, the bare symbol from SYM.
+SYM is either a symbol or a symbol with position.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym)
{
if (BARE_SYMBOL_P (sym))
return sym;
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_SYM (sym);
+ if (SYMBOL_WITH_POS_P (sym))
+ return XSYMBOL_WITH_POS_SYM (sym);
+ xsignal2 (Qwrong_type_argument, list2 (Qsymbolp, Qsymbol_with_pos_p), sym);
}
DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0,
- doc: /* Extract the position from a symbol with position. */)
- (register Lisp_Object ls)
+ doc: /* Extract the position from the symbol with position SYMPOS.
+Ignore `symbols-with-pos-enabled'. */)
+ (register Lisp_Object sympos)
{
- /* Type checking is done in the following macro. */
- return SYMBOL_WITH_POS_POS (ls);
+ CHECK_TYPE (SYMBOL_WITH_POS_P (sympos), Qsymbol_with_pos_p, sympos);
+ return XSYMBOL_WITH_POS_POS (sympos);
}
DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol,
Sremove_pos_from_symbol, 1, 1, 0,
doc: /* If ARG is a symbol with position, return it without the position.
-Otherwise, return ARG unchanged. Compare with `bare-symbol'. */)
+Otherwise, return ARG unchanged. Ignore `symbols-with-pos-enabled'.
+Compare with `bare-symbol'. */)
(register Lisp_Object arg)
{
if (SYMBOL_WITH_POS_P (arg))
- return (SYMBOL_WITH_POS_SYM (arg));
+ return XSYMBOL_WITH_POS_SYM (arg);
return arg;
}
DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0,
- doc: /* Create a new symbol with position.
+ doc: /* Make a new symbol with position.
SYM is a symbol, with or without position, the symbol to position.
-POS, the position, is either a fixnum or a symbol with position from which
-the position will be taken. */)
+POS, the position, is either a nonnegative fixnum,
+or a symbol with position from which the position will be taken.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym, register Lisp_Object pos)
{
- Lisp_Object bare;
+ Lisp_Object bare = Fbare_symbol (sym);
Lisp_Object position;
- if (BARE_SYMBOL_P (sym))
- bare = sym;
- else if (SYMBOL_WITH_POS_P (sym))
- bare = XSYMBOL_WITH_POS (sym)->sym;
- else
- wrong_type_argument (Qsymbolp, sym);
-
if (FIXNUMP (pos))
position = pos;
else if (SYMBOL_WITH_POS_P (pos))
- position = XSYMBOL_WITH_POS (pos)->pos;
+ position = XSYMBOL_WITH_POS_POS (pos);
else
wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos);
@@ -3810,30 +3834,6 @@ count_trailing_zero_bits (bits_word val)
}
}
-static bits_word
-bits_word_to_host_endian (bits_word val)
-{
-#ifndef WORDS_BIGENDIAN
- return val;
-#else
- if (BITS_WORD_MAX >> 31 == 1)
- return bswap_32 (val);
- if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
- return bswap_64 (val);
- {
- int i;
- bits_word r = 0;
- for (i = 0; i < sizeof val; i++)
- {
- r = ((r << 1 << (CHAR_BIT - 1))
- | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
- val = val >> 1 >> (CHAR_BIT - 1);
- }
- return r;
- }
-#endif
-}
-
DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or,
Sbool_vector_exclusive_or, 2, 3, 0,
doc: /* Return A ^ B, bitwise exclusive or.
@@ -4047,6 +4047,7 @@ syms_of_data (void)
DEFSYM (Qminibuffer_quit, "minibuffer-quit");
DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
+ DEFSYM (Qtype_mismatch, "type-mismatch")
DEFSYM (Qargs_out_of_range, "args-out-of-range");
DEFSYM (Qvoid_function, "void-function");
DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection");
@@ -4138,6 +4139,7 @@ syms_of_data (void)
PUT_ERROR (Quser_error, error_tail, "");
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
+ PUT_ERROR (Qtype_mismatch, error_tail, "Types do not match");
PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
PUT_ERROR (Qvoid_function, error_tail,
"Symbol's function definition is void");
@@ -4201,7 +4203,9 @@ syms_of_data (void)
"Variable binding depth exceeds max-specpdl-size");
/* Types that type-of returns. */
+ DEFSYM (Qboolean, "boolean");
DEFSYM (Qinteger, "integer");
+ DEFSYM (Qbignum, "bignum");
DEFSYM (Qsymbol, "symbol");
DEFSYM (Qstring, "string");
DEFSYM (Qcons, "cons");
@@ -4217,6 +4221,9 @@ syms_of_data (void)
DEFSYM (Qprocess, "process");
DEFSYM (Qwindow, "window");
DEFSYM (Qsubr, "subr");
+ DEFSYM (Qspecial_form, "special-form");
+ DEFSYM (Qprimitive_function, "primitive-function");
+ DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
@@ -4238,6 +4245,7 @@ syms_of_data (void)
DEFSYM (Qtreesit_parser, "treesit-parser");
DEFSYM (Qtreesit_node, "treesit-node");
DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query");
+ DEFSYM (Qobarray, "obarray");
DEFSYM (Qdefun, "defun");
@@ -4253,6 +4261,7 @@ syms_of_data (void)
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
+ defsubr (&Scl_type_of);
defsubr (&Slistp);
defsubr (&Snlistp);
defsubr (&Sconsp);
@@ -4381,7 +4390,7 @@ This variable cannot be set; trying to do so will signal an error. */);
DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled");
DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled,
- doc: /* Non-nil when "symbols with position" can be used as symbols.
+ doc: /* If non-nil, a symbol with position ordinarily behaves as its bare symbol.
Bind this to non-nil in applications such as the byte compiler. */);
symbols_with_pos_enabled = false;
diff --git a/src/dired.c b/src/dired.c
index 9a372201ae0..bfbacf70917 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -351,7 +351,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
specpdl_ptr = specpdl_ref_to_ptr (count);
if (NILP (nosort))
- list = Fsort (Fnreverse (list),
+ list = CALLN (Fsort, Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
diff --git a/src/dispextern.h b/src/dispextern.h
index 6cab3ff243e..1c3232fae3d 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -315,7 +315,7 @@ struct text_pos
/* Set marker MARKER from text position POS. */
#define SET_MARKER_FROM_TEXT_POS(MARKER, POS) \
- set_marker_both ((MARKER), Qnil, CHARPOS ((POS)), BYTEPOS ((POS)))
+ set_marker_both (MARKER, Qnil, CHARPOS (POS), BYTEPOS (POS))
/* Value is non-zero if character and byte positions of POS1 and POS2
are equal. */
@@ -399,7 +399,7 @@ GLYPH_CODE_FACE (Lisp_Object gc)
SET_GLYPH (glyph, XFIXNUM (XCAR (gc)), XFIXNUM (XCDR (gc))); \
else \
SET_GLYPH (glyph, (XFIXNUM (gc) & ((1 << CHARACTERBITS)-1)), \
- (XFIXNUM (gc) >> CHARACTERBITS)); \
+ XFIXNUM (gc) >> CHARACTERBITS); \
} \
while (false)
@@ -676,9 +676,9 @@ struct glyph
defined in lisp.h. */
#define SET_CHAR_GLYPH_FROM_GLYPH(GLYPH, FROM) \
- SET_CHAR_GLYPH ((GLYPH), \
- GLYPH_CHAR ((FROM)), \
- GLYPH_FACE ((FROM)), \
+ SET_CHAR_GLYPH (GLYPH, \
+ GLYPH_CHAR (FROM), \
+ GLYPH_FACE (FROM), \
false)
/* Construct a glyph code from a character glyph GLYPH. If the
@@ -689,9 +689,9 @@ struct glyph
do \
{ \
if ((GLYPH).u.ch < 256) \
- SET_GLYPH ((G), (GLYPH).u.ch, ((GLYPH).face_id)); \
+ SET_GLYPH (G, (GLYPH).u.ch, (GLYPH).face_id); \
else \
- SET_GLYPH ((G), -1, 0); \
+ SET_GLYPH (G, -1, 0); \
} \
while (false)
@@ -837,7 +837,7 @@ struct glyph_matrix
#ifdef GLYPH_DEBUG
void check_matrix_pointer_lossage (struct glyph_matrix *);
-#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage ((MATRIX))
+#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage (MATRIX)
#else
#define CHECK_MATRIX(MATRIX) ((void) 0)
#endif
@@ -1130,7 +1130,7 @@ struct glyph_row
#ifdef GLYPH_DEBUG
struct glyph_row *matrix_row (struct glyph_matrix *, int);
-#define MATRIX_ROW(MATRIX, ROW) matrix_row ((MATRIX), (ROW))
+#define MATRIX_ROW(MATRIX, ROW) matrix_row (MATRIX, ROW)
#else
#define MATRIX_ROW(MATRIX, ROW) ((MATRIX)->rows + (ROW))
#endif
@@ -1166,12 +1166,12 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
MATRIX. */
#define MATRIX_ROW_GLYPH_START(MATRIX, ROW) \
- (MATRIX_ROW ((MATRIX), (ROW))->glyphs[TEXT_AREA])
+ (MATRIX_ROW (MATRIX, ROW)->glyphs[TEXT_AREA])
/* Return the number of used glyphs in the text area of a row. */
#define MATRIX_ROW_USED(MATRIX, ROW) \
- (MATRIX_ROW ((MATRIX), (ROW))->used[TEXT_AREA])
+ (MATRIX_ROW (MATRIX, ROW)->used[TEXT_AREA])
/* Return the character/ byte position at which the display of ROW
starts. BIDI Note: this is the smallest character/byte position
@@ -1201,7 +1201,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \
((MATRIX)->rows \
+ (MATRIX)->nrows \
- - (window_wants_mode_line ((W)) ? 1 : 0))
+ - (window_wants_mode_line (W) ? 1 : 0))
/* Non-zero if the face of the last glyph in ROW's text area has
to be drawn to the end of the text area. */
@@ -1211,7 +1211,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
/* Set and query the enabled_p flag of glyph row ROW in MATRIX. */
#define SET_MATRIX_ROW_ENABLED_P(MATRIX, ROW, VALUE) \
- (MATRIX_ROW (MATRIX, ROW)->enabled_p = (VALUE))
+ (MATRIX_ROW (MATRIX, ROW)->enabled_p = VALUE)
#define MATRIX_ROW_ENABLED_P(MATRIX, ROW) \
(MATRIX_ROW (MATRIX, ROW)->enabled_p)
@@ -1232,28 +1232,28 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MR_PARTIALLY_VISIBLE_AT_BOTTOM(W, ROW) \
(((ROW)->y + (ROW)->height - (ROW)->extra_line_spacing) \
- > WINDOW_BOX_HEIGHT_NO_MODE_LINE ((W)))
+ > WINDOW_BOX_HEIGHT_NO_MODE_LINE (W))
/* Non-zero if ROW is not completely visible in window W. */
#define MATRIX_ROW_PARTIALLY_VISIBLE_P(W, ROW) \
- (MR_PARTIALLY_VISIBLE ((ROW)) \
- && (MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW)) \
- || MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW))))
+ (MR_PARTIALLY_VISIBLE (ROW) \
+ && (MR_PARTIALLY_VISIBLE_AT_TOP (W, ROW) \
+ || MR_PARTIALLY_VISIBLE_AT_BOTTOM (W, ROW)))
/* Non-zero if ROW is partially visible at the top of window W. */
#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P(W, ROW) \
- (MR_PARTIALLY_VISIBLE ((ROW)) \
- && MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW)))
+ (MR_PARTIALLY_VISIBLE (ROW) \
+ && MR_PARTIALLY_VISIBLE_AT_TOP (W, ROW))
/* Non-zero if ROW is partially visible at the bottom of window W. */
#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P(W, ROW) \
- (MR_PARTIALLY_VISIBLE ((ROW)) \
- && MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW)))
+ (MR_PARTIALLY_VISIBLE (ROW) \
+ && MR_PARTIALLY_VISIBLE_AT_BOTTOM (W, ROW))
/* Return the bottom Y + 1 of ROW. */
@@ -1263,7 +1263,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
iterator structure pointed to by IT?. */
#define MATRIX_ROW_LAST_VISIBLE_P(ROW, IT) \
- (MATRIX_ROW_BOTTOM_Y ((ROW)) >= (IT)->last_visible_y)
+ (MATRIX_ROW_BOTTOM_Y (ROW) >= (IT)->last_visible_y)
/* Non-zero if ROW displays a continuation line. */
@@ -1537,9 +1537,9 @@ struct glyph_string
/* Return the desired face id for the mode line of window W. */
#define CURRENT_MODE_LINE_ACTIVE_FACE_ID(W) \
- (CURRENT_MODE_LINE_ACTIVE_FACE_ID_3((W), \
+ CURRENT_MODE_LINE_ACTIVE_FACE_ID_3(W, \
XWINDOW (selected_window), \
- (W)))
+ W)
/* Return the current height of the mode line of window W. If not known
from W->mode_line_height, look at W's current glyph matrix, or return
@@ -1625,8 +1625,8 @@ struct glyph_string
#define VCENTER_BASELINE_OFFSET(FONT, F) \
(FONT_DESCENT (FONT) \
- + (FRAME_LINE_HEIGHT ((F)) - FONT_HEIGHT ((FONT)) \
- + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \
+ + (FRAME_LINE_HEIGHT (F) - FONT_HEIGHT (FONT) \
+ + (FRAME_LINE_HEIGHT (F) > FONT_HEIGHT (FONT))) / 2 \
- (FONT_DESCENT (FRAME_FONT (F)) - FRAME_BASELINE_OFFSET (F)))
/* A heuristic test for fonts that claim they need a preposterously
@@ -2752,6 +2752,16 @@ struct it
pixel_width with each call to produce_glyphs. */
int current_x;
+ /* Pixel position within a display line with a wrap prefix. Updated
+ to reflect current_x in produce_glyphs when producing glyphs from
+ a prefix string and continuation_lines_width > 0, which is to
+ say, from a wrap prefix.
+
+ Such updates are unnecessary where it is impossible for a wrap
+ prefix to be active, e.g. when continuation lines are being
+ produced. */
+ int wrap_prefix_width;
+
/* Accumulated width of continuation lines. If > 0, this means we
are currently in a continuation line. This is initially zero and
incremented/reset by display_line, move_it_to etc. */
@@ -2858,12 +2868,12 @@ struct it
if ((IT)->glyph_row != NULL && (IT)->bidi_p) \
(IT)->glyph_row->reversed_p = (IT)->bidi_it.paragraph_dir == R2L; \
if (FRAME_RIF ((IT)->f) != NULL) \
- FRAME_RIF ((IT)->f)->produce_glyphs ((IT)); \
+ FRAME_RIF ((IT)->f)->produce_glyphs (IT); \
else \
- produce_glyphs ((IT)); \
+ produce_glyphs (IT); \
if ((IT)->glyph_row != NULL) \
inhibit_free_realized_faces =true; \
- reset_box_start_end_flags ((IT)); \
+ reset_box_start_end_flags (IT); \
} while (false)
/* Bit-flags indicating what operation move_it_to should perform. */
@@ -3428,6 +3438,7 @@ extern void bidi_pop_it (struct bidi_it *);
extern void *bidi_shelve_cache (void);
extern void bidi_unshelve_cache (void *, bool);
extern ptrdiff_t bidi_find_first_overridden (struct bidi_it *);
+extern ptrdiff_t bidi_level_start (int);
/* Defined in xdisp.c */
diff --git a/src/dispnew.c b/src/dispnew.c
index d0f259eef6c..c204a9dbf1b 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -134,8 +134,8 @@ static struct frame *frame_matrix_frame;
static int window_to_frame_vpos (struct window *, int);
static int window_to_frame_hpos (struct window *, int);
-#define WINDOW_TO_FRAME_VPOS(W, VPOS) window_to_frame_vpos ((W), (VPOS))
-#define WINDOW_TO_FRAME_HPOS(W, HPOS) window_to_frame_hpos ((W), (HPOS))
+#define WINDOW_TO_FRAME_VPOS(W, VPOS) window_to_frame_vpos (W, VPOS)
+#define WINDOW_TO_FRAME_HPOS(W, HPOS) window_to_frame_hpos (W, HPOS)
/* One element of the ring buffer containing redisplay history
information. */
@@ -5240,7 +5240,7 @@ count_match (struct glyph *str1, struct glyph *end1, struct glyph *str2, struct
/* Char insertion/deletion cost vector, from term.c */
#ifndef HAVE_ANDROID
-#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_TOTAL_COLS ((f))])
+#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_TOTAL_COLS (f)])
#endif
diff --git a/src/disptab.h b/src/disptab.h
index d63d19ae754..2080181610a 100644
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -39,13 +39,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
extern Lisp_Object disp_char_vector (struct Lisp_Char_Table *, int);
#define DISP_CHAR_VECTOR(dp, c) \
- (ASCII_CHAR_P(c) \
+ (ASCII_CHAR_P (c) \
? (NILP ((dp)->ascii) \
? (dp)->defalt \
: (SUB_CHAR_TABLE_P ((dp)->ascii) \
? XSUB_CHAR_TABLE ((dp)->ascii)->contents[c] \
: (dp)->ascii)) \
- : disp_char_vector ((dp), (c)))
+ : disp_char_vector (dp, c))
/* Defined in window.c. */
extern struct Lisp_Char_Table *window_display_table (struct window *);
@@ -78,8 +78,8 @@ extern struct Lisp_Char_Table *buffer_display_table (void);
LENGTH), and set G to the final glyph. */
#define GLYPH_FOLLOW_ALIASES(base, length, g) \
do { \
- while (GLYPH_ALIAS_P ((base), (length), (g))) \
- SET_GLYPH_CHAR ((g), XFIXNUM ((base)[GLYPH_CHAR (g)])); \
+ while (GLYPH_ALIAS_P (base, length, g)) \
+ SET_GLYPH_CHAR (g, XFIXNUM ((base)[GLYPH_CHAR (g)])); \
if (!GLYPH_CHAR_VALID_P (g)) \
SET_GLYPH_CHAR (g, ' '); \
} while (false)
diff --git a/src/doc.c b/src/doc.c
index a451b468ef2..b5a9ed498af 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file)
return 1;
}
+DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp,
+ 1, 1, 0,
+ doc: /* Return non-nil if OBJECT is a well-formed docstring object.
+OBJECT can be either a string or a reference if it's kept externally. */)
+ (Lisp_Object object)
+{
+ return (STRINGP (object)
+ || FIXNUMP (object) /* Reference to DOC. */
+ || (CONSP (object) /* Reference to .elc. */
+ && STRINGP (XCAR (object))
+ && FIXNUMP (XCDR (object)))
+ ? Qt : Qnil);
+}
+
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
@@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* If it's a lisp form, stick it in the form. */
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
- if (CONSP (fun))
- {
- Lisp_Object tem = XCAR (fun);
- if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
- || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
- {
- tem = Fcdr (Fcdr (fun));
- if (CONSP (tem) && FIXNUMP (XCAR (tem)))
- /* FIXME: This modifies typically pure hash-cons'd data, so its
- correctness is quite delicate. */
- XSETCAR (tem, make_fixnum (offset));
- }
- }
/* Lisp_Subrs have a slot for it. */
- else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
- {
- XSUBR (fun)->doc = offset;
- }
-
- /* Bytecode objects sometimes have slots for it. */
- else if (COMPILEDP (fun))
+ if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
+ XSUBR (fun)->doc = offset;
+ else
{
- /* This bytecode object must have a slot for the
- docstring, since we've found a docstring for it. */
- if (PVSIZE (fun) > COMPILED_DOC_STRING
- /* Don't overwrite a non-docstring value placed there,
- * such as the symbols used for Oclosures. */
- && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING)))
- ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
- else
- {
- AUTO_STRING (format,
- (PVSIZE (fun) > COMPILED_DOC_STRING
- ? "Docstring slot busy for %s"
- : "No docstring slot for %s"));
- CALLN (Fmessage, format,
- (SYMBOLP (obj)
- ? SYMBOL_NAME (obj)
- : build_string ("<anonymous>")));
- }
+ AUTO_STRING (format, "Ignoring DOC string on non-subr: %S");
+ CALLN (Fmessage, format, obj);
}
}
@@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */);
doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */);
/* Initialized by ā€˜mainā€™. */
+ defsubr (&Sdocumentation_stringp);
defsubr (&Sdocumentation);
defsubr (&Ssubr_documentation);
defsubr (&Sdocumentation_property);
diff --git a/src/dosfns.c b/src/dosfns.c
index 3eb3b34145e..96087116c19 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -652,10 +652,7 @@ dos_memory_info (unsigned long *totalram, unsigned long *freeram,
mem2 *= 4096;
/* Surely, the available memory is at least what we have physically
available, right? */
- if (mem1 >= mem2)
- freemem = mem1;
- else
- freemem = mem2;
+ freemem = max (mem1, mem2);
*freeram = freemem;
*totalswap =
((long)info.max_pages_in_paging_file == -1L)
diff --git a/src/editfns.c b/src/editfns.c
index f3b3cfb7243..4ccf765bd4b 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -272,24 +272,6 @@ 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.
-
- Note: this can return overlays that do not touch POS. The caller
- should filter these out. */
-
-static ptrdiff_t
-overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len)
-{
- /* 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,
doc: /* Return the value of POSITION's property PROP, in OBJECT.
Almost identical to `get-char-property' except for the following difference:
@@ -315,53 +297,44 @@ at POSITION. */)
else
{
EMACS_INT posn = XFIXNUM (position);
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec, tem;
+ Lisp_Object tem;
struct buffer *obuf = current_buffer;
- USE_SAFE_ALLOCA;
+ struct itree_node *node;
+ struct sortvec items[2];
+ struct buffer *b = XBUFFER (object);
+ struct sortvec *result = NULL;
+ Lisp_Object res = Qnil;
- set_buffer_temp (XBUFFER (object));
-
- /* First try with room for 40 overlays. */
- Lisp_Object overlay_vecbuf[40];
- noverlays = ARRAYELTS (overlay_vecbuf);
- overlay_vec = overlay_vecbuf;
- noverlays = overlays_around (posn, overlay_vec, noverlays);
-
- /* If there are more than 40,
- make enough space for all, and try again. */
- if (ARRAYELTS (overlay_vecbuf) < noverlays)
- {
- SAFE_ALLOCA_LISP (overlay_vec, noverlays);
- noverlays = overlays_around (posn, overlay_vec, noverlays);
- }
- noverlays = sort_overlays (overlay_vec, noverlays, NULL);
-
- set_buffer_temp (obuf);
+ set_buffer_temp (b);
- /* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
+ ITREE_FOREACH (node, b->overlays, posn - 1, posn + 1, ASCENDING)
{
- Lisp_Object ol = overlay_vec[noverlays];
+ Lisp_Object ol = node->data;
tem = Foverlay_get (ol, prop);
- if (!NILP (tem))
- {
+ if (NILP (tem)
/* Check the overlay is indeed active at point. */
- if ((OVERLAY_START (ol) == posn
+ || ((node->begin == posn
&& OVERLAY_FRONT_ADVANCE_P (ol))
- || (OVERLAY_END (ol) == posn
+ || (node->end == 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
- {
- SAFE_FREE ();
- return tem;
- }
- }
+ || node->begin > posn
+ || node->end < posn))
+ /* The overlay will not cover a char inserted at point. */
+ continue;
+
+ struct sortvec *this = (result == items ? items + 1 : items);
+ if (NILP (res)
+ || (make_sortvec_item (this, node->data),
+ compare_overlays (result, this) < 0))
+ {
+ result = this;
+ res = tem;
+ }
}
- SAFE_FREE ();
+ set_buffer_temp (obuf);
+
+ if (!NILP (res))
+ return res;
{ /* Now check the text properties. */
int stickiness = text_property_stickiness (prop, position, object);
@@ -1908,7 +1881,7 @@ determines whether case is significant or ignored. */)
#define USE_HEURISTIC
#define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff) \
- buffer_chars_equal ((ctx), (xoff), (yoff))
+ buffer_chars_equal (ctx, xoff, yoff)
#define OFFSET ptrdiff_t
@@ -2877,9 +2850,9 @@ void
labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv,
Lisp_Object label)
{
- Finternal__labeled_narrow_to_region (begv, zv, label);
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (unwind_labeled_narrow_to_region, label);
+ Finternal__labeled_narrow_to_region (begv, zv, label);
}
DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 46bd732e8eb..08db39b0b0d 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -410,12 +410,9 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n)
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
/* Note that we can't use `hash_lookup' because V might be a local
reference that's identical to some global reference. */
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- if (!BASE_EQ (HASH_KEY (h, i), Qunbound)
- && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v)
- return true;
- }
+ DOHASH (h, k, val)
+ if (&XMODULE_GLOBAL_REFERENCE (val)->value == v)
+ return true;
/* Only used for debugging, so we don't care about overflow, just
make sure the operation is defined. */
ckd_add (n, *n, h->count);
@@ -427,8 +424,9 @@ module_make_global_ref (emacs_env *env, emacs_value value)
{
MODULE_FUNCTION_BEGIN (NULL);
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
- Lisp_Object new_obj = value_to_lisp (value), hashcode;
- ptrdiff_t i = hash_lookup (h, new_obj, &hashcode);
+ Lisp_Object new_obj = value_to_lisp (value);
+ hash_hash_t hashcode;
+ ptrdiff_t i = hash_lookup_get_hash (h, new_obj, &hashcode);
/* Note: This approach requires the garbage collector to never move
objects. */
@@ -467,7 +465,7 @@ module_free_global_ref (emacs_env *env, emacs_value global_value)
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object obj = value_to_lisp (global_value);
- ptrdiff_t i = hash_lookup (h, obj, NULL);
+ ptrdiff_t i = hash_lookup (h, obj);
if (module_assertions)
{
@@ -1697,9 +1695,7 @@ syms_of_module (void)
{
staticpro (&Vmodule_refs_hash);
Vmodule_refs_hash
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
- DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
- Qnil, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
DEFSYM (Qmodule_load_failed, "module-load-failed");
Fput (Qmodule_load_failed, Qerror_conditions,
diff --git a/src/emacs.c b/src/emacs.c
index eb1871841ec..87f12d3fa86 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2444,6 +2444,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#if !defined ANDROID_STUBIFY
syms_of_androidfont ();
syms_of_androidselect ();
+ syms_of_androidvfs ();
syms_of_sfntfont ();
syms_of_sfntfont_android ();
#endif /* !ANDROID_STUBIFY */
@@ -2900,7 +2901,7 @@ sort_args (int argc, char **argv)
new[to++] = argv[best + i + 1];
}
- incoming_used += 1 + (options[best] > 0 ? options[best] : 0);
+ incoming_used += 1 + max (options[best], 0);
/* Clear out this option in ARGV. */
argv[best] = 0;
@@ -3116,10 +3117,6 @@ shut_down_emacs (int sig, Lisp_Object stuff)
check_message_stack ();
}
-#ifdef HAVE_NATIVE_COMP
- eln_load_path_final_clean_up ();
-#endif
-
#ifdef MSDOS
dos_cleanup ();
#endif
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
index 9fa9ef79278..2db78fd00b5 100644
--- a/src/emacsgtkfixed.h
+++ b/src/emacsgtkfixed.h
@@ -28,8 +28,8 @@ struct frame;
G_BEGIN_DECLS
#ifdef HAVE_PGTK
-#define EMACS_TYPE_FIXED (emacs_fixed_get_type ())
-#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED))
+#define EMACS_TYPE_FIXED emacs_fixed_get_type ()
+#define EMACS_IS_FIXED(obj) G_TYPE_CHECK_INSTANCE_TYPE (obj, EMACS_TYPE_FIXED)
#endif
struct frame;
diff --git a/src/eval.c b/src/eval.c
index 7f67b5a9db8..f48d7b0682f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -57,12 +57,6 @@ Lisp_Object Vrun_hooks;
/* FIXME: We should probably get rid of this! */
Lisp_Object Vsignaling_function;
-/* The handler structure which will catch errors in Lisp hooks called
- from redisplay. We do not use it for this; we compare it with the
- handler which is about to be used in signal_or_quit, and if it
- matches, cause a backtrace to be generated. */
-static struct handler *redisplay_deep_handler;
-
/* These would ordinarily be static, but they need to be visible to GDB. */
bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
@@ -212,7 +206,6 @@ void
init_eval_once (void)
{
/* Don't forget to update docs (lispref node "Eval"). */
- max_lisp_eval_depth = 1600;
Vrun_hooks = Qnil;
pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
}
@@ -245,25 +238,31 @@ init_eval (void)
lisp_eval_depth = 0;
/* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
- redisplay_deep_handler = NULL;
}
-/* Ensure that *M is at least A + B if possible, or is its maximum
- value otherwise. */
-
static void
-max_ensure_room (intmax_t *m, intmax_t a, intmax_t b)
+restore_stack_limits (Lisp_Object data)
{
- intmax_t sum = ckd_add (&sum, a, b) ? INTMAX_MAX : sum;
- *m = max (*m, sum);
+ intmax_t old_depth;
+ integer_to_intmax (data, &old_depth);
+ lisp_eval_depth_reserve += max_lisp_eval_depth - old_depth;
+ max_lisp_eval_depth = old_depth;
}
-/* Unwind-protect function used by call_debugger. */
+/* Try and ensure that we have at least B dpeth available. */
static void
-restore_stack_limits (Lisp_Object data)
+max_ensure_room (intmax_t b)
{
- integer_to_intmax (data, &max_lisp_eval_depth);
+ intmax_t sum = ckd_add (&sum, lisp_eval_depth, b) ? INTMAX_MAX : sum;
+ intmax_t diff = min (sum - max_lisp_eval_depth, lisp_eval_depth_reserve);
+ if (diff <= 0)
+ return;
+ intmax_t old_depth = max_lisp_eval_depth;
+ max_lisp_eval_depth += diff;
+ lisp_eval_depth_reserve -= diff;
+ /* Restore limits after leaving the debugger. */
+ record_unwind_protect (restore_stack_limits, make_int (old_depth));
}
/* Call the Lisp debugger, giving it argument ARG. */
@@ -274,16 +273,12 @@ call_debugger (Lisp_Object arg)
bool debug_while_redisplaying;
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object val;
- intmax_t old_depth = max_lisp_eval_depth;
/* The previous value of 40 is too small now that the debugger
prints using cl-prin1 instead of prin1. Printing lists nested 8
deep (which is the value of print-level used in the debugger)
currently requires 77 additional frames. See bug#31919. */
- max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
-
- /* Restore limits after leaving the debugger. */
- record_unwind_protect (restore_stack_limits, make_int (old_depth));
+ max_ensure_room (100);
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
@@ -317,6 +312,7 @@ call_debugger (Lisp_Object arg)
/* Interrupting redisplay and resuming it later is not safe under
all circumstances. So, when the debugger returns, abort the
interrupted redisplay by going back to the top-level. */
+ /* FIXME: Move this to the redisplay code? */
if (debug_while_redisplaying
&& !EQ (Vdebugger, Qdebug_early))
Ftop_level ();
@@ -1198,6 +1194,12 @@ usage: (catch TAG BODY...) */)
#define clobbered_eassert(E) verify (sizeof (E) != 0)
+void
+pop_handler (void)
+{
+ handlerlist = handlerlist->next;
+}
+
/* Set up a catch, then call C function FUNC on argument ARG.
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
@@ -1361,6 +1363,49 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
return internal_lisp_condition_case (var, bodyform, handlers);
}
+void
+push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip)
+{
+ if (!CONSP (conditions))
+ conditions = Fcons (conditions, Qnil);
+ struct handler *c = push_handler (conditions, HANDLER_BIND);
+ c->val = handler;
+ c->bytecode_dest = skip;
+}
+
+DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0,
+ doc: /* Set up error handlers around execution of BODYFUN.
+BODYFUN should be a function and it is called with no arguments.
+CONDITIONS should be a list of condition names (symbols).
+When an error is signaled during execution of BODYFUN, if that
+error matches one of CONDITIONS, then the associated HANDLER is
+called with the error as argument.
+HANDLER should either transfer the control via a non-local exit,
+or return normally.
+If it returns normally, the search for an error handler continues
+from where it left off.
+
+usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ eassert (nargs >= 1);
+ Lisp_Object bodyfun = args[0];
+ int count = 0;
+ if (nargs % 2 == 0)
+ error ("Trailing CONDITIONS without HANDLER in `handler-bind`");
+ for (ptrdiff_t i = nargs - 2; i > 0; i -= 2)
+ {
+ Lisp_Object conditions = args[i], handler = args[i + 1];
+ if (NILP (conditions))
+ continue;
+ push_handler_bind (conditions, handler, count++);
+ }
+ Lisp_Object ret = call0 (bodyfun);
+ for (; count > 0; count--)
+ pop_handler ();
+ return ret;
+}
+
/* Like Fcondition_case, but the args are separate
rather than passed in a list. Used by Fbyte_code. */
@@ -1559,16 +1604,12 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
ptrdiff_t nargs,
Lisp_Object *args))
{
- struct handler *old_deep = redisplay_deep_handler;
struct handler *c = push_handler (handlers, CONDITION_CASE);
- if (redisplaying_p)
- redisplay_deep_handler = c;
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- redisplay_deep_handler = old_deep;
return hfun (val, nargs, args);
}
else
@@ -1576,7 +1617,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
Lisp_Object val = bfun (nargs, args);
eassert (handlerlist == c);
handlerlist = c->next;
- redisplay_deep_handler = old_deep;
return val;
}
}
@@ -1654,8 +1694,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool);
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
-static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
- Lisp_Object data);
+static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object error);
static void
process_quit_flag (void)
@@ -1715,28 +1754,29 @@ quit (void)
return signal_or_quit (Qquit, Qnil, true);
}
-/* Has an error in redisplay giving rise to a backtrace occurred as
- yet in the current command? This gets reset in the command
- loop. */
-bool backtrace_yet = false;
-
/* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal.
- If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
- Qquit and DATA should be Qnil, and this function may return.
+ If CONTINUABLE, the caller allows this function to return
+ (presumably after calling the debugger);
Otherwise this function is like Fsignal and does not return. */
static Lisp_Object
-signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
+signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
{
/* When memory is full, ERROR-SYMBOL is nil,
and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
That is a special case--don't do this in other situations. */
+ bool oom = NILP (error_symbol);
+ Lisp_Object error /* The error object. */
+ = oom ? data
+ : (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol
+ : Fcons (error_symbol, data);
Lisp_Object conditions;
Lisp_Object string;
Lisp_Object real_error_symbol
- = (NILP (error_symbol) ? Fcar (data) : error_symbol);
+ = CONSP (error) ? XCAR (error) : error_symbol;
Lisp_Object clause = Qnil;
struct handler *h;
+ int skip;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -1751,15 +1791,15 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
/* This hook is used by edebug. */
if (! NILP (Vsignal_hook_function)
- && ! NILP (error_symbol)
- /* Don't try to call a lisp function if we've already overflowed
- the specpdl stack. */
- && specpdl_ptr < specpdl_end)
+ && !oom)
{
- /* Edebug takes care of restoring these variables when it exits. */
- max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20);
-
+ specpdl_ref count = SPECPDL_INDEX ();
+ max_ensure_room (20);
+ /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */
+ /* FIXME: Here we still "split" the error object
+ into its error-symbol and its error-data? */
call2 (Vsignal_hook_function, error_symbol, data);
+ unbind_to (count, Qnil);
}
conditions = Fget (real_error_symbol, Qerror_conditions);
@@ -1769,7 +1809,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
too. Don't do this when ERROR_SYMBOL is nil, because that
is a memory-full error. */
Vsignaling_function = Qnil;
- if (!NILP (error_symbol))
+ if (!oom)
{
union specbinding *pdl = backtrace_next (backtrace_top ());
if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
@@ -1778,16 +1818,42 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
Vsignaling_function = backtrace_function (pdl);
}
- for (h = handlerlist; h; h = h->next)
+ for (skip = 0, h = handlerlist; h; skip++, h = h->next)
{
- if (h->type == CATCHER_ALL)
+ switch (h->type)
{
+ case CATCHER_ALL:
clause = Qt;
break;
- }
- if (h->type != CONDITION_CASE)
- continue;
- clause = find_handler_clause (h->tag_or_ch, conditions);
+ case CATCHER:
+ continue;
+ case CONDITION_CASE:
+ clause = find_handler_clause (h->tag_or_ch, conditions);
+ break;
+ case HANDLER_BIND:
+ {
+ if (!NILP (find_handler_clause (h->tag_or_ch, conditions)))
+ {
+ specpdl_ref count = SPECPDL_INDEX ();
+ max_ensure_room (20);
+ push_handler (make_fixnum (skip + h->bytecode_dest),
+ SKIP_CONDITIONS);
+ call1 (h->val, error);
+ unbind_to (count, Qnil);
+ pop_handler ();
+ }
+ continue;
+ }
+ case SKIP_CONDITIONS:
+ {
+ int toskip = XFIXNUM (h->tag_or_ch);
+ while (toskip-- >= 0)
+ h = h->next;
+ continue;
+ }
+ default:
+ abort ();
+ }
if (!NILP (clause))
break;
}
@@ -1795,7 +1861,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
bool debugger_called = false;
if (/* Don't run the debugger for a memory-full error.
(There is no room in memory to do that!) */
- !NILP (error_symbol)
+ !oom
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
|| NILP (clause)
@@ -1804,85 +1870,25 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
|| (CONSP (clause) && !NILP (Fmemq (Qdebug, clause)))
/* Special handler that means "print a message and run debugger
if requested". */
- || EQ (h->tag_or_ch, Qerror)))
+ || EQ (clause, Qerror)))
{
debugger_called
- = maybe_call_debugger (conditions, error_symbol, data);
+ = maybe_call_debugger (conditions, error);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
- if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit))
+ if (continuable && debugger_called)
return Qnil;
}
- /* If we're in batch mode, print a backtrace unconditionally to help
- with debugging. Make sure to use `debug-early' unconditionally
- to not interfere with ERT or other packages that install custom
- debuggers. */
- if (!debugger_called && !NILP (error_symbol)
- && (NILP (clause) || EQ (h->tag_or_ch, Qerror))
- && noninteractive && backtrace_on_error_noninteractive
- && NILP (Vinhibit_debugger)
- && !NILP (Ffboundp (Qdebug_early)))
- {
- max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
- specpdl_ref count = SPECPDL_INDEX ();
- specbind (Qdebugger, Qdebug_early);
- call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
- unbind_to (count, Qnil);
- }
-
- /* If an error is signaled during a Lisp hook in redisplay, write a
- backtrace into the buffer *Redisplay-trace*. */
- if (!debugger_called && !NILP (error_symbol)
- && backtrace_on_redisplay_error
- && (NILP (clause) || h == redisplay_deep_handler)
- && NILP (Vinhibit_debugger)
- && !NILP (Ffboundp (Qdebug_early)))
- {
- max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
- specpdl_ref count = SPECPDL_INDEX ();
- 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;
- 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? */
- Ferase_buffer ();
- else
- Finsert (1, &gap);
- backtrace_yet = true;
- specbind (Qstandard_output, redisplay_trace_buffer);
- specbind (Qdebugger, Qdebug_early);
- call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
- unbind_to (count, Qnil);
- delayed_warning = make_string
- ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61);
-
- Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
- Vdelayed_warnings_list);
- }
-
if (!NILP (clause))
- {
- Lisp_Object unwind_data
- = (NILP (error_symbol) ? data : Fcons (error_symbol, data));
-
- unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data);
- }
- else
- {
- if (handlerlist != handlerlist_sentinel)
- /* FIXME: This will come right back here if there's no `top-level'
- catcher. A better solution would be to abort here, and instead
- add a catch-all condition handler so we never come here. */
- Fthrow (Qtop_level, Qt);
- }
-
- if (! NILP (error_symbol))
- data = Fcons (error_symbol, data);
-
- string = Ferror_message_string (data);
+ unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
+ else if (handlerlist != handlerlist_sentinel)
+ /* FIXME: This will come right back here if there's no `top-level'
+ catcher. A better solution would be to abort here, and instead
+ add a catch-all condition handler so we never come here. */
+ Fthrow (Qtop_level, Qt);
+
+ string = Ferror_message_string (error);
fatal ("%s", SDATA (string));
}
@@ -2007,14 +2013,15 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
return 0;
}
-/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */
+/* Say whether SIGNAL is a `quit' error (or inherits from it). */
bool
-signal_quit_p (Lisp_Object signal)
+signal_quit_p (Lisp_Object error)
{
+ Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil;
Lisp_Object list;
return EQ (signal, Qquit)
- || (!NILP (Fsymbolp (signal))
+ || (SYMBOLP (signal)
&& CONSP (list = Fget (signal, Qerror_conditions))
&& !NILP (Fmemq (Qquit, list)));
}
@@ -2025,27 +2032,23 @@ signal_quit_p (Lisp_Object signal)
= SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
This is for memory-full errors only. */
static bool
-maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
+maybe_call_debugger (Lisp_Object conditions, Lisp_Object error)
{
- Lisp_Object combined_data;
-
- combined_data = Fcons (sig, data);
-
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
- && (signal_quit_p (sig)
+ && (signal_quit_p (error)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
- && ! skip_debugger (conditions, combined_data)
+ && ! skip_debugger (conditions, error)
/* See commentary on definition of
`internal-when-entered-debugger'. */
&& when_entered_debugger < num_nonmacro_input_events)
{
- call_debugger (list2 (Qerror, combined_data));
+ call_debugger (list2 (Qerror, error));
return 1;
}
@@ -2058,13 +2061,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
register Lisp_Object h;
/* t is used by handlers for all conditions, set up by C code. */
- if (EQ (handlers, Qt))
- return Qt;
-
/* error is used similarly, but means print an error message
and run the debugger if that is enabled. */
- if (EQ (handlers, Qerror))
- return Qt;
+ if (!CONSP (handlers))
+ return handlers;
for (h = handlers; CONSP (h); h = XCDR (h))
{
@@ -3122,19 +3122,6 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs));
}
-/* Call the compiled Lisp function FUN. If we have not yet read FUN's
- bytecode string and constants vector, fetch them from the file first. */
-
-static Lisp_Object
-fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
- ptrdiff_t nargs, Lisp_Object *args)
-{
- if (CONSP (AREF (fun, COMPILED_BYTECODE)))
- Ffetch_bytecode (fun);
-
- return exec_byte_code (fun, args_template, nargs, args);
-}
-
static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count)
{
@@ -3204,8 +3191,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
ARGLIST slot value: pass the arguments to the byte-code
engine directly. */
if (FIXNUMP (syms_left))
- return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left),
- nargs, arg_vector);
+ return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector);
/* Otherwise the bytecode object uses dynamic binding and the
ARGLIST slot contains a standard formal argument list whose
variables are bound dynamically below. */
@@ -3293,7 +3279,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
val = XSUBR (fun)->function.a0 ();
}
else
- val = fetch_and_exec_byte_code (fun, 0, 0, NULL);
+ val = exec_byte_code (fun, 0, 0, NULL);
return unbind_to (count, val);
}
@@ -3411,46 +3397,6 @@ lambda_arity (Lisp_Object fun)
return Fcons (make_fixnum (minargs), make_fixnum (maxargs));
}
-DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
- 1, 1, 0,
- doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
- (Lisp_Object object)
-{
- Lisp_Object tem;
-
- if (COMPILEDP (object))
- {
- if (CONSP (AREF (object, COMPILED_BYTECODE)))
- {
- tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
- if (! (CONSP (tem) && STRINGP (XCAR (tem))
- && VECTORP (XCDR (tem))))
- {
- tem = AREF (object, COMPILED_BYTECODE);
- if (CONSP (tem) && STRINGP (XCAR (tem)))
- error ("Invalid byte code in %s", SDATA (XCAR (tem)));
- else
- error ("Invalid byte code");
- }
-
- Lisp_Object bytecode = XCAR (tem);
- if (STRING_MULTIBYTE (bytecode))
- {
- /* BYTECODE must have been produced by Emacs 20.2 or earlier
- because it produced a raw 8-bit string for byte-code and now
- such a byte-code string is loaded as multibyte with raw 8-bit
- characters converted to multibyte form. Convert them back to
- the original unibyte form. */
- bytecode = Fstring_as_unibyte (bytecode);
- }
-
- pin_string (bytecode);
- ASET (object, COMPILED_BYTECODE, bytecode);
- ASET (object, COMPILED_CONSTANTS, XCDR (tem));
- }
- }
- return object;
-}
/* Return true if SYMBOL's default currently has a let-binding
which was made in the buffer that is now current. */
@@ -4250,23 +4196,18 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
}
}
+/* Fill ARRAY of size SIZE with backtrace entries, most recent call first.
+ Truncate the backtrace if longer than SIZE; pad with nil if shorter. */
void
-get_backtrace (Lisp_Object array)
+get_backtrace (Lisp_Object *array, ptrdiff_t size)
{
- union specbinding *pdl = backtrace_top ();
- ptrdiff_t i = 0, asize = ASIZE (array);
-
/* Copy the backtrace contents into working memory. */
- for (; i < asize; i++)
- {
- if (backtrace_p (pdl))
- {
- ASET (array, i, backtrace_function (pdl));
- pdl = backtrace_next (pdl);
- }
- else
- ASET (array, i, Qnil);
- }
+ union specbinding *pdl = backtrace_top ();
+ ptrdiff_t i = 0;
+ for (; i < size && backtrace_p (pdl); i++, pdl = backtrace_next (pdl))
+ array[i] = backtrace_function (pdl);
+ for (; i < size; i++)
+ array[i] = Qnil;
}
Lisp_Object backtrace_top_function (void)
@@ -4286,6 +4227,13 @@ actual stack overflow in C, which would be fatal for Emacs.
You can safely make it considerably larger than its default value,
if that proves inconveniently small. However, if you increase it too far,
Emacs could overflow the real C stack, and crash. */);
+ max_lisp_eval_depth = 1600;
+
+ DEFVAR_INT ("lisp-eval-depth-reserve", lisp_eval_depth_reserve,
+ doc: /* Extra depth that can be allocated to handle errors.
+This is the max depth that the system will add to `max-lisp-eval-depth'
+when calling debuggers or `handler-bind' handlers. */);
+ lisp_eval_depth_reserve = 200;
DEFVAR_LISP ("quit-flag", Vquit_flag,
doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
@@ -4322,6 +4270,7 @@ before making `inhibit-quit' nil. */);
DEFSYM (QCdocumentation, ":documentation");
DEFSYM (Qdebug, "debug");
DEFSYM (Qdebug_early, "debug-early");
+ DEFSYM (Qdebug_early__handler, "debug-early--handler");
DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
doc: /* Non-nil means never enter the debugger.
@@ -4494,6 +4443,7 @@ alist of active lexical bindings. */);
defsubr (&Sthrow);
defsubr (&Sunwind_protect);
defsubr (&Scondition_case);
+ defsubr (&Shandler_bind_1);
DEFSYM (QCsuccess, ":success");
defsubr (&Ssignal);
defsubr (&Scommandp);
@@ -4508,7 +4458,6 @@ alist of active lexical bindings. */);
defsubr (&Srun_hook_with_args_until_success);
defsubr (&Srun_hook_with_args_until_failure);
defsubr (&Srun_hook_wrapped);
- defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
DEFSYM (QCdebug_on_exit, ":debug-on-exit");
defsubr (&Smapbacktrace);
diff --git a/src/fileio.c b/src/fileio.c
index a92da93ae48..12da7a9ed3a 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -847,7 +847,7 @@ Each element in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don't end with a slash, a slash will be
inserted before concatenating.
-usage: (record DIRECTORY &rest COMPONENTS) */)
+usage: (file-name-concat DIRECTORY &rest COMPONENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
@@ -5628,7 +5628,15 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
changed to a call to `stat'. */
if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0
- && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
+ && st.st_dev == st1.st_dev
+ && (st.st_ino == st1.st_ino
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* `st1.st_ino' == 0 indicates that the inode number
+ cannot be extracted from this document file, despite
+ `st' potentially being backed by a real file. */
+ || st1.st_ino == 0
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+ ))
{
/* Use the heuristic if it appears to be valid. With neither
O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
diff --git a/src/fns.c b/src/fns.c
index 05b7fe85601..db5e856d5bd 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <vla.h>
#include <errno.h>
#include <ctype.h>
+#include <math.h>
#include "lisp.h"
#include "bignum.h"
@@ -466,21 +467,10 @@ load_unaligned_size_t (const void *p)
return x;
}
-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.
-Symbols are also allowed; their print names are used instead. */)
- (Lisp_Object string1, Lisp_Object string2)
+/* Return -1/0/1 to indicate the relation </=/> between string1 and string2. */
+static int
+string_cmp (Lisp_Object string1, Lisp_Object string2)
{
- if (SYMBOLP (string1))
- string1 = SYMBOL_NAME (string1);
- else
- CHECK_STRING (string1);
- if (SYMBOLP (string2))
- string2 = SYMBOL_NAME (string2);
- else
- CHECK_STRING (string2);
-
ptrdiff_t n = min (SCHARS (string1), SCHARS (string2));
if ((!STRING_MULTIBYTE (string1) || SCHARS (string1) == SBYTES (string1))
@@ -489,7 +479,9 @@ Symbols are also allowed; their print names are used instead. */)
/* 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;
+ if (d)
+ return d;
+ return n < SCHARS (string2) ? -1 : n > SCHARS (string2);
}
else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2))
{
@@ -523,7 +515,7 @@ Symbols are also allowed; their print names are used instead. */)
if (b >= nb)
/* One string is a prefix of the other. */
- return b < nb2 ? Qt : Qnil;
+ return b < nb2 ? -1 : b > nb2;
/* Now back up to the start of the differing characters:
it's the last byte not having the bit pattern 10xxxxxx. */
@@ -535,7 +527,7 @@ Symbols are also allowed; their print names are used instead. */)
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;
+ return c1 < c2 ? -1 : c1 > c2;
}
else if (STRING_MULTIBYTE (string1))
{
@@ -546,9 +538,9 @@ Symbols are also allowed; their print names are used instead. */)
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 c1 < c2 ? -1 : 1;
}
- return i1 < SCHARS (string2) ? Qt : Qnil;
+ return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2);
}
else
{
@@ -559,12 +551,30 @@ Symbols are also allowed; their print names are used instead. */)
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 c1 < c2 ? -1 : 1;
}
- return i1 < SCHARS (string2) ? Qt : Qnil;
+ return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2);
}
}
+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.
+Symbols are also allowed; their print names are used instead. */)
+ (Lisp_Object string1, Lisp_Object string2)
+{
+ if (SYMBOLP (string1))
+ string1 = SYMBOL_NAME (string1);
+ else
+ CHECK_STRING (string1);
+ if (SYMBOLP (string2))
+ string2 = SYMBOL_NAME (string2);
+ else
+ CHECK_STRING (string2);
+
+ return string_cmp (string1, string2) < 0 ? Qt : Qnil;
+}
+
DEFUN ("string-version-lessp", Fstring_version_lessp,
Sstring_version_lessp, 2, 2, 0,
doc: /* Return non-nil if S1 is less than S2, as version strings.
@@ -2337,17 +2347,17 @@ See also the function `nreverse', which is used more often. */)
}
-/* Stably sort LIST ordered by PREDICATE using the TIMSORT
- algorithm. This converts the list to a vector, sorts the vector,
- and returns the result converted back to a list. The input list
- is destructively reused to hold the sorted result. */
-
+/* Stably sort LIST ordered by PREDICATE and KEYFUNC, optionally reversed.
+ This converts the list to a vector, sorts the vector, and returns the
+ result converted back to a list. If INPLACE, the input list is
+ reused to hold the sorted result; otherwise a new list is returned. */
static Lisp_Object
-sort_list (Lisp_Object list, Lisp_Object predicate)
+sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc,
+ bool reverse, bool inplace)
{
ptrdiff_t length = list_length (list);
if (length < 2)
- return list;
+ return inplace ? list : list1 (XCAR (list));
else
{
Lisp_Object *result;
@@ -2359,49 +2369,109 @@ sort_list (Lisp_Object list, Lisp_Object predicate)
result[i] = Fcar (tail);
tail = XCDR (tail);
}
- tim_sort (predicate, result, length);
+ tim_sort (predicate, keyfunc, result, length, reverse);
- ptrdiff_t i = 0;
- tail = list;
- while (CONSP (tail))
+ if (inplace)
{
- XSETCAR (tail, result[i]);
- tail = XCDR (tail);
- i++;
+ /* Copy sorted vector contents back onto the original list. */
+ ptrdiff_t i = 0;
+ tail = list;
+ while (CONSP (tail))
+ {
+ XSETCAR (tail, result[i]);
+ tail = XCDR (tail);
+ i++;
+ }
+ }
+ else
+ {
+ /* Create a new list for the sorted vector contents. */
+ list = Qnil;
+ for (ptrdiff_t i = length - 1; i >= 0; i--)
+ list = Fcons (result[i], list);
}
SAFE_FREE ();
return list;
}
}
-/* Stably sort VECTOR ordered by PREDICATE using the TIMSORT
- algorithm. */
-
-static void
-sort_vector (Lisp_Object vector, Lisp_Object predicate)
+/* Stably sort VECTOR in-place ordered by PREDICATE and KEYFUNC,
+ optionally reversed. */
+static Lisp_Object
+sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc,
+ bool reverse)
{
ptrdiff_t length = ASIZE (vector);
- if (length < 2)
- return;
-
- tim_sort (predicate, XVECTOR (vector)->contents, length);
+ if (length >= 2)
+ tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length, reverse);
+ return vector;
}
-DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
- doc: /* Sort SEQ, stably, comparing elements using PREDICATE.
-Returns the sorted sequence. SEQ should be a list or vector. SEQ is
-modified by side effects. PREDICATE is called with two elements of
-SEQ, and should return non-nil if the first element should sort before
-the second. */)
- (Lisp_Object seq, Lisp_Object predicate)
+DEFUN ("sort", Fsort, Ssort, 1, MANY, 0,
+ doc: /* Sort SEQ, stably, and return the sorted sequence.
+SEQ should be a list or vector.
+Optional arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:key FUNC -- FUNC is a function that takes a single element from SEQ and
+ returns the key value to be used in comparison. If absent or nil,
+ `identity' is used.
+
+:lessp FUNC -- FUNC is a function that takes two arguments and returns
+ non-nil if the first element should come before the second.
+ If absent or nil, `value<' is used.
+
+:reverse BOOL -- if BOOL is non-nil, the sorting order implied by FUNC is
+ reversed. This does not affect stability: equal elements still retain
+ their order in the input sequence.
+
+:in-place BOOL -- if BOOL is non-nil, SEQ is sorted in-place and returned.
+ Otherwise, a sorted copy of SEQ is returned and SEQ remains unmodified;
+ this is the default.
+
+For compatibility, the calling convention (sort SEQ LESSP) can also be used;
+in this case, sorting is always done in-place.
+
+usage: (sort SEQ &key KEY LESSP REVERSE IN-PLACE) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
+ Lisp_Object seq = args[0];
+ Lisp_Object key = Qnil;
+ Lisp_Object lessp = Qnil;
+ bool inplace = false;
+ bool reverse = false;
+ if (nargs == 2)
+ {
+ /* old-style invocation without keywords */
+ lessp = args[1];
+ inplace = true;
+ }
+ else if ((nargs & 1) == 0)
+ error ("Invalid argument list");
+ else
+ for (ptrdiff_t i = 1; i < nargs - 1; i += 2)
+ {
+ if (EQ (args[i], QCkey))
+ key = args[i + 1];
+ else if (EQ (args[i], QClessp))
+ lessp = args[i + 1];
+ else if (EQ (args[i], QCin_place))
+ inplace = !NILP (args[i + 1]);
+ else if (EQ (args[i], QCreverse))
+ reverse = !NILP (args[i + 1]);
+ else
+ signal_error ("Invalid keyword argument", args[i]);
+ }
+
if (CONSP (seq))
- seq = sort_list (seq, predicate);
+ return sort_list (seq, lessp, key, reverse, inplace);
+ else if (NILP (seq))
+ return seq;
else if (VECTORP (seq))
- sort_vector (seq, predicate);
- else if (!NILP (seq))
+ return sort_vector (inplace ? seq : Fcopy_sequence (seq),
+ lessp, key, reverse);
+ else
wrong_type_argument (Qlist_or_vector_p, seq);
- return seq;
}
Lisp_Object
@@ -2731,6 +2801,10 @@ equal_no_quit (Lisp_Object o1, Lisp_Object o2)
return internal_equal (o1, o2, EQUAL_NO_QUIT, 0, Qnil);
}
+static ptrdiff_t hash_lookup_with_hash (struct Lisp_Hash_Table *h,
+ Lisp_Object key, hash_hash_t hash);
+
+
/* Return true if O1 and O2 are equal. EQUAL_KIND specifies what kind
of equality test to use: if it is EQUAL_NO_QUIT, do not check for
cycles or large arguments or quits; if EQUAL_PLAIN, do ordinary
@@ -2759,8 +2833,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
case Lisp_Cons: case Lisp_Vectorlike:
{
struct Lisp_Hash_Table *h = XHASH_TABLE (ht);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h, o1, &hash);
+ hash_hash_t hash = hash_from_key (h, o1);
+ ptrdiff_t i = hash_lookup_with_hash (h, o1, hash);
if (i >= 0)
{ /* `o1' was seen already. */
Lisp_Object o2s = HASH_VALUE (h, i);
@@ -2778,13 +2852,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
/* A symbol with position compares the contained symbol, and is
`equal' to the corresponding ordinary symbol. */
- if (symbols_with_pos_enabled)
- {
- if (SYMBOL_WITH_POS_P (o1))
- o1 = SYMBOL_WITH_POS_SYM (o1);
- if (SYMBOL_WITH_POS_P (o2))
- o2 = SYMBOL_WITH_POS_SYM (o2);
- }
+ o1 = maybe_remove_pos_from_symbol (o1);
+ o2 = maybe_remove_pos_from_symbol (o2);
if (BASE_EQ (o1, o2))
return true;
@@ -2865,11 +2934,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
if (TS_NODEP (o1))
return treesit_node_eq (o1, o2);
#endif
- if (SYMBOL_WITH_POS_P(o1)) /* symbols_with_pos_enabled is false. */
- return (BASE_EQ (XSYMBOL_WITH_POS (o1)->sym,
- XSYMBOL_WITH_POS (o2)->sym)
- && BASE_EQ (XSYMBOL_WITH_POS (o1)->pos,
- XSYMBOL_WITH_POS (o2)->pos));
+ if (SYMBOL_WITH_POS_P (o1))
+ {
+ eassert (!symbols_with_pos_enabled);
+ return (BASE_EQ (XSYMBOL_WITH_POS_SYM (o1),
+ XSYMBOL_WITH_POS_SYM (o2))
+ && BASE_EQ (XSYMBOL_WITH_POS_POS (o1),
+ XSYMBOL_WITH_POS_POS (o2)));
+ }
/* Aside from them, only true vectors, char-tables, compiled
functions, and fonts (font-spec, font-entity, font-object)
@@ -2906,6 +2978,233 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
return false;
}
+
+/* Return -1/0/1 for the </=/> lexicographic relation between bool-vectors. */
+static int
+bool_vector_cmp (Lisp_Object a, Lisp_Object b)
+{
+ ptrdiff_t na = bool_vector_size (a);
+ ptrdiff_t nb = bool_vector_size (b);
+ /* Skip equal words. */
+ ptrdiff_t words_min = min (na, nb) / BITS_PER_BITS_WORD;
+ bits_word *ad = bool_vector_data (a);
+ bits_word *bd = bool_vector_data (b);
+ ptrdiff_t i = 0;
+ while (i < words_min && ad[i] == bd[i])
+ i++;
+ na -= i * BITS_PER_BITS_WORD;
+ nb -= i * BITS_PER_BITS_WORD;
+ eassume (na >= 0 && nb >= 0);
+ if (nb == 0)
+ return na != 0;
+ if (na == 0)
+ return -1;
+
+ bits_word aw = bits_word_to_host_endian (ad[i]);
+ bits_word bw = bits_word_to_host_endian (bd[i]);
+ bits_word xw = aw ^ bw;
+ if (xw == 0)
+ return na < nb ? -1 : na > nb;
+
+ bits_word d = xw & -xw; /* Isolate first difference. */
+ eassume (d != 0);
+ return (d & aw) ? 1 : -1;
+}
+
+/* Return -1, 0 or 1 to indicate whether a<b, a=b or a>b in the sense of value<.
+ In particular 0 does not mean equality in the sense of Fequal, only
+ that the arguments cannot be ordered yet they can be compared (same
+ type). */
+static int
+value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth)
+{
+ if (maxdepth < 0)
+ error ("Maximum depth exceeded in comparison");
+
+ tail_recurse:
+ /* Shortcut for a common case. */
+ if (BASE_EQ (a, b))
+ return 0;
+
+ switch (XTYPE (a))
+ {
+ case_Lisp_Int:
+ {
+ EMACS_INT ia = XFIXNUM (a);
+ if (FIXNUMP (b))
+ return ia < XFIXNUM (b) ? -1 : 1; /* we know that aā‰ b */
+ if (FLOATP (b))
+ return ia < XFLOAT_DATA (b) ? -1 : ia > XFLOAT_DATA (b);
+ if (BIGNUMP (b))
+ return -mpz_sgn (*xbignum_val (b));
+ }
+ goto type_mismatch;
+
+ case Lisp_Symbol:
+ if (BARE_SYMBOL_P (b))
+ return string_cmp (XBARE_SYMBOL (a)->u.s.name,
+ XBARE_SYMBOL (b)->u.s.name);
+ if (CONSP (b) && NILP (a))
+ return -1;
+ if (SYMBOLP (b))
+ /* Slow-path branch when B is a symbol-with-pos. */
+ return string_cmp (XBARE_SYMBOL (a)->u.s.name, XSYMBOL (b)->u.s.name);
+ goto type_mismatch;
+
+ case Lisp_String:
+ if (STRINGP (b))
+ return string_cmp (a, b);
+ goto type_mismatch;
+
+ case Lisp_Cons:
+ /* FIXME: Optimise for difference in the first element? */
+ FOR_EACH_TAIL (b)
+ {
+ int cmp = value_cmp (XCAR (a), XCAR (b), maxdepth - 1);
+ if (cmp != 0)
+ return cmp;
+ a = XCDR (a);
+ if (!CONSP (a))
+ {
+ b = XCDR (b);
+ goto tail_recurse;
+ }
+ }
+ if (NILP (b))
+ return 1;
+ else
+ goto type_mismatch;
+ goto tail_recurse;
+
+ case Lisp_Vectorlike:
+ if (VECTORLIKEP (b))
+ {
+ enum pvec_type ta = PSEUDOVECTOR_TYPE (XVECTOR (a));
+ enum pvec_type tb = PSEUDOVECTOR_TYPE (XVECTOR (b));
+ if (ta == tb)
+ switch (ta)
+ {
+ case PVEC_NORMAL_VECTOR:
+ case PVEC_RECORD:
+ {
+ ptrdiff_t len_a = ASIZE (a);
+ ptrdiff_t len_b = ASIZE (b);
+ if (ta == PVEC_RECORD)
+ {
+ len_a &= PSEUDOVECTOR_SIZE_MASK;
+ len_b &= PSEUDOVECTOR_SIZE_MASK;
+ }
+ ptrdiff_t len_min = min (len_a, len_b);
+ for (ptrdiff_t i = 0; i < len_min; i++)
+ {
+ int cmp = value_cmp (AREF (a, i), AREF (b, i),
+ maxdepth - 1);
+ if (cmp != 0)
+ return cmp;
+ }
+ return len_a < len_b ? -1 : len_a > len_b;
+ }
+
+ case PVEC_BOOL_VECTOR:
+ return bool_vector_cmp (a, b);
+
+ case PVEC_MARKER:
+ {
+ Lisp_Object buf_a = Fmarker_buffer (a);
+ Lisp_Object buf_b = Fmarker_buffer (b);
+ if (NILP (buf_a))
+ return NILP (buf_b) ? 0 : -1;
+ if (NILP (buf_b))
+ return 1;
+ int cmp = value_cmp (buf_a, buf_b, maxdepth - 1);
+ if (cmp != 0)
+ return cmp;
+ ptrdiff_t pa = XMARKER (a)->charpos;
+ ptrdiff_t pb = XMARKER (b)->charpos;
+ return pa < pb ? -1 : pa > pb;
+ }
+
+ case PVEC_PROCESS:
+ a = Fprocess_name (a);
+ b = Fprocess_name (b);
+ goto tail_recurse;
+
+ case PVEC_BUFFER:
+ {
+ /* Killed buffers lack names and sort before those alive. */
+ Lisp_Object na = Fbuffer_name (a);
+ Lisp_Object nb = Fbuffer_name (b);
+ if (NILP (na))
+ return NILP (nb) ? 0 : -1;
+ if (NILP (nb))
+ return 1;
+ a = na;
+ b = nb;
+ goto tail_recurse;
+ }
+
+ case PVEC_BIGNUM:
+ return mpz_cmp (*xbignum_val (a), *xbignum_val (b));
+
+ case PVEC_SYMBOL_WITH_POS:
+ /* Compare by name, enabled or not. */
+ a = XSYMBOL_WITH_POS_SYM (a);
+ b = XSYMBOL_WITH_POS_SYM (b);
+ goto tail_recurse;
+
+ default:
+ /* Treat other types as unordered. */
+ return 0;
+ }
+ }
+ else if (BIGNUMP (a))
+ return -value_cmp (b, a, maxdepth);
+ else if (SYMBOL_WITH_POS_P (a) && symbols_with_pos_enabled)
+ {
+ a = XSYMBOL_WITH_POS_SYM (a);
+ goto tail_recurse;
+ }
+
+ goto type_mismatch;
+
+ case Lisp_Float:
+ {
+ double fa = XFLOAT_DATA (a);
+ if (FLOATP (b))
+ return fa < XFLOAT_DATA (b) ? -1 : fa > XFLOAT_DATA (b);
+ if (FIXNUMP (b))
+ return fa < XFIXNUM (b) ? -1 : fa > XFIXNUM (b);
+ if (BIGNUMP (b))
+ {
+ if (isnan (fa))
+ return 0;
+ return -mpz_cmp_d (*xbignum_val (b), fa);
+ }
+ }
+ goto type_mismatch;
+
+ default:
+ eassume (0);
+ }
+ type_mismatch:
+ xsignal2 (Qtype_mismatch, a, b);
+}
+
+DEFUN ("value<", Fvaluelt, Svaluelt, 2, 2, 0,
+ doc: /* Return non-nil if A precedes B in standard value order.
+A and B must have the same basic type.
+Numbers are compared with `<'.
+Strings and symbols are compared with `string-lessp'.
+Lists, vectors, bool-vectors and records are compared lexicographically.
+Markers are compared lexicographically by buffer and position.
+Buffers and processes are compared by name.
+Other types are considered unordered and the return value will be `nil'. */)
+ (Lisp_Object a, Lisp_Object b)
+{
+ int maxdepth = 200; /* FIXME: arbitrary value */
+ return value_cmp (a, b, maxdepth) < 0 ? Qt : Qnil;
+}
+
DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
@@ -3207,7 +3506,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
Lisp_Object
do_yes_or_no_p (Lisp_Object prompt)
{
- return call1 (intern ("yes-or-no-p"), prompt);
+ return call1 (Qyes_or_no_p, prompt);
}
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
@@ -3252,7 +3551,7 @@ by a mouse, or by some window-system gesture, or via a menu. */)
}
if (use_short_answers)
- return call1 (intern ("y-or-n-p"), prompt);
+ return call1 (Qy_or_n_p, prompt);
{
char *s = SSDATA (prompt);
@@ -4275,17 +4574,20 @@ CHECK_HASH_TABLE (Lisp_Object x)
static void
set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
{
- gc_aset (h->next, idx, make_fixnum (val));
+ eassert (idx >= 0 && idx < h->table_size);
+ h->next[idx] = val;
}
static void
-set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
{
- gc_aset (h->hash, idx, val);
+ eassert (idx >= 0 && idx < h->table_size);
+ h->hash[idx] = val;
}
static void
set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
{
- gc_aset (h->index, idx, make_fixnum (val));
+ eassert (idx >= 0 && idx < hash_table_index_size (h));
+ h->index[idx] = val;
}
/* If OBJ is a Lisp hash table, return a pointer to its struct
@@ -4339,11 +4641,10 @@ get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used)
/* Return a Lisp vector which has the same contents as VEC but has
at least INCR_MIN more entries, where INCR_MIN is positive.
If NITEMS_MAX is not -1, do not grow the vector to be any larger
- than NITEMS_MAX. New entries in the resulting vector are
- uninitialized. */
+ than NITEMS_MAX. New entries in the resulting vector are nil. */
-static Lisp_Object
-larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
+Lisp_Object
+larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
ptrdiff_t incr, incr_max, old_size, new_size;
@@ -4360,23 +4661,11 @@ larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
new_size = old_size + incr;
v = allocate_vector (new_size);
memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
+ memclear (v->contents + old_size, (new_size - old_size) * word_size);
XSETVECTOR (vec, v);
return vec;
}
-/* Likewise, except set new entries in the resulting vector to nil. */
-
-Lisp_Object
-larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
-{
- ptrdiff_t old_size = ASIZE (vec);
- Lisp_Object v = larger_vecalloc (vec, incr_min, nitems_max);
- ptrdiff_t new_size = ASIZE (v);
- memclear (XVECTOR (v)->contents + old_size,
- (new_size - old_size) * word_size);
- return v;
-}
-
/***********************************************************************
Low-level Functions
@@ -4388,7 +4677,8 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
static ptrdiff_t
HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- return XFIXNUM (AREF (h->next, idx));
+ eassert (idx >= 0 && idx < h->table_size);
+ return h->next[idx];
}
/* Return the index of the element in hash table H that is the start
@@ -4397,7 +4687,8 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
static ptrdiff_t
HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- return XFIXNUM (AREF (h->index, idx));
+ eassert (idx >= 0 && idx < hash_table_index_size (h));
+ return h->index[idx];
}
/* Restore a hash table's mutability after the critical section exits. */
@@ -4452,89 +4743,93 @@ static Lisp_Object
cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2,
struct Lisp_Hash_Table *h)
{
- Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 };
+ Lisp_Object args[] = { h->test->user_cmp_function, key1, key2 };
return hash_table_user_defined_call (ARRAYELTS (args), args, h);
}
+static EMACS_INT
+sxhash_eq (Lisp_Object key)
+{
+ Lisp_Object k = maybe_remove_pos_from_symbol (key);
+ return XHASH (k) ^ XTYPE (k);
+}
+
+static EMACS_INT
+sxhash_eql (Lisp_Object key)
+{
+ return FLOATP (key) || BIGNUMP (key) ? sxhash (key) : sxhash_eq (key);
+}
+
/* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */
-static Lisp_Object
+static hash_hash_t
hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key))
- key = SYMBOL_WITH_POS_SYM (key);
- return make_ufixnum (XHASH (key) ^ XTYPE (key));
+ return reduce_emacs_uint_to_hash_hash (sxhash_eq (key));
}
-/* Ignore H and return a hash code for KEY which uses 'equal' to compare keys.
- The hash code is at most INTMASK. */
-
-static Lisp_Object
+/* Ignore H and return a hash code for KEY which uses 'equal' to
+ compare keys. */
+static hash_hash_t
hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- return make_ufixnum (sxhash (key));
+ return reduce_emacs_uint_to_hash_hash (sxhash (key));
}
-/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys.
- The hash code is at most INTMASK. */
-
-static Lisp_Object
+/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. */
+static hash_hash_t
hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h);
+ return reduce_emacs_uint_to_hash_hash (sxhash_eql (key));
}
/* Given H, return a hash code for KEY which uses a user-defined
function to compare keys. */
-Lisp_Object
+static hash_hash_t
hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- Lisp_Object args[] = { h->test.user_hash_function, key };
+ Lisp_Object args[] = { h->test->user_hash_function, key };
Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
- return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash));
+ return reduce_emacs_uint_to_hash_hash (FIXNUMP (hash)
+ ? XUFIXNUM(hash) : sxhash (hash));
}
struct hash_table_test const
- hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil),
- LISPSYM_INITIALLY (Qnil), 0, hashfn_eq },
- hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil),
- LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql },
- hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil),
- LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal };
+ hashtest_eq = { .name = LISPSYM_INITIALLY (Qeq),
+ .cmpfn = 0, .hashfn = hashfn_eq },
+ hashtest_eql = { .name = LISPSYM_INITIALLY (Qeql),
+ .cmpfn = cmpfn_eql, .hashfn = hashfn_eql },
+ hashtest_equal = { .name = LISPSYM_INITIALLY (Qequal),
+ .cmpfn = cmpfn_equal, .hashfn = hashfn_equal };
/* Allocate basically initialized hash table. */
static struct Lisp_Hash_Table *
allocate_hash_table (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table,
- index, PVEC_HASH_TABLE);
+ return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
}
-/* An upper bound on the size of a hash table index. It must fit in
- ptrdiff_t and be a valid Emacs fixnum. This is an upper bound on
- VECTOR_ELTS_MAX (see alloc.c) and gets as close as we can without
- violating modularity. */
-#define INDEX_SIZE_BOUND \
- ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
- ((min (PTRDIFF_MAX, SIZE_MAX) \
- - header_size - GCALIGNMENT) \
- / word_size)))
-
-static ptrdiff_t
-hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size)
-{
- double threshold = h->rehash_threshold;
- double index_float = size / threshold;
- ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1
- ? next_almost_prime (index_float)
- : INDEX_SIZE_BOUND + 1);
- if (INDEX_SIZE_BOUND < index_size)
+/* Compute the size of the index (as log2) from the table capacity. */
+static int
+compute_hash_index_bits (hash_idx_t size)
+{
+ /* An upper bound on the size of a hash table index index. */
+ hash_idx_t upper_bound = min (MOST_POSITIVE_FIXNUM,
+ min (TYPE_MAXIMUM (hash_idx_t),
+ PTRDIFF_MAX / sizeof (hash_idx_t)));
+ /* Use next higher power of 2. This works even for size=0. */
+ int bits = elogb (size) + 1;
+ if (bits >= TYPE_WIDTH (uintmax_t) || ((uintmax_t)1 << bits) > upper_bound)
error ("Hash table too large");
- return index_size;
+ return bits;
}
+/* Constant hash index vector used when the table size is zero.
+ This avoids allocating it from the heap. */
+static const hash_idx_t empty_hash_index_vector[] = {-1};
+
/* Create and initialize a new hash table.
TEST specifies the test the hash table will use to compare keys.
@@ -4544,68 +4839,63 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size)
Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM.
- If REHASH_SIZE is equal to a negative integer, this hash table's
- new size when it becomes full is computed by subtracting
- REHASH_SIZE from its old size. Otherwise it must be positive, and
- the table's new size is computed by multiplying its old size by
- REHASH_SIZE + 1.
-
- REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will
- be resized when the approximate ratio of table entries to table
- size exceeds REHASH_THRESHOLD.
-
- WEAK specifies the weakness of the table. If non-nil, it must be
- one of the symbols `key', `value', `key-or-value', or `key-and-value'.
+ WEAK specifies the weakness of the table.
If PURECOPY is non-nil, the table can be copied to pure storage via
`purecopy' when Emacs is being dumped. Such tables can no longer be
changed after purecopy. */
Lisp_Object
-make_hash_table (struct hash_table_test test, EMACS_INT size,
- float rehash_size, float rehash_threshold,
- Lisp_Object weak, bool purecopy)
+make_hash_table (const struct hash_table_test *test, EMACS_INT size,
+ hash_table_weakness_t weak, bool purecopy)
{
- struct Lisp_Hash_Table *h;
- Lisp_Object table;
- ptrdiff_t i;
+ eassert (SYMBOLP (test->name));
+ eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
- /* Preconditions. */
- eassert (SYMBOLP (test.name));
- eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM);
- eassert (rehash_size <= -1 || 0 < rehash_size);
- eassert (0 < rehash_threshold && rehash_threshold <= 1);
+ struct Lisp_Hash_Table *h = allocate_hash_table ();
+
+ h->test = test;
+ h->weakness = weak;
+ h->count = 0;
+ h->table_size = size;
if (size == 0)
- size = 1;
+ {
+ h->key_and_value = NULL;
+ h->hash = NULL;
+ h->next = NULL;
+ h->index_bits = 0;
+ h->index = (hash_idx_t *)empty_hash_index_vector;
+ h->next_free = -1;
+ }
+ else
+ {
+ h->key_and_value = hash_table_alloc_bytes (2 * size
+ * sizeof *h->key_and_value);
+ for (ptrdiff_t i = 0; i < 2 * size; i++)
+ h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY;
- /* Allocate a table and initialize it. */
- h = allocate_hash_table ();
+ h->hash = hash_table_alloc_bytes (size * sizeof *h->hash);
- /* Initialize hash table slots. */
- h->test = test;
- h->weak = weak;
- h->rehash_threshold = rehash_threshold;
- h->rehash_size = rehash_size;
- h->count = 0;
- h->key_and_value = make_vector (2 * size, Qunbound);
- h->hash = make_nil_vector (size);
- h->next = make_vector (size, make_fixnum (-1));
- h->index = make_vector (hash_index_size (h, size), make_fixnum (-1));
- h->next_weak = NULL;
- h->purecopy = purecopy;
- h->mutable = true;
+ h->next = hash_table_alloc_bytes (size * sizeof *h->next);
+ for (ptrdiff_t i = 0; i < size - 1; i++)
+ h->next[i] = i + 1;
+ h->next[size - 1] = -1;
- /* Set up the free list. */
- for (i = 0; i < size - 1; ++i)
- set_hash_next_slot (h, i, i + 1);
- h->next_free = 0;
+ int index_bits = compute_hash_index_bits (size);
+ h->index_bits = index_bits;
+ ptrdiff_t index_size = hash_table_index_size (h);
+ h->index = hash_table_alloc_bytes (index_size * sizeof *h->index);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ h->index[i] = -1;
- XSET_HASH_TABLE (table, h);
- eassert (HASH_TABLE_P (table));
- eassert (XHASH_TABLE (table) == h);
+ h->next_free = 0;
+ }
- return table;
+ h->next_weak = NULL;
+ h->purecopy = purecopy;
+ h->mutable = true;
+ return make_lisp_hash_table (h);
}
@@ -4615,21 +4905,39 @@ make_hash_table (struct hash_table_test test, EMACS_INT size,
static Lisp_Object
copy_hash_table (struct Lisp_Hash_Table *h1)
{
- Lisp_Object table;
struct Lisp_Hash_Table *h2;
h2 = allocate_hash_table ();
*h2 = *h1;
h2->mutable = true;
- h2->key_and_value = Fcopy_sequence (h1->key_and_value);
- h2->hash = Fcopy_sequence (h1->hash);
- h2->next = Fcopy_sequence (h1->next);
- h2->index = Fcopy_sequence (h1->index);
- XSET_HASH_TABLE (table, h2);
- return table;
+ if (h1->table_size > 0)
+ {
+ ptrdiff_t kv_bytes = 2 * h1->table_size * sizeof *h1->key_and_value;
+ h2->key_and_value = hash_table_alloc_bytes (kv_bytes);
+ memcpy (h2->key_and_value, h1->key_and_value, kv_bytes);
+
+ ptrdiff_t hash_bytes = h1->table_size * sizeof *h1->hash;
+ h2->hash = hash_table_alloc_bytes (hash_bytes);
+ memcpy (h2->hash, h1->hash, hash_bytes);
+
+ ptrdiff_t next_bytes = h1->table_size * sizeof *h1->next;
+ h2->next = hash_table_alloc_bytes (next_bytes);
+ memcpy (h2->next, h1->next, next_bytes);
+
+ ptrdiff_t index_bytes = hash_table_index_size (h1) * sizeof *h1->index;
+ h2->index = hash_table_alloc_bytes (index_bytes);
+ memcpy (h2->index, h1->index, index_bytes);
+ }
+ return make_lisp_hash_table (h2);
}
+/* Compute index into the index vector from a hash value. */
+static inline ptrdiff_t
+hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
+{
+ return knuth_hash (hash, h->index_bits);
+}
/* Resize hash table H if it's too full. If H cannot be resized
because it's already too large, throw an error. */
@@ -4640,121 +4948,168 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
if (h->next_free < 0)
{
ptrdiff_t old_size = HASH_TABLE_SIZE (h);
- EMACS_INT new_size;
- double rehash_size = h->rehash_size;
-
- if (rehash_size < 0)
- new_size = old_size - rehash_size;
- else
- {
- double float_new_size = old_size * (rehash_size + 1);
- if (float_new_size < EMACS_INT_MAX)
- new_size = float_new_size;
- else
- new_size = EMACS_INT_MAX;
- }
- if (PTRDIFF_MAX < new_size)
- new_size = PTRDIFF_MAX;
- if (new_size <= old_size)
- new_size = old_size + 1;
+ ptrdiff_t min_size = 6;
+ ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
+ /* Grow aggressively at small sizes, then just double. */
+ ptrdiff_t new_size =
+ old_size == 0
+ ? min_size
+ : (base_size <= 64 ? base_size * 4 : base_size * 2);
/* Allocate all the new vectors before updating *H, to
- avoid problems if memory is exhausted. larger_vecalloc
- finishes computing the size of the replacement vectors. */
- Lisp_Object next = larger_vecalloc (h->next, new_size - old_size,
- new_size);
- ptrdiff_t next_size = ASIZE (next);
- for (ptrdiff_t i = old_size; i < next_size - 1; i++)
- ASET (next, i, make_fixnum (i + 1));
- ASET (next, next_size - 1, make_fixnum (-1));
-
- /* Build the new&larger key_and_value vector, making sure the new
- fields are initialized to `unbound`. */
- Lisp_Object key_and_value
- = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
- 2 * next_size);
- for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++)
- ASET (key_and_value, i, Qunbound);
-
- Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
- next_size);
- ptrdiff_t index_size = hash_index_size (h, next_size);
- h->index = make_vector (index_size, make_fixnum (-1));
+ avoid problems if memory is exhausted. */
+ hash_idx_t *next = hash_table_alloc_bytes (new_size * sizeof *next);
+ for (ptrdiff_t i = old_size; i < new_size - 1; i++)
+ next[i] = i + 1;
+ next[new_size - 1] = -1;
+
+ Lisp_Object *key_and_value
+ = hash_table_alloc_bytes (2 * new_size * sizeof *key_and_value);
+ memcpy (key_and_value, h->key_and_value,
+ 2 * old_size * sizeof *key_and_value);
+ for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++)
+ key_and_value[i] = HASH_UNUSED_ENTRY_KEY;
+
+ hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash);
+ memcpy (hash, h->hash, old_size * sizeof *hash);
+
+ ptrdiff_t old_index_size = hash_table_index_size (h);
+ ptrdiff_t index_bits = compute_hash_index_bits (new_size);
+ ptrdiff_t index_size = (ptrdiff_t)1 << index_bits;
+ hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ index[i] = -1;
+
+ h->index_bits = index_bits;
+ h->table_size = new_size;
+ h->next_free = old_size;
+
+ if (old_index_size > 1)
+ hash_table_free_bytes (h->index, old_index_size * sizeof *h->index);
+ h->index = index;
+
+ hash_table_free_bytes (h->key_and_value,
+ 2 * old_size * sizeof *h->key_and_value);
h->key_and_value = key_and_value;
+
+ hash_table_free_bytes (h->hash, old_size * sizeof *h->hash);
h->hash = hash;
+
+ hash_table_free_bytes (h->next, old_size * sizeof *h->next);
h->next = next;
- h->next_free = old_size;
- /* Rehash. */
+ h->key_and_value = key_and_value;
+
+ /* Rehash: all data occupy entries 0..old_size-1. */
for (ptrdiff_t i = 0; i < old_size; i++)
- if (!NILP (HASH_HASH (h, i)))
- {
- EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i));
- ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
- set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
- set_hash_index_slot (h, start_of_bucket, i);
- }
+ {
+ hash_hash_t hash_code = HASH_HASH (h, i);
+ ptrdiff_t start_of_bucket = hash_index_index (h, hash_code);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, i);
+ }
#ifdef ENABLE_CHECKING
if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h)
- message ("Growing hash table to: %"pD"d", next_size);
+ message ("Growing hash table to: %"pD"d", new_size);
#endif
}
}
-/* Recompute the hashes (and hence also the "next" pointers).
- Normally there's never a need to recompute hashes.
- This is done only on first access to a hash-table loaded from
- the "pdump", because the objects' addresses may have changed, thus
- affecting their hashes. */
+static const struct hash_table_test *
+hash_table_test_from_std (hash_table_std_test_t test)
+{
+ switch (test)
+ {
+ case Test_eq: return &hashtest_eq;
+ case Test_eql: return &hashtest_eql;
+ case Test_equal: return &hashtest_equal;
+ }
+ emacs_abort();
+}
+
+/* Rebuild a hash table from its frozen (dumped) form. */
void
-hash_table_rehash (Lisp_Object hash)
+hash_table_thaw (Lisp_Object hash_table)
{
- struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
- ptrdiff_t i, count = h->count;
+ struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table);
- /* Recompute the actual hash codes for each entry in the table.
- Order is still invalid. */
- for (i = 0; i < count; i++)
+ /* Freezing discarded most non-essential information; recompute it.
+ The allocation is minimal with no room for growth. */
+ h->test = hash_table_test_from_std (h->frozen_test);
+ ptrdiff_t size = h->count;
+ h->table_size = size;
+ h->next_free = -1;
+
+ if (size == 0)
{
- Lisp_Object key = HASH_KEY (h, i);
- Lisp_Object hash_code = h->test.hashfn (key, h);
- ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
- set_hash_hash_slot (h, i, hash_code);
- set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
- set_hash_index_slot (h, start_of_bucket, i);
- eassert (HASH_NEXT (h, i) != i); /* Stop loops. */
+ h->key_and_value = NULL;
+ h->hash = NULL;
+ h->next = NULL;
+ h->index_bits = 0;
+ h->index = (hash_idx_t *)empty_hash_index_vector;
}
+ else
+ {
+ ptrdiff_t index_bits = compute_hash_index_bits (size);
+ h->index_bits = index_bits;
- ptrdiff_t size = ASIZE (h->next);
- for (; i + 1 < size; i++)
- set_hash_next_slot (h, i, i + 1);
-}
-
-/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH
- the hash code of KEY. Value is the index of the entry in H
- matching KEY, or -1 if not found. */
+ h->hash = hash_table_alloc_bytes (size * sizeof *h->hash);
-ptrdiff_t
-hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash)
-{
- ptrdiff_t start_of_bucket, i;
+ h->next = hash_table_alloc_bytes (size * sizeof *h->next);
- Lisp_Object hash_code;
- hash_code = h->test.hashfn (key, h);
- if (hash)
- *hash = hash_code;
+ ptrdiff_t index_size = hash_table_index_size (h);
+ h->index = hash_table_alloc_bytes (index_size * sizeof *h->index);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ h->index[i] = -1;
- start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
+ /* Recompute the hash codes for each entry in the table. */
+ for (ptrdiff_t i = 0; i < size; i++)
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ hash_hash_t hash_code = hash_from_key (h, key);
+ ptrdiff_t start_of_bucket = hash_index_index (h, hash_code);
+ set_hash_hash_slot (h, i, hash_code);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, i);
+ }
+ }
+}
- for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i))
+/* Look up KEY with hash HASH in table H.
+ Return entry index or -1 if none. */
+static ptrdiff_t
+hash_lookup_with_hash (struct Lisp_Hash_Table *h,
+ Lisp_Object key, hash_hash_t hash)
+{
+ ptrdiff_t start_of_bucket = hash_index_index (h, hash);
+ for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
+ 0 <= i; i = HASH_NEXT (h, i))
if (EQ (key, HASH_KEY (h, i))
- || (h->test.cmpfn
- && EQ (hash_code, HASH_HASH (h, i))
- && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h))))
- break;
+ || (h->test->cmpfn
+ && hash == HASH_HASH (h, i)
+ && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h))))
+ return i;
- return i;
+ return -1;
+}
+
+/* Look up KEY in table H. Return entry index or -1 if none. */
+ptrdiff_t
+hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
+{
+ return hash_lookup_with_hash (h, key, hash_from_key (h, key));
+}
+
+/* Look up KEY in hash table H. Return its hash value in *PHASH.
+ Value is the index of the entry in H matching KEY, or -1 if not found. */
+ptrdiff_t
+hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key,
+ hash_hash_t *phash)
+{
+ EMACS_UINT hash = hash_from_key (h, key);
+ *phash = hash;
+ return hash_lookup_with_hash (h, key, hash);
}
static void
@@ -4765,33 +5120,22 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h)
eassert (!PURE_P (h));
}
-static void
-collect_interval (INTERVAL interval, Lisp_Object collector)
-{
- nconc2 (collector,
- list1(list3 (make_fixnum (interval->position),
- make_fixnum (interval->position + LENGTH (interval)),
- interval->plist)));
-}
-
/* Put an entry into hash table H that associates KEY with VALUE.
HASH is a previously computed hash code of KEY.
Value is the index of the entry in H matching KEY. */
ptrdiff_t
hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
- Lisp_Object hash)
+ hash_hash_t hash)
{
- ptrdiff_t start_of_bucket, i;
-
+ eassert (!hash_unused_entry_key_p (key));
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
h->count++;
/* Store key/value in the key_and_value vector. */
- i = h->next_free;
- eassert (NILP (HASH_HASH (h, i)));
- eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i))));
+ ptrdiff_t i = h->next_free;
+ eassert (hash_unused_entry_key_p (HASH_KEY (h, i)));
h->next_free = HASH_NEXT (h, i);
set_hash_key_slot (h, i, key);
set_hash_value_slot (h, i, value);
@@ -4800,7 +5144,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
set_hash_hash_slot (h, i, hash);
/* Add new entry to its collision chain. */
- start_of_bucket = XUFIXNUM (hash) % ASIZE (h->index);
+ ptrdiff_t start_of_bucket = hash_index_index (h, hash);
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index_slot (h, start_of_bucket, i);
return i;
@@ -4812,8 +5156,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- Lisp_Object hash_code = h->test.hashfn (key, h);
- ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index);
+ hash_hash_t hashval = hash_from_key (h, key);
+ ptrdiff_t start_of_bucket = hash_index_index (h, hashval);
ptrdiff_t prev = -1;
for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
@@ -4821,9 +5165,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
i = HASH_NEXT (h, i))
{
if (EQ (key, HASH_KEY (h, i))
- || (h->test.cmpfn
- && EQ (hash_code, HASH_HASH (h, i))
- && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h))))
+ || (h->test->cmpfn
+ && hashval == HASH_HASH (h, i)
+ && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h))))
{
/* Take entry out of collision chain. */
if (prev < 0)
@@ -4833,9 +5177,8 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
/* Clear slots in key_and_value and add the slots to
the free list. */
- set_hash_key_slot (h, i, Qunbound);
+ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
set_hash_value_slot (h, i, Qnil);
- set_hash_hash_slot (h, i, Qnil);
set_hash_next_slot (h, i, h->next_free);
h->next_free = i;
h->count--;
@@ -4856,16 +5199,16 @@ hash_clear (struct Lisp_Hash_Table *h)
if (h->count > 0)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
- memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
- set_hash_key_slot (h, i, Qunbound);
+ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
set_hash_value_slot (h, i, Qnil);
}
- for (ptrdiff_t i = 0; i < ASIZE (h->index); i++)
- ASET (h->index, i, make_fixnum (-1));
+ ptrdiff_t index_size = hash_table_index_size (h);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ h->index[i] = -1;
h->next_free = 0;
h->count = 0;
@@ -4878,6 +5221,23 @@ hash_clear (struct Lisp_Hash_Table *h)
Weak Hash Tables
************************************************************************/
+/* Whether to keep an entry whose key and value are known to be retained
+ if STRONG_KEY and STRONG_VALUE, respectively, are true. */
+static inline bool
+keep_entry_p (hash_table_weakness_t weakness,
+ bool strong_key, bool strong_value)
+{
+ switch (weakness)
+ {
+ case Weak_None: return true;
+ case Weak_Key: return strong_key;
+ case Weak_Value: return strong_value;
+ case Weak_Key_Or_Value: return strong_key || strong_value;
+ case Weak_Key_And_Value: return strong_key && strong_value;
+ }
+ emacs_abort();
+}
+
/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove
entries from the table that don't survive the current GC.
!REMOVE_ENTRIES_P means mark entries that are in use. Value is
@@ -4886,7 +5246,7 @@ hash_clear (struct Lisp_Hash_Table *h)
bool
sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- ptrdiff_t n = gc_asize (h->index);
+ ptrdiff_t n = hash_table_index_size (h);
bool marked = false;
for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
@@ -4899,18 +5259,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
- bool remove_p;
-
- if (EQ (h->weak, Qkey))
- remove_p = !key_known_to_survive_p;
- else if (EQ (h->weak, Qvalue))
- remove_p = !value_known_to_survive_p;
- else if (EQ (h->weak, Qkey_or_value))
- remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
- else if (EQ (h->weak, Qkey_and_value))
- remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
- else
- emacs_abort ();
+ bool remove_p = !keep_entry_p (h->weakness,
+ key_known_to_survive_p,
+ value_known_to_survive_p);
next = HASH_NEXT (h, i);
@@ -4930,11 +5281,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
set_hash_next_slot (h, i, h->next_free);
h->next_free = i;
- /* Clear key, value, and hash. */
- set_hash_key_slot (h, i, Qunbound);
+ /* Clear key and value. */
+ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
set_hash_value_slot (h, i, Qnil);
- if (!NILP (h->hash))
- set_hash_hash_slot (h, i, Qnil);
eassert (h->count != 0);
h->count--;
@@ -4993,39 +5342,57 @@ hash_string (char const *ptr, ptrdiff_t len)
EMACS_UINT hash = len;
/* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
* but dividing by 8 is cheaper. */
- ptrdiff_t step = sizeof hash + ((end - p) >> 3);
+ ptrdiff_t step = max (sizeof hash, ((end - p) >> 3));
- while (p + sizeof hash <= end)
+ if (p + sizeof hash <= end)
{
+ do
+ {
+ EMACS_UINT c;
+ /* We presume that the compiler will replace this `memcpy` with
+ a single load/move instruction when applicable. */
+ memcpy (&c, p, sizeof hash);
+ p += step;
+ hash = sxhash_combine (hash, c);
+ }
+ while (p + sizeof hash <= end);
+ /* Hash the last wordful of bytes in the string, because that is
+ is often the part where strings differ. This may cause some
+ bytes to be hashed twice but we assume that's not a big problem. */
EMACS_UINT c;
- /* We presume that the compiler will replace this `memcpy` with
- a single load/move instruction when applicable. */
- memcpy (&c, p, sizeof hash);
- p += step;
+ memcpy (&c, end - sizeof c, sizeof c);
hash = sxhash_combine (hash, c);
}
- /* A few last bytes may remain (smaller than an EMACS_UINT). */
- /* FIXME: We could do this without a loop, but it'd require
- endian-dependent code :-( */
- while (p < end)
+ else
{
- unsigned char c = *p++;
- hash = sxhash_combine (hash, c);
+ /* String is shorter than an EMACS_UINT. Use smaller loads. */
+ eassume (p <= end && end - p < sizeof (EMACS_UINT));
+ EMACS_UINT tail = 0;
+ verify (sizeof tail <= 8);
+#if EMACS_INT_MAX > INT32_MAX
+ if (end - p >= 4)
+ {
+ uint32_t c;
+ memcpy (&c, p, sizeof c);
+ tail = (tail << (8 * sizeof c)) + c;
+ p += sizeof c;
+ }
+#endif
+ if (end - p >= 2)
+ {
+ uint16_t c;
+ memcpy (&c, p, sizeof c);
+ tail = (tail << (8 * sizeof c)) + c;
+ p += sizeof c;
+ }
+ if (p < end)
+ tail = (tail << 8) + (unsigned char)*p;
+ hash = sxhash_combine (hash, tail);
}
return hash;
}
-/* Return a hash for string PTR which has length LEN. The hash
- code returned is at most INTMASK. */
-
-static EMACS_UINT
-sxhash_string (char const *ptr, ptrdiff_t len)
-{
- EMACS_UINT hash = hash_string (ptr, len);
- return SXHASH_REDUCE (hash);
-}
-
/* Return a hash for the floating point value VAL. */
static EMACS_UINT
@@ -5035,7 +5402,7 @@ sxhash_float (double val)
union double_and_words u = { .val = val };
for (int i = 0; i < WORDS_PER_DOUBLE; i++)
hash = sxhash_combine (hash, u.word[i]);
- return SXHASH_REDUCE (hash);
+ return hash;
}
/* Return a hash for list LIST. DEPTH is the current depth in the
@@ -5062,7 +5429,7 @@ sxhash_list (Lisp_Object list, int depth)
hash = sxhash_combine (hash, hash2);
}
- return SXHASH_REDUCE (hash);
+ return hash;
}
@@ -5082,7 +5449,7 @@ sxhash_vector (Lisp_Object vec, int depth)
hash = sxhash_combine (hash, hash2);
}
- return SXHASH_REDUCE (hash);
+ return hash;
}
/* Return a hash for bool-vector VECTOR. */
@@ -5098,7 +5465,7 @@ sxhash_bool_vector (Lisp_Object vec)
for (i = 0; i < n; ++i)
hash = sxhash_combine (hash, bool_vector_data (vec)[i]);
- return SXHASH_REDUCE (hash);
+ return hash;
}
/* Return a hash for a bignum. */
@@ -5108,24 +5475,23 @@ sxhash_bignum (Lisp_Object bignum)
{
mpz_t const *n = xbignum_val (bignum);
size_t i, nlimbs = mpz_size (*n);
- EMACS_UINT hash = 0;
+ EMACS_UINT hash = mpz_sgn(*n) < 0;
for (i = 0; i < nlimbs; ++i)
hash = sxhash_combine (hash, mpz_getlimbn (*n, i));
- return SXHASH_REDUCE (hash);
+ return hash;
}
-
-/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
- structure. Value is an unsigned integer clipped to INTMASK. */
-
EMACS_UINT
sxhash (Lisp_Object obj)
{
return sxhash_obj (obj, 0);
}
+/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
+ structure. */
+
static EMACS_UINT
sxhash_obj (Lisp_Object obj, int depth)
{
@@ -5141,7 +5507,7 @@ sxhash_obj (Lisp_Object obj, int depth)
return XHASH (obj);
case Lisp_String:
- return sxhash_string (SSDATA (obj), SBYTES (obj));
+ return hash_string (SSDATA (obj), SBYTES (obj));
case Lisp_Vectorlike:
{
@@ -5168,7 +5534,7 @@ sxhash_obj (Lisp_Object obj, int depth)
= XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
EMACS_UINT hash
= sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
- return SXHASH_REDUCE (hash);
+ return hash;
}
else if (pvec_type == PVEC_BOOL_VECTOR)
return sxhash_bool_vector (obj);
@@ -5177,14 +5543,17 @@ sxhash_obj (Lisp_Object obj, int 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);
+ return hash;
}
- else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS)
- return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1);
else
- /* Others are 'equal' if they are 'eq', so take their
- address as hash. */
- return XHASH (obj);
+ {
+ if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS)
+ obj = XSYMBOL_WITH_POS_SYM (obj);
+
+ /* Others are 'equal' if they are 'eq', so take their
+ address as hash. */
+ return XHASH (obj);
+ }
}
case Lisp_Cons:
@@ -5198,12 +5567,41 @@ sxhash_obj (Lisp_Object obj, int depth)
}
}
+static void
+hash_interval (INTERVAL interval, void *arg)
+{
+ EMACS_UINT *phash = arg;
+ EMACS_UINT hash = *phash;
+ hash = sxhash_combine (hash, interval->position);
+ hash = sxhash_combine (hash, LENGTH (interval));
+ hash = sxhash_combine (hash, sxhash_obj (interval->plist, 0));
+ *phash = hash;
+}
+
+static void
+collect_interval (INTERVAL interval, void *arg)
+{
+ Lisp_Object *collector = arg;
+ *collector = Fcons (list3 (make_fixnum (interval->position),
+ make_fixnum (interval->position
+ + LENGTH (interval)),
+ interval->plist),
+ *collector);
+}
+
/***********************************************************************
Lisp Interface
***********************************************************************/
+/* Reduce the hash value X to a Lisp fixnum. */
+static inline Lisp_Object
+reduce_emacs_uint_to_fixnum (EMACS_UINT x)
+{
+ return make_ufixnum (SXHASH_REDUCE (x));
+}
+
DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
doc: /* Return an integer hash code for OBJ suitable for `eq'.
If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).
@@ -5211,7 +5609,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
(Lisp_Object obj)
{
- return hashfn_eq (obj, NULL);
+ return reduce_emacs_uint_to_fixnum (sxhash_eq (obj));
}
DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
@@ -5222,7 +5620,7 @@ isn't necessarily true.
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
(Lisp_Object obj)
{
- return hashfn_eql (obj, NULL);
+ return reduce_emacs_uint_to_fixnum (sxhash_eql (obj));
}
DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
@@ -5233,7 +5631,7 @@ opposite isn't necessarily true.
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
(Lisp_Object obj)
{
- return hashfn_equal (obj, NULL);
+ return reduce_emacs_uint_to_fixnum (sxhash (obj));
}
DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties,
@@ -5246,18 +5644,65 @@ If (sxhash-equal-including-properties A B), then
Hash codes are not guaranteed to be preserved across Emacs sessions. */)
(Lisp_Object obj)
{
+ EMACS_UINT hash = sxhash (obj);
if (STRINGP (obj))
+ traverse_intervals (string_intervals (obj), 0, hash_interval, &hash);
+ return reduce_emacs_uint_to_fixnum (hash);
+}
+
+
+/* This is a cache of hash_table_test structures so that they can be
+ shared between hash tables using the same test.
+ FIXME: This way of storing and looking up hash_table_test structs
+ isn't wonderful. Find a better solution. */
+struct hash_table_user_test
+{
+ struct hash_table_test test;
+ struct hash_table_user_test *next;
+};
+
+static struct hash_table_user_test *hash_table_user_tests = NULL;
+
+void
+mark_fns (void)
+{
+ for (struct hash_table_user_test *ut = hash_table_user_tests;
+ ut; ut = ut->next)
{
- Lisp_Object collector = Fcons (Qnil, Qnil);
- traverse_intervals (string_intervals (obj), 0, collect_interval,
- collector);
- return
- make_ufixnum (
- SXHASH_REDUCE (sxhash_combine (sxhash (obj),
- sxhash (CDR (collector)))));
+ mark_object (ut->test.name);
+ mark_object (ut->test.user_cmp_function);
+ mark_object (ut->test.user_hash_function);
}
+}
- return hashfn_equal (obj, NULL);
+/* Find the hash_table_test object corresponding to the (bare) symbol TEST,
+ creating one if none existed. */
+static struct hash_table_test *
+get_hash_table_user_test (Lisp_Object test)
+{
+ Lisp_Object prop = Fget (test, Qhash_table_test);
+ if (!CONSP (prop) || !CONSP (XCDR (prop)))
+ signal_error ("Invalid hash table test", test);
+
+ Lisp_Object equal_fn = XCAR (prop);
+ Lisp_Object hash_fn = XCAR (XCDR (prop));
+ struct hash_table_user_test *ut = hash_table_user_tests;
+ while (ut && !(BASE_EQ (test, ut->test.name)
+ && EQ (equal_fn, ut->test.user_cmp_function)
+ && EQ (hash_fn, ut->test.user_hash_function)))
+ ut = ut->next;
+ if (!ut)
+ {
+ ut = xmalloc (sizeof *ut);
+ ut->test.name = test;
+ ut->test.user_cmp_function = equal_fn;
+ ut->test.user_hash_function = hash_fn;
+ ut->test.hashfn = hashfn_user_defined;
+ ut->test.cmpfn = cmpfn_user_defined;
+ ut->next = hash_table_user_tests;
+ hash_table_user_tests = ut;
+ }
+ return &ut->test;
}
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
@@ -5272,16 +5717,8 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and
`define-hash-table-test'.
:size SIZE -- A hint as to how many elements will be put in the table.
-Default is 65.
-
-:rehash-size REHASH-SIZE - Indicates how to expand the table when it
-fills up. If REHASH-SIZE is an integer, increase the size by that
-amount. If it is a float, it must be > 1.0, and the new size is the
-old size multiplied by that factor. Default is 1.5.
-
-:rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.
-Resize the hash table when the ratio (table entries / table size)
-exceeds an approximation to THRESHOLD. Default is 0.8125.
+The table will always grow as needed; this argument may help performance
+slightly if the size is known in advance but is never required.
:weakness WEAK -- WEAK must be one of nil, t, `key', `value',
`key-or-value', or `key-and-value'. If WEAK is not nil, the table
@@ -5296,13 +5733,12 @@ to pure storage when Emacs is being dumped, making the contents of the
table read only. Any further changes to purified tables will result
in an error.
+The keywords arguments :rehash-threshold and :rehash-size are obsolete
+and ignored.
+
usage: (make-hash-table &rest KEYWORD-ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object test, weak;
- bool purecopy;
- struct hash_table_test testdesc;
- ptrdiff_t i;
USE_SAFE_ALLOCA;
/* The vector `used' is used to keep track of arguments that
@@ -5311,32 +5747,21 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
memset (used, 0, nargs * sizeof *used);
/* See if there's a `:test TEST' among the arguments. */
- i = get_key_arg (QCtest, nargs, args, used);
- test = i ? args[i] : Qeql;
- if (EQ (test, Qeq))
- testdesc = hashtest_eq;
- else if (EQ (test, Qeql))
- testdesc = hashtest_eql;
- else if (EQ (test, Qequal))
- testdesc = hashtest_equal;
+ ptrdiff_t i = get_key_arg (QCtest, nargs, args, used);
+ Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql;
+ const struct hash_table_test *testdesc;
+ if (BASE_EQ (test, Qeq))
+ testdesc = &hashtest_eq;
+ else if (BASE_EQ (test, Qeql))
+ testdesc = &hashtest_eql;
+ else if (BASE_EQ (test, Qequal))
+ testdesc = &hashtest_equal;
else
- {
- /* See if it is a user-defined test. */
- Lisp_Object prop;
-
- prop = Fget (test, Qhash_table_test);
- if (!CONSP (prop) || !CONSP (XCDR (prop)))
- signal_error ("Invalid hash table test", test);
- testdesc.name = test;
- testdesc.user_cmp_function = XCAR (prop);
- testdesc.user_hash_function = XCAR (XCDR (prop));
- testdesc.hashfn = hashfn_user_defined;
- testdesc.cmpfn = cmpfn_user_defined;
- }
+ testdesc = get_hash_table_user_test (test);
/* See if there's a `:purecopy PURECOPY' argument. */
i = get_key_arg (QCpurecopy, nargs, args, used);
- purecopy = i && !NILP (args[i]);
+ bool purecopy = i && !NILP (args[i]);
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
Lisp_Object size_arg = i ? args[i] : Qnil;
@@ -5348,46 +5773,36 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
else
signal_error ("Invalid hash table size", size_arg);
- /* Look for `:rehash-size SIZE'. */
- float rehash_size;
- i = get_key_arg (QCrehash_size, nargs, args, used);
- if (!i)
- rehash_size = DEFAULT_REHASH_SIZE;
- else if (FIXNUMP (args[i]) && 0 < XFIXNUM (args[i]))
- rehash_size = - XFIXNUM (args[i]);
- else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1))
- rehash_size = (float) (XFLOAT_DATA (args[i]) - 1);
- else
- signal_error ("Invalid hash table rehash size", args[i]);
-
- /* Look for `:rehash-threshold THRESHOLD'. */
- i = get_key_arg (QCrehash_threshold, nargs, args, used);
- float rehash_threshold = (!i ? DEFAULT_REHASH_THRESHOLD
- : !FLOATP (args[i]) ? 0
- : (float) XFLOAT_DATA (args[i]));
- if (! (0 < rehash_threshold && rehash_threshold <= 1))
- signal_error ("Invalid hash table rehash threshold", args[i]);
-
/* Look for `:weakness WEAK'. */
i = get_key_arg (QCweakness, nargs, args, used);
- weak = i ? args[i] : Qnil;
- if (EQ (weak, Qt))
- weak = Qkey_and_value;
- if (!NILP (weak)
- && !EQ (weak, Qkey)
- && !EQ (weak, Qvalue)
- && !EQ (weak, Qkey_or_value)
- && !EQ (weak, Qkey_and_value))
- signal_error ("Invalid hash table weakness", weak);
+ Lisp_Object weakness = i ? args[i] : Qnil;
+ hash_table_weakness_t weak;
+ if (NILP (weakness))
+ weak = Weak_None;
+ else if (EQ (weakness, Qkey))
+ weak = Weak_Key;
+ else if (EQ (weakness, Qvalue))
+ weak = Weak_Value;
+ else if (EQ (weakness, Qkey_or_value))
+ weak = Weak_Key_Or_Value;
+ else if (EQ (weakness, Qt) || EQ (weakness, Qkey_and_value))
+ weak = Weak_Key_And_Value;
+ else
+ signal_error ("Invalid hash table weakness", weakness);
/* Now, all args should have been used up, or there's a problem. */
for (i = 0; i < nargs; ++i)
if (!used[i])
- signal_error ("Invalid argument list", args[i]);
+ {
+ /* Ignore obsolete arguments. */
+ if (EQ (args[i], QCrehash_threshold) || EQ (args[i], QCrehash_size))
+ i++;
+ else
+ signal_error ("Invalid argument list", args[i]);
+ }
SAFE_FREE ();
- return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
- purecopy);
+ return make_hash_table (testdesc, size, weak, purecopy);
}
@@ -5410,34 +5825,37 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
Shash_table_rehash_size, 1, 1, 0,
- doc: /* Return the current rehash size of TABLE. */)
+ doc: /* Return the rehash size of TABLE.
+This function is for compatibility only; it returns a nominal value
+without current significance. */)
(Lisp_Object table)
{
- double rehash_size = check_hash_table (table)->rehash_size;
- if (rehash_size < 0)
- {
- EMACS_INT s = -rehash_size;
- return make_fixnum (min (s, MOST_POSITIVE_FIXNUM));
- }
- else
- return make_float (rehash_size + 1);
+ CHECK_HASH_TABLE (table);
+ return make_float (1.5); /* The old default rehash-size value. */
}
DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold,
Shash_table_rehash_threshold, 1, 1, 0,
- doc: /* Return the current rehash threshold of TABLE. */)
+ doc: /* Return the rehash threshold of TABLE.
+This function is for compatibility only; it returns a nominal value
+without current significance. */)
(Lisp_Object table)
{
- return make_float (check_hash_table (table)->rehash_threshold);
+ CHECK_HASH_TABLE (table);
+ return make_float (0.8125); /* The old default rehash-threshold value. */
}
DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0,
- doc: /* Return the size of TABLE.
-The size can be used as an argument to `make-hash-table' to create
-a hash table than can hold as many elements as TABLE holds
-without need for resizing. */)
+ doc: /* Return the current allocation size of TABLE.
+
+This is probably not the function that you are looking for. To get the
+number of entries in a table, use `hash-table-count' instead.
+
+The returned value is the number of entries that TABLE can currently
+hold without growing, but since hash tables grow automatically, this
+number is rarely of interest. */)
(Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
@@ -5449,16 +5867,29 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
- return check_hash_table (table)->test.name;
+ return check_hash_table (table)->test->name;
}
+Lisp_Object
+hash_table_weakness_symbol (hash_table_weakness_t weak)
+{
+ switch (weak)
+ {
+ case Weak_None: return Qnil;
+ case Weak_Key: return Qkey;
+ case Weak_Value: return Qvalue;
+ case Weak_Key_And_Value: return Qkey_and_value;
+ case Weak_Key_Or_Value: return Qkey_or_value;
+ }
+ emacs_abort ();
+}
DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness,
1, 1, 0,
doc: /* Return the weakness of TABLE. */)
(Lisp_Object table)
{
- return check_hash_table (table)->weak;
+ return hash_table_weakness_symbol (check_hash_table (table)->weakness);
}
@@ -5488,7 +5919,7 @@ If KEY is not found, return DFLT which defaults to nil. */)
(Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- ptrdiff_t i = hash_lookup (h, key, NULL);
+ ptrdiff_t i = hash_lookup (h, key);
return i >= 0 ? HASH_VALUE (h, i) : dflt;
}
@@ -5502,8 +5933,8 @@ VALUE. In any case, return VALUE. */)
struct Lisp_Hash_Table *h = check_hash_table (table);
check_mutable_hash_table (table, h);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h, key, &hash);
+ EMACS_UINT hash = hash_from_key (h, key);
+ ptrdiff_t i = hash_lookup_with_hash (h, key, hash);
if (i >= 0)
set_hash_value_slot (h, i, value);
else
@@ -5527,18 +5958,17 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
doc: /* Call FUNCTION for all entries in hash table TABLE.
FUNCTION is called with two arguments, KEY and VALUE.
+It should not alter TABLE in any way other than using `puthash' to
+set a new value for KEY, or `remhash' to remove KEY.
`maphash' always returns nil. */)
(Lisp_Object function, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
-
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- Lisp_Object k = HASH_KEY (h, i);
- if (!BASE_EQ (k, Qunbound))
- call2 (function, k, HASH_VALUE (h, i));
- }
-
+ /* We can't use DOHASH here since FUNCTION may violate the rules and
+ we shouldn't crash as a result (although the effects are
+ unpredictable). */
+ DOHASH_SAFE (h, i)
+ call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i));
return Qnil;
}
@@ -5560,6 +5990,67 @@ returns nil, then (funcall TEST x1 x2) also returns nil. */)
return Fput (name, Qhash_table_test, list2 (test, hash));
}
+DEFUN ("internal--hash-table-histogram",
+ Finternal__hash_table_histogram,
+ Sinternal__hash_table_histogram,
+ 1, 1, 0,
+ doc: /* Bucket size histogram of HASH-TABLE. Internal use only. */)
+ (Lisp_Object hash_table)
+{
+ struct Lisp_Hash_Table *h = check_hash_table (hash_table);
+ ptrdiff_t size = HASH_TABLE_SIZE (h);
+ ptrdiff_t *freq = xzalloc (size * sizeof *freq);
+ ptrdiff_t index_size = hash_table_index_size (h);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ {
+ ptrdiff_t n = 0;
+ for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j))
+ n++;
+ if (n > 0)
+ freq[n - 1]++;
+ }
+ Lisp_Object ret = Qnil;
+ for (ptrdiff_t i = 0; i < size; i++)
+ if (freq[i] > 0)
+ ret = Fcons (Fcons (make_int (i + 1), make_int (freq[i])),
+ ret);
+ xfree (freq);
+ return Fnreverse (ret);
+}
+
+DEFUN ("internal--hash-table-buckets",
+ Finternal__hash_table_buckets,
+ Sinternal__hash_table_buckets,
+ 1, 1, 0,
+ doc: /* (KEY . HASH) in HASH-TABLE, grouped by bucket.
+Internal use only. */)
+ (Lisp_Object hash_table)
+{
+ struct Lisp_Hash_Table *h = check_hash_table (hash_table);
+ Lisp_Object ret = Qnil;
+ ptrdiff_t index_size = hash_table_index_size (h);
+ for (ptrdiff_t i = 0; i < index_size; i++)
+ {
+ Lisp_Object bucket = Qnil;
+ for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j))
+ bucket = Fcons (Fcons (HASH_KEY (h, j), make_int (HASH_HASH (h, j))),
+ bucket);
+ if (!NILP (bucket))
+ ret = Fcons (Fnreverse (bucket), ret);
+ }
+ return Fnreverse (ret);
+}
+
+DEFUN ("internal--hash-table-index-size",
+ Finternal__hash_table_index_size,
+ Sinternal__hash_table_index_size,
+ 1, 1, 0,
+ doc: /* Index size of HASH-TABLE. Internal use only. */)
+ (Lisp_Object hash_table)
+{
+ struct Lisp_Hash_Table *h = check_hash_table (hash_table);
+ return make_int (hash_table_index_size (h));
+}
/************************************************************************
@@ -6142,7 +6633,6 @@ Altering this copy does not change the layout of the text properties
in OBJECT. */)
(register Lisp_Object object)
{
- Lisp_Object collector = Fcons (Qnil, Qnil);
INTERVAL intervals;
if (STRINGP (object))
@@ -6155,8 +6645,9 @@ in OBJECT. */)
if (! intervals)
return Qnil;
- traverse_intervals (intervals, 0, collect_interval, collector);
- return CDR (collector);
+ Lisp_Object collector = Qnil;
+ traverse_intervals (intervals, 0, collect_interval, &collector);
+ return Fnreverse (collector);
}
DEFUN ("line-number-at-pos", Fline_number_at_pos,
@@ -6250,6 +6741,9 @@ syms_of_fns (void)
defsubr (&Sremhash);
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
+ defsubr (&Sinternal__hash_table_histogram);
+ defsubr (&Sinternal__hash_table_buckets);
+ defsubr (&Sinternal__hash_table_index_size);
defsubr (&Sstring_search);
defsubr (&Sobject_intervals);
defsubr (&Sline_number_at_pos);
@@ -6337,7 +6831,7 @@ The same variable also affects the function `read-answer'. See also
DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt,
doc: /* String to append when `yes-or-no-p' asks a question.
For best results this should end in a space. */);
- Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) "));
+ Vyes_or_no_prompt = build_unibyte_string ("(yes or no) ");
defsubr (&Sidentity);
defsubr (&Srandom);
@@ -6392,6 +6886,7 @@ For best results this should end in a space. */);
defsubr (&Seql);
defsubr (&Sequal);
defsubr (&Sequal_including_properties);
+ defsubr (&Svaluelt);
defsubr (&Sfillarray);
defsubr (&Sclear_string);
defsubr (&Snconc);
@@ -6423,4 +6918,12 @@ For best results this should end in a space. */);
DEFSYM (Qreal_this_command, "real-this-command");
DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p");
+ DEFSYM (Qyes_or_no_p, "yes-or-no-p");
+ DEFSYM (Qy_or_n_p, "y-or-n-p");
+
+ DEFSYM (QCkey, ":key");
+ DEFSYM (QClessp, ":lessp");
+ DEFSYM (QCin_place, ":in-place");
+ DEFSYM (QCreverse, ":reverse");
+ DEFSYM (Qvaluelt, "value<");
}
diff --git a/src/font.h b/src/font.h
index ad92f9f4739..8ee1940be0a 100644
--- a/src/font.h
+++ b/src/font.h
@@ -191,16 +191,16 @@ enum font_property_index
/* Return the numeric weight value of FONT. */
#define FONT_WEIGHT_NUMERIC(font) \
- (FIXNUMP (AREF ((font), FONT_WEIGHT_INDEX)) \
- ? (XFIXNUM (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1)
+ (FIXNUMP (AREF (font, FONT_WEIGHT_INDEX)) \
+ ? (XFIXNUM (AREF (font, FONT_WEIGHT_INDEX)) >> 8) : -1)
/* Return the numeric slant value of FONT. */
#define FONT_SLANT_NUMERIC(font) \
- (FIXNUMP (AREF ((font), FONT_SLANT_INDEX)) \
- ? (XFIXNUM (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1)
+ (FIXNUMP (AREF (font, FONT_SLANT_INDEX)) \
+ ? (XFIXNUM (AREF (font, FONT_SLANT_INDEX)) >> 8) : -1)
/* Return the numeric width value of FONT. */
#define FONT_WIDTH_NUMERIC(font) \
- (FIXNUMP (AREF ((font), FONT_WIDTH_INDEX)) \
- ? (XFIXNUM (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1)
+ (FIXNUMP (AREF (font, FONT_WIDTH_INDEX)) \
+ ? (XFIXNUM (AREF (font, FONT_WIDTH_INDEX)) >> 8) : -1)
/* Return the symbolic weight value of FONT. */
#define FONT_WEIGHT_SYMBOLIC(font) \
font_style_symbolic (font, FONT_WEIGHT_INDEX, false)
@@ -222,19 +222,19 @@ enum font_property_index
/* Return the numeric weight value corresponding to the symbol NAME. */
#define FONT_WEIGHT_NAME_NUMERIC(name) \
- (font_style_to_value (FONT_WEIGHT_INDEX, (name), false) >> 8)
+ (font_style_to_value (FONT_WEIGHT_INDEX, name, false) >> 8)
/* Return the numeric slant value corresponding to the symbol NAME. */
#define FONT_SLANT_NAME_NUMERIC(name) \
- (font_style_to_value (FONT_SLANT_INDEX, (name), false) >> 8)
+ (font_style_to_value (FONT_SLANT_INDEX, name, false) >> 8)
/* Return the numeric width value corresponding to the symbol NAME. */
#define FONT_WIDTH_NAME_NUMERIC(name) \
- (font_style_to_value (FONT_WIDTH_INDEX, (name), false) >> 8)
+ (font_style_to_value (FONT_WIDTH_INDEX, name, false) >> 8)
/* Set the font property PROP of FONT to VAL. PROP is one of
style-related font property index (FONT_WEIGHT/SLANT/WIDTH_INDEX).
VAL (integer or symbol) is the numeric or symbolic style value. */
#define FONT_SET_STYLE(font, prop, val) \
- ASET ((font), prop, make_fixnum (font_style_to_value (prop, val, true)))
+ ASET (font, prop, make_fixnum (font_style_to_value (prop, val, true)))
#ifndef MSDOS
#define FONT_WIDTH(f) ((f)->max_width)
@@ -549,7 +549,7 @@ GC_XFONT_OBJECT (Lisp_Object p)
return XUNTAG (p, Lisp_Vectorlike, struct font);
}
-#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
+#define XSETFONT(a, b) XSETPSEUDOVECTOR (a, b, PVEC_FONT)
INLINE struct font *
CHECK_FONT_GET_OBJECT (Lisp_Object x)
@@ -1004,13 +1004,13 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object);
#define FONT_ADD_LOG(ACTION, ARG, RESULT) \
do { \
if (! EQ (Vfont_log, Qt)) \
- font_add_log ((ACTION), (ARG), (RESULT)); \
+ font_add_log (ACTION, ARG, RESULT); \
} while (false)
#define FONT_DEFERRED_LOG(ACTION, ARG, RESULT) \
do { \
if (! EQ (Vfont_log, Qt)) \
- font_deferred_log ((ACTION), (ARG), (RESULT)); \
+ font_deferred_log (ACTION, ARG, RESULT); \
} while (false)
/* FIXME: This is for use in functions that can be called while
diff --git a/src/fontset.c b/src/fontset.c
index 005d0a98d2a..d27fa22015e 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -266,19 +266,19 @@ font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
#define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
#define RFONT_DEF_SET_FACE(rfont_def, face_id) \
- ASET ((rfont_def), 0, make_fixnum (face_id))
+ ASET (rfont_def, 0, make_fixnum (face_id))
#define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
#define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
#define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
#define RFONT_DEF_SET_OBJECT(rfont_def, object) \
- ASET ((rfont_def), 2, (object))
+ ASET (rfont_def, 2, object)
/* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
the order of listing by font backends, the higher bits represents
the order given by charset priority list. The smaller value is
preferable. */
#define RFONT_DEF_SCORE(rfont_def) XFIXNUM (AREF (rfont_def, 3))
#define RFONT_DEF_SET_SCORE(rfont_def, score) \
- ASET ((rfont_def), 3, make_fixnum (score))
+ ASET (rfont_def, 3, make_fixnum (score))
#define RFONT_DEF_NEW(rfont_def, font_def) \
do { \
(rfont_def) = make_nil_vector (4); \
@@ -295,7 +295,7 @@ font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
#define FONTSET_REF(fontset, c) \
(EQ (fontset, Vdefault_fontset) \
? CHAR_TABLE_REF (fontset, c) \
- : fontset_ref ((fontset), (c)))
+ : fontset_ref (fontset, c))
static Lisp_Object
fontset_ref (Lisp_Object fontset, int c)
@@ -315,7 +315,7 @@ fontset_ref (Lisp_Object fontset, int c)
specifying a range. */
#define FONTSET_SET(fontset, range, elt) \
- Fset_char_table_range ((fontset), (range), (elt))
+ Fset_char_table_range (fontset, range, elt)
/* Modify the elements of FONTSET for characters in RANGE by replacing
@@ -329,7 +329,7 @@ fontset_ref (Lisp_Object fontset, int c)
? (NILP (range) \
? set_fontset_fallback (fontset, make_vector (1, elt)) \
: (void) Fset_char_table_range (fontset, range, make_vector (1, elt))) \
- : fontset_add ((fontset), (range), (elt), (add)))
+ : fontset_add (fontset, range, elt, add))
static void
fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
diff --git a/src/frame.c b/src/frame.c
index f5b07e212f2..abd6ef00901 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1040,8 +1040,7 @@ make_frame (bool mini_p)
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
fset_face_hash_table
- (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false));
+ (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false));
if (mini_p)
{
diff --git a/src/frame.h b/src/frame.h
index d574fe93a57..e03362361a7 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -909,7 +909,7 @@ default_pixels_per_inch_y (void)
#define XFRAME(p) \
(eassert (FRAMEP (p)), XUNTAG (p, Lisp_Vectorlike, struct frame))
-#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
+#define XSETFRAME(a, b) XSETPSEUDOVECTOR (a, b, PVEC_FRAME)
/* Given a window, return its frame as a Lisp_Object. */
#define WINDOW_FRAME(w) ((w)->frame)
@@ -992,7 +992,7 @@ default_pixels_per_inch_y (void)
FRAME_DISPLAY_INFO (f)->font_resolution)
#else /* !HAVE_ANDROID */
-#define FRAME_RES(f) (FRAME_RES_Y (f))
+#define FRAME_RES(f) FRAME_RES_Y (f)
#endif /* HAVE_ANDROID */
#else /* !HAVE_WINDOW_SYSTEM */
@@ -1130,12 +1130,12 @@ default_pixels_per_inch_y (void)
/* Height of F's bottom margin in frame lines. */
#define FRAME_BOTTOM_MARGIN(f) \
- (FRAME_TOOL_BAR_BOTTOM_LINES (f))
+ FRAME_TOOL_BAR_BOTTOM_LINES (f)
/* Pixel height of frame F's bottom margin. */
#define FRAME_BOTTOM_MARGIN_HEIGHT(f) \
- (FRAME_TOOL_BAR_BOTTOM_HEIGHT (f))
+ FRAME_TOOL_BAR_BOTTOM_HEIGHT (f)
/* Size of both vertical margins combined. */
@@ -1159,7 +1159,7 @@ default_pixels_per_inch_y (void)
visible by the X server. */
#ifndef HAVE_X_WINDOWS
-#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f))
+#define FRAME_REDISPLAY_P(f) FRAME_VISIBLE_P (f)
#else
#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \
|| (FRAME_X_P (f) \
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 6cfb4034ed9..c067f7b53ac 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -117,10 +117,10 @@ static void xg_widget_style_updated (GtkWidget *, gpointer);
#define gtk_box_new(ori, spacing) \
((ori) == GTK_ORIENTATION_HORIZONTAL \
- ? gtk_hbox_new (FALSE, (spacing)) : gtk_vbox_new (FALSE, (spacing)))
+ ? gtk_hbox_new (FALSE, spacing) : gtk_vbox_new (FALSE, spacing))
#define gtk_scrollbar_new(ori, spacing) \
((ori) == GTK_ORIENTATION_HORIZONTAL \
- ? gtk_hscrollbar_new ((spacing)) : gtk_vscrollbar_new ((spacing)))
+ ? gtk_hscrollbar_new (spacing) : gtk_vscrollbar_new (spacing))
#endif /* HAVE_GTK3 */
#define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x))
diff --git a/src/haiku_select.cc b/src/haiku_select.cc
index 02f3272514f..f497eb3d24b 100644
--- a/src/haiku_select.cc
+++ b/src/haiku_select.cc
@@ -18,6 +18,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <intprops.h>
+#include <stdckdint.h>
#include <Application.h>
#include <Bitmap.h>
@@ -619,8 +620,7 @@ be_display_notification (const char *title, const char *body,
/* SUPERSEDES hasn't been provided, so allocate a new
notification ID. */
- INT_ADD_WRAPV (last_notification_id, 1,
- &last_notification_id);
+ ckd_add (&last_notification_id, last_notification_id, 1);
id = last_notification_id;
}
else
diff --git a/src/image.c b/src/image.c
index f09552c4017..41d72964631 100644
--- a/src/image.c
+++ b/src/image.c
@@ -3561,7 +3561,7 @@ anim_prune_animation_cache (Lisp_Object clear)
{
struct anim_cache *cache = *pcache;
if (EQ (clear, Qt)
- || (EQ (clear, Qnil) && timespec_cmp (old, cache->update_time) > 0)
+ || (NILP (clear) && timespec_cmp (old, cache->update_time) > 0)
|| EQ (clear, cache->spec))
{
if (cache->handle)
@@ -4373,7 +4373,7 @@ slurp_image (Lisp_Object filename, ptrdiff_t *size, const char *image_type)
char *result = slurp_file (fd, size);
if (result == NULL)
image_error ("Error loading %s image `%s'",
- make_unibyte_string (image_type, strlen (image_type)),
+ build_unibyte_string (image_type),
file);
return result;
}
@@ -4875,7 +4875,7 @@ xbm_read_bitmap_data (struct frame *f, char *contents, char *end,
while (0)
#define expect_ident(IDENT) \
- if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
+ if (LA1 == XBM_TK_IDENT && strcmp (buffer, IDENT) == 0) \
match (); \
else \
goto failure
@@ -6069,9 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
{
*put_func = xpm_put_color_table_h;
*get_func = xpm_get_color_table_h;
- return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
- DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
- Qnil, false);
+ return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false);
}
static void
@@ -6081,9 +6079,10 @@ xpm_put_color_table_h (Lisp_Object color_table,
Lisp_Object color)
{
struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
- Lisp_Object chars = make_unibyte_string (chars_start, chars_len), hash_code;
+ Lisp_Object chars = make_unibyte_string (chars_start, chars_len);
- hash_lookup (table, chars, &hash_code);
+ hash_hash_t hash_code;
+ hash_lookup_get_hash (table, chars, &hash_code);
hash_put (table, chars, color, hash_code);
}
@@ -6094,7 +6093,7 @@ xpm_get_color_table_h (Lisp_Object color_table,
{
struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
ptrdiff_t i =
- hash_lookup (table, make_unibyte_string (chars_start, chars_len), NULL);
+ hash_lookup (table, make_unibyte_string (chars_start, chars_len));
return i >= 0 ? HASH_VALUE (table, i) : Qnil;
}
@@ -6155,7 +6154,7 @@ xpm_load_image (struct frame *f,
#define expect_ident(IDENT) \
if (LA1 == XPM_TK_IDENT \
- && strlen ((IDENT)) == len && memcmp ((IDENT), beg, len) == 0) \
+ && strlen (IDENT) == len && memcmp (IDENT, beg, len) == 0) \
match (); \
else \
goto failure
diff --git a/src/inotify.c b/src/inotify.c
index 2ee874530cc..7140568f1b6 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -26,6 +26,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include <errno.h>
+#include <fcntl.h>
+
#include <sys/inotify.h>
#include <sys/ioctl.h>
@@ -434,7 +436,15 @@ IN_ONESHOT */)
if (inotifyfd < 0)
{
+#ifdef HAVE_INOTIFY_INIT1
inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC);
+#else /* !HAVE_INOTIFY_INIT1 */
+ /* This is prey to race conditions with other threads calling
+ exec. */
+ inotifyfd = inotify_init ();
+ fcntl (inotifyfd, F_SETFL, O_NONBLOCK);
+ fcntl (inotifyfd, F_SETFD, O_CLOEXEC);
+#endif /* HAVE_INOTIFY_INIT1 */
if (inotifyfd < 0)
report_file_notify_error ("File watching is not available", Qnil);
watch_list = Qnil;
diff --git a/src/insdel.c b/src/insdel.c
index e41d9945551..3809f8bc060 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -803,7 +803,7 @@ count_combining_before (const unsigned char *string, ptrdiff_t length,
while (!CHAR_HEAD_P (*p) && p < string + length)
p++;
- return (combining_bytes < p - string ? combining_bytes : p - string);
+ return min (combining_bytes, p - string);
}
/* See if the bytes after POS/POS_BYTE combine with bytes
@@ -865,7 +865,7 @@ count_combining_after (const unsigned char *string,
bufp++, pos_byte++;
while (!CHAR_HEAD_P (*bufp)) bufp++, pos_byte++;
- return (bytes <= pos_byte - opos_byte ? bytes : pos_byte - opos_byte);
+ return min (bytes, pos_byte - opos_byte);
}
#endif
@@ -1568,9 +1568,8 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
/* Relocate point as if it were a marker. */
if (from < PT)
- adjust_point ((from + inschars - (PT < to ? PT : to)),
- (from_byte + outgoing_insbytes
- - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
+ adjust_point ((from + inschars - min (PT, to)),
+ (from_byte + outgoing_insbytes - min (PT_BYTE, to_byte)));
check_markers ();
@@ -1919,8 +1918,8 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
/* Relocate point as if it were a marker. */
if (from < PT)
- adjust_point (from - (PT < to ? PT : to),
- from_byte - (PT_BYTE < to_byte ? PT_BYTE : to_byte));
+ adjust_point (from - min (PT, to),
+ from_byte - min (PT_BYTE, to_byte));
offset_intervals (current_buffer, from, - nchars_del);
diff --git a/src/intervals.c b/src/intervals.c
index 1b1fb3b8181..2ab19c2cc56 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -256,7 +256,7 @@ traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *),
void
traverse_intervals (INTERVAL tree, ptrdiff_t position,
- void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
+ void (*function) (INTERVAL, void *), void *arg)
{
while (tree)
{
diff --git a/src/intervals.h b/src/intervals.h
index aa7502b4f68..610c803cc77 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -245,8 +245,8 @@ extern INTERVAL create_root_interval (Lisp_Object);
extern void copy_properties (INTERVAL, INTERVAL);
extern bool intervals_equal (INTERVAL, INTERVAL);
extern void traverse_intervals (INTERVAL, ptrdiff_t,
- void (*) (INTERVAL, Lisp_Object),
- Lisp_Object);
+ void (*) (INTERVAL, void *),
+ void *);
extern void traverse_intervals_noorder (INTERVAL,
void (*) (INTERVAL, void *), void *);
extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t)
diff --git a/src/json.c b/src/json.c
index af5f30c7275..afc48c59d5a 100644
--- a/src/json.c
+++ b/src/json.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stddef.h>
#include <stdint.h>
#include <stdlib.h>
+#include <math.h>
#include <jansson.h>
@@ -30,8 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "coding.h"
-#define JSON_HAS_ERROR_CODE (JANSSON_VERSION_HEX >= 0x020B00)
-
#ifdef WINDOWSNT
# include <windows.h>
# include "w32common.h"
@@ -56,23 +55,7 @@ DEF_DLL_FN (char *, json_dumps, (const json_t *json, size_t flags));
DEF_DLL_FN (int, json_dump_callback,
(const json_t *json, json_dump_callback_t callback, void *data,
size_t flags));
-DEF_DLL_FN (json_int_t, json_integer_value, (const json_t *integer));
-DEF_DLL_FN (double, json_real_value, (const json_t *real));
-DEF_DLL_FN (const char *, json_string_value, (const json_t *string));
-DEF_DLL_FN (size_t, json_string_length, (const json_t *string));
-DEF_DLL_FN (json_t *, json_array_get, (const json_t *array, size_t index));
DEF_DLL_FN (json_t *, json_object_get, (const json_t *object, const char *key));
-DEF_DLL_FN (size_t, json_object_size, (const json_t *object));
-DEF_DLL_FN (const char *, json_object_iter_key, (void *iter));
-DEF_DLL_FN (void *, json_object_iter, (json_t *object));
-DEF_DLL_FN (json_t *, json_object_iter_value, (void *iter));
-DEF_DLL_FN (void *, json_object_key_to_iter, (const char *key));
-DEF_DLL_FN (void *, json_object_iter_next, (json_t *object, void *iter));
-DEF_DLL_FN (json_t *, json_loads,
- (const char *input, size_t flags, json_error_t *error));
-DEF_DLL_FN (json_t *, json_load_callback,
- (json_load_callback_t callback, void *data, size_t flags,
- json_error_t *error));
/* This is called by json_decref, which is an inline function. */
void json_delete(json_t *json)
@@ -105,20 +88,7 @@ init_json_functions (void)
LOAD_DLL_FN (library, json_stringn);
LOAD_DLL_FN (library, json_dumps);
LOAD_DLL_FN (library, json_dump_callback);
- LOAD_DLL_FN (library, json_integer_value);
- LOAD_DLL_FN (library, json_real_value);
- LOAD_DLL_FN (library, json_string_value);
- LOAD_DLL_FN (library, json_string_length);
- LOAD_DLL_FN (library, json_array_get);
LOAD_DLL_FN (library, json_object_get);
- LOAD_DLL_FN (library, json_object_size);
- LOAD_DLL_FN (library, json_object_iter_key);
- LOAD_DLL_FN (library, json_object_iter);
- LOAD_DLL_FN (library, json_object_iter_value);
- LOAD_DLL_FN (library, json_object_key_to_iter);
- LOAD_DLL_FN (library, json_object_iter_next);
- LOAD_DLL_FN (library, json_loads);
- LOAD_DLL_FN (library, json_load_callback);
init_json ();
@@ -139,20 +109,7 @@ init_json_functions (void)
#define json_stringn fn_json_stringn
#define json_dumps fn_json_dumps
#define json_dump_callback fn_json_dump_callback
-#define json_integer_value fn_json_integer_value
-#define json_real_value fn_json_real_value
-#define json_string_value fn_json_string_value
-#define json_string_length fn_json_string_length
-#define json_array_get fn_json_array_get
#define json_object_get fn_json_object_get
-#define json_object_size fn_json_object_size
-#define json_object_iter_key fn_json_object_iter_key
-#define json_object_iter fn_json_object_iter
-#define json_object_iter_value fn_json_object_iter_value
-#define json_object_key_to_iter fn_json_object_key_to_iter
-#define json_object_iter_next fn_json_object_iter_next
-#define json_loads fn_json_loads
-#define json_load_callback fn_json_load_callback
#endif /* WINDOWSNT */
@@ -190,29 +147,6 @@ init_json (void)
json_set_alloc_funcs (json_malloc, json_free);
}
-#if !JSON_HAS_ERROR_CODE
-
-/* Return whether STRING starts with PREFIX. */
-
-static bool
-json_has_prefix (const char *string, const char *prefix)
-{
- return strncmp (string, prefix, strlen (prefix)) == 0;
-}
-
-/* Return whether STRING ends with SUFFIX. */
-
-static bool
-json_has_suffix (const char *string, const char *suffix)
-{
- size_t string_len = strlen (string);
- size_t suffix_len = strlen (suffix);
- return string_len >= suffix_len
- && memcmp (string + string_len - suffix_len, suffix, suffix_len) == 0;
-}
-
-#endif
-
/* Note that all callers of make_string_from_utf8 and build_string_from_utf8
below either pass only value UTF-8 strings or use the functionf for
formatting error messages; in the latter case correctness isn't
@@ -237,41 +171,6 @@ json_out_of_memory (void)
xsignal0 (Qjson_out_of_memory);
}
-/* Signal a Lisp error corresponding to the JSON ERROR. */
-
-static AVOID
-json_parse_error (const json_error_t *error)
-{
- Lisp_Object symbol;
-#if JSON_HAS_ERROR_CODE
- switch (json_error_code (error))
- {
- case json_error_premature_end_of_input:
- symbol = Qjson_end_of_file;
- break;
- case json_error_end_of_input_expected:
- symbol = Qjson_trailing_content;
- break;
- default:
- symbol = Qjson_parse_error;
- break;
- }
-#else
- if (json_has_suffix (error->text, "expected near end of file"))
- symbol = Qjson_end_of_file;
- else if (json_has_prefix (error->text, "end of file expected"))
- symbol = Qjson_trailing_content;
- else
- symbol = Qjson_parse_error;
-#endif
- xsignal (symbol,
- list5 (build_string_from_utf8 (error->text),
- build_string_from_utf8 (error->source),
- INT_TO_INTEGER (error->line),
- INT_TO_INTEGER (error->column),
- INT_TO_INTEGER (error->position)));
-}
-
static void
json_release_object (void *object)
{
@@ -361,33 +260,29 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp,
json = json_check (json_object ());
count = SPECPDL_INDEX ();
record_unwind_protect_ptr (json_release_object, json);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ DOHASH (h, key, v)
{
- Lisp_Object key = HASH_KEY (h, i);
- if (!BASE_EQ (key, Qunbound))
- {
- CHECK_STRING (key);
- Lisp_Object ekey = json_encode (key);
- /* We can't specify the length, so the string must be
- null-terminated. */
- check_string_without_embedded_nulls (ekey);
- const char *key_str = SSDATA (ekey);
- /* Reject duplicate keys. These are possible if the hash
- table test is not `equal'. */
- if (json_object_get (json, key_str) != NULL)
- wrong_type_argument (Qjson_value_p, lisp);
- int status
- = json_object_set_new (json, key_str,
- lisp_to_json (HASH_VALUE (h, i), conf));
- if (status == -1)
- {
- /* A failure can be caused either by an invalid key or
- by low memory. */
- json_check_utf8 (ekey);
- json_out_of_memory ();
- }
- }
- }
+ CHECK_STRING (key);
+ Lisp_Object ekey = json_encode (key);
+ /* We can't specify the length, so the string must be
+ null-terminated. */
+ check_string_without_embedded_nulls (ekey);
+ const char *key_str = SSDATA (ekey);
+ /* Reject duplicate keys. These are possible if the hash
+ table test is not `equal'. */
+ if (json_object_get (json, key_str) != NULL)
+ wrong_type_argument (Qjson_value_p, lisp);
+ int status
+ = json_object_set_new (json, key_str,
+ lisp_to_json (v, conf));
+ if (status == -1)
+ {
+ /* A failure can be caused either by an invalid key or
+ by low memory. */
+ json_check_utf8 (ekey);
+ json_out_of_memory ();
+ }
+ }
}
else if (NILP (lisp))
return json_check (json_object ());
@@ -798,144 +693,1087 @@ usage: (json-insert OBJECT &rest ARGS) */)
return unbind_to (count, Qnil);
}
-/* Convert a JSON object to a Lisp object. */
+#define JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE 64
+#define JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE 512
+
+struct json_parser
+{
+ /* Because of a possible gap in the input (an emacs buffer can have
+ a gap), the input is described by [input_begin;input_end) and
+ [secondary_input_begin;secondary_input_end). If the input is
+ continuous, then secondary_input_begin and secondary_input_end
+ should be NULL */
+ const unsigned char *input_current;
+ const unsigned char *input_begin;
+ const unsigned char *input_end;
+
+ const unsigned char *secondary_input_begin;
+ const unsigned char *secondary_input_end;
+
+ ptrdiff_t current_line;
+ ptrdiff_t current_column;
+ ptrdiff_t point_of_current_line;
+
+ /* The parser has a maximum allowed depth. available_depth
+ decreases at each object/array begin. If reaches zero, then an
+ error is generated */
+ int available_depth;
+
+ struct json_configuration conf;
+
+ size_t additional_bytes_count;
+
+ /* Lisp_Objects are collected in this area during object/array
+ parsing. To avoid allocations, initially
+ internal_object_workspace is used. If it runs out of space then
+ we switch to allocated space. Important note: with this design,
+ GC must not run during JSON parsing, otherwise Lisp_Objects in
+ the workspace may get incorrectly collected. */
+ Lisp_Object internal_object_workspace
+ [JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE];
+ Lisp_Object *object_workspace;
+ size_t object_workspace_size;
+ size_t object_workspace_current;
+
+ /* String and number parsing uses this workspace. The idea behind
+ internal_byte_workspace is the same as the idea behind
+ internal_object_workspace */
+ unsigned char
+ internal_byte_workspace[JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE];
+ unsigned char *byte_workspace;
+ unsigned char *byte_workspace_end;
+ unsigned char *byte_workspace_current;
+};
+
+static AVOID
+json_signal_error (struct json_parser *parser, Lisp_Object error)
+{
+ xsignal3 (error, INT_TO_INTEGER (parser->current_line),
+ INT_TO_INTEGER (parser->current_column),
+ INT_TO_INTEGER (parser->point_of_current_line
+ + parser->current_column));
+}
+
+static void
+json_parser_init (struct json_parser *parser,
+ struct json_configuration conf,
+ const unsigned char *input,
+ const unsigned char *input_end,
+ const unsigned char *secondary_input,
+ const unsigned char *secondary_input_end)
+{
+ if (secondary_input >= secondary_input_end)
+ {
+ secondary_input = NULL;
+ secondary_input_end = NULL;
+ }
+
+ if (input < input_end)
+ {
+ parser->input_begin = input;
+ parser->input_end = input_end;
+
+ parser->secondary_input_begin = secondary_input;
+ parser->secondary_input_end = secondary_input_end;
+ }
+ else
+ {
+ parser->input_begin = secondary_input;
+ parser->input_end = secondary_input_end;
+
+ parser->secondary_input_begin = NULL;
+ parser->secondary_input_end = NULL;
+ }
+
+ parser->input_current = parser->input_begin;
+
+ parser->current_line = 1;
+ parser->current_column = 0;
+ parser->point_of_current_line = 0;
+ parser->available_depth = 10000;
+ parser->conf = conf;
+
+ parser->additional_bytes_count = 0;
+
+ parser->object_workspace = parser->internal_object_workspace;
+ parser->object_workspace_size
+ = JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE;
+ parser->object_workspace_current = 0;
+
+ parser->byte_workspace = parser->internal_byte_workspace;
+ parser->byte_workspace_end
+ = (parser->byte_workspace
+ + JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE);
+}
+
+static void
+json_parser_done (void *parser)
+{
+ struct json_parser *p = (struct json_parser *) parser;
+ if (p->object_workspace != p->internal_object_workspace)
+ xfree (p->object_workspace);
+ if (p->byte_workspace != p->internal_byte_workspace)
+ xfree (p->byte_workspace);
+}
+
+/* Makes sure that the object_workspace has 'size' available space for
+ Lisp_Objects */
+NO_INLINE static void
+json_make_object_workspace_for_slow_path (struct json_parser *parser,
+ size_t size)
+{
+ size_t needed_workspace_size
+ = (parser->object_workspace_current + size);
+ size_t new_workspace_size = parser->object_workspace_size;
+ while (new_workspace_size < needed_workspace_size)
+ {
+ if (ckd_mul (&new_workspace_size, new_workspace_size, 2))
+ {
+ json_signal_error (parser, Qjson_out_of_memory);
+ }
+ }
+
+ Lisp_Object *new_workspace_ptr;
+ if (parser->object_workspace_size
+ == JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE)
+ {
+ new_workspace_ptr
+ = xnmalloc (new_workspace_size, sizeof (Lisp_Object));
+ memcpy (new_workspace_ptr, parser->object_workspace,
+ (sizeof (Lisp_Object)
+ * parser->object_workspace_current));
+ }
+ else
+ {
+ new_workspace_ptr
+ = xnrealloc (parser->object_workspace, new_workspace_size,
+ sizeof (Lisp_Object));
+ }
+
+ parser->object_workspace = new_workspace_ptr;
+ parser->object_workspace_size = new_workspace_size;
+}
+
+INLINE void
+json_make_object_workspace_for (struct json_parser *parser,
+ size_t size)
+{
+ if (parser->object_workspace_size - parser->object_workspace_current
+ < size)
+ {
+ json_make_object_workspace_for_slow_path (parser, size);
+ }
+}
+
+static void
+json_byte_workspace_reset (struct json_parser *parser)
+{
+ parser->byte_workspace_current = parser->byte_workspace;
+}
+
+/* Puts 'value' into the byte_workspace. If there is no space
+ available, it allocates space */
+NO_INLINE static void
+json_byte_workspace_put_slow_path (struct json_parser *parser,
+ unsigned char value)
+{
+ size_t new_workspace_size
+ = parser->byte_workspace_end - parser->byte_workspace;
+ if (ckd_mul (&new_workspace_size, new_workspace_size, 2))
+ {
+ json_signal_error (parser, Qjson_out_of_memory);
+ }
+
+ size_t offset
+ = parser->byte_workspace_current - parser->byte_workspace;
+
+ if (parser->byte_workspace == parser->internal_byte_workspace)
+ {
+ parser->byte_workspace = xmalloc (new_workspace_size);
+ memcpy (parser->byte_workspace, parser->internal_byte_workspace,
+ offset);
+ }
+ else
+ {
+ parser->byte_workspace
+ = xrealloc (parser->byte_workspace, new_workspace_size);
+ }
+ parser->byte_workspace_end
+ = parser->byte_workspace + new_workspace_size;
+ parser->byte_workspace_current = parser->byte_workspace + offset;
+ *parser->byte_workspace_current++ = value;
+}
+
+INLINE void
+json_byte_workspace_put (struct json_parser *parser,
+ unsigned char value)
+{
+ if (parser->byte_workspace_current < parser->byte_workspace_end)
+ {
+ *parser->byte_workspace_current++ = value;
+ }
+ else
+ {
+ json_byte_workspace_put_slow_path (parser, value);
+ }
+}
+
+static bool
+json_input_at_eof (struct json_parser *parser)
+{
+ if (parser->input_current < parser->input_end)
+ return false;
+ return parser->secondary_input_end == NULL;
+}
+
+/* If there is a secondary buffer, this switches to it */
+static int
+json_input_switch_to_secondary (struct json_parser *parser)
+{
+ if (parser->secondary_input_begin < parser->secondary_input_end)
+ {
+ parser->additional_bytes_count
+ = parser->input_end - parser->input_begin;
+ parser->input_begin = parser->secondary_input_begin;
+ parser->input_end = parser->secondary_input_end;
+ parser->input_current = parser->secondary_input_begin;
+ parser->secondary_input_begin = NULL;
+ parser->secondary_input_end = NULL;
+ return 0;
+ }
+ else
+ return -1;
+}
+
+/* Reads a byte from the JSON input stream */
+NO_INLINE static unsigned char
+json_input_get_slow_path (struct json_parser *parser)
+{
+ if (json_input_switch_to_secondary (parser) < 0)
+ json_signal_error (parser, Qjson_end_of_file);
+ return *parser->input_current++;
+}
+
+static unsigned char
+json_input_get (struct json_parser *parser)
+{
+ if (parser->input_current < parser->input_end)
+ return *parser->input_current++;
+ return json_input_get_slow_path (parser);
+}
+
+/* Reads a byte from the JSON input stream, if the stream is not at
+ * eof. At eof, returns -1 */
+static int
+json_input_get_if_possible (struct json_parser *parser)
+{
+ if (parser->input_current >= parser->input_end
+ && json_input_switch_to_secondary (parser) < 0)
+ return -1;
+ return *parser->input_current++;
+}
+
+/* Puts back the last read input byte. Only one byte can be put back,
+ because otherwise this code would need to handle switching from
+ the secondary buffer to the initial */
+static void
+json_input_put_back (struct json_parser *parser)
+{
+ parser->input_current--;
+}
+
+static bool
+json_skip_whitespace_internal (struct json_parser *parser, int c)
+{
+ parser->current_column++;
+ if (c == 0x20 || c == 0x09 || c == 0x0d)
+ return false;
+ else if (c == 0x0a)
+ {
+ parser->current_line++;
+ parser->point_of_current_line += parser->current_column;
+ parser->current_column = 0;
+ return false;
+ }
+ else
+ return true;
+}
+
+/* Skips JSON whitespace, and returns with the first non-whitespace
+ * character */
+static int
+json_skip_whitespace (struct json_parser *parser)
+{
+ for (;;)
+ {
+ int c = json_input_get (parser);
+ if (json_skip_whitespace_internal (parser, c))
+ return c;
+ }
+}
+
+/* Skips JSON whitespace, and returns with the first non-whitespace
+ * character, if possible. If there is no non-whitespace character
+ * (because we reached the end), it returns -1 */
+static int
+json_skip_whitespace_if_possible (struct json_parser *parser)
+{
+ for (;;)
+ {
+ int c = json_input_get_if_possible (parser);
+ if (c < 0)
+ return c;
+ if (json_skip_whitespace_internal (parser, c))
+ return c;
+ }
+}
-static Lisp_Object ARG_NONNULL ((1))
-json_to_lisp (json_t *json, const struct json_configuration *conf)
+static int
+json_hex_value (int c)
+{
+ if (c >= '0' && c <= '9')
+ return c - '0';
+ else if (c >= 'A' && c <= 'F')
+ return c - 'A' + 10;
+ else if (c >= 'a' && c <= 'f')
+ return c - 'a' + 10;
+ else
+ return -1;
+}
+
+/* Parses the CCCC part of the unicode escape sequence \uCCCC */
+static int
+json_parse_unicode (struct json_parser *parser)
{
- switch (json_typeof (json))
+ unsigned char v[4];
+ for (int i = 0; i < 4; i++)
{
- case JSON_NULL:
- return conf->null_object;
- case JSON_FALSE:
- return conf->false_object;
- case JSON_TRUE:
- return Qt;
- case JSON_INTEGER:
+ int c = json_hex_value (json_input_get (parser));
+ parser->current_column++;
+ if (c < 0)
+ json_signal_error (parser, Qjson_escape_sequence_error);
+ v[i] = c;
+ }
+
+ return v[0] << 12 | v[1] << 8 | v[2] << 4 | v[3];
+}
+
+/* Parses an utf-8 code-point encoding (except the first byte), and
+ returns the numeric value of the code-point (without considering
+ the first byte) */
+static int
+json_handle_utf8_tail_bytes (struct json_parser *parser, int n)
+{
+ int v = 0;
+ for (int i = 0; i < n; i++)
+ {
+ int c = json_input_get (parser);
+ json_byte_workspace_put (parser, c);
+ if ((c & 0xc0) != 0x80)
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ v = (v << 6) | (c & 0x3f);
+ }
+ return v;
+}
+
+/* Reads a JSON string, and puts the result into the byte workspace */
+static void
+json_parse_string (struct json_parser *parser)
+{
+ /* a single_uninteresting byte can be simply copied from the input
+ to output, it doesn't need any extra care. This means all the
+ characters between [0x20;0x7f], except the double quote and
+ the backslash */
+ static const char is_single_uninteresting[256] = {
+ /* 0 1 2 3 4 5 6 7 8 9 a b c d e f */
+ /* 0 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* 1 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* 2 */ 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 3 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 4 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 5 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1,
+ /* 6 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 7 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ /* 8 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* 9 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* a */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* b */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* c */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* d */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* e */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ };
+
+ for (;;)
+ {
+ /* This if is only here for a possible speedup. If there are 4
+ bytes available, and all of them are single_uninteresting,
+ then we can just copy these 4 bytes to output */
+ if (parser->input_end - parser->input_current >= 4)
+ {
+ int c0 = parser->input_current[0];
+ int c1 = parser->input_current[1];
+ int c2 = parser->input_current[2];
+ int c3 = parser->input_current[3];
+ bool v0 = is_single_uninteresting[c0];
+ bool v1 = is_single_uninteresting[c1];
+ bool v2 = is_single_uninteresting[c2];
+ bool v3 = is_single_uninteresting[c3];
+ if (v0 && v1 && v2 && v3)
+ {
+ json_byte_workspace_put (parser, c0);
+ json_byte_workspace_put (parser, c1);
+ json_byte_workspace_put (parser, c2);
+ json_byte_workspace_put (parser, c3);
+ parser->input_current += 4;
+ parser->current_column += 4;
+ continue;
+ }
+ }
+
+ int c = json_input_get (parser);
+ parser->current_column++;
+ if (is_single_uninteresting[c])
+ {
+ json_byte_workspace_put (parser, c);
+ continue;
+ }
+
+ if (c == '"')
+ return;
+ else if (c & 0x80)
+ {
+ /* Handle utf-8 encoding */
+ json_byte_workspace_put (parser, c);
+ if (c < 0xc0)
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ else if (c < 0xe0)
+ {
+ int n = ((c & 0x1f) << 6
+ | json_handle_utf8_tail_bytes (parser, 1));
+ if (n < 0x80)
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ }
+ else if (c < 0xf0)
+ {
+ int n = ((c & 0xf) << 12
+ | json_handle_utf8_tail_bytes (parser, 2));
+ if (n < 0x800 || (n >= 0xd800 && n < 0xe000))
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ }
+ else if (c < 0xf8)
+ {
+ int n = ((c & 0x7) << 18
+ | json_handle_utf8_tail_bytes (parser, 3));
+ if (n < 0x10000 || n > 0x10ffff)
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ }
+ else
+ json_signal_error (parser, Qjson_utf8_decode_error);
+ }
+ else if (c == '\\')
+ {
+ /* Handle escape sequences */
+ c = json_input_get (parser);
+ parser->current_column++;
+ if (c == '"')
+ json_byte_workspace_put (parser, '"');
+ else if (c == '\\')
+ json_byte_workspace_put (parser, '\\');
+ else if (c == '/')
+ json_byte_workspace_put (parser, '/');
+ else if (c == 'b')
+ json_byte_workspace_put (parser, '\b');
+ else if (c == 'f')
+ json_byte_workspace_put (parser, '\f');
+ else if (c == 'n')
+ json_byte_workspace_put (parser, '\n');
+ else if (c == 'r')
+ json_byte_workspace_put (parser, '\r');
+ else if (c == 't')
+ json_byte_workspace_put (parser, '\t');
+ else if (c == 'u')
+ {
+ int num = json_parse_unicode (parser);
+ /* is the first half of the surrogate pair */
+ if (num >= 0xd800 && num < 0xdc00)
+ {
+ parser->current_column++;
+ if (json_input_get (parser) != '\\')
+ json_signal_error (parser,
+ Qjson_invalid_surrogate_error);
+ parser->current_column++;
+ if (json_input_get (parser) != 'u')
+ json_signal_error (parser,
+ Qjson_invalid_surrogate_error);
+ int num2 = json_parse_unicode (parser);
+ if (num2 < 0xdc00 || num2 >= 0xe000)
+ json_signal_error (parser,
+ Qjson_invalid_surrogate_error);
+ num = (0x10000
+ + ((num - 0xd800) << 10 | (num2 - 0xdc00)));
+ }
+ else if (num >= 0xdc00 && num < 0xe000)
+ /* is the second half of the surrogate pair without
+ the first half */
+ json_signal_error (parser,
+ Qjson_invalid_surrogate_error);
+
+ /* utf-8 encode the code-point */
+ if (num < 0x80)
+ json_byte_workspace_put (parser, num);
+ else if (num < 0x800)
+ {
+ json_byte_workspace_put (parser, 0xc0 | num >> 6);
+ json_byte_workspace_put (parser,
+ 0x80 | (num & 0x3f));
+ }
+ else if (num < 0x10000)
+ {
+ json_byte_workspace_put (parser, 0xe0 | num >> 12);
+ json_byte_workspace_put (parser,
+ (0x80
+ | ((num >> 6) & 0x3f)));
+ json_byte_workspace_put (parser,
+ 0x80 | (num & 0x3f));
+ }
+ else
+ {
+ json_byte_workspace_put (parser, 0xf0 | num >> 18);
+ json_byte_workspace_put (parser,
+ (0x80
+ | ((num >> 12) & 0x3f)));
+ json_byte_workspace_put (parser,
+ (0x80
+ | ((num >> 6) & 0x3f)));
+ json_byte_workspace_put (parser,
+ 0x80 | (num & 0x3f));
+ }
+ }
+ else
+ json_signal_error (parser, Qjson_escape_sequence_error);
+ }
+ else
+ json_signal_error (parser, Qjson_parse_error);
+ }
+}
+
+/* If there was no integer overflow during parsing the integer, this
+ puts 'value' to the output. Otherwise this calls string_to_number
+ to parse integer on the byte workspace. This could just always
+ call string_to_number, but for performance reasons, during parsing
+ the code tries to calculate the value, so in most cases, we can
+ save call of string_to_number */
+static Lisp_Object
+json_create_integer (struct json_parser *parser,
+ bool integer_overflow, bool negative,
+ EMACS_UINT value)
+{
+ if (!integer_overflow)
+ {
+ if (negative)
+ {
+ uintmax_t v = value;
+ if (v <= (uintmax_t) INTMAX_MAX + 1)
+ return INT_TO_INTEGER ((intmax_t) -v);
+ }
+ else
+ return INT_TO_INTEGER (value);
+ }
+
+ json_byte_workspace_put (parser, 0);
+ ptrdiff_t len;
+ Lisp_Object result
+ = string_to_number ((const char *) parser->byte_workspace, 10,
+ &len);
+ if (len
+ != parser->byte_workspace_current - parser->byte_workspace - 1)
+ json_signal_error (parser, Qjson_error);
+ return result;
+}
+
+/* Parses a float using the byte workspace */
+static Lisp_Object
+json_create_float (struct json_parser *parser)
+{
+ json_byte_workspace_put (parser, 0);
+ errno = 0;
+ char *e;
+ double value = strtod ((const char *) parser->byte_workspace, &e);
+ bool out_of_range
+ = (errno != 0 && (value == HUGE_VAL || value == -HUGE_VAL));
+ if (out_of_range)
+ json_signal_error (parser, Qjson_number_out_of_range);
+ else if ((const unsigned char *) e
+ != parser->byte_workspace_current - 1)
+ json_signal_error (parser, Qjson_error);
+ else
+ return make_float (value);
+}
+
+/* Parses a number. The first character is the input parameter 'c'.
+ */
+static Lisp_Object
+json_parse_number (struct json_parser *parser, int c)
+{
+ json_byte_workspace_reset (parser);
+ json_byte_workspace_put (parser, c);
+
+ bool negative = false;
+ if (c == '-')
+ {
+ negative = true;
+ c = json_input_get (parser);
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ }
+ if (c < '0' || c > '9')
+ json_signal_error (parser, Qjson_parse_error);
+
+ /* The idea is that during finding the last character of the
+ number, the for loop below also tries to calculate the value. If
+ the parsed number is an integer which fits into unsigned long,
+ then the parser can use the value of 'integer' right away,
+ instead of having to re-parse the byte workspace later.
+ Ideally, this integer should have the same size as a CPU general
+ purpose register. */
+ EMACS_UINT integer = c - '0';
+ bool integer_overflow = false;
+
+ if (integer == 0)
+ {
+ if (json_input_at_eof (parser))
+ return INT_TO_INTEGER (0);
+ c = json_input_get (parser);
+ }
+ else
+ {
+ for (;;)
+ {
+ if (json_input_at_eof (parser))
+ return json_create_integer (parser, integer_overflow,
+ negative, integer);
+ c = json_input_get (parser);
+ if (c < '0' || c > '9')
+ break;
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+
+ integer_overflow |= ckd_mul (&integer, integer, 10);
+ integer_overflow |= ckd_add (&integer, integer, c - '0');
+ }
+ }
+
+ bool is_float = false;
+ if (c == '.')
+ {
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+
+ is_float = true;
+ c = json_input_get (parser);
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ if (c < '0' || c > '9')
+ json_signal_error (parser, Qjson_parse_error);
+ for (;;)
+ {
+ if (json_input_at_eof (parser))
+ return json_create_float (parser);
+ c = json_input_get (parser);
+ if (c < '0' || c > '9')
+ break;
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ }
+ }
+ if (c == 'e' || c == 'E')
+ {
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+
+ is_float = true;
+ c = json_input_get (parser);
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ if (c == '-' || c == '+')
+ {
+ c = json_input_get (parser);
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ }
+ if (c < '0' || c > '9')
+ json_signal_error (parser, Qjson_parse_error);
+ for (;;)
+ {
+ if (json_input_at_eof (parser))
+ return json_create_float (parser);
+ c = json_input_get (parser);
+ if (c < '0' || c > '9')
+ break;
+ json_byte_workspace_put (parser, c);
+ parser->current_column++;
+ }
+ }
+
+ /* 'c' contains a character which is not part of the number,
+ so it is need to be put back */
+ json_input_put_back (parser);
+
+ if (is_float)
+ return json_create_float (parser);
+ else
+ return json_create_integer (parser, integer_overflow, negative,
+ integer);
+}
+
+static Lisp_Object json_parse_value (struct json_parser *parser,
+ int c);
+
+/* Parses a JSON array. */
+static Lisp_Object
+json_parse_array (struct json_parser *parser)
+{
+ int c = json_skip_whitespace (parser);
+
+ const size_t first = parser->object_workspace_current;
+ Lisp_Object result = Qnil;
+
+ if (c != ']')
+ {
+ parser->available_depth--;
+ if (parser->available_depth < 0)
+ json_signal_error (parser, Qjson_object_too_deep);
+
+ size_t number_of_elements = 0;
+ Lisp_Object *cdr = &result;
+ /* This loop collects the array elements in the object workspace
+ */
+ for (;;)
+ {
+ Lisp_Object element = json_parse_value (parser, c);
+ switch (parser->conf.array_type)
+ {
+ case json_array_array:
+ json_make_object_workspace_for (parser, 1);
+ parser->object_workspace[parser->object_workspace_current]
+ = element;
+ parser->object_workspace_current++;
+ break;
+ case json_array_list:
+ {
+ Lisp_Object nc = Fcons (element, Qnil);
+ *cdr = nc;
+ cdr = xcdr_addr (nc);
+ break;
+ }
+ default:
+ emacs_abort ();
+ }
+
+ c = json_skip_whitespace (parser);
+
+ number_of_elements++;
+ if (c == ']')
+ {
+ parser->available_depth++;
+ break;
+ }
+
+ if (c != ',')
+ json_signal_error (parser, Qjson_parse_error);
+
+ c = json_skip_whitespace (parser);
+ }
+ }
+
+ switch (parser->conf.array_type)
+ {
+ case json_array_array:
{
- json_int_t i = json_integer_value (json);
- return INT_TO_INTEGER (i);
+ size_t number_of_elements
+ = parser->object_workspace_current - first;
+ result = make_vector (number_of_elements, Qnil);
+ for (size_t i = 0; i < number_of_elements; i++)
+ {
+ rarely_quit (i);
+ ASET (result, i, parser->object_workspace[first + i]);
+ }
+ parser->object_workspace_current = first;
+ break;
}
- case JSON_REAL:
- return make_float (json_real_value (json));
- case JSON_STRING:
- return make_string_from_utf8 (json_string_value (json),
- json_string_length (json));
- case JSON_ARRAY:
+ case json_array_list:
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ return result;
+}
+
+/* Parses the ": value" part of a JSON object member. */
+static Lisp_Object
+json_parse_object_member_value (struct json_parser *parser)
+{
+ int c = json_skip_whitespace (parser);
+ if (c != ':')
+ json_signal_error (parser, Qjson_parse_error);
+
+ c = json_skip_whitespace (parser);
+
+ return json_parse_value (parser, c);
+}
+
+/* Parses a JSON object. */
+static Lisp_Object
+json_parse_object (struct json_parser *parser)
+{
+ int c = json_skip_whitespace (parser);
+
+ const size_t first = parser->object_workspace_current;
+ Lisp_Object result = Qnil;
+
+ if (c != '}')
+ {
+ parser->available_depth--;
+ if (parser->available_depth < 0)
+ json_signal_error (parser, Qjson_object_too_deep);
+
+ Lisp_Object *cdr = &result;
+
+ /* This loop collects the object members (key/value pairs) in
+ * the object workspace */
+ for (;;)
+ {
+ if (c != '"')
+ json_signal_error (parser, Qjson_parse_error);
+
+ json_byte_workspace_reset (parser);
+ switch (parser->conf.object_type)
+ {
+ case json_object_hashtable:
+ {
+ json_parse_string (parser);
+ Lisp_Object key
+ = make_string_from_utf8 ((char *)
+ parser->byte_workspace,
+ (parser->byte_workspace_current
+ - parser->byte_workspace));
+ Lisp_Object value
+ = json_parse_object_member_value (parser);
+ json_make_object_workspace_for (parser, 2);
+ parser->object_workspace[parser->object_workspace_current]
+ = key;
+ parser->object_workspace_current++;
+ parser->object_workspace[parser->object_workspace_current]
+ = value;
+ parser->object_workspace_current++;
+ break;
+ }
+ case json_object_alist:
+ {
+ json_parse_string (parser);
+ Lisp_Object key
+ = Fintern (make_string_from_utf8 (
+ (char *) parser->byte_workspace,
+ (parser->byte_workspace_current
+ - parser->byte_workspace)),
+ Qnil);
+ Lisp_Object value
+ = json_parse_object_member_value (parser);
+ Lisp_Object nc = Fcons (Fcons (key, value), Qnil);
+ *cdr = nc;
+ cdr = xcdr_addr (nc);
+ break;
+ }
+ case json_object_plist:
+ {
+ json_byte_workspace_put (parser, ':');
+ json_parse_string (parser);
+ Lisp_Object key
+ = intern_1 ((char *) parser->byte_workspace,
+ (parser->byte_workspace_current
+ - parser->byte_workspace));
+ Lisp_Object value
+ = json_parse_object_member_value (parser);
+ Lisp_Object nc = Fcons (key, Qnil);
+ *cdr = nc;
+ cdr = xcdr_addr (nc);
+
+ nc = Fcons (value, Qnil);
+ *cdr = nc;
+ cdr = xcdr_addr (nc);
+ break;
+ }
+ default:
+ emacs_abort ();
+ }
+
+ c = json_skip_whitespace (parser);
+
+ if (c == '}')
+ {
+ parser->available_depth++;
+ break;
+ }
+
+ if (c != ',')
+ json_signal_error (parser, Qjson_parse_error);
+
+ c = json_skip_whitespace (parser);
+ }
+ }
+
+ switch (parser->conf.object_type)
+ {
+ case json_object_hashtable:
{
- if (++lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qjson_object_too_deep);
- size_t size = json_array_size (json);
- if (PTRDIFF_MAX < size)
- overflow_error ();
- Lisp_Object result;
- switch (conf->array_type)
- {
- case json_array_array:
- {
- result = make_vector (size, Qunbound);
- for (ptrdiff_t i = 0; i < size; ++i)
- {
- rarely_quit (i);
- ASET (result, i,
- json_to_lisp (json_array_get (json, i), conf));
- }
- break;
- }
- case json_array_list:
- {
- result = Qnil;
- for (ptrdiff_t i = size - 1; i >= 0; --i)
- {
- rarely_quit (i);
- result = Fcons (json_to_lisp (json_array_get (json, i), conf),
- result);
- }
- break;
- }
- default:
- /* Can't get here. */
- emacs_abort ();
- }
- --lisp_eval_depth;
- return result;
+ result
+ = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize,
+ make_fixed_natnum (
+ (parser->object_workspace_current - first) / 2));
+ struct Lisp_Hash_Table *h = XHASH_TABLE (result);
+ for (size_t i = first; i < parser->object_workspace_current;
+ i += 2)
+ {
+ hash_hash_t hash;
+ Lisp_Object key = parser->object_workspace[i];
+ Lisp_Object value = parser->object_workspace[i + 1];
+ ptrdiff_t i = hash_lookup_get_hash (h, key, &hash);
+ if (i < 0)
+ hash_put (h, key, value, hash);
+ else
+ set_hash_value_slot (h, i, value);
+ }
+ parser->object_workspace_current = first;
+ break;
}
- case JSON_OBJECT:
+ case json_object_alist:
+ case json_object_plist:
+ break;
+ default:
+ emacs_abort ();
+ }
+
+ return result;
+}
+
+/* Token-char is not a JSON terminology. When parsing
+ null/false/true, this function tells the character set that is need
+ to be considered as part of a token. For example, if the input is
+ "truesomething", then the parser shouldn't consider it as "true",
+ and an additional later "something" token. An additional example:
+ if the input is "truetrue", then calling (json-parse-buffer) twice
+ shouldn't produce two successful calls which return t, but a
+ parsing error */
+static bool
+json_is_token_char (int c)
+{
+ return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')
+ || (c >= '0' && c <= '9') || (c == '-'));
+}
+
+/* This is the entry point to the value parser, this parses a JSON
+ * value */
+Lisp_Object
+json_parse_value (struct json_parser *parser, int c)
+{
+ if (c == '{')
+ return json_parse_object (parser);
+ else if (c == '[')
+ return json_parse_array (parser);
+ else if (c == '"')
+ {
+ json_byte_workspace_reset (parser);
+ json_parse_string (parser);
+ Lisp_Object result
+ = make_string_from_utf8 ((const char *)
+ parser->byte_workspace,
+ (parser->byte_workspace_current
+ - parser->byte_workspace));
+ return result;
+ }
+ else if ((c >= '0' && c <= '9') || (c == '-'))
+ return json_parse_number (parser, c);
+ else
+ {
+ int c2 = json_input_get (parser);
+ int c3 = json_input_get (parser);
+ int c4 = json_input_get (parser);
+ int c5 = json_input_get_if_possible (parser);
+
+ if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e'
+ && (c5 < 0 || !json_is_token_char (c5)))
+ {
+ if (c5 >= 0)
+ json_input_put_back (parser);
+ parser->current_column += 3;
+ return Qt;
+ }
+ if (c == 'n' && c2 == 'u' && c3 == 'l' && c4 == 'l'
+ && (c5 < 0 || !json_is_token_char (c5)))
+ {
+ if (c5 >= 0)
+ json_input_put_back (parser);
+ parser->current_column += 3;
+ return parser->conf.null_object;
+ }
+ if (c == 'f' && c2 == 'a' && c3 == 'l' && c4 == 's'
+ && c5 == 'e')
+ {
+ int c6 = json_input_get_if_possible (parser);
+ if (c6 < 0 || !json_is_token_char (c6))
+ {
+ if (c6 >= 0)
+ json_input_put_back (parser);
+ parser->current_column += 4;
+ return parser->conf.false_object;
+ }
+ }
+
+ json_signal_error (parser, Qjson_parse_error);
+ }
+}
+
+enum ParseEndBehavior
+ {
+ PARSEENDBEHAVIOR_CheckForGarbage,
+ PARSEENDBEHAVIOR_MovePoint
+ };
+
+static Lisp_Object
+json_parse (struct json_parser *parser,
+ enum ParseEndBehavior parse_end_behavior)
+{
+ int c = json_skip_whitespace (parser);
+
+ Lisp_Object result = json_parse_value (parser, c);
+
+ switch (parse_end_behavior)
+ {
+ case PARSEENDBEHAVIOR_CheckForGarbage:
+ c = json_skip_whitespace_if_possible (parser);
+ if (c >= 0)
+ json_signal_error (parser, Qjson_trailing_content);
+ break;
+ case PARSEENDBEHAVIOR_MovePoint:
{
- if (++lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qjson_object_too_deep);
- Lisp_Object result;
- switch (conf->object_type)
- {
- case json_object_hashtable:
- {
- size_t size = json_object_size (json);
- if (FIXNUM_OVERFLOW_P (size))
- overflow_error ();
- result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize,
- make_fixed_natnum (size));
- struct Lisp_Hash_Table *h = XHASH_TABLE (result);
- const char *key_str;
- json_t *value;
- json_object_foreach (json, key_str, value)
- {
- Lisp_Object key = build_string_from_utf8 (key_str), hash;
- ptrdiff_t i = hash_lookup (h, key, &hash);
- /* Keys in JSON objects are unique, so the key can't
- be present yet. */
- eassert (i < 0);
- hash_put (h, key, json_to_lisp (value, conf), hash);
- }
- break;
- }
- case json_object_alist:
- {
- result = Qnil;
- const char *key_str;
- json_t *value;
- json_object_foreach (json, key_str, value)
- {
- Lisp_Object key
- = Fintern (build_string_from_utf8 (key_str), Qnil);
- result
- = Fcons (Fcons (key, json_to_lisp (value, conf)),
- result);
- }
- result = Fnreverse (result);
- break;
- }
- case json_object_plist:
- {
- result = Qnil;
- const char *key_str;
- json_t *value;
- json_object_foreach (json, key_str, value)
- {
- USE_SAFE_ALLOCA;
- ptrdiff_t key_str_len = strlen (key_str);
- char *keyword_key_str = SAFE_ALLOCA (1 + key_str_len + 1);
- keyword_key_str[0] = ':';
- strcpy (&keyword_key_str[1], key_str);
- Lisp_Object key = intern_1 (keyword_key_str, key_str_len + 1);
- /* Build the plist as value-key since we're going to
- reverse it in the end.*/
- result = Fcons (key, result);
- result = Fcons (json_to_lisp (value, conf), result);
- SAFE_FREE ();
- }
- result = Fnreverse (result);
- break;
- }
- default:
- /* Can't get here. */
- emacs_abort ();
- }
- --lisp_eval_depth;
- return result;
+ ptrdiff_t byte
+ = (PT_BYTE + parser->input_current - parser->input_begin
+ + parser->additional_bytes_count);
+ ptrdiff_t position;
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ position = byte;
+ else
+ position
+ = PT + parser->point_of_current_line + parser->current_column;
+
+ SET_PT_BOTH (position, byte);
+ break;
}
}
- /* Can't get here. */
- emacs_abort ();
+
+ return result;
}
DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
@@ -953,7 +1791,9 @@ The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
-defaults to `hash-table'.
+defaults to `hash-table'. If an object has members with the same
+key, `hash-table' keeps only the last value of such keys, while
+`alist' and `plist' keep all the members.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
@@ -964,62 +1804,27 @@ to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'.
usage: (json-parse-string STRING &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
+(ptrdiff_t nargs, Lisp_Object *args)
{
specpdl_ref count = SPECPDL_INDEX ();
-#ifdef WINDOWSNT
- ensure_json_available ();
-#endif
-
Lisp_Object string = args[0];
CHECK_STRING (string);
Lisp_Object encoded = json_encode (string);
- check_string_without_embedded_nulls (encoded);
- struct json_configuration conf =
- {json_object_hashtable, json_array_array, QCnull, QCfalse};
+ struct json_configuration conf
+ = { json_object_hashtable, json_array_array, QCnull, QCfalse };
json_parse_args (nargs - 1, args + 1, &conf, true);
- json_error_t error;
- json_t *object
- = json_loads (SSDATA (encoded), JSON_DECODE_ANY | JSON_ALLOW_NUL, &error);
- if (object == NULL)
- json_parse_error (&error);
-
- /* Avoid leaking the object in case of further errors. */
- if (object != NULL)
- record_unwind_protect_ptr (json_release_object, object);
+ struct json_parser p;
+ const unsigned char *begin
+ = (const unsigned char *) SSDATA (encoded);
+ json_parser_init (&p, conf, begin, begin + SBYTES (encoded), NULL,
+ NULL);
+ record_unwind_protect_ptr (json_parser_done, &p);
- return unbind_to (count, json_to_lisp (object, &conf));
-}
-
-struct json_read_buffer_data
-{
- /* Byte position of position to read the next chunk from. */
- ptrdiff_t point;
-};
-
-/* Callback for json_load_callback that reads from the current buffer.
- DATA must point to a structure of type json_read_buffer_data.
- data->point must point to the byte position to read from; after
- reading, data->point is advanced accordingly. The buffer point
- itself is ignored. This function may not exit nonlocally. */
-
-static size_t
-json_read_buffer_callback (void *buffer, size_t buflen, void *data)
-{
- struct json_read_buffer_data *d = data;
-
- /* First, parse from point to the gap or the end of the accessible
- portion, whatever is closer. */
- ptrdiff_t point = d->point;
- ptrdiff_t end = BUFFER_CEILING_OF (point) + 1;
- ptrdiff_t count = end - point;
- if (buflen < count)
- count = buflen;
- memcpy (buffer, BYTE_POS_ADDR (point), count);
- d->point += count;
- return count;
+ return unbind_to (count,
+ json_parse (&p,
+ PARSEENDBEHAVIOR_CheckForGarbage));
}
DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
@@ -1041,7 +1846,9 @@ The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
-defaults to `hash-table'.
+defaults to `hash-table'. If an object has members with the same
+key, `hash-table' keeps only the last value of such keys, while
+`alist' and `plist' keep all the members.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
@@ -1052,42 +1859,33 @@ to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'.
usage: (json-parse-buffer &rest args) */)
- (ptrdiff_t nargs, Lisp_Object *args)
+(ptrdiff_t nargs, Lisp_Object *args)
{
specpdl_ref count = SPECPDL_INDEX ();
-#ifdef WINDOWSNT
- ensure_json_available ();
-#endif
-
- struct json_configuration conf =
- {json_object_hashtable, json_array_array, QCnull, QCfalse};
+ struct json_configuration conf
+ = { json_object_hashtable, json_array_array, QCnull, QCfalse };
json_parse_args (nargs, args, &conf, true);
- ptrdiff_t point = PT_BYTE;
- struct json_read_buffer_data data = {.point = point};
- json_error_t error;
- json_t *object
- = json_load_callback (json_read_buffer_callback, &data,
- JSON_DECODE_ANY
- | JSON_DISABLE_EOF_CHECK
- | JSON_ALLOW_NUL,
- &error);
-
- if (object == NULL)
- json_parse_error (&error);
-
- /* Avoid leaking the object in case of further errors. */
- record_unwind_protect_ptr (json_release_object, object);
-
- /* Convert and then move point only if everything succeeded. */
- Lisp_Object lisp = json_to_lisp (object, &conf);
+ struct json_parser p;
+ unsigned char *begin = PT_ADDR;
+ unsigned char *end = GPT_ADDR;
+ unsigned char *secondary_begin = NULL;
+ unsigned char *secondary_end = NULL;
+ if (GPT_ADDR < Z_ADDR)
+ {
+ secondary_begin = GAP_END_ADDR;
+ if (secondary_begin < PT_ADDR)
+ secondary_begin = PT_ADDR;
+ secondary_end = Z_ADDR;
+ }
- /* Adjust point by how much we just read. */
- point += error.position;
- SET_PT_BOTH (BYTE_TO_CHAR (point), point);
+ json_parser_init (&p, conf, begin, end, secondary_begin,
+ secondary_end);
+ record_unwind_protect_ptr (json_parser_done, &p);
- return unbind_to (count, lisp);
+ return unbind_to (count,
+ json_parse (&p, PARSEENDBEHAVIOR_MovePoint));
}
void
@@ -1105,6 +1903,10 @@ syms_of_json (void)
DEFSYM (Qjson_end_of_file, "json-end-of-file");
DEFSYM (Qjson_trailing_content, "json-trailing-content");
DEFSYM (Qjson_object_too_deep, "json-object-too-deep");
+ DEFSYM (Qjson_utf8_decode_error, "json-utf8-decode-error")
+ DEFSYM (Qjson_invalid_surrogate_error, "json-invalid-surrogate-error")
+ DEFSYM (Qjson_number_out_of_range, "json-number-out-of-range-error")
+ DEFSYM (Qjson_escape_sequence_error, "json-escape-sequence-error")
DEFSYM (Qjson_unavailable, "json-unavailable");
define_error (Qjson_error, "generic JSON error", Qerror);
define_error (Qjson_out_of_memory,
@@ -1116,6 +1918,14 @@ syms_of_json (void)
Qjson_parse_error);
define_error (Qjson_object_too_deep,
"object cyclic or Lisp evaluation too deep", Qjson_error);
+ define_error (Qjson_utf8_decode_error,
+ "invalid utf-8 encoding", Qjson_error);
+ define_error (Qjson_invalid_surrogate_error,
+ "invalid surrogate pair", Qjson_error);
+ define_error (Qjson_number_out_of_range,
+ "number out of range", Qjson_error);
+ define_error (Qjson_escape_sequence_error,
+ "invalid escape sequence", Qjson_parse_error);
DEFSYM (Qpure, "pure");
DEFSYM (Qside_effect_free, "side-effect-free");
diff --git a/src/keyboard.c b/src/keyboard.c
index 4555b71abe7..91faf4582fa 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -580,7 +580,10 @@ echo_dash (void)
idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1);
last_char = Faref (KVAR (current_kboard, echo_string), idx);
- if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
+ if ((XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
+ /* Or a keystroke help message. */
+ || (echo_keystrokes_help
+ && XFIXNUM (last_char) == ')' && XFIXNUM (prev_char) == 'p'))
return;
}
@@ -589,6 +592,12 @@ echo_dash (void)
AUTO_STRING (dash, "-");
kset_echo_string (current_kboard,
concat2 (KVAR (current_kboard, echo_string), dash));
+
+ if (echo_keystrokes_help)
+ kset_echo_string (current_kboard,
+ calln (Qhelp__append_keystrokes_help,
+ KVAR (current_kboard, echo_string)));
+
echo_now ();
}
@@ -1026,7 +1035,7 @@ cmd_error_internal (Lisp_Object data, const char *context)
{
/* The immediate context is not interesting for Quits,
since they are asynchronous. */
- if (signal_quit_p (XCAR (data)))
+ if (signal_quit_p (data))
Vsignaling_function = Qnil;
Vquit_flag = Qnil;
@@ -1067,8 +1076,9 @@ Default value of `command-error-function'. */)
write to stderr and quit. In daemon mode, there are
many other potential errors that do not prevent frames
from being created, so continuing as normal is better in
- that case. */
- || (!IS_DAEMON && FRAME_INITIAL_P (sf))
+ that case, as long as the daemon has actually finished
+ initialization. */
+ || (!(IS_DAEMON && !DAEMON_RUNNING) && FRAME_INITIAL_P (sf))
|| noninteractive))
{
print_error_message (data, Qexternal_debugging_output,
@@ -1163,7 +1173,18 @@ command_loop_2 (Lisp_Object handlers)
static Lisp_Object
top_level_2 (void)
{
- return Feval (Vtop_level, Qnil);
+ /* If we're in batch mode, print a backtrace unconditionally when
+ encountering an error, to help with debugging. */
+ bool setup_handler = noninteractive;
+ if (setup_handler)
+ /* FIXME: Should we (re)use `list_of_error` from `xdisp.c`? */
+ push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0);
+
+ Lisp_Object res = Feval (Vtop_level, Qt);
+
+ if (setup_handler)
+ pop_handler ();
+ return res;
}
static Lisp_Object
@@ -1355,7 +1376,6 @@ command_loop_1 (void)
display_malloc_warning ();
Vdeactivate_mark = Qnil;
- backtrace_yet = false;
/* Don't ignore mouse movements for more than a single command
loop. (This flag is set in xdisp.c whenever the tool bar is
@@ -2600,7 +2620,8 @@ read_char (int commandflag, Lisp_Object map,
goto reread_for_input_method;
}
- if (!NILP (Vexecuting_kbd_macro))
+ /* If we're executing a macro, process it unless we are at its end. */
+ if (!NILP (Vexecuting_kbd_macro) && !at_end_of_macro_p ())
{
/* We set this to Qmacro; since that's not a frame, nobody will
try to switch frames on us, and the selected window will
@@ -2614,16 +2635,6 @@ read_char (int commandflag, Lisp_Object map,
selected. */
Vlast_event_frame = internal_last_event_frame = Qmacro;
- /* Exit the macro if we are at the end.
- Also, some things replace the macro with t
- to force an early exit. */
- if (EQ (Vexecuting_kbd_macro, Qt)
- || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro)))
- {
- XSETINT (c, -1);
- goto exit;
- }
-
c = Faref (Vexecuting_kbd_macro, make_int (executing_kbd_macro_index));
if (STRINGP (Vexecuting_kbd_macro)
&& (XFIXNAT (c) & 0x80) && (XFIXNAT (c) <= 0xff))
@@ -4176,6 +4187,16 @@ kbd_buffer_get_event (KBOARD **kbp,
break;
}
+#ifdef HAVE_ANDROID
+ case NOTIFICATION_EVENT:
+ {
+ kbd_fetch_ptr = next_kbd_event (event);
+ input_pending = readable_events (0);
+ CALLN (Fapply, XCAR (event->ie.arg), XCDR (event->ie.arg));
+ break;
+ }
+#endif /* HAVE_ANDROID */
+
#ifdef HAVE_EXT_MENU_BAR
case MENU_BAR_ACTIVATE_EVENT:
{
@@ -8609,7 +8630,7 @@ menu_item_eval_property_1 (Lisp_Object arg)
{
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
- if (CONSP (arg) && signal_quit_p (XCAR (arg)))
+ if (signal_quit_p (arg))
quit ();
return Qnil;
@@ -9072,7 +9093,7 @@ process_tab_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *
}
/* Access slot with index IDX of vector tab_bar_item_properties. */
-#define PROP(IDX) AREF (tab_bar_item_properties, (IDX))
+#define PROP(IDX) AREF (tab_bar_item_properties, IDX)
static void
set_prop_tab_bar (ptrdiff_t idx, Lisp_Object val)
{
@@ -9456,7 +9477,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void
}
/* Access slot with index IDX of vector tool_bar_item_properties. */
-#define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
+#define PROP(IDX) AREF (tool_bar_item_properties, IDX)
static void
set_prop (ptrdiff_t idx, Lisp_Object val)
{
@@ -10431,9 +10452,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
Lisp_Object original_uppercase UNINIT;
int original_uppercase_position = -1;
- /* Gets around Microsoft compiler limitations. */
- bool dummyflag = false;
-
#ifdef HAVE_TEXT_CONVERSION
bool disabled_conversion;
@@ -10675,8 +10693,16 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
}
used_mouse_menu = used_mouse_menu_history[t];
}
-
- /* If not, we should actually read a character. */
+ /* If we're at the end of a macro, exit it by returning 0,
+ unless there are unread events pending. */
+ else if (!NILP (Vexecuting_kbd_macro)
+ && at_end_of_macro_p ()
+ && !requeued_events_pending_p ())
+ {
+ t = 0;
+ goto done;
+ }
+ /* Otherwise, we should actually read a character. */
else
{
{
@@ -10768,18 +10794,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
return -1;
}
- /* read_char returns -1 at the end of a macro.
- Emacs 18 handles this by returning immediately with a
- zero, so that's what we'll do. */
- if (FIXNUMP (key) && XFIXNUM (key) == -1)
- {
- t = 0;
- /* The Microsoft C compiler can't handle the goto that
- would go here. */
- dummyflag = true;
- break;
- }
-
/* If the current buffer has been changed from under us, the
keymap may have changed, so replay the sequence. */
if (BUFFERP (key))
@@ -11281,10 +11295,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
&& help_char_p (EVENT_HEAD (key)) && t > 1)
{
read_key_sequence_cmd = Vprefix_help_command;
- /* The Microsoft C compiler can't handle the goto that
- would go here. */
- dummyflag = true;
- break;
+ goto done;
}
/* If KEY is not defined in any of the keymaps,
@@ -11333,8 +11344,9 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
}
}
}
- if (!dummyflag)
- read_key_sequence_cmd = current_binding;
+ read_key_sequence_cmd = current_binding;
+
+ done:
read_key_sequence_remapped
/* Remap command through active keymaps.
Do the remapping here, before the unbind_to so it uses the keymaps
@@ -11546,18 +11558,26 @@ clear_input_pending (void)
input_pending = false;
}
-/* Return true if there are pending requeued events.
- This isn't used yet. The hope is to make wait_reading_process_output
- call it, and return if it runs Lisp code that unreads something.
- The problem is, kbd_buffer_get_event needs to be fixed to know what
- to do in that case. It isn't trivial. */
+/* Return true if there are pending requeued command events. */
bool
-requeued_events_pending_p (void)
+requeued_command_events_pending_p (void)
{
return (CONSP (Vunread_command_events));
}
+/* Return true if there are any pending requeued events (command events
+ or events to be processed by other levels of the input processing
+ stages). */
+
+bool
+requeued_events_pending_p (void)
+{
+ return (requeued_command_events_pending_p ()
+ || !NILP (Vunread_post_input_method_events)
+ || !NILP (Vunread_input_method_events));
+}
+
DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
doc: /* Return t if command input is currently available with no wait.
Actually, the value is nil only if we can be sure that no input is available;
@@ -11566,9 +11586,7 @@ if there is a doubt, the value is t.
If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
(Lisp_Object check_timers)
{
- if (CONSP (Vunread_command_events)
- || !NILP (Vunread_post_input_method_events)
- || !NILP (Vunread_input_method_events))
+ if (requeued_events_pending_p ())
return (Qt);
/* Process non-user-visible events (Bug#10195). */
@@ -12938,6 +12956,8 @@ syms_of_keyboard (void)
DEFSYM (Qhelp_key_binding, "help-key-binding");
+ DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help");
+
DEFSYM (Qecho_keystrokes, "echo-keystrokes");
Fset (Qinput_method_exit_on_first_char, Qnil);
@@ -13213,11 +13233,17 @@ Emacs also does a garbage collection if that seems to be warranted. */);
XSETFASTINT (Vauto_save_timeout, 30);
DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
- doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
+ doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
The value may be integer or floating point.
If the value is zero, don't echo at all. */);
Vecho_keystrokes = make_fixnum (1);
+ DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help,
+ doc: /* Whether to append help text to echoed commands.
+When non-nil, a reference to `C-h' is printed after echoed
+keystrokes. */);
+ echo_keystrokes_help = true;
+
DEFVAR_LISP ("polling-period", Vpolling_period,
doc: /* Interval between polling for input during Lisp execution.
The reason for polling is to make C-g work to stop a running program.
diff --git a/src/keyboard.h b/src/keyboard.h
index 05245f366f5..2ce003fd444 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -396,7 +396,7 @@ extern void unuse_menu_items (void);
/* Macros for dealing with lispy events. */
/* True if EVENT has data fields describing it (i.e. a mouse click). */
-#define EVENT_HAS_PARAMETERS(event) (CONSP (event))
+#define EVENT_HAS_PARAMETERS(event) CONSP (event)
/* Extract the head from an event.
This works on composite and simple events. */
@@ -414,32 +414,32 @@ extern void unuse_menu_items (void);
: CAR_SAFE (CDR_SAFE (event)))
/* This does not handle touchscreen events. */
-#define EVENT_END(event) (CAR_SAFE (CDR_SAFE (CDR_SAFE (event))))
+#define EVENT_END(event) CAR_SAFE (CDR_SAFE (CDR_SAFE (event)))
/* Extract the click count from a multi-click event. */
-#define EVENT_CLICK_COUNT(event) (Fnth (make_fixnum (2), (event)))
+#define EVENT_CLICK_COUNT(event) Fnth (make_fixnum (2), event)
/* Extract the fields of a position. */
-#define POSN_WINDOW(posn) (CAR_SAFE (posn))
-#define POSN_POSN(posn) (CAR_SAFE (CDR_SAFE (posn)))
-#define POSN_SET_POSN(posn,x) (XSETCAR (XCDR (posn), (x)))
-#define POSN_WINDOW_POSN(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (posn))))
-#define POSN_TIMESTAMP(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn)))))
-#define POSN_SCROLLBAR_PART(posn) (Fnth (make_fixnum (4), (posn)))
+#define POSN_WINDOW(posn) CAR_SAFE (posn)
+#define POSN_POSN(posn) CAR_SAFE (CDR_SAFE (posn))
+#define POSN_SET_POSN(posn,x) XSETCAR (XCDR (posn), x)
+#define POSN_WINDOW_POSN(posn) CAR_SAFE (CDR_SAFE (CDR_SAFE (posn)))
+#define POSN_TIMESTAMP(posn) CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn))))
+#define POSN_SCROLLBAR_PART(posn) Fnth (make_fixnum (4), posn)
/* A cons (STRING . STRING-CHARPOS), or nil in mouse-click events.
It's a cons if the click is over a string in the mode line. */
-#define POSN_STRING(posn) (Fnth (make_fixnum (4), (posn)))
+#define POSN_STRING(posn) Fnth (make_fixnum (4), posn)
/* If POSN_STRING is nil, event refers to buffer location. */
-#define POSN_INBUFFER_P(posn) (NILP (POSN_STRING (posn)))
-#define POSN_BUFFER_POSN(posn) (Fnth (make_fixnum (5), (posn)))
+#define POSN_INBUFFER_P(posn) NILP (POSN_STRING (posn))
+#define POSN_BUFFER_POSN(posn) Fnth (make_fixnum (5), posn)
/* Getting the kind of an event head. */
#define EVENT_HEAD_KIND(event_head) \
- (Fget ((event_head), Qevent_kind))
+ Fget (event_head, Qevent_kind)
/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
happens. */
@@ -483,6 +483,7 @@ extern void set_poll_suppress_count (int);
extern int gobble_input (void);
extern bool input_polling_used (void);
extern void clear_input_pending (void);
+extern bool requeued_command_events_pending_p (void);
extern bool requeued_events_pending_p (void);
extern void bind_polling_period (int);
extern int make_ctrl_char (int) ATTRIBUTE_CONST;
diff --git a/src/lisp.h b/src/lisp.h
index 10018e4dde7..f066c876619 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -36,6 +36,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#endif
#include <attribute.h>
+#include <byteswap.h>
#include <count-leading-zeros.h>
#include <intprops.h>
#include <verify.h>
@@ -303,6 +304,9 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
#if LISP_WORDS_ARE_POINTERS
+/* TAG_PTR_INITIALLY casts to Lisp_Word and can be used in static initializers
+ so this typedef assumes static initializers can contain casts to pointers.
+ All Emacs targets support this extension to the C standard. */
typedef struct Lisp_X *Lisp_Word;
#else
typedef EMACS_INT Lisp_Word;
@@ -327,7 +331,8 @@ typedef EMACS_INT Lisp_Word;
without worrying about the implementations diverging, since
lisp_h_OP defines the actual implementation. The lisp_h_OP macros
are intended to be private to this include file, and should not be
- used elsewhere.
+ used elsewhere. They should evaluate each argument exactly once,
+ so that they behave like their functional counterparts.
FIXME: Remove the lisp_h_OP macros, and define just the inline OP
functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well
@@ -369,39 +374,12 @@ typedef EMACS_INT Lisp_Word;
# define lisp_h_Qnil {0}
#endif
-#define lisp_h_PSEUDOVECTORP(a,code) \
- (lisp_h_VECTORLIKEP((a)) && \
- ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size \
- & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))))
-
#define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
((ok) ? (void) 0 : wrong_type_argument (predicate, x))
#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y))
-#define lisp_h_BASE2_EQ(x, y) \
- (BASE_EQ (x, y) \
- || (symbols_with_pos_enabled \
- && SYMBOL_WITH_POS_P (x) \
- && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, y)))
-
-/* FIXME: Do we really need to inline the whole thing?
- * What about keeping the part after `symbols_with_pos_enabled` in
- * a separate function? */
-#define lisp_h_EQ(x, y) \
- ((XLI ((x)) == XLI ((y))) \
- || (symbols_with_pos_enabled \
- && (SYMBOL_WITH_POS_P ((x)) \
- ? (BARE_SYMBOL_P ((y)) \
- ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \
- : SYMBOL_WITH_POS_P((y)) \
- && (XLI (XSYMBOL_WITH_POS((x))->sym) \
- == XLI (XSYMBOL_WITH_POS((y))->sym))) \
- : (SYMBOL_WITH_POS_P ((y)) \
- && BARE_SYMBOL_P ((x)) \
- && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym))))))
#define lisp_h_FIXNUMP(x) \
(! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
@@ -409,18 +387,11 @@ typedef EMACS_INT Lisp_Word;
& ((1 << INTTYPEBITS) - 1)))
#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
#define lisp_h_NILP(x) BASE_EQ (x, Qnil)
-#define lisp_h_SET_SYMBOL_VAL(sym, v) \
- (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
- (sym)->u.s.val.value = (v))
#define lisp_h_SYMBOL_CONSTANT_P(sym) \
(XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
-#define lisp_h_SYMBOL_VAL(sym) \
- (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
-#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS)
-#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol)
-#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) || \
- (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x))))))
+#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS)
+#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol)
#define lisp_h_TAGGEDP(a, tag) \
(! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
- (unsigned) (tag)) \
@@ -428,8 +399,6 @@ typedef EMACS_INT Lisp_Word;
#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
-#define lisp_h_XCONS(a) \
- (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
#define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
#if USE_LSB_TAG
# define lisp_h_make_fixnum_wrap(n) \
@@ -471,20 +440,15 @@ typedef EMACS_INT Lisp_Word;
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
# define CONSP(x) lisp_h_CONSP (x)
# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y)
-# define BASE2_EQ(x, y) lisp_h_BASE2_EQ (x, y)
# define FLOATP(x) lisp_h_FLOATP (x)
# define FIXNUMP(x) lisp_h_FIXNUMP (x)
# define NILP(x) lisp_h_NILP (x)
-# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
-# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
-/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */
# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
# define XCAR(c) lisp_h_XCAR (c)
# define XCDR(c) lisp_h_XCDR (c)
-# define XCONS(a) lisp_h_XCONS (a)
# define XHASH(a) lisp_h_XHASH (a)
# if USE_LSB_TAG
# define make_fixnum(n) lisp_h_make_fixnum (n)
@@ -515,6 +479,16 @@ typedef EMACS_INT Lisp_Word;
#endif
+/* Lisp_Object tagging scheme:
+ Tag location
+ Upper bits Lower bits Type Payload
+ 000....... .......000 symbol offset from lispsym to struct Lisp_Symbol
+ 001....... .......001 unused
+ 01........ ........10 fixnum signed integer of FIXNUM_BITS
+ 110....... .......011 cons pointer to struct Lisp_Cons
+ 100....... .......100 string pointer to struct Lisp_String
+ 101....... .......101 vectorlike pointer to union vectorlike_header
+ 111....... .......111 float pointer to struct Lisp_Float */
enum Lisp_Type
{
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
@@ -596,10 +570,8 @@ enum Lisp_Fwd_Type
your object -- this way, the same object could be used to represent
several disparate C structures.
- In addition, you need to add switch branches in data.c for Ftype_of.
-
- You also need to add the new type to the constant
- `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */
+ In addition, you need to add switch branches in data.c for Fcl_type_of
+ and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */
/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a
@@ -931,14 +903,16 @@ typedef EMACS_UINT Lisp_Word_tag;
#define LISP_WORD_TAG(tag) \
((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS))
-/* An initializer for a Lisp_Object that contains TAG along with PTR. */
-#define TAG_PTR(tag, ptr) \
- LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (ptr) + LISP_WORD_TAG (tag)))
+/* An initializer for a Lisp_Object that contains TAG along with P.
+ P can be a pointer or an integer. The result is usable in a static
+ initializer if TAG and P are both integer constant expressions. */
+#define TAG_PTR_INITIALLY(tag, p) \
+ LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (p) + LISP_WORD_TAG (tag)))
/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
- designed for use as an initializer, even for a constant initializer. */
+ designed for use as a (possibly static) initializer. */
#define LISPSYM_INITIALLY(name) \
- TAG_PTR (Lisp_Symbol, (char *) (intptr_t) ((i##name) * sizeof *lispsym))
+ TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym))
/* Declare extern constants for Lisp symbols. These can be helpful
when using a debugger like GDB, on older platforms where the debug
@@ -1057,6 +1031,7 @@ enum pvec_type
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
+ PVEC_OBARRAY,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
@@ -1116,7 +1091,10 @@ enum More_Lisp_Bits
INLINE bool
PSEUDOVECTORP (Lisp_Object a, int code)
{
- return lisp_h_PSEUDOVECTORP (a, code);
+ return (lisp_h_VECTORLIKEP (a)
+ && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size
+ & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))));
}
INLINE bool
@@ -1132,9 +1110,10 @@ INLINE bool
}
INLINE bool
-(SYMBOLP) (Lisp_Object x)
+SYMBOLP (Lisp_Object x)
{
- return lisp_h_SYMBOLP (x);
+ return (BARE_SYMBOL_P (x)
+ || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)));
}
INLINE struct Lisp_Symbol_With_Pos *
@@ -1144,8 +1123,29 @@ XSYMBOL_WITH_POS (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
}
+INLINE Lisp_Object
+XSYMBOL_WITH_POS_SYM (Lisp_Object a)
+{
+ Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym;
+ eassume (BARE_SYMBOL_P (sym));
+ return sym;
+}
+
+INLINE Lisp_Object
+XSYMBOL_WITH_POS_POS (Lisp_Object a)
+{
+ return XSYMBOL_WITH_POS (a)->pos;
+}
+
+INLINE Lisp_Object
+maybe_remove_pos_from_symbol (Lisp_Object x)
+{
+ return (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)
+ ? XSYMBOL_WITH_POS_SYM (x) : x);
+}
+
INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
-(XBARE_SYMBOL) (Lisp_Object a)
+XBARE_SYMBOL (Lisp_Object a)
{
eassert (BARE_SYMBOL_P (a));
intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
@@ -1154,29 +1154,41 @@ INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
}
INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
-(XSYMBOL) (Lisp_Object a)
+XSYMBOL (Lisp_Object a)
{
- eassert (SYMBOLP ((a)));
- if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a))
- return XBARE_SYMBOL (a);
- return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym);
+ if (!BARE_SYMBOL_P (a))
+ {
+ eassume (symbols_with_pos_enabled);
+ a = XSYMBOL_WITH_POS_SYM (a);
+ }
+ return XBARE_SYMBOL (a);
}
+/* Internal use only. */
INLINE Lisp_Object
-make_lisp_symbol (struct Lisp_Symbol *sym)
+make_lisp_symbol_internal (struct Lisp_Symbol *sym)
{
/* GCC 7 x86-64 generates faster code if lispsym is
- cast to char * rather than to intptr_t. */
+ cast to char * rather than to intptr_t.
+ Do not use eassert here, so that builtin symbols like Qnil compile to
+ constants; this is needed for some circa-2024 GCCs even with -O2. */
char *symoffset = (char *) ((char *) sym - (char *) lispsym);
- Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
- eassert (XSYMBOL (a) == sym);
+ Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Symbol, symoffset);
+ return a;
+}
+
+INLINE Lisp_Object
+make_lisp_symbol (struct Lisp_Symbol *sym)
+{
+ Lisp_Object a = make_lisp_symbol_internal (sym);
+ eassert (XBARE_SYMBOL (a) == sym);
return a;
}
INLINE Lisp_Object
builtin_lisp_symbol (int index)
{
- return make_lisp_symbol (&lispsym[index]);
+ return make_lisp_symbol_internal (&lispsym[index]);
}
INLINE bool
@@ -1335,20 +1347,15 @@ INLINE bool
return lisp_h_BASE_EQ (x, y);
}
-/* Return true if X and Y are the same object, reckoning X to be the
- same as a bare symbol Y if X is Y with position. */
-INLINE bool
-(BASE2_EQ) (Lisp_Object x, Lisp_Object y)
-{
- return lisp_h_BASE2_EQ (x, y);
-}
-
/* Return true if X and Y are the same object, reckoning a symbol with
position as being the same as the bare symbol. */
INLINE bool
-(EQ) (Lisp_Object x, Lisp_Object y)
+EQ (Lisp_Object x, Lisp_Object y)
{
- return lisp_h_EQ (x, y);
+ return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x)
+ ? XSYMBOL_WITH_POS_SYM (x) : x),
+ (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y)
+ ? XSYMBOL_WITH_POS_SYM (y) : y));
}
INLINE intmax_t
@@ -1362,7 +1369,7 @@ clip_to_bounds (intmax_t lower, intmax_t num, intmax_t upper)
INLINE Lisp_Object
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
- Lisp_Object a = TAG_PTR (type, ptr);
+ Lisp_Object a = TAG_PTR_INITIALLY (type, ptr);
eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr);
return a;
}
@@ -1407,19 +1414,19 @@ dead_object (void)
== (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
#define XSETWINDOW_CONFIGURATION(a, b) \
- (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
-#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
-#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
-#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
-#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
-#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
-#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
-#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
-#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD))
-#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX))
-#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR))
-#define XSETNATIVE_COMP_UNIT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT))
+ XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION)
+#define XSETPROCESS(a, b) XSETPSEUDOVECTOR (a, b, PVEC_PROCESS)
+#define XSETWINDOW(a, b) XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)
+#define XSETTERMINAL(a, b) XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)
+#define XSETSUBR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_SUBR)
+#define XSETBUFFER(a, b) XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)
+#define XSETCHAR_TABLE(a, b) XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)
+#define XSETBOOL_VECTOR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)
+#define XSETSUB_CHAR_TABLE(a, b) XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)
+#define XSETTHREAD(a, b) XSETPSEUDOVECTOR (a, b, PVEC_THREAD)
+#define XSETMUTEX(a, b) XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)
+#define XSETCONDVAR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)
+#define XSETNATIVE_COMP_UNIT(a, b) XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT)
/* Efficiently convert a pointer to a Lisp object and back. The
pointer is represented as a fixnum, so the garbage collector
@@ -1435,7 +1442,7 @@ XFIXNUMPTR (Lisp_Object a)
INLINE Lisp_Object
make_pointer_integer_unsafe (void *p)
{
- Lisp_Object a = TAG_PTR (Lisp_Int0, p);
+ Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Int0, p);
return a;
}
@@ -1493,9 +1500,10 @@ CHECK_CONS (Lisp_Object x)
}
INLINE struct Lisp_Cons *
-(XCONS) (Lisp_Object a)
+XCONS (Lisp_Object a)
{
- return lisp_h_XCONS (a);
+ eassert (CONSP (a));
+ return XUNTAG (a, Lisp_Cons, struct Lisp_Cons);
}
/* Take the car or cdr of something known to be a cons cell. */
@@ -1875,6 +1883,30 @@ bool_vector_bytes (EMACS_INT size)
return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
}
+INLINE bits_word
+bits_word_to_host_endian (bits_word val)
+{
+#ifndef WORDS_BIGENDIAN
+ return val;
+#else
+ if (BITS_WORD_MAX >> 31 == 1)
+ return bswap_32 (val);
+ if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
+ return bswap_64 (val);
+ {
+ int i;
+ bits_word r = 0;
+ for (i = 0; i < sizeof val; i++)
+ {
+ r = ((r << 1 << (CHAR_BIT - 1))
+ | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
+ val = val >> 1 >> (CHAR_BIT - 1);
+ }
+ return r;
+ }
+#endif
+}
+
INLINE bool
BOOL_VECTOR_P (Lisp_Object a)
{
@@ -2280,9 +2312,10 @@ typedef jmp_buf sys_jmp_buf;
/* Value is name of symbol. */
INLINE Lisp_Object
-(SYMBOL_VAL) (struct Lisp_Symbol *sym)
+SYMBOL_VAL (struct Lisp_Symbol *sym)
{
- return lisp_h_SYMBOL_VAL (sym);
+ eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+ return sym->u.s.val.value;
}
INLINE struct Lisp_Symbol *
@@ -2305,9 +2338,10 @@ SYMBOL_FWD (struct Lisp_Symbol *sym)
}
INLINE void
-(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v)
+SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
{
- lisp_h_SET_SYMBOL_VAL (sym, v);
+ eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+ sym->u.s.val.value = v;
}
INLINE void
@@ -2376,6 +2410,118 @@ INLINE int
definition is done by lread.c's define_symbol. */
#define DEFSYM(sym, name) /* empty */
+
+struct Lisp_Obarray
+{
+ union vectorlike_header header;
+
+ /* Array of 2**size_bits values, each being either a (bare) symbol or
+ the fixnum 0. The symbols for each bucket are chained via
+ their s.next field. */
+ Lisp_Object *buckets;
+
+ unsigned size_bits; /* log2(size of buckets vector) */
+ unsigned count; /* number of symbols in obarray */
+};
+
+INLINE bool
+OBARRAYP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_OBARRAY);
+}
+
+INLINE struct Lisp_Obarray *
+XOBARRAY (Lisp_Object a)
+{
+ eassert (OBARRAYP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray);
+}
+
+INLINE void
+CHECK_OBARRAY (Lisp_Object x)
+{
+ CHECK_TYPE (OBARRAYP (x), Qobarrayp, x);
+}
+
+INLINE Lisp_Object
+make_lisp_obarray (struct Lisp_Obarray *o)
+{
+ eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY));
+ return make_lisp_ptr (o, Lisp_Vectorlike);
+}
+
+INLINE ptrdiff_t
+obarray_size (const struct Lisp_Obarray *o)
+{
+ return (ptrdiff_t)1 << o->size_bits;
+}
+
+Lisp_Object check_obarray_slow (Lisp_Object);
+
+/* Return an obarray object from OBARRAY or signal an error. */
+INLINE Lisp_Object
+check_obarray (Lisp_Object obarray)
+{
+ return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray);
+}
+
+/* Obarray iterator state. Don't access these members directly.
+ The iterator functions must be called in the order followed by DOOBARRAY. */
+typedef struct {
+ struct Lisp_Obarray *o;
+ ptrdiff_t idx; /* Current bucket index. */
+ struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end
+ of current bucket. */
+} obarray_iter_t;
+
+INLINE obarray_iter_t
+make_obarray_iter (struct Lisp_Obarray *oa)
+{
+ return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL};
+}
+
+/* Whether IT has reached the end and there are no more symbols.
+ If true, IT is dead and cannot be used any more. */
+INLINE bool
+obarray_iter_at_end (obarray_iter_t *it)
+{
+ if (it->symbol)
+ return false;
+ ptrdiff_t size = obarray_size (it->o);
+ while (++it->idx < size)
+ {
+ Lisp_Object obj = it->o->buckets[it->idx];
+ if (!BASE_EQ (obj, make_fixnum (0)))
+ {
+ it->symbol = XBARE_SYMBOL (obj);
+ return false;
+ }
+ }
+ return true;
+}
+
+/* Advance IT to the next symbol if any. */
+INLINE void
+obarray_iter_step (obarray_iter_t *it)
+{
+ it->symbol = it->symbol->u.s.next;
+}
+
+/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */
+INLINE Lisp_Object
+obarray_iter_symbol (obarray_iter_t *it)
+{
+ return make_lisp_symbol (it->symbol);
+}
+
+/* Iterate IT over the symbols of the obarray OA.
+ The body shouldn't add or remove symbols in OA, but disobeying that rule
+ only risks symbols to be iterated more than once or not at all,
+ not crashes or data corruption. */
+#define DOOBARRAY(oa, it) \
+ for (obarray_iter_t it = make_obarray_iter (oa); \
+ !obarray_iter_at_end (&it); obarray_iter_step (&it))
+
/***********************************************************************
Hash Tables
@@ -2385,10 +2531,23 @@ INLINE int
struct Lisp_Hash_Table;
+/* The type of a hash value stored in the table.
+ It's unsigned and a subtype of EMACS_UINT. */
+typedef uint32_t hash_hash_t;
+
+typedef enum {
+ Test_eql,
+ Test_eq,
+ Test_equal,
+} hash_table_std_test_t;
+
struct hash_table_test
{
- /* Name of the function used to compare keys. */
- Lisp_Object name;
+ /* C function to compute hash code. */
+ hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *);
+
+ /* C function to compare two keys. */
+ Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *);
/* User-supplied hash function, or nil. */
Lisp_Object user_hash_function;
@@ -2396,78 +2555,109 @@ struct hash_table_test
/* User-supplied key comparison function, or nil. */
Lisp_Object user_cmp_function;
- /* C function to compare two keys. */
- Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *);
-
- /* C function to compute hash code. */
- Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *);
+ /* Function used to compare keys; always a bare symbol. */
+ Lisp_Object name;
};
+typedef enum {
+ Weak_None, /* No weak references. */
+ Weak_Key, /* Reference to key is weak. */
+ Weak_Value, /* Reference to value is weak. */
+ Weak_Key_Or_Value, /* References to key or value are weak:
+ element kept as long as strong reference to
+ either key or value remains. */
+ Weak_Key_And_Value, /* References to key and value are weak:
+ element kept as long as strong references to
+ both key and value remain. */
+} hash_table_weakness_t;
+
+/* The type of a hash table index, both for table indices and index
+ (hash) indices. It's signed and a subtype of ptrdiff_t. */
+typedef int32_t hash_idx_t;
+
struct Lisp_Hash_Table
{
- /* Change pdumper.c if you change the fields here. */
-
- /* This is for Lisp; the hash table code does not refer to it. */
union vectorlike_header header;
- /* Nil if table is non-weak. Otherwise a symbol describing the
- weakness of the table. */
- Lisp_Object weak;
+ /* Hash table internal structure:
+
+ Lisp key index table
+ | vector
+ | hash fn hash key value next
+ v +--+ +------+-------+------+----+
+ hash value |-1| | C351 | cow | moo | -1 |<-
+ | +--+ +------+-------+------+----+ |
+ ------------>| -------->| 07A8 | cat | meow | -1 | |
+ range +--+ +------+-------+------+----+ |
+ reduction |-1| ->| 91D2 | dog | woof | ----
+ +--+ | +------+-------+------+----+
+ | ------ | ? |unbound| ? | -1 |<-
+ +--+ +------+-------+------+----+ |
+ | -------->| F6B0 | duck |quack | -1 | |
+ +--+ +------+-------+------+----+ |
+ |-1| ->| ? |unbound| ? | ----
+ +--+ | +------+-------+------+----+
+ : : | : : : : :
+ |
+ next_free
+
+ The table is physically split into three vectors (hash, next,
+ key_and_value) which may or may not be beneficial. */
+
+ /* Bucket vector. An entry of -1 indicates no item is present,
+ and a nonnegative entry is the index of the first item in
+ a collision chain.
+ This vector is 2**index_bits entries long.
+ If index_bits is 0 (and table_size is 0), then this is the
+ constant read-only vector {-1}, shared between all instances.
+ Otherwise it is heap-allocated. */
+ hash_idx_t *index;
+
+ /* Vector of hash codes. Unused entries have undefined values.
+ This vector is table_size entries long. */
+ hash_hash_t *hash;
- /* Vector of hash codes, or nil if the table needs rehashing.
- If the I-th entry is unused, then hash[I] should be nil. */
- Lisp_Object hash;
+ /* Vector of keys and values. The key of item I is found at index
+ 2 * I, the value is found at index 2 * I + 1.
+ If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused.
+ This is gc_marked specially if the table is weak.
+ This vector is 2 * table_size entries long. */
+ Lisp_Object *key_and_value;
+
+ /* The comparison and hash functions. */
+ const struct hash_table_test *test;
/* Vector used to chain entries. If entry I is free, next[I] is the
entry number of the next free item. If entry I is non-free,
next[I] is the index of the next entry in the collision chain,
- or -1 if there is such entry. */
- Lisp_Object next;
-
- /* Bucket vector. An entry of -1 indicates no item is present,
- and a nonnegative entry is the index of the first item in
- a collision chain. This vector's size can be larger than the
- hash table size to reduce collisions. */
- Lisp_Object index;
-
- /* Only the fields above are traced normally by the GC. The ones after
- 'index' are special and are either ignored by the GC or traced in
- a special way (e.g. because of weakness). */
+ or -1 if there is no such entry.
+ This vector is table_size entries long. */
+ hash_idx_t *next;
/* Number of key/value entries in the table. */
- ptrdiff_t count;
+ hash_idx_t count;
/* Index of first free entry in free list, or -1 if none. */
- ptrdiff_t next_free;
+ hash_idx_t next_free;
+
+ hash_idx_t table_size; /* Size of the next and hash vectors. */
+
+ unsigned char index_bits; /* log2 (size of the index vector). */
+
+ /* Weakness of the table. */
+ hash_table_weakness_t weakness : 3;
+
+ /* Hash table test (only used when frozen in dump) */
+ hash_table_std_test_t frozen_test : 2;
/* True if the table can be purecopied. The table cannot be
changed afterwards. */
- bool purecopy;
+ bool_bf purecopy : 1;
/* True if the table is mutable. Ordinarily tables are mutable, but
pure tables are not, and while a table is being mutated it is
immutable for recursive attempts to mutate it. */
- bool mutable;
-
- /* Resize hash table when number of entries / table size is >= this
- ratio. */
- float rehash_threshold;
-
- /* Used when the table is resized. If equal to a negative integer,
- the user rehash-size is the integer -REHASH_SIZE, and the new
- size is the old size plus -REHASH_SIZE. If positive, the user
- rehash-size is the floating-point value REHASH_SIZE + 1, and the
- new size is the old size times REHASH_SIZE + 1. */
- float rehash_size;
-
- /* Vector of keys and values. The key of item I is found at index
- 2 * I, the value is found at index 2 * I + 1.
- If the key is equal to Qunbound, then this slot is unused.
- This is gc_marked specially if the table is weak. */
- Lisp_Object key_and_value;
-
- /* The comparison and hash functions. */
- struct hash_table_test test;
+ bool_bf mutable : 1;
/* Next weak hash table if this is a weak hash table. The head of
the list is in weak_hash_tables. Used only during garbage
@@ -2475,8 +2665,20 @@ struct Lisp_Hash_Table
struct Lisp_Hash_Table *next_weak;
} GCALIGNED_STRUCT;
-/* Sanity-check pseudovector layout. */
-verify (offsetof (struct Lisp_Hash_Table, weak) == header_size);
+/* A specific Lisp_Object that is not a valid Lisp value.
+ We need to be careful not to leak this value into machinery
+ where it may be treated as one; we'd get a segfault if lucky. */
+#define INVALID_LISP_VALUE make_lisp_ptr (NULL, Lisp_Float)
+
+/* Key value that marks an unused hash table entry. */
+#define HASH_UNUSED_ENTRY_KEY INVALID_LISP_VALUE
+
+/* KEY is a key of an unused hash table entry. */
+INLINE bool
+hash_unused_entry_key_p (Lisp_Object key)
+{
+ return BASE_EQ (key, HASH_UNUSED_ENTRY_KEY);
+}
INLINE bool
HASH_TABLE_P (Lisp_Object a)
@@ -2491,54 +2693,97 @@ XHASH_TABLE (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table);
}
-#define XSET_HASH_TABLE(VAR, PTR) \
- (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
+INLINE Lisp_Object
+make_lisp_hash_table (struct Lisp_Hash_Table *h)
+{
+ eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_HASH_TABLE));
+ return make_lisp_ptr (h, Lisp_Vectorlike);
+}
/* Value is the key part of entry IDX in hash table H. */
INLINE Lisp_Object
HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- return AREF (h->key_and_value, 2 * idx);
+ eassert (idx >= 0 && idx < h->table_size);
+ return h->key_and_value[2 * idx];
}
/* Value is the value part of entry IDX in hash table H. */
INLINE Lisp_Object
HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- return AREF (h->key_and_value, 2 * idx + 1);
+ eassert (idx >= 0 && idx < h->table_size);
+ return h->key_and_value[2 * idx + 1];
}
/* Value is the hash code computed for entry IDX in hash table H. */
-INLINE Lisp_Object
+INLINE hash_hash_t
HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
- return AREF (h->hash, idx);
+ eassert (idx >= 0 && idx < h->table_size);
+ return h->hash[idx];
}
/* Value is the size of hash table H. */
INLINE ptrdiff_t
HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
{
- ptrdiff_t size = ASIZE (h->next);
- eassume (0 < size);
- return size;
+ return h->table_size;
}
-void hash_table_rehash (Lisp_Object);
+/* Size of the index vector in hash table H. */
+INLINE ptrdiff_t
+hash_table_index_size (const struct Lisp_Hash_Table *h)
+{
+ return (ptrdiff_t)1 << h->index_bits;
+}
+
+/* Hash value for KEY in hash table H. */
+INLINE hash_hash_t
+hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
+{
+ return h->test->hashfn (key, h);
+}
+
+/* Iterate K and V as key and value of valid entries in hash table H.
+ The body may remove the current entry or alter its value slot, but not
+ mutate TABLE in any other way. */
+#define DOHASH(h, k, v) \
+ for (Lisp_Object *dohash_##k##_##v##_kv = (h)->key_and_value, \
+ *dohash_##k##_##v##_end = dohash_##k##_##v##_kv \
+ + 2 * HASH_TABLE_SIZE (h), \
+ *dohash_##k##_##v##_base = dohash_##k##_##v##_kv, \
+ k, v; \
+ dohash_##k##_##v##_kv < dohash_##k##_##v##_end \
+ && (k = dohash_##k##_##v##_kv[0], \
+ v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \
+ true); \
+ eassert (dohash_##k##_##v##_base == (h)->key_and_value \
+ && dohash_##k##_##v##_end \
+ == dohash_##k##_##v##_base \
+ + 2 * HASH_TABLE_SIZE (h)), \
+ dohash_##k##_##v##_kv += 2) \
+ if (hash_unused_entry_key_p (k)) \
+ ; \
+ else
+
+/* Iterate I as index of valid entries in hash table H.
+ Unlike DOHASH, this construct copes with arbitrary table mutations
+ in the body. The consequences of such mutations are limited to
+ whether and in what order entries are encountered by the loop
+ (which is usually bad enough), but not crashing or corrupting the
+ Lisp state. */
+#define DOHASH_SAFE(h, i) \
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); i++) \
+ if (hash_unused_entry_key_p (HASH_KEY (h, i))) \
+ ; \
+ else
+
+void hash_table_thaw (Lisp_Object hash_table);
/* Default size for hash tables if not specified. */
-enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
-
-/* Default threshold specifying when to resize a hash table. The
- value gives the ratio of current entries in the hash table and the
- size of the hash table. */
-
-static float const DEFAULT_REHASH_THRESHOLD = 0.8125;
-
-/* Default factor by which to increase the size of a hash table, minus 1. */
-
-static float const DEFAULT_REHASH_SIZE = 1.5 - 1;
+enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 0 };
/* Combine two integers X and Y for hashing. The result might exceed
INTMASK. */
@@ -2557,6 +2802,28 @@ SXHASH_REDUCE (EMACS_UINT x)
return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK;
}
+/* Reduce an EMACS_UINT hash value to hash_hash_t. */
+INLINE hash_hash_t
+reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
+{
+ verify (sizeof x <= 2 * sizeof (hash_hash_t));
+ return (sizeof x == sizeof (hash_hash_t)
+ ? x
+ : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
+}
+
+/* Reduce HASH to a value BITS wide. */
+INLINE ptrdiff_t
+knuth_hash (hash_hash_t hash, unsigned bits)
+{
+ /* Knuth multiplicative hashing, tailored for 32-bit indices
+ (avoiding a 64-bit multiply). */
+ uint32_t alpha = 2654435769; /* 2**32/phi */
+ /* Note the cast to uint64_t, to make it work for bits=0. */
+ return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits);
+}
+
+
struct Lisp_Marker
{
union vectorlike_header header;
@@ -2641,7 +2908,7 @@ extern Lisp_Object make_misc_ptr (void *);
INLINE Lisp_Object
make_mint_ptr (void *a)
{
- Lisp_Object val = TAG_PTR (Lisp_Int0, a);
+ Lisp_Object val = TAG_PTR_INITIALLY (Lisp_Int0, a);
return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a);
}
@@ -2735,22 +3002,6 @@ XOVERLAY (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay);
}
-INLINE Lisp_Object
-SYMBOL_WITH_POS_SYM (Lisp_Object a)
-{
- if (!SYMBOL_WITH_POS_P (a))
- wrong_type_argument (Qsymbol_with_pos_p, a);
- return XSYMBOL_WITH_POS (a)->sym;
-}
-
-INLINE Lisp_Object
-SYMBOL_WITH_POS_POS (Lisp_Object a)
-{
- if (!SYMBOL_WITH_POS_P (a))
- wrong_type_argument (Qsymbol_with_pos_p, a);
- return XSYMBOL_WITH_POS (a)->pos;
-}
-
INLINE bool
USER_PTRP (Lisp_Object x)
{
@@ -3543,7 +3794,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
}
/* This structure helps implement the `catch/throw' and `condition-case/signal'
- control structures. A struct handler contains all the information needed to
+ control structures as well as 'handler-bind'.
+ A struct handler contains all the information needed to
restore the state of the interpreter after a non-local jump.
Handler structures are chained together in a doubly linked list; the `next'
@@ -3564,9 +3816,41 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
state.
Members are volatile if their values need to survive _longjmp when
- a 'struct handler' is a local variable. */
-
-enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
+ a 'struct handler' is a local variable.
+
+ When running the HANDLER of a 'handler-bind', we need to
+ temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below"
+ the current handler, but without hiding any CATCHERs. We do that by
+ installing a SKIP_CONDITIONS which tells the search to skip the
+ N next conditions. */
+
+enum handlertype {
+ CATCHER, /* Entry for 'catch'.
+ 'tag_or_ch' holds the catch's tag.
+ 'val' holds the retval during longjmp. */
+ CONDITION_CASE, /* Entry for 'condition-case'.
+ 'tag_or_ch' holds the list of conditions.
+ 'val' holds the retval during longjmp. */
+ CATCHER_ALL, /* Wildcard which catches all 'throw's.
+ 'tag_or_ch' is unused.
+ 'val' holds the retval during longjmp. */
+ HANDLER_BIND, /* Entry for 'handler-bind'.
+ 'tag_or_ch' holds the list of conditions.
+ 'val' holds the handler function.
+ The rest of the handler is unused,
+ except for 'bytecode_dest' that holds
+ the number of preceding HANDLER_BIND
+ entries which belong to the same
+ 'handler-bind' (and hence need to
+ be muted together). */
+ SKIP_CONDITIONS /* Mask out the N preceding entries.
+ Used while running the handler of
+ a HANDLER_BIND to hides the condition
+ handlers underneath (and including)
+ the 'handler-bind'.
+ 'tag_or_ch' holds that number, the rest
+ is unused. */
+};
enum nonlocal_exit
{
@@ -3712,13 +3996,15 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args,
INLINE void
set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
- gc_aset (h->key_and_value, 2 * idx, val);
+ eassert (idx >= 0 && idx < h->table_size);
+ h->key_and_value[2 * idx] = val;
}
INLINE void
set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
- gc_aset (h->key_and_value, 2 * idx + 1, val);
+ eassert (idx >= 0 && idx < h->table_size);
+ h->key_and_value[2 * idx + 1] = val;;
}
/* Use these functions to set Lisp_Object
@@ -3956,6 +4242,7 @@ extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
extern void syms_of_character (void);
/* Defined in charset.c. */
+extern void mark_charset (void);
extern void init_charset (void);
extern void init_charset_once (void);
extern void syms_of_charset (void);
@@ -3976,12 +4263,14 @@ extern void hexbuf_digest (char *, void const *, int);
extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object);
-Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
-Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
- Lisp_Object, bool);
-ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *);
+Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT,
+ hash_table_weakness_t, bool);
+Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak);
+ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object);
+ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key,
+ hash_hash_t *phash);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
- Lisp_Object);
+ hash_hash_t);
void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
@@ -4008,9 +4297,11 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop,
Lisp_Object val);
extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop);
extern void syms_of_fns (void);
+extern void mark_fns (void);
/* Defined in sort.c */
-extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t);
+extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t,
+ bool);
/* Defined in floatfns.c. */
verify (FLT_RADIX == 2 || FLT_RADIX == 16);
@@ -4389,6 +4680,9 @@ extern void syms_of_alloc (void);
extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL;
extern int valid_lisp_object_p (Lisp_Object);
+void *hash_table_alloc_bytes (ptrdiff_t nbytes) ATTRIBUTE_MALLOC_SIZE ((1));
+void hash_table_free_bytes (void *p, ptrdiff_t nbytes);
+
/* Defined in gmalloc.c. */
#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC
extern size_t __malloc_extra_blocks;
@@ -4450,7 +4744,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t,
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object check_obarray (Lisp_Object);
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
@@ -4496,7 +4789,6 @@ extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
extern bool signal_quit_p (Lisp_Object);
-extern bool backtrace_yet;
/* To run a normal hook, use the appropriate function from the list below.
The calling convention:
@@ -4537,6 +4829,8 @@ extern Lisp_Object internal_condition_case_n
extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object));
extern struct handler *push_handler (Lisp_Object, enum handlertype)
ATTRIBUTE_RETURNS_NONNULL;
+extern void pop_handler (void);
+extern void push_handler_bind (Lisp_Object, Lisp_Object, int);
extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
extern void specbind (Lisp_Object, Lisp_Object);
extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
@@ -4574,7 +4868,7 @@ extern void init_eval (void);
extern void syms_of_eval (void);
extern void prog_ignore (Lisp_Object);
extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
-extern void get_backtrace (Lisp_Object array);
+extern void get_backtrace (Lisp_Object *array, ptrdiff_t size);
Lisp_Object backtrace_top_function (void);
extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
void do_debug_on_call (Lisp_Object code, specpdl_ref count);
@@ -4655,7 +4949,7 @@ extern void syms_of_editfns (void);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
-extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
+extern bool disable_line_numbers_overlay_at_eob (void);
extern AVOID nsberror (Lisp_Object);
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
@@ -4883,6 +5177,7 @@ extern bool build_details;
/* 0 not a daemon, 1 foreground daemon, 2 background daemon. */
extern int daemon_type;
#define IS_DAEMON (daemon_type != 0)
+/* Non-zero means daemon-initialized has not yet been called. */
#define DAEMON_RUNNING (daemon_type >= 0)
#else /* WINDOWSNT */
extern void *w32_daemon_event;
@@ -5191,6 +5486,7 @@ void syms_of_dbusbind (void);
extern bool profiler_memory_running;
extern void malloc_probe (size_t);
extern void syms_of_profiler (void);
+extern void mark_profiler (void);
#ifdef DOS_NT
@@ -5402,7 +5698,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val)
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577
which causes GCC to mistakenly complain about the
memory allocation in SAFE_ALLOCA_LISP_EXTRA. */
-#if GNUC_PREREQ (13, 0, 0)
+#if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0)
# pragma GCC diagnostic ignored "-Wanalyzer-allocation-size"
#endif
diff --git a/src/lread.c b/src/lread.c
index e95dafcf222..1cb941e84fc 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -124,7 +124,7 @@ static struct android_fd_or_asset invalid_file_stream =
#define file_stream struct android_fd_or_asset
#define file_offset off_t
-#define file_tell(n) (android_asset_lseek ((n), 0, SEEK_CUR))
+#define file_tell(n) android_asset_lseek (n, 0, SEEK_CUR)
#define file_seek android_asset_lseek
#define file_stream_valid_p(p) ((p).asset || (p).fd >= 0)
#define file_stream_close android_close_asset
@@ -1950,9 +1950,9 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
= Fcons (list2
(Qcomp,
CALLN (Fformat,
- build_string ("Cannot look up eln "
- "file as no source file "
- "was found for %s"),
+ build_string ("Cannot look up .eln file "
+ "for %s because no source "
+ "file was found for it"),
*filename)),
Vdelayed_warnings_list);
return;
@@ -2369,8 +2369,14 @@ build_load_history (Lisp_Object filename, bool entire)
front of load-history, the most-recently-loaded position. Also
do this if we didn't find an existing member for the file. */
if (entire || !foundit)
- Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
- Vload_history);
+ {
+ Lisp_Object tem = Fnreverse (Vcurrent_load_list);
+ eassert (EQ (filename, Fcar (tem)));
+ Vload_history = Fcons (tem, Vload_history);
+ /* FIXME: There should be an unbind_to right after calling us which
+ should re-establish the previous value of Vcurrent_load_list. */
+ Vcurrent_load_list = Qt;
+ }
}
static void
@@ -2437,11 +2443,13 @@ readevalloop (Lisp_Object readcharfun,
bool whole_buffer = 0;
/* True on the first time around. */
bool first_sexp = 1;
- Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+ Lisp_Object macroexpand;
if (!NILP (sourcename))
CHECK_STRING (sourcename);
+ macroexpand = Qinternal_macroexpand_for_load;
+
if (NILP (Ffboundp (macroexpand))
|| (STRINGP (sourcename) && suffix_p (sourcename, ".elc")))
/* Don't macroexpand before the corresponding function is defined
@@ -2544,15 +2552,11 @@ readevalloop (Lisp_Object readcharfun,
if (! HASH_TABLE_P (read_objects_map)
|| XHASH_TABLE (read_objects_map)->count)
read_objects_map
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
- DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
- Qnil, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (! HASH_TABLE_P (read_objects_completed)
|| XHASH_TABLE (read_objects_completed)->count)
read_objects_completed
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
- DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
- Qnil, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (!NILP (Vpurify_flag) && c == '(')
val = read0 (readcharfun, false);
else
@@ -2796,13 +2800,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
if (! HASH_TABLE_P (read_objects_map)
|| XHASH_TABLE (read_objects_map)->count)
read_objects_map
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (! HASH_TABLE_P (read_objects_completed)
|| XHASH_TABLE (read_objects_completed)->count)
read_objects_completed
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
@@ -3412,7 +3414,7 @@ read_string_literal (Lisp_Object readcharfun)
static Lisp_Object
hash_table_from_plist (Lisp_Object plist)
{
- Lisp_Object params[12];
+ Lisp_Object params[4 * 2];
Lisp_Object *par = params;
/* This is repetitive but fast and simple. */
@@ -3426,31 +3428,30 @@ hash_table_from_plist (Lisp_Object plist)
} \
} while (0)
- ADDPARAM (size);
ADDPARAM (test);
ADDPARAM (weakness);
- ADDPARAM (rehash_size);
- ADDPARAM (rehash_threshold);
ADDPARAM (purecopy);
Lisp_Object data = plist_get (plist, Qdata);
+ if (!(NILP (data) || CONSP (data)))
+ error ("Hash table data is not a list");
+ ptrdiff_t data_len = list_length (data);
+ if (data_len & 1)
+ error ("Hash table data length is odd");
+ *par++ = QCsize;
+ *par++ = make_fixnum (data_len / 2);
/* Now use params to make a new hash table and fill it. */
Lisp_Object ht = Fmake_hash_table (par - params, params);
- Lisp_Object last = data;
- FOR_EACH_TAIL_SAFE (data)
+ while (!NILP (data))
{
Lisp_Object key = XCAR (data);
data = XCDR (data);
- if (!CONSP (data))
- break;
Lisp_Object val = XCAR (data);
- last = XCDR (data);
Fputhash (key, val, ht);
+ data = XCDR (data);
}
- if (!NILP (last))
- error ("Hash table data is not a list of even length");
return ht;
}
@@ -3488,6 +3489,8 @@ vector_from_rev_list (Lisp_Object elems)
return obj;
}
+static Lisp_Object get_lazy_string (Lisp_Object val);
+
static Lisp_Object
bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
{
@@ -3495,49 +3498,50 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
Lisp_Object *vec = XVECTOR (obj)->contents;
ptrdiff_t size = ASIZE (obj);
+ if (infile && size >= COMPILED_CONSTANTS)
+ {
+ /* Always read 'lazily-loaded' bytecode (generated by the
+ `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to
+ avoid code in the fast path during execution. */
+ if (CONSP (vec[COMPILED_BYTECODE])
+ && FIXNUMP (XCDR (vec[COMPILED_BYTECODE])))
+ vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]);
+
+ /* Lazily-loaded bytecode is represented by the constant slot being nil
+ and the bytecode slot a (lazily loaded) string containing the
+ print representation of (BYTECODE . CONSTANTS). Unpack the
+ pieces by coerceing the string to unibyte and reading the result. */
+ if (NILP (vec[COMPILED_CONSTANTS]) && STRINGP (vec[COMPILED_BYTECODE]))
+ {
+ Lisp_Object enc = vec[COMPILED_BYTECODE];
+ Lisp_Object pair = Fread (Fcons (enc, readcharfun));
+ if (!CONSP (pair))
+ invalid_syntax ("Invalid byte-code object", readcharfun);
+
+ vec[COMPILED_BYTECODE] = XCAR (pair);
+ vec[COMPILED_CONSTANTS] = XCDR (pair);
+ }
+ }
+
if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1
&& (FIXNUMP (vec[COMPILED_ARGLIST])
|| CONSP (vec[COMPILED_ARGLIST])
|| NILP (vec[COMPILED_ARGLIST]))
+ && STRINGP (vec[COMPILED_BYTECODE])
+ && VECTORP (vec[COMPILED_CONSTANTS])
&& FIXNATP (vec[COMPILED_STACK_DEPTH])))
invalid_syntax ("Invalid byte-code object", readcharfun);
- if (load_force_doc_strings
- && NILP (vec[COMPILED_CONSTANTS])
- && STRINGP (vec[COMPILED_BYTECODE]))
- {
- /* Lazily-loaded bytecode is represented by the constant slot being nil
- and the bytecode slot a (lazily loaded) string containing the
- print representation of (BYTECODE . CONSTANTS). Unpack the
- pieces by coerceing the string to unibyte and reading the result. */
- Lisp_Object enc = vec[COMPILED_BYTECODE];
- Lisp_Object pair = Fread (Fcons (enc, readcharfun));
- if (!CONSP (pair))
- invalid_syntax ("Invalid byte-code object", readcharfun);
-
- vec[COMPILED_BYTECODE] = XCAR (pair);
- vec[COMPILED_CONSTANTS] = XCDR (pair);
- }
+ if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE]))
+ /* BYTESTR must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and
+ now such a byte-code string is loaded as multibyte with
+ raw 8-bit characters converted to multibyte form.
+ Convert them back to the original unibyte form. */
+ vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]);
- if (!((STRINGP (vec[COMPILED_BYTECODE])
- && VECTORP (vec[COMPILED_CONSTANTS]))
- || CONSP (vec[COMPILED_BYTECODE])))
- invalid_syntax ("Invalid byte-code object", readcharfun);
-
- if (STRINGP (vec[COMPILED_BYTECODE]))
- {
- if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE]))
- {
- /* BYTESTR must have been produced by Emacs 20.2 or earlier
- because it produced a raw 8-bit string for byte-code and
- now such a byte-code string is loaded as multibyte with
- raw 8-bit characters converted to multibyte form.
- Convert them back to the original unibyte form. */
- vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]);
- }
- /* Bytecode must be immovable. */
- pin_string (vec[COMPILED_BYTECODE]);
- }
+ /* Bytecode must be immovable. */
+ pin_string (vec[COMPILED_BYTECODE]);
XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED);
return obj;
@@ -4262,8 +4266,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
struct Lisp_Hash_Table *h
= XHASH_TABLE (read_objects_map);
Lisp_Object number = make_fixnum (n);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h, number, &hash);
+ hash_hash_t hash;
+ ptrdiff_t i = hash_lookup_get_hash (h, number, &hash);
if (i >= 0)
/* Not normal, but input could be malformed. */
set_hash_value_slot (h, i, placeholder);
@@ -4281,7 +4285,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
/* #N# -- reference to numbered object */
struct Lisp_Hash_Table *h
= XHASH_TABLE (read_objects_map);
- ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL);
+ ptrdiff_t i = hash_lookup (h, make_fixnum (n));
if (i < 0)
invalid_syntax ("#", readcharfun);
obj = HASH_VALUE (h, i);
@@ -4476,7 +4480,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
&longhand_chars,
&longhand_bytes);
- if (SYMBOLP (found))
+ if (BARE_SYMBOL_P (found))
result = found;
else if (longhand)
{
@@ -4578,8 +4582,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
struct Lisp_Hash_Table *h2
= XHASH_TABLE (read_objects_completed);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h2, placeholder, &hash);
+ hash_hash_t hash;
+ ptrdiff_t i = hash_lookup_get_hash (h2, placeholder, &hash);
eassert (i < 0);
hash_put (h2, placeholder, Qnil, hash);
obj = placeholder;
@@ -4593,8 +4597,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
{
struct Lisp_Hash_Table *h2
= XHASH_TABLE (read_objects_completed);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h2, obj, &hash);
+ hash_hash_t hash;
+ ptrdiff_t i = hash_lookup_get_hash (h2, obj, &hash);
eassert (i < 0);
hash_put (h2, obj, Qnil, hash);
}
@@ -4605,8 +4609,9 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
/* ...and #n# will use the real value from now on. */
struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map);
- Lisp_Object hash;
- ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash);
+ hash_hash_t hash;
+ ptrdiff_t i = hash_lookup_get_hash (h, e->u.numbered.number,
+ &hash);
eassert (i >= 0);
set_hash_value_slot (h, i, obj);
}
@@ -4660,7 +4665,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
by #n=, which means that we can find it as a value in
COMPLETED. */
if (EQ (subst->completed, Qt)
- || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
+ || hash_lookup (XHASH_TABLE (subst->completed), subtree) >= 0)
subst->seen = Fcons (subtree, subst->seen);
/* Recurse according to subtree's type.
@@ -4881,49 +4886,65 @@ static Lisp_Object initial_obarray;
static size_t oblookup_last_bucket_number;
-/* Get an error if OBARRAY is not an obarray.
- If it is one, return it. */
+static Lisp_Object make_obarray (unsigned bits);
+/* Slow path obarray check: return the obarray to use or signal an error. */
Lisp_Object
-check_obarray (Lisp_Object obarray)
+check_obarray_slow (Lisp_Object obarray)
{
- /* We don't want to signal a wrong-type-argument error when we are
- shutting down due to a fatal error, and we don't want to hit
- assertions in VECTORP and ASIZE if the fatal error was during GC. */
- if (!fatal_error_in_progress
- && (!VECTORP (obarray) || ASIZE (obarray) == 0))
+ /* For compatibility, we accept vectors whose first element is 0,
+ and store an obarray object there. */
+ if (VECTORP (obarray) && ASIZE (obarray) > 0)
{
- /* If Vobarray is now invalid, force it to be valid. */
- if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
- wrong_type_argument (Qvectorp, obarray);
+ Lisp_Object obj = AREF (obarray, 0);
+ if (OBARRAYP (obj))
+ return obj;
+ if (BASE_EQ (obj, make_fixnum (0)))
+ {
+ /* Put an actual obarray object in the first slot.
+ The rest of the vector remains unused. */
+ obj = make_obarray (0);
+ ASET (obarray, 0, obj);
+ return obj;
+ }
}
- return obarray;
+ /* Reset Vobarray to the standard obarray for nicer error handling. */
+ if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray;
+
+ wrong_type_argument (Qobarrayp, obarray);
}
+static void grow_obarray (struct Lisp_Obarray *o);
+
/* Intern symbol SYM in OBARRAY using bucket INDEX. */
+/* FIXME: retype arguments as pure C types */
static Lisp_Object
intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{
- Lisp_Object *ptr;
-
- XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray)
- ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
- : SYMBOL_INTERNED);
+ eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index));
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym);
+ s->u.s.interned = (BASE_EQ (obarray, initial_obarray)
+ ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+ : SYMBOL_INTERNED);
- if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
+ if (SREF (s->u.s.name, 0) == ':' && BASE_EQ (obarray, initial_obarray))
{
- make_symbol_constant (sym);
- XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
+ s->u.s.trapped_write = SYMBOL_NOWRITE;
+ s->u.s.redirect = SYMBOL_PLAINVAL;
/* Mark keywords as special. This makes (let ((:key 'foo)) ...)
in lexically bound elisp signal an error, as documented. */
- XSYMBOL (sym)->u.s.declared_special = true;
- SET_SYMBOL_VAL (XSYMBOL (sym), sym);
+ s->u.s.declared_special = true;
+ SET_SYMBOL_VAL (s, sym);
}
- ptr = aref_addr (obarray, XFIXNUM (index));
- set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ Lisp_Object *ptr = o->buckets + XFIXNUM (index);
+ s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL;
*ptr = sym;
+ o->count++;
+ if (o->count > obarray_size (o))
+ grow_obarray (o);
return sym;
}
@@ -4932,7 +4953,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
Lisp_Object
intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
{
- SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qobarray_cache), Qnil);
return intern_sym (Fmake_symbol (string), obarray, index);
}
@@ -4945,7 +4966,7 @@ intern_1 (const char *str, ptrdiff_t len)
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- return (SYMBOLP (tem) ? tem
+ return (BARE_SYMBOL_P (tem) ? tem
/* The above `oblookup' was done on the basis of nchars==nbytes, so
the string has to be unibyte. */
: intern_driver (make_unibyte_string (str, len),
@@ -4958,7 +4979,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
{
Lisp_Object string;
@@ -5010,7 +5031,7 @@ it defaults to the value of `obarray'. */)
&longhand, &longhand_chars,
&longhand_bytes);
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
{
if (longhand)
{
@@ -5059,10 +5080,11 @@ it defaults to the value of `obarray'. */)
{
/* If already a symbol, we don't do shorthand-longhand translation,
as promised in the docstring. */
- string = SYMBOL_NAME (name);
+ Lisp_Object sym = maybe_remove_pos_from_symbol (name);
+ string = XSYMBOL (name)->u.s.name;
tem
= oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
- return EQ (name, tem) ? name : Qnil;
+ return BASE_EQ (sym, tem) ? name : Qnil;
}
}
@@ -5077,13 +5099,16 @@ usage: (unintern NAME OBARRAY) */)
{
register Lisp_Object tem;
Lisp_Object string;
- size_t hash;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
if (SYMBOLP (name))
- string = SYMBOL_NAME (name);
+ {
+ if (!BARE_SYMBOL_P (name))
+ name = XSYMBOL_WITH_POS (name)->sym;
+ string = SYMBOL_NAME (name);
+ }
else
{
CHECK_STRING (name);
@@ -5103,7 +5128,7 @@ usage: (unintern NAME OBARRAY) */)
if (FIXNUMP (tem))
return Qnil;
/* If arg was a symbol, don't delete anything but that symbol itself. */
- if (SYMBOLP (name) && !EQ (name, tem))
+ if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem))
return Qnil;
/* There are plenty of other symbols which will screw up the Emacs
@@ -5113,41 +5138,42 @@ usage: (unintern NAME OBARRAY) */)
/* if (NILP (tem) || EQ (tem, Qt))
error ("Attempt to unintern t or nil"); */
- XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
+ struct Lisp_Symbol *sym = XBARE_SYMBOL (tem);
+ sym->u.s.interned = SYMBOL_UNINTERNED;
- hash = oblookup_last_bucket_number;
+ ptrdiff_t idx = oblookup_last_bucket_number;
+ Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx];
- if (EQ (AREF (obarray, hash), tem))
- {
- if (XSYMBOL (tem)->u.s.next)
- {
- Lisp_Object sym;
- XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next);
- ASET (obarray, hash, sym);
- }
- else
- ASET (obarray, hash, make_fixnum (0));
- }
+ eassert (BARE_SYMBOL_P (*loc));
+ struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc);
+ if (sym == prev)
+ *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0);
else
- {
- Lisp_Object tail, following;
+ while (1)
+ {
+ struct Lisp_Symbol *next = prev->u.s.next;
+ if (next == sym)
+ {
+ prev->u.s.next = next->u.s.next;
+ break;
+ }
+ prev = next;
+ }
- for (tail = AREF (obarray, hash);
- XSYMBOL (tail)->u.s.next;
- tail = following)
- {
- XSETSYMBOL (following, XSYMBOL (tail)->u.s.next);
- if (EQ (following, tem))
- {
- set_symbol_next (tail, XSYMBOL (following)->u.s.next);
- break;
- }
- }
- }
+ XOBARRAY (obarray)->count--;
return Qt;
}
+
+/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */
+static ptrdiff_t
+obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte)
+{
+ EMACS_UINT hash = hash_string (str, size_byte);
+ return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits);
+}
+
/* Return the symbol in OBARRAY whose names matches the string
of SIZE characters (SIZE_BYTE bytes) at PTR.
If there is no such symbol, return the integer bucket number of
@@ -5158,35 +5184,27 @@ usage: (unintern NAME OBARRAY) */)
Lisp_Object
oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
{
- size_t hash;
- size_t obsize;
- register Lisp_Object tail;
- Lisp_Object bucket, tem;
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ ptrdiff_t idx = obarray_index (o, ptr, size_byte);
+ Lisp_Object bucket = o->buckets[idx];
- obarray = check_obarray (obarray);
- /* This is sometimes needed in the middle of GC. */
- obsize = gc_asize (obarray);
- hash = hash_string (ptr, size_byte) % obsize;
- bucket = AREF (obarray, hash);
- oblookup_last_bucket_number = hash;
- if (BASE_EQ (bucket, make_fixnum (0)))
- ;
- else if (!SYMBOLP (bucket))
- /* Like CADR error message. */
- xsignal2 (Qwrong_type_argument, Qobarrayp,
- build_string ("Bad data in guts of obarray"));
- else
- for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
- {
- if (SBYTES (SYMBOL_NAME (tail)) == size_byte
- && SCHARS (SYMBOL_NAME (tail)) == size
- && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
- return tail;
- else if (XSYMBOL (tail)->u.s.next == 0)
- break;
- }
- XSETINT (tem, hash);
- return tem;
+ oblookup_last_bucket_number = idx;
+ if (!BASE_EQ (bucket, make_fixnum (0)))
+ {
+ Lisp_Object sym = bucket;
+ while (1)
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym);
+ Lisp_Object name = s->u.s.name;
+ if (SBYTES (name) == size_byte && SCHARS (name) == size
+ && memcmp (SDATA (name), ptr, size_byte) == 0)
+ return sym;
+ if (s->u.s.next == NULL)
+ break;
+ sym = make_lisp_symbol(s->u.s.next);
+ }
+ }
+ return make_fixnum (idx);
}
/* Like 'oblookup', but considers 'Vread_symbol_shorthands',
@@ -5253,24 +5271,134 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in,
}
-void
-map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
+static struct Lisp_Obarray *
+allocate_obarray (void)
{
- ptrdiff_t i;
- register Lisp_Object tail;
- CHECK_VECTOR (obarray);
- for (i = ASIZE (obarray) - 1; i >= 0; i--)
+ return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY);
+}
+
+static Lisp_Object
+make_obarray (unsigned bits)
+{
+ struct Lisp_Obarray *o = allocate_obarray ();
+ o->count = 0;
+ o->size_bits = bits;
+ ptrdiff_t size = (ptrdiff_t)1 << bits;
+ o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < size; i++)
+ o->buckets[i] = make_fixnum (0);
+ return make_lisp_obarray (o);
+}
+
+enum {
+ obarray_default_bits = 3,
+ word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */
+ obarray_max_bits = min (8 * sizeof (int),
+ 8 * sizeof (ptrdiff_t) - word_size_log2) - 1,
+};
+
+static void
+grow_obarray (struct Lisp_Obarray *o)
+{
+ ptrdiff_t old_size = obarray_size (o);
+ eassert (o->count > old_size);
+ Lisp_Object *old_buckets = o->buckets;
+
+ int new_bits = o->size_bits + 1;
+ if (new_bits > obarray_max_bits)
+ error ("Obarray too big");
+ ptrdiff_t new_size = (ptrdiff_t)1 << new_bits;
+ o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ o->buckets[i] = make_fixnum (0);
+ o->size_bits = new_bits;
+
+ /* Rehash symbols.
+ FIXME: this is expensive since we need to recompute the hash for every
+ symbol name. Would it be reasonable to store it in the symbol? */
+ for (ptrdiff_t i = 0; i < old_size; i++)
{
- tail = AREF (obarray, i);
- if (SYMBOLP (tail))
- while (1)
- {
- (*fn) (tail, arg);
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
+ Lisp_Object obj = old_buckets[i];
+ if (BARE_SYMBOL_P (obj))
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (obj);
+ while (1)
+ {
+ Lisp_Object name = s->u.s.name;
+ ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name));
+ Lisp_Object *loc = o->buckets + idx;
+ struct Lisp_Symbol *next = s->u.s.next;
+ s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL;
+ *loc = make_lisp_symbol (s);
+ if (next == NULL)
+ break;
+ s = next;
+ }
+ }
}
+
+ hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets);
+}
+
+DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0,
+ doc: /* Return a new obarray of size SIZE.
+The obarray will grow to accommodate any number of symbols; the size, if
+given, is only a hint for the expected number. */)
+ (Lisp_Object size)
+{
+ int bits;
+ if (NILP (size))
+ bits = obarray_default_bits;
+ else
+ {
+ CHECK_FIXNAT (size);
+ EMACS_UINT n = XFIXNUM (size);
+ bits = elogb (n) + 1;
+ if (bits > obarray_max_bits)
+ xsignal (Qargs_out_of_range, size);
+ }
+ return make_obarray (bits);
+}
+
+DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0,
+ doc: /* Return t iff OBJECT is an obarray. */)
+ (Lisp_Object object)
+{
+ return OBARRAYP (object) ? Qt : Qnil;
+}
+
+DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0,
+ doc: /* Remove all symbols from OBARRAY. */)
+ (Lisp_Object obarray)
+{
+ CHECK_OBARRAY (obarray);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+
+ /* This function does not bother setting the status of its contained symbols
+ to uninterned. It doesn't matter very much. */
+ int new_bits = obarray_default_bits;
+ int new_size = (ptrdiff_t)1 << new_bits;
+ Lisp_Object *new_buckets
+ = hash_table_alloc_bytes (new_size * sizeof *new_buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ new_buckets[i] = make_fixnum (0);
+
+ int old_size = obarray_size (o);
+ hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets);
+ o->buckets = new_buckets;
+ o->size_bits = new_bits;
+ o->count = 0;
+
+ return Qnil;
+}
+
+void
+map_obarray (Lisp_Object obarray,
+ void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
+{
+ CHECK_OBARRAY (obarray);
+ DOOBARRAY (XOBARRAY (obarray), it)
+ (*fn) (obarray_iter_symbol (&it), arg);
}
static void
@@ -5291,12 +5419,37 @@ OBARRAY defaults to the value of `obarray'. */)
return Qnil;
}
-#define OBARRAY_SIZE 15121
+DEFUN ("internal--obarray-buckets",
+ Finternal__obarray_buckets, Sinternal__obarray_buckets, 1, 1, 0,
+ doc: /* Symbols in each bucket of OBARRAY. Internal use only. */)
+ (Lisp_Object obarray)
+{
+ obarray = check_obarray (obarray);
+ ptrdiff_t size = obarray_size (XOBARRAY (obarray));
+
+ Lisp_Object ret = Qnil;
+ for (ptrdiff_t i = 0; i < size; i++)
+ {
+ Lisp_Object bucket = Qnil;
+ Lisp_Object sym = XOBARRAY (obarray)->buckets[i];
+ if (BARE_SYMBOL_P (sym))
+ while (1)
+ {
+ bucket = Fcons (sym, bucket);
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym)->u.s.next;
+ if (!s)
+ break;
+ sym = make_lisp_symbol (s);
+ }
+ ret = Fcons (Fnreverse (bucket), ret);
+ }
+ return Fnreverse (ret);
+}
void
init_obarray_once (void)
{
- Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
+ Vobarray = make_obarray (15);
initial_obarray = Vobarray;
staticpro (&initial_obarray);
@@ -5306,14 +5459,14 @@ init_obarray_once (void)
DEFSYM (Qunbound, "unbound");
DEFSYM (Qnil, "nil");
- SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qnil), Qnil);
make_symbol_constant (Qnil);
- XSYMBOL (Qnil)->u.s.declared_special = true;
+ XBARE_SYMBOL (Qnil)->u.s.declared_special = true;
DEFSYM (Qt, "t");
- SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
+ SET_SYMBOL_VAL (XBARE_SYMBOL (Qt), Qt);
make_symbol_constant (Qt);
- XSYMBOL (Qt)->u.s.declared_special = true;
+ XBARE_SYMBOL (Qt)->u.s.declared_special = true;
/* Qt is correct even if not dumping. loadup.el will set to nil at end. */
Vpurify_flag = Qt;
@@ -5337,16 +5490,6 @@ defsubr (union Aligned_Lisp_Subr *aname)
#endif
}
-#ifdef NOTDEF /* Use fset in subr.el now! */
-void
-defalias (struct Lisp_Subr *sname, char *string)
-{
- Lisp_Object sym;
- sym = intern (string);
- XSETSUBR (XSYMBOL (sym)->u.s.function, sname);
-}
-#endif /* NOTDEF */
-
/* Define an "integer variable"; a symbol whose value is forwarded to a
C variable of type intmax_t. Sample call (with "xx" to fool make-docfile):
DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
@@ -5354,9 +5497,9 @@ void
defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), i_fwd);
}
/* Similar but define a variable whose value is t if 1, nil if 0. */
@@ -5364,9 +5507,9 @@ void
defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
@@ -5379,9 +5522,9 @@ void
defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), o_fwd);
}
void
@@ -5398,9 +5541,9 @@ void
defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring)
{
Lisp_Object sym = intern_c_string (namestring);
- XSYMBOL (sym)->u.s.declared_special = true;
- XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd);
+ XBARE_SYMBOL (sym)->u.s.declared_special = true;
+ XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_FWD (XBARE_SYMBOL (sym), ko_fwd);
}
/* Check that the elements of lpath exist. */
@@ -5688,6 +5831,10 @@ syms_of_lread (void)
defsubr (&Sget_file_char);
defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
+ defsubr (&Sinternal__obarray_buckets);
+ defsubr (&Sobarray_make);
+ defsubr (&Sobarrayp);
+ defsubr (&Sobarray_clear);
DEFVAR_LISP ("obarray", Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
@@ -5699,7 +5846,7 @@ to find all the symbols in an obarray, use `mapatoms'. */);
doc: /* List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological.
This variable is obsolete as of Emacs 28.1 and should not be used. */);
- XSYMBOL (intern ("values"))->u.s.declared_special = false;
+ XBARE_SYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
@@ -5997,8 +6144,6 @@ that are loaded before your customizations are read! */);
DEFSYM (Qsize, "size");
DEFSYM (Qpurecopy, "purecopy");
DEFSYM (Qweakness, "weakness");
- DEFSYM (Qrehash_size, "rehash-size");
- DEFSYM (Qrehash_threshold, "rehash-threshold");
DEFSYM (Qchar_from_name, "char-from-name");
@@ -6015,4 +6160,7 @@ See Info node `(elisp)Shorthands' for more details. */);
doc: /* List of variables declared dynamic in the current scope.
Only valid during macro-expansion. Internal use only. */);
Vmacroexp__dynvars = Qnil;
+
+ DEFSYM (Qinternal_macroexpand_for_load,
+ "internal-macroexpand-for-load");
}
diff --git a/src/macfont.h b/src/macfont.h
index 77426f6f198..45cb1eaa7e4 100644
--- a/src/macfont.h
+++ b/src/macfont.h
@@ -75,7 +75,7 @@ enum {
#define kCTVersionNumber10_9 0x00060000
#endif
#define MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE \
- (CFSTR ("MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE"))
+ CFSTR ("MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE")
typedef const struct _EmacsScreenFont *ScreenFontRef; /* opaque */
@@ -85,4 +85,4 @@ extern void macfont_update_antialias_threshold (void);
/* This is an undocumented function. */
extern void CGContextSetFontSmoothingStyle(CGContextRef, int)
- __attribute__((weak_import));
+ __attribute__ ((weak_import));
diff --git a/src/macfont.m b/src/macfont.m
index 8aba440d196..e3b3d40df43 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -855,21 +855,42 @@ macfont_store_descriptor_attributes (CTFontDescriptorRef desc,
struct {
enum font_property_index index;
CFStringRef trait;
- CGPoint points[6];
- CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat);
- } numeric_traits[] =
- {{FONT_WEIGHT_INDEX, kCTFontWeightTrait,
- {{-0.4, 50}, /* light */
- {-0.24, 87.5}, /* (semi-light + normal) / 2 */
- {0, 80}, /* normal */
- {0.24, 140}, /* (semi-bold + normal) / 2 */
- {0.4, 200}, /* bold */
- {CGFLOAT_MAX, CGFLOAT_MAX}},
- mac_font_descriptor_get_adjusted_weight},
- {FONT_SLANT_INDEX, kCTFontSlantTrait,
- {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL},
- {FONT_WIDTH_INDEX, kCTFontWidthTrait,
- {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}};
+ CGPoint points[12];
+ CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat);
+ } numeric_traits[] = {
+ { FONT_WEIGHT_INDEX,
+ kCTFontWeightTrait,
+ { { -0.6, 0 }, /* thin */
+ { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */
+ { -0.23, 50 }, /* light */
+ { -0.115, 55 }, /* semi-light, semilight, demilight */
+ { 0, 80 }, /* regular, normal, unspecified, book */
+ { 0.2, 100 }, /* medium */
+ { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */
+ { 0.4, 200 }, /* bold */
+ { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */
+ { 0.8, 210 }, /* black, heavy */
+ { 1, 250 }, /* ultra-heavy, ultraheavy */
+ { CGFLOAT_MAX, CGFLOAT_MAX } },
+ mac_font_descriptor_get_adjusted_weight },
+ { FONT_SLANT_INDEX,
+ kCTFontSlantTrait,
+ { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } },
+ NULL },
+ { FONT_WIDTH_INDEX,
+ kCTFontWidthTrait,
+ { { -0.4, 50 }, /* ultra-condensed, ultracondensed */
+ { -0.3, 63 }, /* extra-condensed, extracondensed */
+ { -0.2, 75 }, /* condensed, compressed, narrow */
+ { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */
+ { 0, 100 }, /* normal, medium, regular, unspecified */
+ { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */
+ { 0.2, 125 }, /* expanded */
+ { 0.3, 150 }, /* extra-expanded, extraexpanded */
+ { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */
+ { CGFLOAT_MAX, CGFLOAT_MAX } },
+ NULL }
+ };
int i;
for (i = 0; i < ARRAYELTS (numeric_traits); i++)
@@ -980,7 +1001,7 @@ macfont_invalidate_family_cache (void)
ptrdiff_t i, size = HASH_TABLE_SIZE (h);
for (i = 0; i < size; ++i)
- if (!NILP (HASH_HASH (h, i)))
+ if (!hash_unused_entry_key_p (HASH_KEY (h, i)))
{
Lisp_Object value = HASH_VALUE (h, i);
@@ -997,7 +1018,7 @@ macfont_get_family_cache_if_present (Lisp_Object symbol, CFStringRef *string)
if (HASH_TABLE_P (macfont_family_cache))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (macfont_family_cache);
- ptrdiff_t i = hash_lookup (h, symbol, NULL);
+ ptrdiff_t i = hash_lookup (h, symbol);
if (i >= 0)
{
@@ -1017,13 +1038,14 @@ macfont_set_family_cache (Lisp_Object symbol, CFStringRef string)
{
struct Lisp_Hash_Table *h;
ptrdiff_t i;
- Lisp_Object hash, value;
+ Lisp_Object value;
if (!HASH_TABLE_P (macfont_family_cache))
macfont_family_cache = CALLN (Fmake_hash_table, QCtest, Qeq);
h = XHASH_TABLE (macfont_family_cache);
- i = hash_lookup (h, symbol, &hash);
+ hash_hash_t hash;
+ i = hash_lookup_get_hash (h, symbol, &hash);
value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil;
if (i >= 0)
{
@@ -1940,19 +1962,38 @@ macfont_create_attributes_with_spec (Lisp_Object spec)
struct {
enum font_property_index index;
CFStringRef trait;
- CGPoint points[6];
- } numeric_traits[] =
- {{FONT_WEIGHT_INDEX, kCTFontWeightTrait,
- {{-0.4, 50}, /* light */
- {-0.24, 87.5}, /* (semi-light + normal) / 2 */
- {0, 100}, /* normal */
- {0.24, 140}, /* (semi-bold + normal) / 2 */
- {0.4, 200}, /* bold */
- {CGFLOAT_MAX, CGFLOAT_MAX}}},
- {FONT_SLANT_INDEX, kCTFontSlantTrait,
- {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}},
- {FONT_WIDTH_INDEX, kCTFontWidthTrait,
- {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}};
+ CGPoint points[12];
+ } numeric_traits[] = {
+ { FONT_WEIGHT_INDEX,
+ kCTFontWeightTrait,
+ { { -0.6, 0 }, /* thin */
+ { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */
+ { -0.23, 50 }, /* light */
+ { -0.115, 55 }, /* semi-light, semilight, demilight */
+ { 0, 80 }, /* regular, normal, unspecified, book */
+ { 0.2, 100 }, /* medium */
+ { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */
+ { 0.4, 200 }, /* bold */
+ { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */
+ { 0.8, 210 }, /* black, heavy */
+ { 1, 250 }, /* ultra-heavy, ultraheavy */
+ { CGFLOAT_MAX, CGFLOAT_MAX } } },
+ { FONT_SLANT_INDEX,
+ kCTFontSlantTrait,
+ { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } } },
+ { FONT_WIDTH_INDEX,
+ kCTFontWidthTrait,
+ { { -0.4, 50 }, /* ultra-condensed, ultracondensed */
+ { -0.3, 63 }, /* extra-condensed, extracondensed */
+ { -0.2, 75 }, /* condensed, compressed, narrow */
+ { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */
+ { 0, 100 }, /* normal, medium, regular, unspecified */
+ { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */
+ { 0.2, 125 }, /* expanded */
+ { 0.3, 150 }, /* extra-expanded, extraexpanded */
+ { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */
+ { CGFLOAT_MAX, CGFLOAT_MAX } } }
+ };
registry = AREF (spec, FONT_REGISTRY_INDEX);
if (NILP (registry)
diff --git a/src/macros.c b/src/macros.c
index 5f71bcbd361..230195d9488 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -314,6 +314,48 @@ buffer before the macro is executed. */)
Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
+ /* The following loop starts the execution of possibly multiple
+ iterations of the macro.
+
+ The state variables that control the execution of a single
+ iteration are Vexecuting_kbd_macro and executing_kbd_macro_index,
+ which can be accessed from lisp. The purpose of the variables
+ executing_kbd_macro and executing_kbd_macro_iteration is to
+ remember the most recently started macro and its iteration count.
+ This makes it possible to produce a meaningful message in case of
+ errors during the execution of the macro.
+
+ In a single iteration, individual characters from the macro are
+ read by read_char, which takes care of incrementing
+ executing_kbd_macro_index after each character.
+
+ The end of a macro iteration is handled as follows:
+ - read_key_sequence asks at_end_of_macro_p whether the end of the
+ iteration has been reached. If so, it returns the magic value 0
+ to command_loop_1.
+ - command_loop_1 returns Qnil to command_loop_2.
+ - command_loop_2 returns Qnil to this function
+ (but only the returning is relevant, not the actual value).
+
+ Macro executions form a stack. After the last iteration of the
+ execution of one stack item, or in case of an error during one of
+ the iterations, pop_kbd_macro (invoked via unwind-protect) will
+ restore Vexecuting_kbd_macro and executing_kbd_macro_index, and
+ run 'kbd-macro-termination-hook'.
+
+ If read_char happens to be called at the end of a macro interation,
+ but before read_key_sequence could handle the end (e.g., when lisp
+ code calls 'read-event', 'read-char', or 'read-char-exclusive'),
+ read_char will simply continue reading other available input
+ (Bug#68272). Vexecuting_kbd_macro and executing_kbd_macro remain
+ untouched until the end of the iteration is handled.
+
+ This is similar (in observable behavior) to a posibly simpler
+ implementation of keyboard macros in which this function pushed all
+ characters of the macro into the incoming event queue and returned
+ immediately. Maybe this is the implementation that we ideally
+ would like to have, but switching to it will require a larger code
+ change. */
do
{
Vexecuting_kbd_macro = final;
@@ -353,6 +395,18 @@ init_macros (void)
executing_kbd_macro = Qnil;
}
+/* Whether the execution of a macro has reached its end.
+ This should be called only while executing a macro. */
+
+bool
+at_end_of_macro_p (void)
+{
+ eassume (!NILP (Vexecuting_kbd_macro));
+ /* Some things replace the macro with t to force an early exit. */
+ return EQ (Vexecuting_kbd_macro, Qt)
+ || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro));
+}
+
void
syms_of_macros (void)
{
diff --git a/src/macros.h b/src/macros.h
index 51599a29bcd..cb6ac8aa206 100644
--- a/src/macros.h
+++ b/src/macros.h
@@ -47,4 +47,9 @@ extern void finalize_kbd_macro_chars (void);
extern void store_kbd_macro_char (Lisp_Object);
+/* Whether the execution of a macro has reached its end.
+ This should be called only while executing a macro. */
+
+extern bool at_end_of_macro_p (void);
+
#endif /* EMACS_MACROS_H */
diff --git a/src/marker.c b/src/marker.c
index 377f6fbe8db..2abc951fc76 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -20,6 +20,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
+/* Work around GCC bug 113253. */
+#if __GNUC__ == 13
+# pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check"
+#endif
+
#include "lisp.h"
#include "character.h"
#include "buffer.h"
@@ -458,6 +463,18 @@ DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
return Qnil;
}
+DEFUN ("marker-last-position", Fmarker_last_position, Smarker_last_position, 1, 1, 0,
+ doc: /* Return last position of MARKER in its buffer.
+This is like `marker-position' with one exception: If the buffer of
+MARKER is dead, it returns the last position of MARKER in that buffer
+before it was killed. */)
+ (Lisp_Object marker)
+{
+ CHECK_MARKER (marker);
+
+ return make_fixnum (XMARKER (marker)->charpos);
+}
+
/* Change M so it points to B at CHARPOS and BYTEPOS. */
static void
@@ -825,6 +842,7 @@ void
syms_of_marker (void)
{
defsubr (&Smarker_position);
+ defsubr (&Smarker_last_position);
defsubr (&Smarker_buffer);
defsubr (&Sset_marker);
defsubr (&Scopy_marker);
diff --git a/src/minibuf.c b/src/minibuf.c
index f4f9da9c3f9..51816133fb2 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1615,13 +1615,15 @@ or from one of the possible completions. */)
ptrdiff_t bestmatchsize = 0;
/* These are in bytes, too. */
ptrdiff_t compare, matchsize;
+ if (VECTORP (collection))
+ collection = check_obarray (collection);
enum { function_table, list_table, obarray_table, hash_table}
type = (HASH_TABLE_P (collection) ? hash_table
- : VECTORP (collection) ? obarray_table
+ : OBARRAYP (collection) ? obarray_table
: ((NILP (collection)
|| (CONSP (collection) && !FUNCTIONP (collection)))
? list_table : function_table));
- ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t idx = 0;
int matchcount = 0;
Lisp_Object bucket, zero, end, tem;
@@ -1634,12 +1636,9 @@ or from one of the possible completions. */)
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
+ obarray_iter_t obit;
if (type == obarray_table)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
+ obit = make_obarray_iter (XOBARRAY (collection));
while (1)
{
@@ -1658,30 +1657,16 @@ or from one of the possible completions. */)
}
else if (type == obarray_table)
{
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
+ if (obarray_iter_at_end (&obit))
break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
+ elt = eltstring = obarray_iter_symbol (&obit);
+ obarray_iter_step (&obit);
}
else /* if (type == hash_table) */
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx),
- Qunbound))
+ && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection),
+ idx)))
idx++;
if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
break;
@@ -1716,11 +1701,12 @@ or from one of the possible completions. */)
tem = Fcommandp (elt, Qnil);
else
{
- tem = (type == hash_table
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection),
- idx - 1))
- : call1 (predicate, elt));
+ if (type == hash_table)
+ tem = call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (collection),
+ idx - 1));
+ else
+ tem = call1 (predicate, elt);
}
if (NILP (tem)) continue;
}
@@ -1858,10 +1844,15 @@ with a space are ignored unless STRING itself starts with a space. */)
{
Lisp_Object tail, elt, eltstring;
Lisp_Object allmatches;
- int type = HASH_TABLE_P (collection) ? 3
- : VECTORP (collection) ? 2
- : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
- ptrdiff_t idx = 0, obsize = 0;
+ if (VECTORP (collection))
+ collection = check_obarray (collection);
+ int type = (HASH_TABLE_P (collection)
+ ? 3 : (OBARRAYP (collection)
+ ? 2 : ((NILP (collection)
+ || (CONSP (collection)
+ && !FUNCTIONP (collection)))
+ ? 1 : 0)));
+ ptrdiff_t idx = 0;
Lisp_Object bucket, tem, zero;
CHECK_STRING (string);
@@ -1872,12 +1863,9 @@ with a space are ignored unless STRING itself starts with a space. */)
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
+ obarray_iter_t obit;
if (type == 2)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
+ obit = make_obarray_iter (XOBARRAY (collection));
while (1)
{
@@ -1896,30 +1884,16 @@ with a space are ignored unless STRING itself starts with a space. */)
}
else if (type == 2)
{
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
+ if (obarray_iter_at_end (&obit))
break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
+ elt = eltstring = obarray_iter_symbol (&obit);
+ obarray_iter_step (&obit);
}
else /* if (type == 3) */
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx),
- Qunbound))
+ && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection),
+ idx)))
idx++;
if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
break;
@@ -1961,10 +1935,12 @@ with a space are ignored unless STRING itself starts with a space. */)
tem = Fcommandp (elt, Qnil);
else
{
- tem = type == 3
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection), idx - 1))
- : call1 (predicate, elt);
+ if (type == 3)
+ tem = call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (collection),
+ idx - 1));
+ else
+ tem = call1 (predicate, elt);
}
if (NILP (tem)) continue;
}
@@ -2059,8 +2035,7 @@ If COLLECTION is a function, it is called with three arguments:
the values STRING, PREDICATE and `lambda'. */)
(Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
{
- Lisp_Object tail, tem = Qnil;
- ptrdiff_t i = 0;
+ Lisp_Object tem = Qnil, arg = Qnil;
CHECK_STRING (string);
@@ -2070,61 +2045,56 @@ the values STRING, PREDICATE and `lambda'. */)
if (NILP (tem))
return Qnil;
}
- else if (VECTORP (collection))
+ else if (OBARRAYP (collection) || VECTORP (collection))
{
+ collection = check_obarray (collection);
/* Bypass intern-soft as that loses for nil. */
tem = oblookup (collection,
SSDATA (string),
SCHARS (string),
SBYTES (string));
- if (completion_ignore_case && !SYMBOLP (tem))
- {
- for (i = ASIZE (collection) - 1; i >= 0; i--)
- {
- tail = AREF (collection, i);
- if (SYMBOLP (tail))
- while (1)
- {
- if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
- Qnil,
- Fsymbol_name (tail),
- make_fixnum (0) , Qnil, Qt),
- Qt))
- {
- tem = tail;
- break;
- }
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
- }
- }
+ if (completion_ignore_case && !BARE_SYMBOL_P (tem))
+ DOOBARRAY (XOBARRAY (collection), it)
+ {
+ Lisp_Object obj = obarray_iter_symbol (&it);
+ if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
+ Qnil,
+ Fsymbol_name (obj),
+ make_fixnum (0) , Qnil, Qt),
+ Qt))
+ {
+ tem = obj;
+ break;
+ }
+ }
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
return Qnil;
}
else if (HASH_TABLE_P (collection))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
- i = hash_lookup (h, string, NULL);
+ ptrdiff_t i = hash_lookup (h, string);
if (i >= 0)
{
tem = HASH_KEY (h, i);
+ arg = HASH_VALUE (h, i);
goto found_matching_key;
}
else
- for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ DOHASH (h, k, v)
{
- tem = HASH_KEY (h, i);
- if (BASE_EQ (tem, Qunbound)) continue;
+ tem = k;
Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem);
if (!STRINGP (strkey)) continue;
if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil,
strkey, Qnil, Qnil,
completion_ignore_case ? Qt : Qnil),
- Qt))
- goto found_matching_key;
+ Qt))
+ {
+ arg = v;
+ goto found_matching_key;
+ }
}
return Qnil;
found_matching_key: ;
@@ -2141,7 +2111,7 @@ the values STRING, PREDICATE and `lambda'. */)
if (!NILP (predicate))
{
return HASH_TABLE_P (collection)
- ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
+ ? call2 (predicate, tem, arg)
: call1 (predicate, tem);
}
else
diff --git a/src/msdos.c b/src/msdos.c
index bdacda50975..7e78c35027e 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -2811,14 +2811,10 @@ IT_menu_make_room (XMenu *menu)
else if (menu->allocated == menu->count)
{
int count = menu->allocated = menu->allocated + 10;
- menu->text
- = (char **) xrealloc (menu->text, count * sizeof (char *));
- menu->submenu
- = (XMenu **) xrealloc (menu->submenu, count * sizeof (XMenu *));
- menu->panenumber
- = (int *) xrealloc (menu->panenumber, count * sizeof (int));
- menu->help_text
- = (const char **) xrealloc (menu->help_text, count * sizeof (char *));
+ menu->text = xrealloc (menu->text, count * sizeof (char *));
+ menu->submenu = xrealloc (menu->submenu, count * sizeof (XMenu *));
+ menu->panenumber = xrealloc (menu->panenumber, count * sizeof (int));
+ menu->help_text = xrealloc (menu->help_text, count * sizeof (char *));
}
}
@@ -2869,7 +2865,7 @@ IT_menu_calc_size (XMenu *menu, int *width, int *height)
do \
{ \
(GLYPH).type = CHAR_GLYPH; \
- SET_CHAR_GLYPH ((GLYPH), CODE, FACE_ID, PADDING_P); \
+ SET_CHAR_GLYPH (GLYPH, CODE, FACE_ID, PADDING_P); \
(GLYPH).charpos = -1; \
} \
while (0)
diff --git a/src/nsfont.m b/src/nsfont.m
index 1205fbe5263..4e1d85a5c4a 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -601,7 +601,7 @@ static NSString
{
Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist);
return CONSP (script)
- ? [NSString stringWithLispString: SYMBOL_NAME (XCDR ((script)))]
+ ? [NSString stringWithLispString: SYMBOL_NAME (XCDR (script))]
: @"";
}
@@ -1035,7 +1035,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
font->underline_position = lrint (font_info->underpos);
font->underline_thickness = lrint (font_info->underwidth);
- font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
+ font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qnil);
font->props[FONT_FULLNAME_INDEX] = build_unibyte_string (font_info->name);
}
unblock_input ();
diff --git a/src/nsterm.h b/src/nsterm.h
index faa839dc1af..ae940ec5b4f 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -278,9 +278,9 @@ char const * nstrace_fullscreen_type_name (int);
#define NSTRACE_WHEN(cond, ...) \
- __attribute__((cleanup(nstrace_restore_global_trace_state))) \
+ __attribute__ ((cleanup (nstrace_restore_global_trace_state))) \
int nstrace_saved_enabled_global = nstrace_enabled_global; \
- __attribute__((cleanup(nstrace_leave))) \
+ __attribute__ ((cleanup (nstrace_leave))) \
int nstrace_enabled = nstrace_enabled_global && (cond); \
if (nstrace_enabled) { ++nstrace_depth; } \
else { nstrace_enabled_global = 0; } \
@@ -1290,7 +1290,7 @@ extern char gnustep_base_version[]; /* version tracking */
/* Little utility macros */
#define IN_BOUND(min, x, max) (((x) < (min)) \
? (min) : (((x)>(max)) ? (max) : (x)))
-#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX))
+#define SCREENMAXBOUND(x) IN_BOUND (-SCREENMAX, x, SCREENMAX)
#ifdef NS_IMPL_COCOA
diff --git a/src/nsterm.m b/src/nsterm.m
index f094b145fe3..faf9324402b 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4739,12 +4739,15 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds,
check_native_fs ();
#endif
- if (hold_event_q.nr > 0 && !run_loop_only)
+ /* If there are input events pending, store them so that Emacs can
+ recognize C-g. (And we must make sure [NSApp run] is called in
+ this function, so that C-g has a chance to land in
+ hold_event_q.) */
+ if (hold_event_q.nr > 0)
{
- /* We already have events pending. */
- raise (SIGIO);
- errno = EINTR;
- return -1;
+ for (int i = 0; i < hold_event_q.nr; ++i)
+ kbd_buffer_store_event_hold (&hold_event_q.q[i], NULL);
+ hold_event_q.nr = 0;
}
eassert (nfds <= FD_SETSIZE);
@@ -4754,11 +4757,15 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds,
if (writefds && FD_ISSET(k, writefds)) ++nr;
}
- if (NSApp == nil
- || ![NSThread isMainThread]
+ /* emacs -nw doesn't have an NSApp, so we're done. */
+ if (NSApp == nil)
+ return thread_select (pselect, nfds, readfds, writefds, exceptfds,
+ timeout, sigmask);
+
+ if (![NSThread isMainThread]
|| (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
- return thread_select (pselect, nfds, readfds, writefds,
- exceptfds, timeout, sigmask);
+ thread_select (pselect, nfds, readfds, writefds,
+ exceptfds, timeout, sigmask);
else
{
struct timespec t = {0, 0};
diff --git a/src/pdumper.c b/src/pdumper.c
index ba318605773..ac8bf6f31f4 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1226,7 +1226,7 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
dump_tailq_length (&dump_queue->zero_weight_objects),
dump_tailq_length (&dump_queue->one_weight_normal_objects),
dump_tailq_length (&dump_queue->one_weight_strong_objects),
- XHASH_TABLE (dump_queue->link_weights)->count);
+ (ptrdiff_t) XHASH_TABLE (dump_queue->link_weights)->count);
static const int nr_candidates = 3;
struct candidate
@@ -1331,13 +1331,7 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
static bool
dump_object_needs_dumping_p (Lisp_Object object)
{
- /* Some objects, like symbols, are self-representing because they
- have invariant bit patterns, but sometimes these objects have
- associated data too, and these data-carrying objects need to be
- included in the dump despite all references to them being
- bitwise-invariant. */
- return (!dump_object_self_representing_p (object)
- || dump_object_emacs_ptr (object));
+ return !(FIXNUMP (object));
}
static void
@@ -1864,11 +1858,10 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
/* Set a pointer field on an output object during dump.
- CTX is the dump context. OFFSET is the offset at which the current
- object starts. OUT is a pointer to the dump output object.
- IN_START is the start of the current Emacs object. IN_FIELD is a
- pointer to the field in that object. TYPE is the type of pointer
- to which IN_FIELD points.
+ CTX is the dump context. OUT is a pointer to the dump output
+ object. IN_START is the start of the current Emacs object.
+ IN_FIELD is a pointer to the field in that object. TYPE is the
+ type of pointer to which IN_FIELD points.
*/
static void
dump_field_lv_rawptr (struct dump_context *ctx,
@@ -1883,8 +1876,7 @@ dump_field_lv_rawptr (struct dump_context *ctx,
/* Set a Lisp_Object field on an output object during dump.
- CTX is a dump context. OFFSET is the offset at which the current
- object starts. OUT is a pointer to the dump output object.
+ CTX is a dump context. OUT is a pointer to the dump output object.
IN_START is the start of the current Emacs object. IN_FIELD is a
pointer to a Lisp_Object field in that object.
@@ -2646,73 +2638,88 @@ dump_vectorlike_generic (struct dump_context *ctx,
return offset;
}
-/* Return a vector of KEY, VALUE pairs in the given hash table H. The
- first H->count pairs are valid, and the rest are unbound. */
-static Lisp_Object
+/* Return a vector of KEY, VALUE pairs in the given hash table H.
+ No room for growth is included. */
+static Lisp_Object *
hash_table_contents (struct Lisp_Hash_Table *h)
{
- if (h->test.hashfn == hashfn_user_defined)
- error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
-
- ptrdiff_t size = HASH_TABLE_SIZE (h);
- Lisp_Object key_and_value = make_uninit_vector (2 * size);
+ ptrdiff_t size = h->count;
+ Lisp_Object *key_and_value = hash_table_alloc_bytes (2 * size
+ * sizeof *key_and_value);
ptrdiff_t n = 0;
- /* Make sure key_and_value ends up in the same order; charset.c
- relies on it by expecting hash table indices to stay constant
- across the dump. */
- for (ptrdiff_t i = 0; i < size; i++)
- if (!NILP (HASH_HASH (h, i)))
- {
- ASET (key_and_value, n++, HASH_KEY (h, i));
- ASET (key_and_value, n++, HASH_VALUE (h, i));
- }
-
- while (n < 2 * size)
+ DOHASH (h, k, v)
{
- ASET (key_and_value, n++, Qunbound);
- ASET (key_and_value, n++, Qnil);
+ key_and_value[n++] = k;
+ key_and_value[n++] = v;
}
return key_and_value;
}
-static dump_off
+static void
dump_hash_table_list (struct dump_context *ctx)
{
if (!NILP (ctx->hash_tables))
- return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
- else
- return 0;
+ dump_object (ctx, CALLN (Fvconcat, ctx->hash_tables));
}
+static hash_table_std_test_t
+hash_table_std_test (const struct hash_table_test *t)
+{
+ if (BASE_EQ (t->name, Qeq))
+ return Test_eq;
+ if (BASE_EQ (t->name, Qeql))
+ return Test_eql;
+ if (BASE_EQ (t->name, Qequal))
+ return Test_equal;
+ error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */
+}
+
+/* Compact contents and discard inessential information from a hash table,
+ preparing it for dumping.
+ See `hash_table_thaw' for the code that restores the object to a usable
+ state. */
static void
hash_table_freeze (struct Lisp_Hash_Table *h)
{
- ptrdiff_t npairs = ASIZE (h->key_and_value) / 2;
h->key_and_value = hash_table_contents (h);
- h->next = h->hash = make_fixnum (npairs);
- h->index = make_fixnum (ASIZE (h->index));
- h->next_free = (npairs == h->count ? -1 : h->count);
+ h->next = NULL;
+ h->hash = NULL;
+ h->index = NULL;
+ h->table_size = 0;
+ h->index_bits = 0;
+ h->frozen_test = hash_table_std_test (h->test);
+ h->test = NULL;
}
-static void
-hash_table_thaw (Lisp_Object hash)
+static dump_off
+dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h)
{
- struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
- h->hash = make_nil_vector (XFIXNUM (h->hash));
- h->next = Fmake_vector (h->next, make_fixnum (-1));
- h->index = Fmake_vector (h->index, make_fixnum (-1));
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off start_offset = ctx->offset;
+ ptrdiff_t n = 2 * h->count;
- hash_table_rehash (hash);
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+
+ for (ptrdiff_t i = 0; i < n; i++)
+ {
+ Lisp_Object out;
+ const Lisp_Object *slot = &h->key_and_value[i];
+ dump_object_start (ctx, &out, sizeof out);
+ dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
+ dump_object_finish (ctx, &out, sizeof out);
+ }
+
+ ctx->flags = old_flags;
+ return start_offset;
}
static dump_off
-dump_hash_table (struct dump_context *ctx,
- Lisp_Object object,
- dump_off offset)
+dump_hash_table (struct dump_context *ctx, Lisp_Object object)
{
-#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -2724,30 +2731,72 @@ dump_hash_table (struct dump_context *ctx,
START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
- /* TODO: dump the hash bucket vectors synchronously here to keep
- them as close to the hash table as possible. */
DUMP_FIELD_COPY (out, hash, count);
- DUMP_FIELD_COPY (out, hash, next_free);
+ DUMP_FIELD_COPY (out, hash, weakness);
DUMP_FIELD_COPY (out, hash, purecopy);
DUMP_FIELD_COPY (out, hash, mutable);
- DUMP_FIELD_COPY (out, hash, rehash_threshold);
- DUMP_FIELD_COPY (out, hash, rehash_size);
- dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG);
- dump_field_lv (ctx, out, hash, &hash->test.name, WEIGHT_STRONG);
- dump_field_lv (ctx, out, hash, &hash->test.user_hash_function,
- WEIGHT_STRONG);
- dump_field_lv (ctx, out, hash, &hash->test.user_cmp_function,
- WEIGHT_STRONG);
- dump_field_emacs_ptr (ctx, out, hash, &hash->test.cmpfn);
- dump_field_emacs_ptr (ctx, out, hash, &hash->test.hashfn);
+ DUMP_FIELD_COPY (out, hash, frozen_test);
+ if (hash->key_and_value)
+ dump_field_fixup_later (ctx, out, hash, &hash->key_and_value);
eassert (hash->next_weak == NULL);
- return finish_dump_pvec (ctx, &out->header);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ if (hash->key_and_value)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Hash_Table, key_and_value),
+ dump_hash_table_contents (ctx, hash));
+ return offset;
+}
+
+static dump_off
+dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
+{
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off start_offset = ctx->offset;
+ ptrdiff_t n = obarray_size (o);
+
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+
+ for (ptrdiff_t i = 0; i < n; i++)
+ {
+ Lisp_Object out;
+ const Lisp_Object *slot = &o->buckets[i];
+ dump_object_start (ctx, &out, sizeof out);
+ dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
+ dump_object_finish (ctx, &out, sizeof out);
+ }
+
+ ctx->flags = old_flags;
+ return start_offset;
+}
+
+static dump_off
+dump_obarray (struct dump_context *ctx, Lisp_Object object)
+{
+#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_D2757E61AD
+# error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ const struct Lisp_Obarray *in_oa = XOBARRAY (object);
+ struct Lisp_Obarray munged_oa = *in_oa;
+ struct Lisp_Obarray *oa = &munged_oa;
+ START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header);
+ DUMP_FIELD_COPY (out, oa, count);
+ DUMP_FIELD_COPY (out, oa, size_bits);
+ dump_field_fixup_later (ctx, out, oa, &oa->buckets);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Obarray, buckets),
+ dump_obarray_buckets (ctx, oa));
+ return offset;
}
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_EB0A5191C5
+#if CHECK_STRUCTS && !defined HASH_buffer_B02F648B82
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2759,6 +2808,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
else
eassert (buffer->window_count == -1);
buffer->local_minor_modes_ = Qnil;
+ buffer->last_name_ = Qnil;
buffer->last_selected_window_ = Qnil;
buffer->display_count_ = make_fixnum (0);
buffer->clip_changed = 0;
@@ -2908,17 +2958,17 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, subr, header.size);
#ifdef HAVE_NATIVE_COMP
- bool native_comp = !NILP (subr->native_comp_u);
+ bool non_primitive = !NILP (subr->native_comp_u);
#else
- bool native_comp = false;
+ bool non_primitive = false;
#endif
- if (native_comp)
+ if (non_primitive)
out.function.a0 = NULL;
else
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
DUMP_FIELD_COPY (&out, subr, min_args);
DUMP_FIELD_COPY (&out, subr, max_args);
- if (native_comp)
+ if (non_primitive)
{
dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
dump_remember_cold_op (ctx,
@@ -2943,7 +2993,7 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
#endif
dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
- if (native_comp && ctx->flags.dump_object_contents)
+ if (non_primitive && ctx->flags.dump_object_contents)
/* We'll do the final addr relocation during VERY_LATE_RELOCS time
after the compilation units has been loaded. */
dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
@@ -3000,7 +3050,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_D8A254BC70
+#if CHECK_STRUCTS && !defined HASH_pvec_type_2D583AC566
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -3026,7 +3076,9 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_BOOL_VECTOR:
return dump_bool_vector(ctx, v);
case PVEC_HASH_TABLE:
- return dump_hash_table (ctx, lv, offset);
+ return dump_hash_table (ctx, lv);
+ case PVEC_OBARRAY:
+ return dump_obarray (ctx, lv);
case PVEC_BUFFER:
return dump_buffer (ctx, XBUFFER (lv));
case PVEC_SUBR:
@@ -3205,37 +3257,42 @@ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object)
static dump_off
dump_charset (struct dump_context *ctx, int cs_i)
{
-#if CHECK_STRUCTS && !defined (HASH_charset_317C49E291)
+#if CHECK_STRUCTS && !defined (HASH_charset_E31F4B5D96)
# error "charset changed. See CHECK_STRUCTS comment in config.h."
#endif
- dump_align_output (ctx, alignof (struct charset));
+ /* We can't change the alignment here, because ctx->offset is what
+ will be used for the whole array. */
+ eassert (ctx->offset % alignof (struct charset) == 0);
const struct charset *cs = charset_table + cs_i;
struct charset out;
dump_object_start (ctx, &out, sizeof (out));
- DUMP_FIELD_COPY (&out, cs, id);
- DUMP_FIELD_COPY (&out, cs, hash_index);
- DUMP_FIELD_COPY (&out, cs, dimension);
- memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space));
- if (cs_i < charset_table_used && cs->code_space_mask)
- dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask);
- DUMP_FIELD_COPY (&out, cs, code_linear_p);
- DUMP_FIELD_COPY (&out, cs, iso_chars_96);
- DUMP_FIELD_COPY (&out, cs, ascii_compatible_p);
- DUMP_FIELD_COPY (&out, cs, supplementary_p);
- DUMP_FIELD_COPY (&out, cs, compact_codes_p);
- DUMP_FIELD_COPY (&out, cs, unified_p);
- DUMP_FIELD_COPY (&out, cs, iso_final);
- DUMP_FIELD_COPY (&out, cs, iso_revision);
- DUMP_FIELD_COPY (&out, cs, emacs_mule_id);
- DUMP_FIELD_COPY (&out, cs, method);
- DUMP_FIELD_COPY (&out, cs, min_code);
- DUMP_FIELD_COPY (&out, cs, max_code);
- DUMP_FIELD_COPY (&out, cs, char_index_offset);
- DUMP_FIELD_COPY (&out, cs, min_char);
- DUMP_FIELD_COPY (&out, cs, max_char);
- DUMP_FIELD_COPY (&out, cs, invalid_code);
- memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map));
- DUMP_FIELD_COPY (&out, cs, code_offset);
+ if (cs_i < charset_table_used) /* Don't look at uninitialized data. */
+ {
+ DUMP_FIELD_COPY (&out, cs, id);
+ dump_field_lv (ctx, &out, cs, &cs->attributes, WEIGHT_NORMAL);
+ DUMP_FIELD_COPY (&out, cs, dimension);
+ memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space));
+ if (cs->code_space_mask)
+ dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask);
+ DUMP_FIELD_COPY (&out, cs, code_linear_p);
+ DUMP_FIELD_COPY (&out, cs, iso_chars_96);
+ DUMP_FIELD_COPY (&out, cs, ascii_compatible_p);
+ DUMP_FIELD_COPY (&out, cs, supplementary_p);
+ DUMP_FIELD_COPY (&out, cs, compact_codes_p);
+ DUMP_FIELD_COPY (&out, cs, unified_p);
+ DUMP_FIELD_COPY (&out, cs, iso_final);
+ DUMP_FIELD_COPY (&out, cs, iso_revision);
+ DUMP_FIELD_COPY (&out, cs, emacs_mule_id);
+ DUMP_FIELD_COPY (&out, cs, method);
+ DUMP_FIELD_COPY (&out, cs, min_code);
+ DUMP_FIELD_COPY (&out, cs, max_code);
+ DUMP_FIELD_COPY (&out, cs, char_index_offset);
+ DUMP_FIELD_COPY (&out, cs, min_char);
+ DUMP_FIELD_COPY (&out, cs, max_char);
+ DUMP_FIELD_COPY (&out, cs, invalid_code);
+ memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map));
+ DUMP_FIELD_COPY (&out, cs, code_offset);
+ }
dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
if (cs_i < charset_table_used && cs->code_space_mask)
dump_remember_cold_op (ctx, COLD_OP_CHARSET,
@@ -3249,14 +3306,17 @@ dump_charset_table (struct dump_context *ctx)
{
struct dump_flags old_flags = ctx->flags;
ctx->flags.pack_objects = true;
- dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_align_output (ctx, alignof (struct charset));
dump_off offset = ctx->offset;
+ if (dump_set_referrer (ctx))
+ ctx->current_referrer = build_string ("charset_table");
/* We are dumping the entire table, not just the used slots, because
otherwise when we restore from the pdump file, the actual size of
the table will be smaller than charset_table_size, and we will
crash if/when a new charset is defined. */
for (int i = 0; i < charset_table_size; ++i)
dump_charset (ctx, i);
+ dump_clear_referrer (ctx);
dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset);
ctx->flags = old_flags;
return offset;
@@ -3308,7 +3368,7 @@ dump_sort_copied_objects (struct dump_context *ctx)
file and the copy into Emacs in-order, where prefetch will be
most effective. */
ctx->copied_queue =
- Fsort (Fnreverse (ctx->copied_queue),
+ CALLN (Fsort, Fnreverse (ctx->copied_queue),
Qdump_emacs_portable__sort_predicate_copied);
}
@@ -3875,7 +3935,7 @@ drain_reloc_list (struct dump_context *ctx,
{
struct dump_flags old_flags = ctx->flags;
ctx->flags.pack_objects = true;
- Lisp_Object relocs = Fsort (Fnreverse (*reloc_list),
+ Lisp_Object relocs = CALLN (Fsort, Fnreverse (*reloc_list),
Qdump_emacs_portable__sort_predicate);
*reloc_list = Qnil;
dump_align_output (ctx, max (alignof (struct dump_reloc),
@@ -3997,7 +4057,7 @@ static void
dump_do_fixups (struct dump_context *ctx)
{
dump_off saved_offset = ctx->offset;
- Lisp_Object fixups = Fsort (Fnreverse (ctx->fixups),
+ Lisp_Object fixups = CALLN (Fsort, Fnreverse (ctx->fixups),
Qdump_emacs_portable__sort_predicate);
Lisp_Object prev_fixup = Qnil;
ctx->fixups = Qnil;
@@ -4212,22 +4272,19 @@ types. */)
dump_drain_deferred_symbols (ctx);
dump_drain_normal_queue (ctx);
}
- while (!dump_queue_empty_p (&ctx->dump_queue)
- || !NILP (ctx->deferred_hash_tables)
- || !NILP (ctx->deferred_symbols));
+ while (!(dump_queue_empty_p (&ctx->dump_queue)
+ && NILP (ctx->deferred_hash_tables)
+ && NILP (ctx->deferred_symbols)));
ctx->header.hash_list = ctx->offset;
dump_hash_table_list (ctx);
- do
- {
- dump_drain_deferred_hash_tables (ctx);
- dump_drain_deferred_symbols (ctx);
- dump_drain_normal_queue (ctx);
- }
- while (!dump_queue_empty_p (&ctx->dump_queue)
- || !NILP (ctx->deferred_hash_tables)
- || !NILP (ctx->deferred_symbols));
+ /* dump_hash_table_list just adds a new vector to the dump but all
+ its content should already have been in the dump, so it doesn't
+ add anything to any queue. */
+ eassert (dump_queue_empty_p (&ctx->dump_queue)
+ && NILP (ctx->deferred_hash_tables)
+ && NILP (ctx->deferred_symbols));
dump_sort_copied_objects (ctx);
@@ -5584,10 +5641,7 @@ pdumper_load (const char *dump_filename, char *argv0)
struct dump_header header_buf = { 0 };
struct dump_header *header = &header_buf;
- struct dump_memory_map sections[NUMBER_DUMP_SECTIONS];
-
- /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */
- memset (sections, 0, sizeof sections);
+ struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 };
const struct timespec start_time = current_timespec ();
char *dump_filename_copy;
diff --git a/src/pdumper.h b/src/pdumper.h
index 726805efdac..0d5e4c2d45f 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -128,7 +128,7 @@ pdumper_do_now_and_after_late_load (pdumper_hook hook)
if (dumped_with_pdumper_p ()) \
(variable) = (value); \
else \
- eassert (EQ ((variable), (value))); \
+ eassert (EQ (variable, value)); \
} while (0)
/* Actually load a dump. */
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index d938427c75a..1ec6bfcda4e 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -3471,9 +3471,7 @@ pgtk_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd)
i = max_fringe_bmp;
max_fringe_bmp = which + 20;
fringe_bmp
- = (cairo_pattern_t **) xrealloc (fringe_bmp,
- max_fringe_bmp *
- sizeof (cairo_pattern_t *));
+ = xrealloc (fringe_bmp, max_fringe_bmp * sizeof (cairo_pattern_t *));
while (i < max_fringe_bmp)
fringe_bmp[i++] = 0;
}
@@ -5827,8 +5825,8 @@ note_mouse_movement (struct frame *frame,
/* Has the mouse moved off the glyph it was on at the last sighting? */
r = &dpyinfo->last_mouse_glyph;
if (frame != dpyinfo->last_mouse_glyph_frame
- || event->x < r->x || event->x >= r->x + r->width
- || event->y < r->y || event->y >= r->y + r->height)
+ || event->x < r->x || event->x >= r->x + (int) r->width
+ || event->y < r->y || event->y >= r->y + (int) r->height)
{
frame->mouse_moved = true;
dpyinfo->last_mouse_scroll_bar = NULL;
@@ -7180,8 +7178,7 @@ If set to a non-float value, there will be no wait at all. */);
DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false);
window_being_scrolled = Qnil;
staticpro (&window_being_scrolled);
diff --git a/src/pgtkterm.h b/src/pgtkterm.h
index e8c54dff4d9..8072d963691 100644
--- a/src/pgtkterm.h
+++ b/src/pgtkterm.h
@@ -462,7 +462,7 @@ enum
#define FRAME_X_WINDOW(f) FRAME_GTK_OUTER_WIDGET (f)
#define FRAME_NATIVE_WINDOW(f) GTK_WINDOW (FRAME_X_WINDOW (f))
#define FRAME_GDK_WINDOW(f) \
- (gtk_widget_get_window (FRAME_GTK_WIDGET (f)))
+ gtk_widget_get_window (FRAME_GTK_WIDGET (f))
#define FRAME_X_DISPLAY(f) (FRAME_DISPLAY_INFO (f)->gdpy)
diff --git a/src/print.c b/src/print.c
index 26ed52b4653..76c577ec800 100644
--- a/src/print.c
+++ b/src/print.c
@@ -87,7 +87,7 @@ static struct print_buffer print_buffer;
print_number_index holds the largest N already used.
N has to be strictly larger than 0 since we need to distinguish -N. */
static ptrdiff_t print_number_index;
-static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
+static void print_interval (INTERVAL interval, void *pprintcharfun);
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
@@ -1285,15 +1285,9 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{ /* Remove unnecessary objects, which appear only once in OBJ;
that is, whose status is Qt. */
struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
- ptrdiff_t i;
-
- for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
- {
- Lisp_Object key = HASH_KEY (h, i);
- if (!BASE_EQ (key, Qunbound)
- && EQ (HASH_VALUE (h, i), Qt))
- Fremhash (key, Vprint_number_table);
- }
+ DOHASH (h, k, v)
+ if (EQ (v, Qt))
+ Fremhash (k, Vprint_number_table);
}
}
@@ -1397,6 +1391,9 @@ static void
print_preprocess (Lisp_Object obj)
{
eassert (!NILP (Vprint_circle));
+ /* The ppstack may contain HASH_UNUSED_ENTRY_KEY which is an invalid
+ Lisp value. Make sure that our filter stops us from traversing it. */
+ eassert (!PRINT_CIRCLE_CANDIDATE_P (HASH_UNUSED_ENTRY_KEY));
ptrdiff_t base_sp = ppstack.sp;
for (;;)
@@ -1415,7 +1412,7 @@ print_preprocess (Lisp_Object obj)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
{ /* OBJ appears more than once. Let's remember that. */
- if (!FIXNUMP (num))
+ if (SYMBOLP (num)) /* In practice, nil or t. */
{
print_number_index++;
/* Negative number indicates it hasn't been printed yet. */
@@ -1455,8 +1452,10 @@ print_preprocess (Lisp_Object obj)
if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- obj = h->key_and_value;
- continue;
+ /* The values pushed here may include
+ HASH_UNUSED_ENTRY_KEY; see top of this function. */
+ pp_stack_push_values (h->key_and_value,
+ 2 * h->table_size);
}
break;
}
@@ -1493,8 +1492,6 @@ print_preprocess_string (INTERVAL interval, void *arg)
print_preprocess (interval->plist);
}
-static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);
-
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
@@ -1502,7 +1499,7 @@ static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object stri
static int print_check_string_result;
static void
-print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
+print_check_string_charset_prop (INTERVAL interval, void *pstring)
{
Lisp_Object val;
@@ -1526,6 +1523,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
ptrdiff_t charpos = interval->position;
+ Lisp_Object string = *(Lisp_Object *)pstring;
ptrdiff_t bytepos = string_char_to_byte (string, charpos);
Lisp_Object charset = XCAR (XCDR (val));
@@ -1550,7 +1548,7 @@ print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
traverse_intervals (string_intervals (string), 0,
- print_check_string_charset_prop, string);
+ print_check_string_charset_prop, &string);
if (NILP (Vprint_charset_text_property)
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
@@ -2080,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
}
return;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = XOBARRAY (obj);
+ /* FIXME: Would it make sense to print the actual symbols (up to
+ a limit)? */
+ int i = sprintf (buf, "#<obarray n=%u>", o->count);
+ strout (buf, i, i, printcharfun);
+ return;
+ }
+
/* Types handled earlier. */
case PVEC_NORMAL_VECTOR:
case PVEC_RECORD:
@@ -2267,6 +2275,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
goto next_obj;
}
}
+ else if (STRINGP (num))
+ {
+ strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun);
+ goto next_obj;
+ }
}
print_depth++;
@@ -2401,8 +2414,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
if (string_intervals (obj))
{
+ Lisp_Object pcf = printcharfun;
traverse_intervals (string_intervals (obj),
- 0, print_interval, printcharfun);
+ 0, print_interval, &pcf);
printchar (')', printcharfun);
}
}
@@ -2555,11 +2569,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
goto next_obj;
case PVEC_SUB_CHAR_TABLE:
{
- /* Make each lowest sub_char_table start a new line.
- Otherwise we'll make a line extremely long, which
- results in slow redisplay. */
- if (XSUB_CHAR_TABLE (obj)->depth == 3)
- printchar ('\n', printcharfun);
print_c_string ("#^^[", printcharfun);
int n = sprintf (buf, "%d %d",
XSUB_CHAR_TABLE (obj)->depth,
@@ -2574,50 +2583,49 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
/* Implement a readable output, e.g.:
- #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
- /* Always print the size. */
- int len = sprintf (buf, "#s(hash-table size %"pD"d",
- HASH_TABLE_SIZE (h));
- strout (buf, len, len, printcharfun);
+ #s(hash-table test equal data (k1 v1 k2 v2)) */
+ print_c_string ("#s(hash-table", printcharfun);
- if (!NILP (h->test.name))
+ if (!BASE_EQ (h->test->name, Qeql))
{
print_c_string (" test ", printcharfun);
- print_object (h->test.name, printcharfun, escapeflag);
+ print_object (h->test->name, printcharfun, escapeflag);
}
- if (!NILP (h->weak))
+ if (h->weakness != Weak_None)
{
print_c_string (" weakness ", printcharfun);
- print_object (h->weak, printcharfun, escapeflag);
+ print_object (hash_table_weakness_symbol (h->weakness),
+ printcharfun, escapeflag);
}
- print_c_string (" rehash-size ", printcharfun);
- print_object (Fhash_table_rehash_size (obj),
- printcharfun, escapeflag);
-
- print_c_string (" rehash-threshold ", printcharfun);
- print_object (Fhash_table_rehash_threshold (obj),
- printcharfun, escapeflag);
-
if (h->purecopy)
print_c_string (" purecopy t", printcharfun);
- print_c_string (" data (", printcharfun);
-
ptrdiff_t size = h->count;
- /* Don't print more elements than the specified maximum. */
- if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
- size = XFIXNAT (Vprint_length);
-
- print_stack_push ((struct print_stack_entry){
- .type = PE_hash,
- .u.hash.obj = obj,
- .u.hash.nobjs = size * 2,
- .u.hash.idx = 0,
- .u.hash.printed = 0,
- .u.hash.truncated = (size < h->count),
- });
+ if (size > 0)
+ {
+ print_c_string (" data (", printcharfun);
+
+ /* Don't print more elements than the specified maximum. */
+ if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
+ size = XFIXNAT (Vprint_length);
+
+ print_stack_push ((struct print_stack_entry){
+ .type = PE_hash,
+ .u.hash.obj = obj,
+ .u.hash.nobjs = size * 2,
+ .u.hash.idx = 0,
+ .u.hash.printed = 0,
+ .u.hash.truncated = (size < h->count),
+ });
+ }
+ else
+ {
+ /* Empty table: we can omit the data entirely. */
+ printchar (')', printcharfun);
+ --print_depth; /* Done with this. */
+ }
goto next_obj;
}
@@ -2666,7 +2674,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
/* With the print-circle feature. */
Lisp_Object num = Fgethash (next, Vprint_number_table,
Qnil);
- if (FIXNUMP (num))
+ if (!(NILP (num) || EQ (num, Qt)))
{
print_c_string (" . ", printcharfun);
obj = next;
@@ -2770,7 +2778,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
Lisp_Object key;
ptrdiff_t idx = e->u.hash.idx;
- while (BASE_EQ ((key = HASH_KEY (h, idx)), Qunbound))
+ while (hash_unused_entry_key_p ((key = HASH_KEY (h, idx))))
idx++;
e->u.hash.idx = idx;
obj = key;
@@ -2793,10 +2801,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
This is part of printing a string that has text properties. */
static void
-print_interval (INTERVAL interval, Lisp_Object printcharfun)
+print_interval (INTERVAL interval, void *pprintcharfun)
{
if (NILP (interval->plist))
return;
+ Lisp_Object printcharfun = *(Lisp_Object *)pprintcharfun;
printchar (' ', printcharfun);
print_object (make_fixnum (interval->position), printcharfun, 1);
printchar (' ', printcharfun);
@@ -2929,7 +2938,10 @@ This variable should not be set with `setq'; bind it with a `let' instead. */);
DEFVAR_LISP ("print-number-table", Vprint_number_table,
doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
The Lisp printer uses this vector to detect Lisp objects referenced more
-than once.
+than once. If an entry contains a number, then the corresponding key is
+referenced more than once: a positive sign indicates that it's already been
+printed, and the absolute value indicates the number to use when printing.
+If an entry contains a string, that string is printed instead.
When you bind `print-continuous-numbering' to t, you should probably
also bind `print-number-table' to nil. This ensures that the value of
diff --git a/src/process.c b/src/process.c
index ddab9ed6c01..6b8b483cdf7 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5209,6 +5209,27 @@ wait_reading_process_output_1 (void)
{
}
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \
+ && defined THREADS_ENABLED
+
+/* Wrapper around `android_select' that exposes a calling interface with
+ an extra argument for compatibility with `thread_pselect'. */
+
+static int
+android_select_wrapper (int nfds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, const struct timespec *timeout,
+ const sigset_t *sigmask)
+{
+ /* sigmask is not supported. */
+ if (sigmask)
+ emacs_abort ();
+
+ return android_select (nfds, readfds, writefds, exceptfds,
+ (struct timespec *) timeout);
+}
+
+#endif /* HAVE_ANDROID && !ANDROID_STUBIFY && THREADS_ENABLED */
+
/* Read and dispose of subprocess output while waiting for timeout to
elapse and/or keyboard input to be available.
@@ -5418,7 +5439,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* This is so a breakpoint can be put here. */
@@ -5701,13 +5722,19 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
timeout = short_timeout;
#endif
- /* Android doesn't support threads and requires using a
- replacement for pselect in android.c to poll for
- events. */
+ /* Android requires using a replacement for pselect in
+ android.c to poll for events. */
#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+#ifndef THREADS_ENABLED
nfds = android_select (max_desc + 1,
&Available, (check_write ? &Writeok : 0),
NULL, &timeout);
+#else /* THREADS_ENABLED */
+ nfds = thread_select (android_select_wrapper,
+ max_desc + 1,
+ &Available, (check_write ? &Writeok : 0),
+ NULL, &timeout, NULL);
+#endif /* THREADS_ENABLED */
#else
/* Non-macOS HAVE_GLIB builds call thread_select in
@@ -5822,7 +5849,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* If we are not checking for keyboard input now,
@@ -8009,7 +8036,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
if (timespec_valid_p (timer_delay))
@@ -8082,7 +8109,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* If wait_for_cell. check for keyboard input
diff --git a/src/profiler.c b/src/profiler.c
index 243a34872c2..5a6a8b48f6b 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -34,23 +34,152 @@ saturated_add (EMACS_INT a, EMACS_INT b)
/* Logs. */
-typedef struct Lisp_Hash_Table log_t;
+/* A fully associative cache of size SIZE, mapping vectors of DEPTH
+ Lisp objects to counts. */
+typedef struct {
+ /* We use `int' throughout for table indices because anything bigger
+ is overkill. (Maybe we should make a typedef, but int is short.) */
+ int size; /* number of entries */
+ int depth; /* elements in each key vector */
+ int index_size; /* size of index */
+ Lisp_Object *trace; /* working trace, `depth' elements */
+ int *index; /* `index_size' indices or -1 if nothing */
+ int *next; /* `size' indices to next bucket or -1 */
+ EMACS_UINT *hash; /* `size' hash values */
+ Lisp_Object *keys; /* `size' keys of `depth' objects each */
+ EMACS_INT *counts; /* `size' entries, 0 indicates unused entry */
+ int next_free; /* next free entry, -1 if all taken */
+} log_t;
-static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object,
- struct Lisp_Hash_Table *);
-static Lisp_Object hashfn_profiler (Lisp_Object, struct Lisp_Hash_Table *);
+static void
+mark_log (log_t *log)
+{
+ if (log == NULL)
+ return;
+ int size = log->size;
+ int depth = log->depth;
+ for (int i = 0; i < size; i++)
+ if (log->counts[i] > 0) /* Only mark valid keys. */
+ mark_objects (log->keys + i * depth, depth);
+}
+
+static log_t *
+make_log (int size, int depth)
+{
+ log_t *log = xmalloc (sizeof *log);
+ log->size = size;
+ log->depth = depth;
+
+ /* The index size is arbitrary but for there to be any point it should be
+ bigger than SIZE. FIXME: make it a power of 2 or a (pseudo)prime. */
+ int index_size = size * 2 + 1;
+ log->index_size = index_size;
+
+ log->trace = xmalloc (depth * sizeof *log->trace);
+
+ log->index = xmalloc (index_size * sizeof *log->index);
+ for (int i = 0; i < index_size; i++)
+ log->index[i] = -1;
+
+ log->next = xmalloc (size * sizeof *log->next);
+ for (int i = 0; i < size - 1; i++)
+ log->next[i] = i + 1;
+ log->next[size - 1] = -1;
+ log->next_free = 0;
+
+ log->hash = xmalloc (size * sizeof *log->hash);
+ log->keys = xzalloc (size * depth * sizeof *log->keys);
+ log->counts = xzalloc (size * sizeof *log->counts);
+
+ return log;
+}
+
+static void
+free_log (log_t *log)
+{
+ xfree (log->trace);
+ xfree (log->index);
+ xfree (log->next);
+ xfree (log->hash);
+ xfree (log->keys);
+ xfree (log->counts);
+ xfree (log);
+}
+
+static inline EMACS_INT
+get_log_count (log_t *log, int idx)
+{
+ eassume (idx >= 0 && idx < log->size);
+ return log->counts[idx];
+}
+
+static inline void
+set_log_count (log_t *log, int idx, EMACS_INT val)
+{
+ eassume (idx >= 0 && idx < log->size && val >= 0);
+ log->counts[idx] = val;
+}
+
+static inline Lisp_Object *
+get_key_vector (log_t *log, int idx)
+{
+ eassume (idx >= 0 && idx < log->size);
+ return log->keys + idx * log->depth;
+}
+
+static inline int
+log_hash_index (log_t *log, EMACS_UINT hash)
+{
+ /* FIXME: avoid division. */
+ return hash % log->index_size;
+}
+
+static void
+remove_log_entry (log_t *log, int idx)
+{
+ eassume (idx >= 0 && idx < log->size);
+ /* Remove from index. */
+ int hidx = log_hash_index (log, log->hash[idx]);
+ int *p = &log->index[hidx];
+ while (*p != idx)
+ {
+ eassert (*p >= 0 && *p < log->size);
+ p = &log->next[*p];
+ }
+ *p = log->next[*p];
+ /* Invalidate entry and put it on the free list. */
+ log->counts[idx] = 0;
+ log->next[idx] = log->next_free;
+ log->next_free = idx;
+}
-static const struct hash_table_test hashtest_profiler =
- {
- LISPSYM_INITIALLY (Qprofiler_backtrace_equal),
- LISPSYM_INITIALLY (Qnil) /* user_hash_function */,
- LISPSYM_INITIALLY (Qnil) /* user_cmp_function */,
- cmpfn_profiler,
- hashfn_profiler,
- };
+static bool
+trace_equal (Lisp_Object *bt1, Lisp_Object *bt2, int depth)
+{
+ for (int i = 0; i < depth; i++)
+ if (!BASE_EQ (bt1[i], bt2[i]) && NILP (Ffunction_equal (bt1[i], bt2[i])))
+ return false;
+ return true;
+}
+
+static EMACS_UINT
+trace_hash (Lisp_Object *trace, int depth)
+{
+ EMACS_UINT hash = 0;
+ for (int i = 0; i < depth; i++)
+ {
+ Lisp_Object f = trace[i];
+ EMACS_UINT hash1
+ = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
+ : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f)))
+ ? XHASH (XCDR (XCDR (f))) : XHASH (f));
+ hash = sxhash_combine (hash, hash1);
+ }
+ return hash;
+}
struct profiler_log {
- Lisp_Object log;
+ log_t *log;
EMACS_INT gc_count; /* Samples taken during GC. */
EMACS_INT discarded; /* Samples evicted during table overflow. */
};
@@ -58,32 +187,22 @@ struct profiler_log {
static Lisp_Object export_log (struct profiler_log *);
static struct profiler_log
-make_log (void)
-{
- /* We use a standard Elisp hash-table object, but we use it in
- a special way. This is OK as long as the object is not exposed
- to Elisp, i.e. until it is returned by *-profiler-log, after which
- it can't be used any more. */
- EMACS_INT heap_size
- = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM);
- ptrdiff_t max_stack_depth
- = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);;
- struct profiler_log log
- = { make_hash_table (hashtest_profiler, heap_size,
- DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD,
- Qnil, false),
- 0, 0 };
- struct Lisp_Hash_Table *h = XHASH_TABLE (log.log);
-
- /* What is special about our hash-tables is that the values are pre-filled
- with the vectors we'll use as keys. */
- ptrdiff_t i = ASIZE (h->key_and_value) >> 1;
- while (i > 0)
- set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth));
- return log;
+make_profiler_log (void)
+{
+ int size = clip_to_bounds (0, profiler_log_size,
+ min (MOST_POSITIVE_FIXNUM, INT_MAX));
+ int max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, INT_MAX);
+ return (struct profiler_log){make_log (size, max_stack_depth), 0, 0};
}
+static void
+free_profiler_log (struct profiler_log *plog)
+{
+ free_log (plog->log);
+ plog->log = NULL;
+}
+
+
/* Evict the least used half of the hash_table.
When the table is full, we have to evict someone.
@@ -100,22 +219,22 @@ make_log (void)
cost of O(1) and we get O(N) time for a new entry to grow larger
than the other least counts before a new round of eviction. */
-static EMACS_INT approximate_median (log_t *log,
- ptrdiff_t start, ptrdiff_t size)
+static EMACS_INT
+approximate_median (log_t *log, int start, int size)
{
eassert (size > 0);
if (size < 2)
- return XFIXNUM (HASH_VALUE (log, start));
+ return get_log_count (log, start);
if (size < 3)
/* Not an actual median, but better for our application than
choosing either of the two numbers. */
- return ((XFIXNUM (HASH_VALUE (log, start))
- + XFIXNUM (HASH_VALUE (log, start + 1)))
+ return ((get_log_count (log, start)
+ + get_log_count (log, start + 1))
/ 2);
else
{
- ptrdiff_t newsize = size / 3;
- ptrdiff_t start2 = start + newsize;
+ int newsize = size / 3;
+ int start2 = start + newsize;
EMACS_INT i1 = approximate_median (log, start, newsize);
EMACS_INT i2 = approximate_median (log, start2, newsize);
EMACS_INT i3 = approximate_median (log, start2 + newsize,
@@ -126,34 +245,24 @@ static EMACS_INT approximate_median (log_t *log,
}
}
-static void evict_lower_half (struct profiler_log *plog)
+static void
+evict_lower_half (struct profiler_log *plog)
{
- log_t *log = XHASH_TABLE (plog->log);
- ptrdiff_t size = ASIZE (log->key_and_value) / 2;
+ log_t *log = plog->log;
+ int size = log->size;
EMACS_INT median = approximate_median (log, 0, size);
- for (ptrdiff_t i = 0; i < size; i++)
- /* Evict not only values smaller but also values equal to the median,
- so as to make sure we evict something no matter what. */
- if (XFIXNUM (HASH_VALUE (log, i)) <= median)
- {
- Lisp_Object key = HASH_KEY (log, i);
- EMACS_INT count = XFIXNUM (HASH_VALUE (log, i));
- plog->discarded = saturated_add (plog->discarded, count);
- { /* FIXME: we could make this more efficient. */
- Lisp_Object tmp;
- XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
- Fremhash (key, tmp);
+ for (int i = 0; i < size; i++)
+ {
+ EMACS_INT count = get_log_count (log, i);
+ /* Evict not only values smaller but also values equal to the median,
+ so as to make sure we evict something no matter what. */
+ if (count <= median)
+ {
+ plog->discarded = saturated_add (plog->discarded, count);
+ remove_log_entry (log, i);
}
- eassert (BASE_EQ (Qunbound, HASH_KEY (log, i)));
- eassert (log->next_free == i);
-
- eassert (VECTORP (key));
- for (ptrdiff_t j = 0; j < ASIZE (key); j++)
- ASET (key, j, Qnil);
-
- set_hash_value_slot (log, i, key);
- }
+ }
}
/* Record the current backtrace in LOG. COUNT is the weight of this
@@ -163,54 +272,52 @@ static void evict_lower_half (struct profiler_log *plog)
static void
record_backtrace (struct profiler_log *plog, EMACS_INT count)
{
- eassert (HASH_TABLE_P (plog->log));
- log_t *log = XHASH_TABLE (plog->log);
+ log_t *log = plog->log;
+ get_backtrace (log->trace, log->depth);
+ EMACS_UINT hash = trace_hash (log->trace, log->depth);
+ int hidx = log_hash_index (log, hash);
+ int idx = log->index[hidx];
+ while (idx >= 0)
+ {
+ if (log->hash[idx] == hash
+ && trace_equal (log->trace, get_key_vector (log, idx), log->depth))
+ {
+ /* Found existing entry. */
+ set_log_count (log, idx,
+ saturated_add (get_log_count (log, idx), count));
+ return;
+ }
+ idx = log->next[idx];
+ }
+
+ /* Add new entry. */
if (log->next_free < 0)
evict_lower_half (plog);
- ptrdiff_t index = log->next_free;
-
- /* Get a "working memory" vector. */
- Lisp_Object backtrace = HASH_VALUE (log, index);
- eassert (BASE_EQ (Qunbound, HASH_KEY (log, index)));
- get_backtrace (backtrace);
-
- { /* We basically do a `gethash+puthash' here, except that we have to be
- careful to avoid memory allocation since we're in a signal
- handler, and we optimize the code to try and avoid computing the
- hash+lookup twice. See fns.c:Fputhash for reference. */
- Lisp_Object hash;
- ptrdiff_t j = hash_lookup (log, backtrace, &hash);
- if (j >= 0)
- {
- EMACS_INT old_val = XFIXNUM (HASH_VALUE (log, j));
- EMACS_INT new_val = saturated_add (old_val, count);
- set_hash_value_slot (log, j, make_fixnum (new_val));
- }
- else
- { /* BEWARE! hash_put in general can allocate memory.
- But currently it only does that if log->next_free is -1. */
- eassert (0 <= log->next_free);
- ptrdiff_t j = hash_put (log, backtrace, make_fixnum (count), hash);
- /* Let's make sure we've put `backtrace' right where it
- already was to start with. */
- eassert (index == j);
-
- /* FIXME: If the hash-table is almost full, we should set
- some global flag so that some Elisp code can offload its
- data elsewhere, so as to avoid the eviction code.
- There are 2 ways to do that, AFAICT:
- - Set a flag checked in maybe_quit, such that maybe_quit can then
- call Fprofiler_cpu_log and stash the full log for later use.
- - Set a flag check in post-gc-hook, so that Elisp code can call
- profiler-cpu-log. That gives us more flexibility since that
- Elisp code can then do all kinds of fun stuff like write
- the log to disk. Or turn it right away into a call tree.
- Of course, using Elisp is generally preferable, but it may
- take longer until we get a chance to run the Elisp code, so
- there's more risk that the table will get full before we
- get there. */
- }
- }
+ idx = log->next_free;
+ eassert (idx >= 0);
+ log->next_free = log->next[idx];
+ log->next[idx] = log->index[hidx];
+ log->index[hidx] = idx;
+ eassert (log->counts[idx] == 0);
+ log->hash[idx] = hash;
+ memcpy (get_key_vector (log, idx), log->trace,
+ log->depth * sizeof *log->trace);
+ log->counts[idx] = count;
+
+ /* FIXME: If the hash-table is almost full, we should set
+ some global flag so that some Elisp code can offload its
+ data elsewhere, so as to avoid the eviction code.
+ There are 2 ways to do that:
+ - Set a flag checked in maybe_quit, such that maybe_quit can then
+ call Fprofiler_cpu_log and stash the full log for later use.
+ - Set a flag check in post-gc-hook, so that Elisp code can call
+ profiler-cpu-log. That gives us more flexibility since that
+ Elisp code can then do all kinds of fun stuff like write
+ the log to disk. Or turn it right away into a call tree.
+ Of course, using Elisp is generally preferable, but it may
+ take longer until we get a chance to run the Elisp code, so
+ there's more risk that the table will get full before we
+ get there. */
}
/* Sampling profiler. */
@@ -234,6 +341,9 @@ add_sample (struct profiler_log *plog, EMACS_INT count)
#ifdef PROFILER_CPU_SUPPORT
+/* The sampling interval specified. */
+static Lisp_Object profiler_cpu_interval = LISPSYM_INITIALLY (Qnil);
+
/* The profiler timer and whether it was properly initialized, if
POSIX timers are available. */
#ifdef HAVE_ITIMERSPEC
@@ -356,8 +466,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
if (profiler_cpu_running)
error ("CPU profiler is already running");
- if (NILP (cpu.log))
- cpu = make_log ();
+ if (cpu.log == NULL)
+ cpu = make_profiler_log ();
int status = setup_cpu_timer (sampling_interval);
if (status < 0)
@@ -367,6 +477,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
}
else
{
+ profiler_cpu_interval = sampling_interval;
profiler_cpu_running = status;
if (! profiler_cpu_running)
error ("Unable to start profiler timer");
@@ -428,30 +539,49 @@ of functions, where the last few elements may be nil.
Before returning, a new log is allocated for future samples. */)
(void)
{
- return (export_log (&cpu));
+ /* Temporarily stop profiling to avoid it interfering with our data
+ access. */
+ bool prof_cpu = profiler_cpu_running;
+ if (prof_cpu)
+ Fprofiler_cpu_stop ();
+
+ Lisp_Object ret = export_log (&cpu);
+
+ if (prof_cpu)
+ Fprofiler_cpu_start (profiler_cpu_interval);
+
+ return ret;
}
#endif /* PROFILER_CPU_SUPPORT */
+/* Extract log data to a Lisp hash table. The log data is then erased. */
static Lisp_Object
-export_log (struct profiler_log *log)
+export_log (struct profiler_log *plog)
{
- Lisp_Object result = log->log;
- if (log->gc_count)
+ log_t *log = plog->log;
+ /* The returned hash table uses `equal' as key equivalence predicate
+ which is more discriminating than the `function-equal' used by
+ the log but close enough, and will never confuse two distinct
+ keys in the log. */
+ Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE,
+ Weak_None, false);
+ for (int i = 0; i < log->size; i++)
+ {
+ int count = get_log_count (log, i);
+ if (count > 0)
+ Fputhash (Fvector (log->depth, get_key_vector (log, i)),
+ make_fixnum (count), h);
+ }
+ if (plog->gc_count)
Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil),
- make_fixnum (log->gc_count),
- result);
- if (log->discarded)
+ make_fixnum (plog->gc_count),
+ h);
+ if (plog->discarded)
Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil),
- make_fixnum (log->discarded),
- result);
-#ifdef PROFILER_CPU_SUPPORT
- /* Here we're making the log visible to Elisp, so it's not safe any
- more for our use afterwards since we can't rely on its special
- pre-allocated keys anymore. So we have to allocate a new one. */
- if (profiler_cpu_running)
- *log = make_log ();
-#endif /* PROFILER_CPU_SUPPORT */
- return result;
+ make_fixnum (plog->discarded),
+ h);
+ free_profiler_log (plog);
+ return h;
}
/* Memory profiler. */
@@ -474,8 +604,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
if (profiler_memory_running)
error ("Memory profiler is already running");
- if (NILP (memory.log))
- memory = make_log ();
+ if (memory.log == NULL)
+ memory = make_profiler_log ();
profiler_memory_running = true;
@@ -514,7 +644,16 @@ of functions, where the last few elements may be nil.
Before returning, a new log is allocated for future samples. */)
(void)
{
- return (export_log (&memory));
+ bool prof_mem = profiler_memory_running;
+ if (prof_mem)
+ Fprofiler_memory_stop ();
+
+ Lisp_Object ret = export_log (&memory);
+
+ if (prof_mem)
+ Fprofiler_memory_start ();
+
+ return ret;
}
@@ -547,50 +686,15 @@ the same lambda expression, or are really unrelated function. */)
return res ? Qt : Qnil;
}
-static Lisp_Object
-cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h)
-{
- if (EQ (bt1, bt2))
- return Qt;
- else if (VECTORP (bt1) && VECTORP (bt2))
- {
- ptrdiff_t l = ASIZE (bt1);
- if (l != ASIZE (bt2))
- return Qnil;
- for (ptrdiff_t i = 0; i < l; i++)
- if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i))))
- return Qnil;
- return Qt;
- }
- else
- return Qnil;
-}
-
-static Lisp_Object
-hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h)
+void
+mark_profiler (void)
{
- EMACS_UINT hash;
- if (VECTORP (bt))
- {
- hash = 0;
- ptrdiff_t l = ASIZE (bt);
- for (ptrdiff_t i = 0; i < l; i++)
- {
- Lisp_Object f = AREF (bt, i);
- EMACS_UINT hash1
- = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
- : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f)))
- ? XHASH (XCDR (XCDR (f))) : XHASH (f));
- hash = sxhash_combine (hash, hash1);
- }
- }
- else
- hash = XHASH (bt);
- return make_ufixnum (SXHASH_REDUCE (hash));
+#ifdef PROFILER_CPU_SUPPORT
+ mark_log (cpu.log);
+#endif
+ mark_log (memory.log);
}
-static void syms_of_profiler_for_pdumper (void);
-
void
syms_of_profiler (void)
{
@@ -603,47 +707,20 @@ If the log gets full, some of the least-seen call-stacks will be evicted
to make room for new entries. */);
profiler_log_size = 10000;
- DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
DEFSYM (QDiscarded_Samples, "Discarded Samples");
defsubr (&Sfunction_equal);
#ifdef PROFILER_CPU_SUPPORT
profiler_cpu_running = NOT_RUNNING;
- cpu.log = Qnil;
- staticpro (&cpu.log);
defsubr (&Sprofiler_cpu_start);
defsubr (&Sprofiler_cpu_stop);
defsubr (&Sprofiler_cpu_running_p);
defsubr (&Sprofiler_cpu_log);
#endif
profiler_memory_running = false;
- memory.log = Qnil;
- staticpro (&memory.log);
defsubr (&Sprofiler_memory_start);
defsubr (&Sprofiler_memory_stop);
defsubr (&Sprofiler_memory_running_p);
defsubr (&Sprofiler_memory_log);
-
- pdumper_do_now_and_after_load (syms_of_profiler_for_pdumper);
-}
-
-static void
-syms_of_profiler_for_pdumper (void)
-{
- if (dumped_with_pdumper_p ())
- {
-#ifdef PROFILER_CPU_SUPPORT
- cpu.log = Qnil;
-#endif
- memory.log = Qnil;
- }
- else
- {
-#ifdef PROFILER_CPU_SUPPORT
- eassert (NILP (cpu.log));
-#endif
- eassert (NILP (memory.log));
- }
-
}
diff --git a/src/puresize.h b/src/puresize.h
index ac5d2da30dc..2a716872832 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 6aa6f4f9b34..0ec0c6eb63f 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -99,7 +99,7 @@
#define IS_REAL_ASCII(c) ((c) < 0200)
/* 1 if C is a unibyte character. */
-#define ISUNIBYTE(c) (SINGLE_BYTE_CHAR_P ((c)))
+#define ISUNIBYTE(c) SINGLE_BYTE_CHAR_P (c)
/* The Emacs definitions should not be directly affected by locales. */
@@ -1345,7 +1345,7 @@ struct range_table_work_area
/* Set a range (RANGE_START, RANGE_END) to WORK_AREA. */
#define SET_RANGE_TABLE_WORK_AREA(work_area, range_start, range_end) \
do { \
- EXTEND_RANGE_TABLE ((work_area), 2); \
+ EXTEND_RANGE_TABLE (work_area, 2); \
(work_area).table[(work_area).used++] = (range_start); \
(work_area).table[(work_area).used++] = (range_end); \
} while (false)
@@ -1380,7 +1380,7 @@ struct range_table_work_area
/* Set the bit for character C in a list. */
-#define SET_LIST_BIT(c) (b[((c)) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH))
+#define SET_LIST_BIT(c) (b[(c) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH))
/* Store characters in the range FROM to TO in the bitmap at B (for
@@ -1403,7 +1403,7 @@ struct range_table_work_area
C1 = TRANSLATE (C0); \
if (! ASCII_CHAR_P (C1)) \
{ \
- SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \
+ SET_RANGE_TABLE_WORK_AREA (work_area, C1, C1); \
if ((C1 = RE_CHAR_TO_UNIBYTE (C1)) < 0) \
C1 = C0; \
} \
@@ -1446,7 +1446,7 @@ struct range_table_work_area
} \
} \
if (I < USED) \
- SET_RANGE_TABLE_WORK_AREA ((work_area), C2, C2); \
+ SET_RANGE_TABLE_WORK_AREA (work_area, C2, C2); \
} \
} \
} while (false)
@@ -1458,7 +1458,7 @@ struct range_table_work_area
do { \
int C0, C1, C2, I, USED = RANGE_TABLE_WORK_USED (work_area); \
\
- SET_RANGE_TABLE_WORK_AREA ((work_area), (FROM), (TO)); \
+ SET_RANGE_TABLE_WORK_AREA (work_area, FROM, TO); \
for (C0 = (FROM); C0 <= (TO); C0++) \
{ \
C1 = TRANSLATE (C0); \
@@ -1482,7 +1482,7 @@ struct range_table_work_area
} \
} \
if (I < USED) \
- SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \
+ SET_RANGE_TABLE_WORK_AREA (work_area, C1, C1); \
} \
} while (false)
@@ -2923,8 +2923,18 @@ forall_firstchar_1 (re_char *p, re_char *pend,
forward over a subsequent `jump`. Recognize this pattern
since that subsequent `jump` is the one that jumps to the
loop-entry. */
- newp2 = ((re_opcode_t) *newp2 == jump)
- ? extract_address (newp2 + 1) : newp2;
+ if ((re_opcode_t) *newp2 == jump)
+ {
+ re_char *p3 = extract_address (newp2 + 1);
+ /* Only recognize this pattern if one of the two destinations
+ is going forward, otherwise we'll fall into the pessimistic
+ "Both destinations go backward" below.
+ This is important if the `jump` at newp2 is the end of an
+ outer loop while the `on_failure_jump` is the end of an
+ inner loop. */
+ if (p3 > p_orig || newp1 > p_orig)
+ newp2 = p3;
+ }
do_twoway_jump:
/* We have to check that both destinations are safe.
@@ -3755,7 +3765,7 @@ execute_charset (re_char **pp, int c, int corig, bool unibyte,
int count;
rtp = CHARSET_RANGE_TABLE (p);
EXTRACT_NUMBER_AND_INCR (count, rtp);
- *pp = CHARSET_RANGE_TABLE_END ((rtp), (count));
+ *pp = CHARSET_RANGE_TABLE_END (rtp, count);
}
else
*pp += 2 + CHARSET_BITMAP_SIZE (p);
diff --git a/src/sfnt.c b/src/sfnt.c
index aa8b49a9ecd..8598b052044 100644
--- a/src/sfnt.c
+++ b/src/sfnt.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <fcntl.h>
#include <intprops.h>
#include <inttypes.h>
+#include <stdckdint.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
@@ -663,14 +664,13 @@ sfnt_read_cmap_format_8 (int fd,
min_size = SFNT_ENDOF (struct sfnt_cmap_format_8, num_groups,
uint32_t);
- if (INT_MULTIPLY_WRAPV (format8->num_groups, sizeof *format8->groups,
- &temp))
+ if (ckd_mul (&temp, format8->num_groups, sizeof *format8->groups))
{
xfree (format8);
return NULL;
}
- if (INT_ADD_WRAPV (min_size, temp, &min_size))
+ if (ckd_add (&min_size, min_size, temp))
{
xfree (format8);
return NULL;
@@ -755,14 +755,13 @@ sfnt_read_cmap_format_12 (int fd,
min_size = SFNT_ENDOF (struct sfnt_cmap_format_12, num_groups,
uint32_t);
- if (INT_MULTIPLY_WRAPV (format12->num_groups, sizeof *format12->groups,
- &temp))
+ if (ckd_mul (&temp, format12->num_groups, sizeof *format12->groups))
{
xfree (format12);
return NULL;
}
- if (INT_ADD_WRAPV (min_size, temp, &min_size))
+ if (ckd_add (&min_size, min_size, temp))
{
xfree (format12);
return NULL;
@@ -841,9 +840,8 @@ sfnt_read_cmap_format_14 (int fd,
14 cmap table. */
size = sizeof *format14;
- if (INT_MULTIPLY_WRAPV (num_records, sizeof *format14->records,
- &temp)
- || INT_ADD_WRAPV (size, temp, &size))
+ if (ckd_mul (&temp, num_records, sizeof *format14->records)
+ || ckd_add (&size, size, temp))
return NULL;
format14 = xmalloc (size);
@@ -901,7 +899,7 @@ sfnt_read_cmap_table_1 (int fd, uint32_t directory_offset,
off_t offset;
struct sfnt_cmap_encoding_subtable_data header;
- if (INT_ADD_WRAPV (directory_offset, table_offset, &offset))
+ if (ckd_add (&offset, directory_offset, table_offset))
return (struct sfnt_cmap_encoding_subtable_data *) -1;
if (lseek (fd, offset, SEEK_SET) == (off_t) -1)
@@ -1937,8 +1935,11 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph,
simple->instructions comes one word past number_of_contours,
because end_pts_of_contours also contains the instruction
length. */
- simple->instructions = (uint8_t *) (simple->end_pts_of_contours
- + glyph->number_of_contours + 1);
+
+ simple->x_coordinates = (int16_t *) (simple->end_pts_of_contours
+ + glyph->number_of_contours + 1);
+ simple->y_coordinates = simple->x_coordinates + number_of_points;
+ simple->instructions = (uint8_t *) (simple->y_coordinates + number_of_points);
simple->flags = simple->instructions + simple->instruction_length;
/* Read instructions into the glyph. */
@@ -2022,7 +2023,6 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph,
/* Now that the flags have been decoded, start decoding the
vectors. */
- simple->x_coordinates = (int16_t *) (simple->flags + number_of_points);
vec_start = flags_start;
i = 0;
x = 0;
@@ -2080,7 +2080,6 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph,
pointer to the flags for the current vector. */
flags_start = simple->flags;
y = 0;
- simple->y_coordinates = simple->x_coordinates + i;
i = 0;
while (i < number_of_points)
@@ -2631,24 +2630,21 @@ sfnt_expand_compound_glyph_context (struct sfnt_compound_glyph_context *context,
size_t size_bytes;
/* Add each field while checking for overflow. */
- if (INT_ADD_WRAPV (number_of_contours, context->num_end_points,
- &context->num_end_points))
+ if (ckd_add (&context->num_end_points, number_of_contours,
+ context->num_end_points))
return 1;
- if (INT_ADD_WRAPV (number_of_points, context->num_points,
- &context->num_points))
+ if (ckd_add (&context->num_points, number_of_points, context->num_points))
return 1;
/* Reallocate each array to the new size if necessary. */
if (context->points_size < context->num_points)
{
- if (INT_MULTIPLY_WRAPV (context->num_points, 2,
- &context->points_size))
+ if (ckd_mul (&context->points_size, context->num_points, 2))
context->points_size = context->num_points;
- if (INT_MULTIPLY_WRAPV (context->points_size,
- sizeof *context->x_coordinates,
- &size_bytes))
+ if (ckd_mul (&size_bytes, context->points_size,
+ sizeof *context->x_coordinates))
return 1;
context->x_coordinates = xrealloc (context->x_coordinates,
@@ -2672,13 +2668,11 @@ sfnt_expand_compound_glyph_context (struct sfnt_compound_glyph_context *context,
if (context->end_points_size < context->num_end_points)
{
- if (INT_MULTIPLY_WRAPV (context->num_end_points, 2,
- &context->end_points_size))
+ if (ckd_mul (&context->end_points_size, context->num_end_points, 2))
context->end_points_size = context->num_end_points;
- if (INT_MULTIPLY_WRAPV (context->end_points_size,
- sizeof *context->contour_end_points,
- &size_bytes))
+ if (ckd_mul (&size_bytes, context->end_points_size,
+ sizeof *context->contour_end_points))
return 1;
context->contour_end_points
@@ -2804,12 +2798,6 @@ sfnt_decompose_compound_glyph (struct sfnt_glyph *glyph,
if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */
sfnt_transform_coordinates (component, &x, &y, 1,
0, 0);
-
- if (component->flags & 04) /* ROUND_XY_TO_GRID */
- {
- x = sfnt_round_fixed (x);
- y = sfnt_round_fixed (y);
- }
}
else
{
@@ -3766,7 +3754,23 @@ sfnt_multiply_divide_2 (struct sfnt_large_integer *ab,
return q;
}
-#endif
+/* Add the specified unsigned 32-bit N to the large integer
+ INTEGER. */
+
+static void
+sfnt_large_integer_add (struct sfnt_large_integer *integer,
+ uint32_t n)
+{
+ struct sfnt_large_integer number;
+
+ number.low = integer->low + n;
+ number.high = integer->high + (number.low
+ < integer->low);
+
+ *integer = number;
+}
+
+#endif /* !INT64_MAX */
/* Calculate (A * B) / C with no rounding and return the result, using
a 64 bit integer if necessary. */
@@ -3779,32 +3783,37 @@ sfnt_multiply_divide (unsigned int a, unsigned int b, unsigned int c)
sfnt_multiply_divide_1 (a, b, &temp);
return sfnt_multiply_divide_2 (&temp, c);
-#else
+#else /* INT64_MAX */
uint64_t temp;
temp = (uint64_t) a * (uint64_t) b;
return temp / c;
-#endif
+#endif /* !INT64_MAX */
}
-#ifndef INT64_MAX
-
-/* Add the specified unsigned 32-bit N to the large integer
- INTEGER. */
+/* Calculate (A * B) / C with rounding and return the result, using a
+ 64 bit integer if necessary. */
-static void
-sfnt_large_integer_add (struct sfnt_large_integer *integer,
- uint32_t n)
+static unsigned int
+sfnt_multiply_divide_rounded (unsigned int a, unsigned int b,
+ unsigned int c)
{
- struct sfnt_large_integer number;
+#ifndef INT64_MAX
+ struct sfnt_large_integer temp;
- number.low = integer->low + n;
- number.high = integer->high + (number.low
- < integer->low);
+ sfnt_multiply_divide_1 (a, b, &temp);
+ sfnt_large_integer_add (&temp, c / 2);
+ return sfnt_multiply_divide_2 (&temp, c);
+#else /* INT64_MAX */
+ uint64_t temp;
- *integer = number;
+ temp = (uint64_t) a * (uint64_t) b + c / 2;
+ return temp / c;
+#endif /* !INT64_MAX */
}
+#ifndef INT64_MAX
+
/* Calculate (A * B) / C, rounding the result with a threshold of N.
Use a 64 bit temporary. */
@@ -3819,9 +3828,9 @@ sfnt_multiply_divide_round (unsigned int a, unsigned int b,
return sfnt_multiply_divide_2 (&temp, c);
}
-#endif /* INT64_MAX */
+#endif /* !INT64_MAX */
-/* The same as sfnt_multiply_divide, but handle signed values
+/* The same as sfnt_multiply_divide_rounded, but handle signed values
instead. */
MAYBE_UNUSED static int
@@ -3840,8 +3849,8 @@ sfnt_multiply_divide_signed (int a, int b, int c)
if (c < 0)
sign = -sign;
- return (sfnt_multiply_divide (abs (a), abs (b), abs (c))
- * sign);
+ return (sfnt_multiply_divide_rounded (abs (a), abs (b),
+ abs (c)) * sign);
}
/* Multiply the two 16.16 fixed point numbers X and Y. Return the
@@ -3857,7 +3866,7 @@ sfnt_mul_fixed (sfnt_fixed x, sfnt_fixed y)
/* This can be done quickly with int64_t. */
return product / (int64_t) 65536;
-#else
+#else /* !INT64_MAX */
int sign;
sign = 1;
@@ -3870,7 +3879,7 @@ sfnt_mul_fixed (sfnt_fixed x, sfnt_fixed y)
return sfnt_multiply_divide (abs (x), abs (y),
65536) * sign;
-#endif
+#endif /* INT64_MAX */
}
/* Multiply the two 16.16 fixed point numbers X and Y, with rounding
@@ -3887,7 +3896,7 @@ sfnt_mul_fixed_round (sfnt_fixed x, sfnt_fixed y)
/* This can be done quickly with int64_t. */
return (product + round) / (int64_t) 65536;
-#else
+#else /* !INT64_MAX */
int sign;
sign = 1;
@@ -3900,7 +3909,7 @@ sfnt_mul_fixed_round (sfnt_fixed x, sfnt_fixed y)
return sfnt_multiply_divide_round (abs (x), abs (y),
32768, 65536) * sign;
-#endif
+#endif /* INT64_MAX */
}
/* Set the pen size to the specified point and return. POINT will be
@@ -5087,7 +5096,7 @@ sfnt_poly_edges_exact (struct sfnt_fedge *edges, size_t nedges,
raster.scanlines = height;
raster.chunks = NULL;
- if (!INT_MULTIPLY_OK (height, sizeof *raster.steps, &size))
+ if (ckd_mul (&size, height, sizeof *raster.steps))
abort ();
raster.steps = xzalloc (size);
@@ -5473,8 +5482,6 @@ be as well. */
next = next->next;
xfree (last);
}
-
-#undef ONE_PIXEL
}
/* Apply winding rule to the coverage value VALUE. Convert VALUE to a
@@ -6020,11 +6027,10 @@ sfnt_read_meta_table (int fd, struct sfnt_offset_subtable *subtable)
so an unswapped copy of the whole meta contents must be
retained. */
- if (INT_MULTIPLY_WRAPV (sizeof *meta->data_maps, meta->num_data_maps,
- &map_size)
+ if (ckd_mul (&map_size, sizeof *meta->data_maps, meta->num_data_maps)
/* Do so while checking for overflow from bad sfnt files. */
- || INT_ADD_WRAPV (map_size, sizeof *meta, &data_size)
- || INT_ADD_WRAPV (data_size, directory->length, &data_size))
+ || ckd_add (&data_size, map_size, sizeof *meta)
+ || ckd_add (&data_size, data_size, directory->length))
{
xfree (meta);
return NULL;
@@ -6074,9 +6080,8 @@ sfnt_read_meta_table (int fd, struct sfnt_offset_subtable *subtable)
/* Verify the data offsets. Overflow checking is particularly
important here. */
- if (INT_ADD_WRAPV (meta->data_maps[i].data_offset,
- meta->data_maps[i].data_length,
- &offset))
+ if (ckd_add (&offset, meta->data_maps[i].data_offset,
+ meta->data_maps[i].data_length))
{
xfree (meta);
return NULL;
@@ -6162,9 +6167,7 @@ sfnt_read_ttc_header (int fd)
/* Now, read the variable length data. Make sure to check for
overflow. */
- if (INT_MULTIPLY_WRAPV (ttc->num_fonts,
- sizeof *ttc->offset_table,
- &size))
+ if (ckd_mul (&size, ttc->num_fonts, sizeof *ttc->offset_table))
{
xfree (ttc);
return NULL;
@@ -6195,7 +6198,7 @@ sfnt_read_ttc_header (int fd)
size = (SFNT_ENDOF (struct sfnt_ttc_header, ul_dsig_offset,
uint32_t)
- offsetof (struct sfnt_ttc_header, ul_dsig_tag));
- rc = read (fd, &ttc->ul_dsig_offset, size);
+ rc = read (fd, &ttc->ul_dsig_tag, size);
if (rc == -1 || rc < size)
{
xfree (ttc);
@@ -6283,7 +6286,7 @@ sfnt_read_cvt_table (int fd, struct sfnt_offset_subtable *subtable)
return NULL;
/* Figure out the minimum amount that has to be read. */
- if (INT_ADD_WRAPV (sizeof *cvt, directory->length, &required))
+ if (ckd_add (&required, directory->length, sizeof *cvt))
return NULL;
/* Allocate enough for that much data. */
@@ -6334,7 +6337,7 @@ sfnt_read_fpgm_table (int fd, struct sfnt_offset_subtable *subtable)
return NULL;
/* Figure out the minimum amount that has to be read. */
- if (INT_ADD_WRAPV (sizeof *fpgm, directory->length, &required))
+ if (ckd_add (&required, directory->length, sizeof *fpgm))
return NULL;
/* Allocate enough for that much data. */
@@ -6382,7 +6385,7 @@ sfnt_read_prep_table (int fd, struct sfnt_offset_subtable *subtable)
return NULL;
/* Figure out the minimum amount that has to be read. */
- if (INT_ADD_WRAPV (sizeof *prep, directory->length, &required))
+ if (ckd_add (&required, directory->length, sizeof *prep))
return NULL;
/* Allocate enough for that much data. */
@@ -6470,19 +6473,21 @@ sfnt_mul_f26dot6 (sfnt_f26dot6 a, sfnt_f26dot6 b)
#endif
}
-/* Multiply the specified 2.14 number with another signed 32 bit
- number. Return the result as a signed 32 bit number. */
+/* Multiply the specified two 26.6 fixed point numbers A and B, with
+ rounding. Return the result, or an undefined value upon
+ overflow. */
-static int32_t
-sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b)
+static sfnt_f26dot6
+sfnt_mul_f26dot6_round (sfnt_f26dot6 a, sfnt_f26dot6 b)
{
#ifdef INT64_MAX
int64_t product;
product = (int64_t) a * (int64_t) b;
- return product / (int64_t) 16384;
-#else
+ /* This can be done quickly with int64_t. */
+ return (product + 32) / (int64_t) 64;
+#else /* !INT64_MAX */
int sign;
sign = 1;
@@ -6493,61 +6498,48 @@ sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b)
if (b < 0)
sign = -sign;
- return sfnt_multiply_divide (abs (a), abs (b),
- 16384) * sign;
-#endif
+ return sfnt_multiply_divide_round (abs (a), abs (b),
+ 32, 64) * sign;
+#endif /* INT64_MAX */
}
-/* Multiply the specified 26.6 fixed point number X by the specified
- 16.16 fixed point number Y with symmetric rounding.
-
- The 26.6 fixed point number must fit inside -32768 to 32767.ffff.
- Value is otherwise undefined. */
+/* Multiply the specified 2.14 number with another signed 32 bit
+ number. Return the result as a signed 32 bit number. */
-static sfnt_f26dot6
-sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y)
+static int32_t
+sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b)
{
#ifdef INT64_MAX
- uint64_t product;
- int sign;
-
- sign = 1;
-
- if (x < 0)
- {
- x = -x;
- sign = -sign;
- }
-
- if (y < 0)
- {
- y = -y;
- sign = -sign;
- }
+ int64_t product;
- product = (uint64_t) y * (uint64_t) x;
+ product = (int64_t) a * (int64_t) b;
- /* This can be done quickly with int64_t. */
- return ((int64_t) (product + 32768)
- / (int64_t) 65536) * sign;
+ return product / (int64_t) 16384;
#else
- struct sfnt_large_integer temp;
int sign;
sign = 1;
- if (x < 0)
+ if (a < 0)
sign = -sign;
- if (y < 0)
+ if (b < 0)
sign = -sign;
- sfnt_multiply_divide_1 (abs (x), abs (y), &temp);
- sfnt_large_integer_add (&temp, 32676);
- return sfnt_multiply_divide_2 (&temp, 65536) * sign;
+ return sfnt_multiply_divide (abs (a), abs (b),
+ 16384) * sign;
#endif
}
+/* Multiply the specified 26.6 fixed point number X by the specified
+ 16.16 fixed point number Y with rounding. */
+
+static sfnt_f26dot6
+sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y)
+{
+ return sfnt_mul_fixed_round (x, y);
+}
+
/* Return the floor of the specified 26.6 fixed point value X. */
static sfnt_f26dot6
@@ -6645,59 +6637,51 @@ sfnt_make_interpreter (struct sfnt_maxp_table *maxp,
size = sizeof (*interpreter);
/* Add program stack. */
- if (INT_ADD_WRAPV ((maxp->max_stack_elements
- * sizeof *interpreter->stack),
- size, &size))
+ if (ckd_add (&size, size, (maxp->max_stack_elements
+ * sizeof *interpreter->stack)))
return NULL;
/* Add twilight zone. */
- if (INT_ADD_WRAPV ((maxp->max_twilight_points
- * sizeof *interpreter->twilight_x),
- size, &size))
+ if (ckd_add (&size, size, (maxp->max_twilight_points
+ * sizeof *interpreter->twilight_x)))
return NULL;
- if (INT_ADD_WRAPV ((maxp->max_twilight_points
- * sizeof *interpreter->twilight_y),
- size, &size))
+ if (ckd_add (&size, size, (maxp->max_twilight_points
+ * sizeof *interpreter->twilight_y)))
return NULL;
- if (INT_ADD_WRAPV ((maxp->max_twilight_points
- * sizeof *interpreter->twilight_y),
- size, &size))
+ if (ckd_add (&size, size, (maxp->max_twilight_points
+ * sizeof *interpreter->twilight_y)))
return NULL;
- if (INT_ADD_WRAPV ((maxp->max_twilight_points
- * sizeof *interpreter->twilight_y),
- size, &size))
+ if (ckd_add (&size, size, (maxp->max_twilight_points
+ * sizeof *interpreter->twilight_y)))
return NULL;
/* Add the storage area. */
storage_size = maxp->max_storage * sizeof *interpreter->storage;
- if (INT_ADD_WRAPV (storage_size, size, &size))
+ if (ckd_add (&size, size, storage_size))
return NULL;
/* Add padding for the storage area. */
pad = alignof (struct sfnt_interpreter_definition);
pad -= size & (pad - 1);
- if (INT_ADD_WRAPV (pad, size, &size))
+ if (ckd_add (&size, size, pad))
return NULL;
/* Add function and instruction definitions. */
- if (INT_ADD_WRAPV ((((int) maxp->max_instruction_defs
- + maxp->max_function_defs)
- * sizeof *interpreter->function_defs),
- size, &size))
+ if (ckd_add (&size, size, (((int) maxp->max_instruction_defs
+ + maxp->max_function_defs)
+ * sizeof *interpreter->function_defs)))
return NULL;
/* Add control value table. */
if (cvt)
{
- if (INT_MULTIPLY_WRAPV (cvt->num_elements,
- sizeof *interpreter->cvt,
- &temp)
- || INT_ADD_WRAPV (temp, size, &size))
+ if (ckd_mul (&temp, cvt->num_elements, sizeof *interpreter->cvt)
+ || ckd_add (&size, size, temp))
return NULL;
}
@@ -6840,7 +6824,7 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter,
(interpreter->SP - interpreter->stack)
#define TRAP(why) \
- sfnt_interpret_trap (interpreter, (why))
+ sfnt_interpret_trap (interpreter, why)
#define MOVE(a, b, n) \
memmove (a, b, (n) * sizeof (uint32_t))
@@ -6944,7 +6928,7 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter,
{ \
int16_t word; \
\
- word = (((int8_t) high) << 8 | low); \
+ word = (((uint8_t) high) << 8 | low); \
PUSH_UNCHECKED (word); \
} \
@@ -7024,14 +7008,18 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter,
#define SLOOP() \
{ \
- uint32_t loop; \
+ int32_t loop; \
\
loop = POP (); \
\
- if (!loop) \
- TRAP ("loop set to 0"); \
+ if (loop < 0) \
+ TRAP ("loop set to invalid value"); \
\
- interpreter->state.loop = loop; \
+ /* N.B. loop might be greater than 65535, \
+ but no reasonable font should define \
+ such values. */ \
+ interpreter->state.loop \
+ = MIN (65535, loop); \
}
#define SMD() \
@@ -7558,12 +7546,13 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter,
#define MUL() \
{ \
- sfnt_f26dot6 n2, n1; \
+ sfnt_f26dot6 n2, n1, r; \
\
n2 = POP (); \
n1 = POP (); \
\
- PUSH_UNCHECKED (sfnt_mul_f26dot6 (n2, n1)); \
+ r = sfnt_mul_f26dot6_round (n2, n1); \
+ PUSH_UNCHECKED (r); \
}
#define ABS() \
@@ -8549,8 +8538,12 @@ sfnt_address_zp2 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->twilight_zone_size)
TRAP ("address to ZP2 (twilight zone) out of bounds");
+ if (!x || !y)
+ goto next;
+
*x = interpreter->twilight_x[number];
*y = interpreter->twilight_y[number];
+ next:
if (!x_org || !y_org)
return;
@@ -8570,8 +8563,11 @@ sfnt_address_zp2 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->glyph_zone->num_points)
TRAP ("address to ZP2 (glyph zone) out of bounds");
- *x = interpreter->glyph_zone->x_current[number];
- *y = interpreter->glyph_zone->y_current[number];
+ if (x && y)
+ {
+ *x = interpreter->glyph_zone->x_current[number];
+ *y = interpreter->glyph_zone->y_current[number];
+ }
if (x_org && y_org)
{
@@ -8597,8 +8593,12 @@ sfnt_address_zp1 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->twilight_zone_size)
TRAP ("address to ZP1 (twilight zone) out of bounds");
+ if (!x || !y)
+ goto next;
+
*x = interpreter->twilight_x[number];
*y = interpreter->twilight_y[number];
+ next:
if (!x_org || !y_org)
return;
@@ -8618,8 +8618,11 @@ sfnt_address_zp1 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->glyph_zone->num_points)
TRAP ("address to ZP1 (glyph zone) out of bounds");
- *x = interpreter->glyph_zone->x_current[number];
- *y = interpreter->glyph_zone->y_current[number];
+ if (x && y)
+ {
+ *x = interpreter->glyph_zone->x_current[number];
+ *y = interpreter->glyph_zone->y_current[number];
+ }
if (x_org && y_org)
{
@@ -8645,8 +8648,12 @@ sfnt_address_zp0 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->twilight_zone_size)
TRAP ("address to ZP0 (twilight zone) out of bounds");
+ if (!x || !y)
+ goto next;
+
*x = interpreter->twilight_x[number];
*y = interpreter->twilight_y[number];
+ next:
if (!x_org || !y_org)
return;
@@ -8666,8 +8673,11 @@ sfnt_address_zp0 (struct sfnt_interpreter *interpreter,
if (number >= interpreter->glyph_zone->num_points)
TRAP ("address to ZP0 (glyph zone) out of bounds");
- *x = interpreter->glyph_zone->x_current[number];
- *y = interpreter->glyph_zone->y_current[number];
+ if (x && y)
+ {
+ *x = interpreter->glyph_zone->x_current[number];
+ *y = interpreter->glyph_zone->y_current[number];
+ }
if (x_org && y_org)
{
@@ -8954,7 +8964,7 @@ sfnt_dual_project_vector (struct sfnt_interpreter *interpreter,
static void
sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter,
- uint32_t l, uint32_t h)
+ uint32_t h, uint32_t l)
{
uint32_t i;
@@ -8964,7 +8974,7 @@ sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter,
if (!interpreter->state.zp0)
return;
- for (i = l; i < h; ++i)
+ for (i = l; i <= h; ++i)
interpreter->glyph_zone->flags[i] &= ~01;
}
@@ -8973,7 +8983,7 @@ sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter,
static void
sfnt_interpret_fliprgon (struct sfnt_interpreter *interpreter,
- uint32_t l, uint32_t h)
+ uint32_t h, uint32_t l)
{
uint32_t i;
@@ -8983,8 +8993,8 @@ sfnt_interpret_fliprgon (struct sfnt_interpreter *interpreter,
if (!interpreter->state.zp0)
return;
- for (i = l; i < h; ++i)
- interpreter->glyph_zone->flags[i] |= ~01;
+ for (i = l; i <= h; ++i)
+ interpreter->glyph_zone->flags[i] |= 01;
}
/* Interpret a FLIPPT instruction in INTERPRETER. For loop times, pop
@@ -9628,6 +9638,8 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter)
sfnt_f26dot6 new_distance;
uint32_t p;
sfnt_f26dot6 x, y, original_x, original_y;
+ struct sfnt_interpreter_zone *zone;
+ bool scale;
/* First load both reference points. */
sfnt_address_zp0 (interpreter, interpreter->state.rp1,
@@ -9637,6 +9649,57 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter)
&rp2x, &rp2y, &rp2_original_x,
&rp2_original_y);
+ /* If RP1, RP2, and all arguments all fall within the glyph zone and
+ a simple glyph is loaded, replace their original coordinates as
+ loaded here with coordinates from the unscaled glyph outline. */
+
+ zone = interpreter->glyph_zone;
+ scale = false;
+
+ if (zone && zone->simple
+ && interpreter->state.zp0
+ && interpreter->state.zp1
+ && interpreter->state.zp2)
+ {
+ p = interpreter->state.rp1;
+
+ /* If P is a phantom point... */
+ if (p >= zone->simple->number_of_points)
+ {
+ /* ...scale the phantom point to the size of the original
+ outline. */
+ rp1_original_x = sfnt_div_fixed (rp1_original_x,
+ interpreter->scale);
+ rp1_original_y = sfnt_div_fixed (rp1_original_y,
+ interpreter->scale);
+ }
+ else
+ {
+ rp1_original_x = zone->simple->x_coordinates[p];
+ rp1_original_y = zone->simple->y_coordinates[p];
+ }
+
+ p = interpreter->state.rp2;
+
+ /* If P is a phantom point... */
+ if (p >= zone->simple->number_of_points)
+ {
+ /* ...scale the phantom point to the size of the original
+ outline. */
+ rp2_original_x = sfnt_div_fixed (rp2_original_x,
+ interpreter->scale);
+ rp2_original_y = sfnt_div_fixed (rp2_original_y,
+ interpreter->scale);
+ }
+ else
+ {
+ rp2_original_x = zone->simple->x_coordinates[p];
+ rp2_original_y = zone->simple->y_coordinates[p];
+ }
+
+ scale = true;
+ }
+
/* Get the original distance between of RP1 and RP2 measured
relative to the dual projection vector. */
range = sfnt_dual_project_vector (interpreter,
@@ -9645,6 +9708,9 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter)
sfnt_sub (rp2_original_y,
rp1_original_y));
+ if (scale)
+ range = sfnt_mul_fixed_round (range, interpreter->scale);
+
/* Get the new distance. */
new_range = sfnt_dual_project_vector (interpreter,
sfnt_sub (rp2x, rp1x),
@@ -9658,6 +9724,25 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter)
sfnt_address_zp2 (interpreter, p, &x, &y, &original_x,
&original_y);
+ if (scale)
+ {
+ /* If P is a phantom point... */
+ if (p >= zone->simple->number_of_points)
+ {
+ /* ...scale the phantom point to the size of the original
+ outline. */
+ original_x = sfnt_div_fixed (original_x,
+ interpreter->scale);
+ original_y = sfnt_div_fixed (original_y,
+ interpreter->scale);
+ }
+ else
+ {
+ original_x = zone->simple->x_coordinates[p];
+ original_y = zone->simple->y_coordinates[p];
+ }
+ }
+
/* Now compute the old distance from this point to rp1. */
org_distance
= sfnt_dual_project_vector (interpreter,
@@ -9666,6 +9751,10 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter)
sfnt_sub (original_y,
rp1_original_y));
+ if (scale)
+ org_distance = sfnt_mul_fixed_round (org_distance,
+ interpreter->scale);
+
/* And the current distance from this point to rp1, so
how much to move can be determined. */
cur_distance
@@ -10570,6 +10659,7 @@ sfnt_dot_fix_14 (int32_t ax, int32_t ay, int bx, int by)
return (int32_t) (((uint32_t) hi << 18) | (l >> 14));
#else
int64_t xx, yy;
+ int64_t temp;
xx = (int64_t) ax * bx;
yy = (int64_t) ay * by;
@@ -10578,7 +10668,12 @@ sfnt_dot_fix_14 (int32_t ax, int32_t ay, int bx, int by)
yy = xx >> 63;
xx += 0x2000 + yy;
- return (int32_t) (xx / (1 << 14));
+ /* TrueType fonts rely on "division" here truncating towards
+ negative infinity, so compute the arithmetic right shift in place
+ of division. */
+ temp = -(xx < 0);
+ temp = (temp ^ xx) >> 14 ^ temp;
+ return (int32_t) (temp);
#endif
}
@@ -10668,6 +10763,7 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y,
sfnt_f26dot6 versor, k;
sfnt_f2dot14 dot_product;
size_t num;
+ unsigned char *flags_start;
dot_product = interpreter->state.vector_dot_product;
@@ -10680,6 +10776,10 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y,
other out, so the result is 26.6. */
versor = interpreter->state.freedom_vector.x;
+ /* Save flags that it may be restored for the second Y axis
+ loop. */
+ flags_start = flags;
+
if (versor)
{
/* Move along X axis, converting the distance to the freedom
@@ -10699,6 +10799,7 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y,
}
}
+ flags = flags_start;
versor = interpreter->state.freedom_vector.y;
if (versor)
@@ -11040,6 +11141,11 @@ sfnt_interpret_shp (struct sfnt_interpreter *interpreter,
? interpreter->glyph_zone->x_points[p] \
: interpreter->glyph_zone->y_points[p])
+#define load_unscaled(p) \
+ (opcode == 0x31 \
+ ? interpreter->glyph_zone->simple->x_coordinates[p] \
+ : interpreter->glyph_zone->simple->y_coordinates[p])
+
#define IUP_SINGLE_PAIR() \
/* Now make touch_start the first point before, i.e. the first \
touched point in this pair. */ \
@@ -11089,23 +11195,40 @@ sfnt_interpret_shp (struct sfnt_interpreter *interpreter,
if (position >= original_min_pos \
&& position <= original_max_pos) \
{ \
+ /* Compute the ratio between the two touched point positions \
+ and the original position of the point being touched with \
+ positions from the unscaled outline, if at all \
+ possible. */ \
+ \
+ if (interpreter->glyph_zone->simple) \
+ { \
+ org_max_pos = load_unscaled (point_max); \
+ org_min_pos = load_unscaled (point_min); \
+ position = load_unscaled (i); \
+ } \
+ else \
+ { \
+ org_max_pos = original_max_pos; \
+ org_min_pos = original_min_pos; \
+ } \
+ \
/* Handle the degenerate case where original_min_pos and \
original_max_pos have not changed by placing the point in \
the middle. */ \
- if (original_min_pos == original_max_pos) \
+ if (org_min_pos == org_max_pos) \
ratio = 077777; \
else \
/* ... preserve the ratio of i between min_pos and \
max_pos... */ \
ratio = sfnt_div_fixed ((sfnt_sub (position, \
- original_min_pos) \
+ org_min_pos) \
* 1024), \
- (sfnt_sub (original_max_pos, \
- original_min_pos) \
+ (sfnt_sub (org_max_pos, \
+ org_min_pos) \
* 1024)); \
\
delta = sfnt_sub (max_pos, min_pos); \
- delta = sfnt_mul_fixed (ratio, delta); \
+ delta = sfnt_mul_fixed_round (ratio, delta); \
store_point (i, sfnt_add (min_pos, delta)); \
} \
else \
@@ -11140,8 +11263,8 @@ sfnt_interpret_iup_1 (struct sfnt_interpreter *interpreter,
size_t first_point;
size_t point_min, point_max, i;
sfnt_f26dot6 position, min_pos, max_pos, delta, ratio;
- sfnt_f26dot6 original_max_pos;
- sfnt_f26dot6 original_min_pos;
+ sfnt_f26dot6 original_max_pos, org_max_pos;
+ sfnt_f26dot6 original_min_pos, org_min_pos;
/* Find the first touched point. If none is found, simply
return. */
@@ -11227,6 +11350,7 @@ sfnt_interpret_iup_1 (struct sfnt_interpreter *interpreter,
#undef load_point
#undef store_point
#undef load_original
+#undef load_unscaled
/* Interpret an IUP (``interpolate untouched points'') instruction.
INTERPRETER is the interpreter, and OPCODE is the instruction
@@ -11412,6 +11536,64 @@ sfnt_interpret_mirp (struct sfnt_interpreter *interpreter,
interpreter->state.rp0 = p;
}
+/* Return the projection of the two points P1 and P2's original values
+ along the dual projection vector, with P1 inside ZP0 and P2 inside
+ ZP1. If this zone is the glyph zone and the outline positions of
+ those points are directly accessible, project their original
+ positions and scale the result with rounding, so as to prevent
+ rounding-introduced inaccuracies.
+
+ The scenario where such inaccuracies are significant is generally
+ where an Italic glyph is being instructed at small PPEM sizes,
+ during which a point moved by MDAP[rN] is within 1/64th of a
+ pixel's distance from a point on the grid, yet the measurements
+ taken between such a point and the reference point against which
+ the distance to move is computed is such that the position of the
+ point after applying their rounded values differs by one grid
+ coordinate from the font designer's intentions, either exaggerating
+ or neutralizing the slant of the stem to which it belongs.
+
+ This behavior applies only to MDRP (which see), although a similar
+ strategy is also applied while interpreting IP instructions. */
+
+static sfnt_f26dot6
+sfnt_project_zp1_zp0_org (struct sfnt_interpreter *interpreter,
+ uint32_t p1, uint32_t p2)
+{
+ sfnt_fword x1, y1, x2, y2, projection;
+ struct sfnt_simple_glyph *simple;
+ sfnt_f26dot6 org_x1, org_y1, org_x2, org_y2;
+
+ /* Addressing the twilight zone, perhaps only partially. */
+ if (!interpreter->state.zp0
+ || !interpreter->state.zp1
+ /* Not interpreting a glyph. */
+ || !interpreter->glyph_zone
+ /* Not interpreting a simple glyph. */
+ || !interpreter->glyph_zone->simple
+ /* P1 or P2 are phantom points. */
+ || p1 >= interpreter->glyph_zone->simple->number_of_points
+ || p2 >= interpreter->glyph_zone->simple->number_of_points)
+ goto project_normally;
+
+ simple = interpreter->glyph_zone->simple;
+ x1 = simple->x_coordinates[p1];
+ y1 = simple->y_coordinates[p1];
+ x2 = simple->x_coordinates[p2];
+ y2 = simple->y_coordinates[p2];
+
+ /* Compute the projection. */
+ projection = DUAL_PROJECT (x1 - x2, y1 - y2);
+
+ /* Return the projection, scaled with rounding. */
+ return sfnt_mul_fixed_round (projection, interpreter->scale);
+
+ project_normally:
+ sfnt_address_zp1 (interpreter, p1, NULL, NULL, &org_x1, &org_y1);
+ sfnt_address_zp0 (interpreter, p2, NULL, NULL, &org_x2, &org_y2);
+ return DUAL_PROJECT (org_x1 - org_x2, org_y1 - org_y2);
+}
+
/* Interpret an MDRP instruction with the specified OPCODE in
INTERPRETER. Pop a point in ZP1, and move the point until its
distance from RP0 in ZP0 is the same as in the original outline.
@@ -11428,20 +11610,19 @@ sfnt_interpret_mdrp (struct sfnt_interpreter *interpreter,
uint32_t p;
sfnt_f26dot6 distance, applied;
sfnt_f26dot6 current_projection;
- sfnt_f26dot6 x, y, org_x, org_y;
- sfnt_f26dot6 rx, ry, org_rx, org_ry;
+ sfnt_f26dot6 x, y, rx, ry;
/* Point number. */
p = POP ();
/* Load the points. */
- sfnt_address_zp1 (interpreter, p, &x, &y, &org_x, &org_y);
+ sfnt_address_zp1 (interpreter, p, &x, &y, NULL, NULL);
sfnt_address_zp0 (interpreter, interpreter->state.rp0,
- &rx, &ry, &org_rx, &org_ry);
+ &rx, &ry, NULL, NULL);
/* Calculate the distance between P and rp0 prior to hinting. */
- distance = DUAL_PROJECT (org_x - org_rx,
- org_y - org_ry);
+ distance = sfnt_project_zp1_zp0_org (interpreter, p,
+ interpreter->state.rp0);
/* Calculate the distance between P and rp0 as of now in the hinting
process. */
@@ -12159,10 +12340,10 @@ sfnt_interpret_control_value_program (struct sfnt_interpreter *interpreter,
sfnt_interpret_run (interpreter,
SFNT_RUN_CONTEXT_CONTROL_VALUE_PROGRAM);
- /* If instruct_control & 4, then changes to the graphics state made
+ /* If instruct_control & 2, then changes to the graphics state made
in this program should be reverted. */
- if (interpreter->state.instruct_control & 4)
+ if (interpreter->state.instruct_control & 2)
sfnt_init_graphics_state (&interpreter->state);
else
{
@@ -12442,19 +12623,16 @@ sfnt_interpret_simple_glyph (struct sfnt_glyph *glyph,
/* Calculate the size of the zone structure. */
- if (INT_MULTIPLY_WRAPV (glyph->simple->number_of_points + 2,
- sizeof *zone->x_points * 4,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_MULTIPLY_WRAPV (glyph->number_of_contours,
- sizeof *zone->contour_end_points,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_MULTIPLY_WRAPV (glyph->simple->number_of_points + 2,
- sizeof *zone->flags,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_ADD_WRAPV (sizeof *zone, zone_size, &zone_size))
+ if (ckd_mul (&temp, glyph->simple->number_of_points + 2,
+ sizeof *zone->x_points * 4)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_mul (&temp, glyph->number_of_contours,
+ sizeof *zone->contour_end_points)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_mul (&temp, glyph->simple->number_of_points + 2,
+ sizeof *zone->flags)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_add (&zone_size, zone_size, sizeof *zone))
return "Glyph exceeded maximum permissible size";
/* Don't use malloc if possible. */
@@ -12478,6 +12656,7 @@ sfnt_interpret_simple_glyph (struct sfnt_glyph *glyph,
zone->y_current = zone->y_points + zone->num_points;
zone->flags = (unsigned char *) (zone->y_current
+ zone->num_points);
+ zone->simple = glyph->simple;
/* Load x_points and x_current. */
for (i = 0; i < glyph->simple->number_of_points; ++i)
@@ -12740,19 +12919,13 @@ sfnt_interpret_compound_glyph_2 (struct sfnt_glyph *glyph,
zone_size = 0;
zone_was_allocated = false;
- if (INT_MULTIPLY_WRAPV (num_points + 2,
- sizeof *zone->x_points * 4,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_MULTIPLY_WRAPV (num_contours,
- sizeof *zone->contour_end_points,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_MULTIPLY_WRAPV (num_points + 2,
- sizeof *zone->flags,
- &temp)
- || INT_ADD_WRAPV (temp, zone_size, &zone_size)
- || INT_ADD_WRAPV (sizeof *zone, zone_size, &zone_size))
+ if (ckd_mul (&temp, num_points + 2, sizeof *zone->x_points * 4)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_mul (&temp, num_contours, sizeof *zone->contour_end_points)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_mul (&temp, num_points + 2, sizeof *zone->flags)
+ || ckd_add (&zone_size, zone_size, temp)
+ || ckd_add (&zone_size, zone_size, sizeof *zone))
return "Glyph exceeded maximum permissible size";
/* Don't use malloc if possible. */
@@ -12776,6 +12949,7 @@ sfnt_interpret_compound_glyph_2 (struct sfnt_glyph *glyph,
zone->y_current = zone->y_points + zone->num_points;
zone->flags = (unsigned char *) (zone->y_current
+ zone->num_points);
+ zone->simple = NULL;
/* Copy and renumber all contour end points to start from
base_index. */
@@ -13394,16 +13568,12 @@ sfnt_interpret_compound_glyph (struct sfnt_glyph *glyph,
/* Copy the compound glyph data into an instructed outline. */
outline_size = sizeof (*outline);
- if (INT_MULTIPLY_WRAPV (context.num_end_points,
- sizeof *outline->contour_end_points,
- &temp)
- || INT_ADD_WRAPV (outline_size, temp, &outline_size)
- || INT_MULTIPLY_WRAPV (context.num_points,
- sizeof *outline->x_points * 2,
- &temp)
- || INT_ADD_WRAPV (outline_size, temp, &outline_size)
- || INT_ADD_WRAPV (context.num_points, outline_size,
- &outline_size))
+ if (ckd_mul (&temp, context.num_end_points,
+ sizeof *outline->contour_end_points)
+ || ckd_add (&outline_size, outline_size, temp)
+ || ckd_mul (&temp, context.num_points, sizeof *outline->x_points * 2)
+ || ckd_add (&outline_size, outline_size, temp)
+ || ckd_add (&outline_size, outline_size, context.num_points))
{
xfree (context.x_coordinates);
xfree (context.y_coordinates);
@@ -13526,9 +13696,8 @@ sfnt_read_default_uvs_table (int fd, off_t offset)
/* Now, allocate enough to hold the UVS table. */
size = sizeof *uvs;
- if (INT_MULTIPLY_WRAPV (sizeof *uvs->ranges, num_ranges,
- &temp)
- || INT_ADD_WRAPV (temp, size, &size))
+ if (ckd_mul (&temp, num_ranges, sizeof *uvs->ranges)
+ || ckd_add (&size, size, temp))
return NULL;
uvs = xmalloc (size);
@@ -13597,9 +13766,8 @@ sfnt_read_nondefault_uvs_table (int fd, off_t offset)
/* Now, allocate enough to hold the UVS table. */
size = sizeof *uvs;
- if (INT_MULTIPLY_WRAPV (sizeof *uvs->mappings, num_mappings,
- &temp)
- || INT_ADD_WRAPV (temp, size, &size))
+ if (ckd_mul (&temp, num_mappings, sizeof *uvs->mappings)
+ || ckd_add (&size, size, temp))
return NULL;
uvs = xmalloc (size);
@@ -13679,9 +13847,9 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd)
off_t offset;
struct sfnt_uvs_context *context;
- if (INT_MULTIPLY_WRAPV (cmap->num_var_selector_records,
- sizeof *table_offsets, &size)
- || INT_MULTIPLY_WRAPV (size, 2, &size))
+ if (ckd_mul (&size, cmap->num_var_selector_records,
+ sizeof *table_offsets)
+ || ckd_mul (&size, size, 2))
return NULL;
context = NULL;
@@ -13701,9 +13869,8 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd)
if (cmap->records[i].default_uvs_offset)
{
- if (INT_ADD_WRAPV (cmap->offset,
- cmap->records[i].default_uvs_offset,
- &table_offsets[j].offset))
+ if (ckd_add (&table_offsets[j].offset, cmap->offset,
+ cmap->records[i].default_uvs_offset))
goto bail;
table_offsets[j++].is_nondefault_table = false;
@@ -13711,9 +13878,8 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd)
if (cmap->records[i].nondefault_uvs_offset)
{
- if (INT_ADD_WRAPV (cmap->offset,
- cmap->records[i].nondefault_uvs_offset,
- &table_offsets[j].offset))
+ if (ckd_add (&table_offsets[j].offset, cmap->offset,
+ cmap->records[i].nondefault_uvs_offset))
goto bail;
table_offsets[j++].is_nondefault_table = true;
@@ -14151,14 +14317,12 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable)
name identifier, or 3 * sizeof (uint16_t) + axisCount * sizeof
(sfnt_fixed), meaning there is. */
- if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof (sfnt_fixed),
- &temp)
- || INT_ADD_WRAPV (2 * sizeof (uint16_t), temp, &non_ps_size))
+ if (ckd_mul (&temp, fvar->axis_count, sizeof (sfnt_fixed))
+ || ckd_add (&non_ps_size, temp, 2 * sizeof (uint16_t)))
goto bail;
- if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof (sfnt_fixed),
- &temp)
- || INT_ADD_WRAPV (3 * sizeof (uint16_t), temp, &ps_size))
+ if (ckd_mul (&temp, fvar->axis_count, sizeof (sfnt_fixed))
+ || ckd_add (&ps_size, temp, 3 * sizeof (uint16_t)))
goto bail;
if (fvar->instance_size != non_ps_size
@@ -14168,8 +14332,7 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable)
/* Now compute the offset of the axis data from the start of the
font file. */
- if (INT_ADD_WRAPV (fvar->offset_to_data, directory->offset,
- &offset))
+ if (ckd_add (&offset, fvar->offset_to_data, directory->offset))
goto bail;
/* Seek there. */
@@ -14186,28 +14349,23 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable)
sfnt_instance) + sizeof (sfnt_fixed) * fvar->instance_count *
fvar->axis_count. */
- if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof *fvar->axis,
- &temp)
- || INT_ADD_WRAPV (min_bytes, temp, &min_bytes))
+ if (ckd_mul (&temp, fvar->axis_count, sizeof *fvar->axis)
+ || ckd_add (&min_bytes, min_bytes, temp))
goto bail;
- pad = alignof (struct sfnt_variation_axis);
+ pad = alignof (struct sfnt_instance);
pad -= min_bytes & (pad - 1);
- if (INT_ADD_WRAPV (min_bytes, pad, &min_bytes))
+ if (ckd_add (&min_bytes, min_bytes, pad))
goto bail;
- if (INT_MULTIPLY_WRAPV (fvar->instance_count,
- sizeof *fvar->instance,
- &temp)
- || INT_ADD_WRAPV (min_bytes, temp, &min_bytes))
+ if (ckd_mul (&temp, fvar->instance_count, sizeof *fvar->instance)
+ || ckd_add (&min_bytes, min_bytes, temp))
goto bail;
- if (INT_MULTIPLY_WRAPV (fvar->instance_count,
- sizeof *fvar->instance->coords,
- &temp)
- || INT_MULTIPLY_WRAPV (temp, fvar->axis_count, &temp)
- || INT_ADD_WRAPV (min_bytes, temp, &min_bytes))
+ if (ckd_mul (&temp, fvar->instance_count, sizeof *fvar->instance->coords)
+ || ckd_mul (&temp, temp, fvar->axis_count)
+ || ckd_add (&min_bytes, min_bytes, temp))
goto bail;
/* Reallocate fvar. */
@@ -14389,9 +14547,9 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable)
goto bail;
/* Figure out how big gvar needs to be. */
- if (INT_ADD_WRAPV (sizeof *gvar, coordinate_size, &min_bytes)
- || INT_ADD_WRAPV (min_bytes, off_size, &min_bytes)
- || INT_ADD_WRAPV (min_bytes, data_size, &min_bytes))
+ if (ckd_add (&min_bytes, coordinate_size, sizeof *gvar)
+ || ckd_add (&min_bytes, min_bytes, off_size)
+ || ckd_add (&min_bytes, min_bytes, data_size))
goto bail;
/* Now allocate enough for all of this extra data. */
@@ -14427,8 +14585,7 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable)
if (gvar->shared_coord_count)
{
- if (INT_ADD_WRAPV (gvar->offset_to_coord, directory->offset,
- &offset))
+ if (ckd_add (&offset, gvar->offset_to_coord, directory->offset))
goto bail;
if (lseek (fd, offset, SEEK_SET) != offset)
@@ -14452,8 +14609,7 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable)
if (gvar->data_size)
{
- if (INT_ADD_WRAPV (gvar->offset_to_data, directory->offset,
- &offset))
+ if (ckd_add (&offset, gvar->offset_to_data, directory->offset))
goto bail;
if (lseek (fd, offset, SEEK_SET) != offset)
@@ -14549,10 +14705,10 @@ sfnt_read_avar_table (int fd, struct sfnt_offset_subtable *subtable)
/* Now add one struct sfnt_short_frac_segment for each axis and
each of its correspondences. */
- if (INT_ADD_WRAPV (sizeof (struct sfnt_short_frac_segment),
- min_size, &min_size)
- || INT_ADD_WRAPV (sizeof (struct sfnt_short_frac_correspondence)
- * buffer[k], min_size, &min_size))
+ if (ckd_add (&min_size, min_size, sizeof (struct sfnt_short_frac_segment))
+ || ckd_add (&min_size, min_size,
+ (sizeof (struct sfnt_short_frac_correspondence)
+ * buffer[k])))
goto bail1;
/* Verify that words from here to buffer[1 + buffer[k] * 2], the
@@ -14901,8 +15057,7 @@ sfnt_read_cvar_table (int fd, struct sfnt_offset_subtable *subtable,
goto bail2;
tuple += sizeof *coords * fvar->axis_count;
- if (INT_ADD_WRAPV (size, sizeof *coords * fvar->axis_count,
- &size))
+ if (ckd_add (&size, size, sizeof *coords * fvar->axis_count))
goto bail2;
}
else
@@ -14914,20 +15069,20 @@ sfnt_read_cvar_table (int fd, struct sfnt_offset_subtable *subtable,
if (index & 0x4000)
{
tuple += fvar->axis_count * 4;
- if (INT_ADD_WRAPV (size, fvar->axis_count * 4, &size))
+ if (ckd_add (&size, size, fvar->axis_count * 4))
goto bail2;
}
/* Add one point and one delta for each CVT element. */
- if (INT_ADD_WRAPV (size, cvt->num_elements * 4, &size))
+ if (ckd_add (&size, size, cvt->num_elements * 4))
goto bail2;
/* Now add the size of the tuple. */
- if (INT_ADD_WRAPV (size, sizeof *cvar->variation, &size))
+ if (ckd_add (&size, size, sizeof *cvar->variation))
goto bail2;
}
- if (INT_ADD_WRAPV (sizeof *cvar, size, &size))
+ if (ckd_add (&size, size, sizeof *cvar))
goto bail2;
/* Reallocate cvar. */
@@ -18459,13 +18614,13 @@ static struct sfnt_interpreter_test all_tests[] =
"SLOOP",
/* PUSHB[0] 2
SLOOP[]
- PUSHB[0] 0
+ PUSHW[0] 255 255 (-1)
SLOOP[] */
(unsigned char []) { 0xb0, 2,
0x17,
- 0xb0, 0,
+ 0xb8, 255, 255,
0x17, },
- 6,
+ 7,
NULL,
sfnt_check_sloop,
},
@@ -20258,7 +20413,8 @@ sfnt_identify_instruction (struct sfnt_interpreter *interpreter)
return buffer;
}
- if (exec_fpgm->instructions
+ if (exec_fpgm
+ && exec_fpgm->instructions
&& where >= exec_fpgm->instructions
&& where < (exec_fpgm->instructions
+ exec_fpgm->num_instructions))
@@ -20529,6 +20685,13 @@ main (int argc, char **argv)
if (!interpreter)
abort ();
+ if (getenv ("SFNT_VERBOSE"))
+ {
+ interpreter->run_hook = sfnt_verbose;
+ interpreter->push_hook = sfnt_push_hook;
+ interpreter->pop_hook = sfnt_pop_hook;
+ }
+
for (i = 0; i < ARRAYELTS (all_tests); ++i)
sfnt_run_interpreter_test (&all_tests[i], interpreter);
@@ -20631,8 +20794,8 @@ main (int argc, char **argv)
return 1;
}
-#define FANCY_PPEM 44
-#define EASY_PPEM 44
+#define FANCY_PPEM 18
+#define EASY_PPEM 18
interpreter = NULL;
head = sfnt_read_head_table (fd, font);
@@ -21023,6 +21186,16 @@ main (int argc, char **argv)
interpreter = sfnt_make_interpreter (maxp, cvt, head,
fvar, FANCY_PPEM,
FANCY_PPEM);
+
+ if (getenv ("SFNT_DEBUG"))
+ interpreter->run_hook = sfnt_run_hook;
+ else if (getenv ("SFNT_VERBOSE"))
+ {
+ interpreter->run_hook = sfnt_verbose;
+ interpreter->push_hook = sfnt_push_hook;
+ interpreter->pop_hook = sfnt_pop_hook;
+ }
+
state = interpreter->state;
if (instance && gvar)
@@ -21236,15 +21409,6 @@ main (int argc, char **argv)
if (interpreter)
{
- if (getenv ("SFNT_DEBUG"))
- interpreter->run_hook = sfnt_run_hook;
- else if (getenv ("SFNT_VERBOSE"))
- {
- interpreter->run_hook = sfnt_verbose;
- interpreter->push_hook = sfnt_push_hook;
- interpreter->pop_hook = sfnt_pop_hook;
- }
-
if (!sfnt_lookup_glyph_metrics (code, &metrics,
hmtx, hhea, maxp))
{
diff --git a/src/sfnt.h b/src/sfnt.h
index 2b92f9f540a..444b1dfe427 100644
--- a/src/sfnt.h
+++ b/src/sfnt.h
@@ -248,7 +248,7 @@ enum sfnt_macintosh_platform_specific_id
SFNT_MACINTOSH_GREEK = 6,
SFNT_MACINTOSH_RUSSIAN = 7,
SFNT_MACINTOSH_RSYMBOL = 8,
- SFNT_MACINTOSH_DEVANGARI = 9,
+ SFNT_MACINTOSH_DEVANAGARI = 9,
SFNT_MACINTOSH_GURMUKHI = 10,
SFNT_MACINTOSH_GUJARATI = 11,
SFNT_MACINTOSH_ORIYA = 12,
@@ -1759,6 +1759,10 @@ struct sfnt_interpreter_zone
/* Pointer to the flags associated with this data. */
unsigned char *flags;
+
+ /* If this structure was produced from a simple glyph, pointer to
+ the simple glyph itself. NULL otherwise. */
+ struct sfnt_simple_glyph *simple;
};
enum
diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c
index 9ead43a9c5d..1ed394b9458 100644
--- a/src/sfntfont-android.c
+++ b/src/sfntfont-android.c
@@ -78,7 +78,7 @@ static size_t max_scanline_buffer_size;
{ \
size_t _size; \
\
- if (INT_MULTIPLY_WRAPV (height, stride, &_size)) \
+ if (ckd_mul (&_size, height, stride)) \
memory_full (SIZE_MAX); \
\
if (_size < MAX_ALLOCA) \
@@ -112,7 +112,7 @@ static size_t max_scanline_buffer_size;
size_t _size; \
void *_temp; \
\
- if (INT_MULTIPLY_WRAPV (height, stride, &_size)) \
+ if (ckd_mul (&_size, height, stride)) \
memory_full (SIZE_MAX); \
\
if (_size > scanline_buffer.buffer_size) \
@@ -770,7 +770,7 @@ init_sfntfont_android (void)
build_string ("Roboto")),
Fcons (build_string ("DejaVu Serif"),
build_string ("Noto Serif")));
- else if (api_level >= 15)
+ else if (api_level >= 14)
/* Android 4.0 and later distribute Roboto in lieu of Droid
Sans. */
Vsfnt_default_family_alist
diff --git a/src/sfntfont.c b/src/sfntfont.c
index 1ad41deac70..fb3feaeaf79 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -1939,13 +1939,51 @@ sfntfont_desc_to_entity (struct sfnt_font_desc *desc, int instance)
return entity;
}
+/* Return whether fewer fields inside the font entity A are set than
+ there are set inside the font entity B. */
+
+static Lisp_Object
+sfntfont_compare_font_entities (Lisp_Object a, Lisp_Object b)
+{
+ ptrdiff_t count_a, count_b, i;
+
+ count_a = 0;
+ count_b = 0;
+
+ for (i = 0; i < FONT_ENTITY_MAX; ++i)
+ {
+ if (!NILP (AREF (a, i)))
+ count_a++;
+ }
+
+ for (i = 0; i < FONT_ENTITY_MAX; ++i)
+ {
+ if (!NILP (AREF (b, i)))
+ count_b++;
+ }
+
+ return count_a < count_b ? Qt : Qnil;
+}
+
+/* Function that compares two font entities to return whether fewer
+ fields are set within the first than in the second. */
+
+static union Aligned_Lisp_Subr Scompare_font_entities =
+ {
+ {
+ { PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS), },
+ { .a2 = sfntfont_compare_font_entities, },
+ 2, 2, "sfntfont_compare_font_entities", {0}, lisp_h_Qnil,
+ },
+ };
+
/* Return a list of font-entities matching the specified
FONT_SPEC. */
Lisp_Object
sfntfont_list (struct frame *f, Lisp_Object font_spec)
{
- Lisp_Object matching, tem;
+ Lisp_Object matching, tem, compare_font_entities;
struct sfnt_font_desc *desc;
int i, rc, instances[100];
@@ -1982,9 +2020,16 @@ sfntfont_list (struct frame *f, Lisp_Object font_spec)
matching);
}
}
-
unblock_input ();
+ /* Sort matching by the number of fields set inside each element, so
+ that values of FONT_SPECs that leave a number of fields
+ unspecified will yield a list with the closest matches (that is
+ to say, those whose fields are precisely as specified by the
+ caller) ordered first. */
+
+ XSETSUBR (compare_font_entities, &Scompare_font_entities.s);
+ matching = CALLN (Fsort, matching, compare_font_entities);
return matching;
}
@@ -3263,7 +3308,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name);
ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer);
ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
+ ASET (font_object, FONT_ADSTYLE_INDEX, desc->adstyle);
ASET (font_object, FONT_REGISTRY_INDEX,
sfntfont_registry_for_desc (desc));
@@ -3281,8 +3326,6 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
FONT_SET_STYLE (font_object, FONT_SLANT_INDEX,
make_fixnum (desc->slant));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
-
/* Clear various offsets. */
font_info->font.baseline_offset = 0;
font_info->font.relative_compose = 0;
@@ -3367,7 +3410,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
AREF (tem, 3));
FONT_SET_STYLE (font_object, FONT_SLANT_INDEX,
AREF (tem, 4));
- ASET (font_object, FONT_ADSTYLE_INDEX, Qnil);
+ ASET (font_object, FONT_ADSTYLE_INDEX, AREF (tem, 1));
}
}
@@ -3736,7 +3779,7 @@ sfntfont_list_family (struct frame *f)
families = Fcons (desc->family, families);
/* Sort families in preparation for removing duplicates. */
- families = Fsort (families, Qstring_lessp);
+ families = CALLN (Fsort, families, Qstring_lessp);
/* Remove each duplicate within families. */
diff --git a/src/sort.c b/src/sort.c
index 5f7a1ee2f53..527d5550342 100644
--- a/src/sort.c
+++ b/src/sort.c
@@ -34,6 +34,90 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
+/* Reverse a slice of a vector in place, from lo up to (exclusive) hi. */
+static void
+reverse_slice(Lisp_Object *lo, Lisp_Object *hi)
+{
+ eassert (lo && hi);
+
+ --hi;
+ while (lo < hi) {
+ Lisp_Object t = *lo;
+ *lo = *hi;
+ *hi = t;
+ ++lo;
+ --hi;
+ }
+}
+
+/* A sortslice contains a pointer to an array of keys and a pointer to
+ an array of corresponding values. In other words, keys[i]
+ corresponds with values[i]. If values == NULL, then the keys are
+ also the values.
+
+ Several convenience routines are provided here, so that keys and
+ values are always moved in sync. */
+
+typedef struct {
+ Lisp_Object *keys;
+ Lisp_Object *values;
+} sortslice;
+
+/* FIXME: Instead of values=NULL, can we set values=keys, so that they
+ are both moved in lockstep and we avoid a lot of branches?
+ We may do some useless work but it might be cheaper overall. */
+
+static inline void
+sortslice_copy (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j)
+{
+ s1->keys[i] = s2->keys[j];
+ if (s1->values != NULL)
+ s1->values[i] = s2->values[j];
+}
+
+static inline void
+sortslice_copy_incr (sortslice *dst, sortslice *src)
+{
+ *dst->keys++ = *src->keys++;
+ if (dst->values != NULL)
+ *dst->values++ = *src->values++;
+}
+
+static inline void
+sortslice_copy_decr (sortslice *dst, sortslice *src)
+{
+ *dst->keys-- = *src->keys--;
+ if (dst->values != NULL)
+ *dst->values-- = *src->values--;
+}
+
+
+static inline void
+sortslice_memcpy (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j,
+ ptrdiff_t n)
+{
+ memcpy (&s1->keys[i], &s2->keys[j], sizeof s1->keys[0] * n);
+ if (s1->values != NULL)
+ memcpy (&s1->values[i], &s2->values[j], sizeof s1->values[0] * n);
+}
+
+static inline void
+sortslice_memmove (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j,
+ ptrdiff_t n)
+{
+ memmove (&s1->keys[i], &s2->keys[j], sizeof s1->keys[0] * n);
+ if (s1->values != NULL)
+ memmove (&s1->values[i], &s2->values[j], sizeof s1->values[0] * n);
+}
+
+static inline void
+sortslice_advance (sortslice *slice, ptrdiff_t n)
+{
+ slice->keys += n;
+ if (slice->values != NULL)
+ slice->values += n;
+}
+
/* MAX_MERGE_PENDING is the maximum number of entries in merge_state's
pending-stretch stack. For a list with n elements, this needs at most
floor(log2(n)) + 1 entries even if we didn't force runs to a
@@ -54,23 +138,24 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
struct stretch
{
- Lisp_Object *base;
+ sortslice base;
ptrdiff_t len;
int power;
};
struct reloc
{
- Lisp_Object **src;
- Lisp_Object **dst;
+ sortslice *src;
+ sortslice *dst;
ptrdiff_t *size;
int order; /* -1 while in merge_lo; +1 while in merg_hi; 0 otherwise. */
};
-typedef struct
+typedef struct merge_state
{
- Lisp_Object *listbase;
+ Lisp_Object *basekeys;
+ Lisp_Object *allocated_keys; /* heap-alloc'ed key array or NULL */
ptrdiff_t listlen;
/* PENDING is a stack of N pending stretches yet to be merged.
@@ -91,7 +176,7 @@ typedef struct
with merges. 'A' initially points to TEMPARRAY, and subsequently
to newly allocated memory if needed. */
- Lisp_Object *a;
+ sortslice a;
ptrdiff_t alloced;
specpdl_ref count;
Lisp_Object temparray[MERGESTATE_TEMP_SIZE];
@@ -102,20 +187,32 @@ typedef struct
struct reloc reloc;
- /* PREDICATE is the lisp comparison predicate for the sort. */
+ /* The C ordering (less-than) predicate. */
+ bool (*pred_fun) (struct merge_state *ms, Lisp_Object a, Lisp_Object b);
+ /* The Lisp ordering predicate; Qnil means value<. */
Lisp_Object predicate;
} merge_state;
-/* Return true iff (PREDICATE A B) is non-nil. */
+static bool
+order_pred_lisp (merge_state *ms, Lisp_Object a, Lisp_Object b)
+{
+ return !NILP (call2 (ms->predicate, a, b));
+}
-static inline bool
-inorder (const Lisp_Object predicate, const Lisp_Object a, const Lisp_Object b)
+static bool
+order_pred_valuelt (merge_state *ms, Lisp_Object a, Lisp_Object b)
{
- return !NILP (call2 (predicate, a, b));
+ return !NILP (Fvaluelt (a, b));
}
+/* Return true iff A < B according to the order predicate. */
+static inline bool
+inorder (merge_state *ms, Lisp_Object a, Lisp_Object b)
+{
+ return ms->pred_fun (ms, a, b);
+}
/* Sort the list starting at LO and ending at HI using a stable binary
insertion sort algorithm. On entry the sublist [LO, START) (with
@@ -124,24 +221,22 @@ inorder (const Lisp_Object predicate, const Lisp_Object a, const Lisp_Object b)
permutation of the input (nothing is lost or duplicated). */
static void
-binarysort (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi,
+binarysort (merge_state *ms, sortslice lo, const Lisp_Object *hi,
Lisp_Object *start)
{
- Lisp_Object pred = ms->predicate;
-
- eassume (lo <= start && start <= hi);
- if (lo == start)
+ eassume (lo.keys <= start && start <= hi);
+ if (lo.keys == start)
++start;
for (; start < hi; ++start)
{
- Lisp_Object *l = lo;
+ Lisp_Object *l = lo.keys;
Lisp_Object *r = start;
Lisp_Object pivot = *r;
eassume (l < r);
do {
Lisp_Object *p = l + ((r - l) >> 1);
- if (inorder (pred, pivot, *p))
+ if (inorder (ms, pivot, *p))
r = p;
else
l = p + 1;
@@ -150,6 +245,17 @@ binarysort (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi,
for (Lisp_Object *p = start; p > l; --p)
p[0] = p[-1];
*l = pivot;
+
+ if (lo.values != NULL)
+ {
+ ptrdiff_t offset = lo.values - lo.keys;
+ Lisp_Object *p = start + offset;
+ pivot = *p;
+ l += offset;
+ for (Lisp_Object *p = start + offset; p > l; --p)
+ p[0] = p[-1];
+ *l = pivot;
+ }
}
}
@@ -167,8 +273,6 @@ static ptrdiff_t
count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi,
bool *descending)
{
- Lisp_Object pred = ms->predicate;
-
eassume (lo < hi);
*descending = 0;
++lo;
@@ -177,12 +281,12 @@ count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi,
return n;
n = 2;
- if (inorder (pred, lo[0], lo[-1]))
+ if (inorder (ms, lo[0], lo[-1]))
{
*descending = 1;
for (lo = lo + 1; lo < hi; ++lo, ++n)
{
- if (!inorder (pred, lo[0], lo[-1]))
+ if (!inorder (ms, lo[0], lo[-1]))
break;
}
}
@@ -190,7 +294,7 @@ count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi,
{
for (lo = lo + 1; lo < hi; ++lo, ++n)
{
- if (inorder (pred, lo[0], lo[-1]))
+ if (inorder (ms, lo[0], lo[-1]))
break;
}
}
@@ -223,21 +327,19 @@ static ptrdiff_t
gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
const ptrdiff_t n, const ptrdiff_t hint)
{
- Lisp_Object pred = ms->predicate;
-
eassume (a && n > 0 && hint >= 0 && hint < n);
a += hint;
ptrdiff_t lastofs = 0;
ptrdiff_t ofs = 1;
- if (inorder (pred, *a, key))
+ if (inorder (ms, *a, key))
{
/* When a[hint] < key, gallop right until
a[hint + lastofs] < key <= a[hint + ofs]. */
const ptrdiff_t maxofs = n - hint; /* This is one after the end of a. */
while (ofs < maxofs)
{
- if (inorder (pred, a[ofs], key))
+ if (inorder (ms, a[ofs], key))
{
lastofs = ofs;
eassume (ofs <= (PTRDIFF_MAX - 1) / 2);
@@ -259,7 +361,7 @@ gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */
while (ofs < maxofs)
{
- if (inorder (pred, a[-ofs], key))
+ if (inorder (ms, a[-ofs], key))
break;
/* Here key <= a[hint - ofs]. */
lastofs = ofs;
@@ -284,7 +386,7 @@ gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
{
ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1);
- if (inorder (pred, a[m], key))
+ if (inorder (ms, a[m], key))
lastofs = m + 1; /* Here a[m] < key. */
else
ofs = m; /* Here key <= a[m]. */
@@ -307,21 +409,19 @@ static ptrdiff_t
gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
const ptrdiff_t n, const ptrdiff_t hint)
{
- Lisp_Object pred = ms->predicate;
-
eassume (a && n > 0 && hint >= 0 && hint < n);
a += hint;
ptrdiff_t lastofs = 0;
ptrdiff_t ofs = 1;
- if (inorder (pred, key, *a))
+ if (inorder (ms, key, *a))
{
/* When key < a[hint], gallop left until
a[hint - ofs] <= key < a[hint - lastofs]. */
const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */
while (ofs < maxofs)
{
- if (inorder (pred, key, a[-ofs]))
+ if (inorder (ms, key, a[-ofs]))
{
lastofs = ofs;
eassume (ofs <= (PTRDIFF_MAX - 1) / 2);
@@ -344,7 +444,7 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
const ptrdiff_t maxofs = n - hint; /* Here &a[n-1] is highest. */
while (ofs < maxofs)
{
- if (inorder (pred, key, a[ofs]))
+ if (inorder (ms, key, a[ofs]))
break;
/* Here a[hint + ofs] <= key. */
lastofs = ofs;
@@ -368,7 +468,7 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
{
ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1);
- if (inorder (pred, key, a[m]))
+ if (inorder (ms, key, a[m]))
ofs = m; /* Here key < a[m]. */
else
lastofs = m + 1; /* Here a[m] <= key. */
@@ -378,21 +478,47 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a,
}
+static void merge_register_cleanup (merge_state *ms);
+
static void
-merge_init (merge_state *ms, const ptrdiff_t list_size, Lisp_Object *lo,
- const Lisp_Object predicate)
+merge_init (merge_state *ms, const ptrdiff_t list_size,
+ Lisp_Object *allocated_keys, sortslice *lo, Lisp_Object predicate)
{
eassume (ms != NULL);
- ms->a = ms->temparray;
- ms->alloced = MERGESTATE_TEMP_SIZE;
+ if (lo->values != NULL)
+ {
+ /* The temporary space for merging will need at most half the list
+ size rounded up. Use the minimum possible space so we can use the
+ rest of temparray for other things. In particular, if there is
+ enough extra space, if will be used to store the keys. */
+ ms->alloced = (list_size + 1) / 2;
+
+ /* ms->alloced describes how many keys will be stored at
+ ms->temparray, but we also need to store the values. Hence,
+ ms->alloced is capped at half of MERGESTATE_TEMP_SIZE. */
+ if (MERGESTATE_TEMP_SIZE / 2 < ms->alloced)
+ ms->alloced = MERGESTATE_TEMP_SIZE / 2;
+ ms->a.values = &ms->temparray[ms->alloced];
+ }
+ else
+ {
+ ms->alloced = MERGESTATE_TEMP_SIZE;
+ ms->a.values = NULL;
+ }
+ ms->a.keys = ms->temparray;
ms->n = 0;
ms->min_gallop = GALLOP_WIN_MIN;
ms->listlen = list_size;
- ms->listbase = lo;
+ ms->basekeys = lo->keys;
+ ms->allocated_keys = allocated_keys;
+ ms->pred_fun = NILP (predicate) ? order_pred_valuelt : order_pred_lisp;
ms->predicate = predicate;
ms->reloc = (struct reloc){NULL, NULL, NULL, 0};
+ ms->count = make_invalid_specpdl_ref ();
+ if (allocated_keys != NULL)
+ merge_register_cleanup (ms);
}
@@ -408,8 +534,10 @@ merge_markmem (void *arg)
if (ms->reloc.size != NULL && *ms->reloc.size > 0)
{
- eassume (ms->reloc.src != NULL);
- mark_objects (*ms->reloc.src, *ms->reloc.size);
+ Lisp_Object *src = (ms->reloc.src->values
+ ? ms->reloc.src->values : ms->reloc.src->keys);
+ eassume (src != NULL);
+ mark_objects (src, *ms->reloc.size);
}
}
@@ -432,16 +560,37 @@ cleanup_mem (void *arg)
if (ms->reloc.order != 0 && *ms->reloc.size > 0)
{
- eassume (*ms->reloc.src != NULL && *ms->reloc.dst != NULL);
+ Lisp_Object *src = (ms->reloc.src->values
+ ? ms->reloc.src->values : ms->reloc.src->keys);
+ Lisp_Object *dst = (ms->reloc.dst->values
+ ? ms->reloc.dst->values : ms->reloc.dst->keys);
+ eassume (src != NULL && dst != NULL);
ptrdiff_t n = *ms->reloc.size;
ptrdiff_t shift = ms->reloc.order == -1 ? 0 : n - 1;
- memcpy (*ms->reloc.dst - shift, *ms->reloc.src, n * word_size);
+ memcpy (dst - shift, src, n * word_size);
}
/* Free any remaining temp storage. */
- xfree (ms->a);
+ if (ms->a.keys != ms->temparray)
+ {
+ xfree (ms->a.keys);
+ ms->a.keys = NULL;
+ }
+
+ if (ms->allocated_keys != NULL)
+ {
+ xfree (ms->allocated_keys);
+ ms->allocated_keys = NULL;
+ }
}
+static void
+merge_register_cleanup (merge_state *ms)
+{
+ specpdl_ref count = SPECPDL_INDEX ();
+ record_unwind_protect_ptr_mark (cleanup_mem, ms, merge_markmem);
+ ms->count = count;
+}
/* Allocate enough temp memory for NEED array slots. Any previously
allocated memory is first freed, and a cleanup routine is
@@ -453,13 +602,12 @@ merge_getmem (merge_state *ms, const ptrdiff_t need)
{
eassume (ms != NULL);
- if (ms->a == ms->temparray)
+ if (ms->a.keys == ms->temparray)
{
/* We only get here if alloc is needed and this is the first
time, so we set up the unwind protection. */
- specpdl_ref count = SPECPDL_INDEX ();
- record_unwind_protect_ptr_mark (cleanup_mem, ms, merge_markmem);
- ms->count = count;
+ if (!specpdl_ref_valid_p (ms->count))
+ merge_register_cleanup (ms);
}
else
{
@@ -467,10 +615,13 @@ merge_getmem (merge_state *ms, const ptrdiff_t need)
what's in the block we don't use realloc which would waste
cycles copying the old data. We just free and alloc
again. */
- xfree (ms->a);
+ xfree (ms->a.keys);
}
- ms->a = xmalloc (need * word_size);
+ ptrdiff_t bytes = (need * word_size) << (ms->a.values != NULL ? 1 : 0);
+ ms->a.keys = xmalloc (bytes);
ms->alloced = need;
+ if (ms->a.values != NULL)
+ ms->a.values = &ms->a.keys[need];
}
@@ -488,21 +639,19 @@ needmem (merge_state *ms, ptrdiff_t na)
NB. */
static void
-merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
- ptrdiff_t nb)
+merge_lo (merge_state *ms, sortslice ssa, ptrdiff_t na,
+ sortslice ssb, ptrdiff_t nb)
{
- Lisp_Object pred = ms->predicate;
-
- eassume (ms && ssa && ssb && na > 0 && nb > 0);
- eassume (ssa + na == ssb);
+ eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0);
+ eassume (ssa.keys + na == ssb.keys);
needmem (ms, na);
- memcpy (ms->a, ssa, na * word_size);
- Lisp_Object *dest = ssa;
+ sortslice_memcpy (&ms->a, 0, &ssa, 0, na);
+ sortslice dest = ssa;
ssa = ms->a;
ms->reloc = (struct reloc){&ssa, &dest, &na, -1};
- *dest++ = *ssb++;
+ sortslice_copy_incr (&dest, &ssb);
--nb;
if (nb == 0)
goto Succeed;
@@ -519,9 +668,9 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
for (;;)
{
eassume (na > 1 && nb > 0);
- if (inorder (pred, *ssb, *ssa))
+ if (inorder (ms, ssb.keys[0], ssa.keys[0]))
{
- *dest++ = *ssb++ ;
+ sortslice_copy_incr (&dest, &ssb);
++bcount;
acount = 0;
--nb;
@@ -532,7 +681,7 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
}
else
{
- *dest++ = *ssa++;
+ sortslice_copy_incr (&dest, &ssa);
++acount;
bcount = 0;
--na;
@@ -552,13 +701,13 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
eassume (na > 1 && nb > 0);
min_gallop -= min_gallop > 1;
ms->min_gallop = min_gallop;
- ptrdiff_t k = gallop_right (ms, ssb[0], ssa, na, 0);
+ ptrdiff_t k = gallop_right (ms, ssb.keys[0], ssa.keys, na, 0);
acount = k;
if (k)
{
- memcpy (dest, ssa, k * word_size);
- dest += k;
- ssa += k;
+ sortslice_memcpy (&dest, 0, &ssa, 0, k);
+ sortslice_advance (&dest, k);
+ sortslice_advance (&ssa, k);
na -= k;
if (na == 1)
goto CopyB;
@@ -567,23 +716,23 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
if (na == 0)
goto Succeed;
}
- *dest++ = *ssb++ ;
+ sortslice_copy_incr (&dest, &ssb);
--nb;
if (nb == 0)
goto Succeed;
- k = gallop_left (ms, ssa[0], ssb, nb, 0);
+ k = gallop_left (ms, ssa.keys[0], ssb.keys, nb, 0);
bcount = k;
if (k)
{
- memmove (dest, ssb, k * word_size);
- dest += k;
- ssb += k;
+ sortslice_memmove (&dest, 0, &ssb, 0, k);
+ sortslice_advance (&dest, k);
+ sortslice_advance (&ssb, k);
nb -= k;
if (nb == 0)
goto Succeed;
}
- *dest++ = *ssa++;
+ sortslice_copy_incr (&dest, &ssa);
--na;
if (na == 1)
goto CopyB;
@@ -595,15 +744,15 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
ms->reloc = (struct reloc){NULL, NULL, NULL, 0};
if (na)
- memcpy (dest, ssa, na * word_size);
+ sortslice_memcpy(&dest, 0, &ssa, 0, na);
return;
CopyB:
eassume (na == 1 && nb > 0);
ms->reloc = (struct reloc){NULL, NULL, NULL, 0};
/* The last element of ssa belongs at the end of the merge. */
- memmove (dest, ssb, nb * word_size);
- dest[nb] = ssa[0];
+ sortslice_memmove (&dest, 0, &ssb, 0, nb);
+ sortslice_copy (&dest, nb, &ssa, 0);
}
@@ -613,25 +762,25 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb,
NB. */
static void
-merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
- Lisp_Object *ssb, ptrdiff_t nb)
+merge_hi (merge_state *ms, sortslice ssa, ptrdiff_t na,
+ sortslice ssb, ptrdiff_t nb)
{
- Lisp_Object pred = ms->predicate;
-
- eassume (ms && ssa && ssb && na > 0 && nb > 0);
- eassume (ssa + na == ssb);
+ eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0);
+ eassume (ssa.keys + na == ssb.keys);
needmem (ms, nb);
- Lisp_Object *dest = ssb;
- dest += nb - 1;
- memcpy(ms->a, ssb, nb * word_size);
- Lisp_Object *basea = ssa;
- Lisp_Object *baseb = ms->a;
- ssb = ms->a + nb - 1;
- ssa += na - 1;
+ sortslice dest = ssb;
+ sortslice_advance (&dest, nb-1);
+ sortslice_memcpy (&ms->a, 0, &ssb, 0, nb);
+ sortslice basea = ssa;
+ sortslice baseb = ms->a;
+ ssb.keys = ms->a.keys + nb - 1;
+ if (ssb.values != NULL)
+ ssb.values = ms->a.values + nb - 1;
+ sortslice_advance (&ssa, na - 1);
ms->reloc = (struct reloc){&baseb, &dest, &nb, 1};
- *dest-- = *ssa--;
+ sortslice_copy_decr (&dest, &ssa);
--na;
if (na == 0)
goto Succeed;
@@ -645,9 +794,9 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
for (;;) {
eassume (na > 0 && nb > 1);
- if (inorder (pred, *ssb, *ssa))
+ if (inorder (ms, ssb.keys[0], ssa.keys[0]))
{
- *dest-- = *ssa--;
+ sortslice_copy_decr (&dest, &ssa);
++acount;
bcount = 0;
--na;
@@ -658,7 +807,7 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
}
else
{
- *dest-- = *ssb--;
+ sortslice_copy_decr (&dest, &ssb);
++bcount;
acount = 0;
--nb;
@@ -677,31 +826,31 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
eassume (na > 0 && nb > 1);
min_gallop -= min_gallop > 1;
ms->min_gallop = min_gallop;
- ptrdiff_t k = gallop_right (ms, ssb[0], basea, na, na - 1);
+ ptrdiff_t k = gallop_right (ms, ssb.keys[0], basea.keys, na, na - 1);
k = na - k;
acount = k;
if (k)
{
- dest += -k;
- ssa += -k;
- memmove(dest + 1, ssa + 1, k * word_size);
+ sortslice_advance (&dest, -k);
+ sortslice_advance (&ssa, -k);
+ sortslice_memmove (&dest, 1, &ssa, 1, k);
na -= k;
if (na == 0)
goto Succeed;
}
- *dest-- = *ssb--;
+ sortslice_copy_decr(&dest, &ssb);
--nb;
if (nb == 1)
goto CopyA;
- k = gallop_left (ms, ssa[0], baseb, nb, nb - 1);
+ k = gallop_left (ms, ssa.keys[0], baseb.keys, nb, nb - 1);
k = nb - k;
bcount = k;
if (k)
{
- dest += -k;
- ssb += -k;
- memcpy(dest + 1, ssb + 1, k * word_size);
+ sortslice_advance (&dest, -k);
+ sortslice_advance (&ssb, -k);
+ sortslice_memcpy (&dest, 1, &ssb, 1, k);
nb -= k;
if (nb == 1)
goto CopyA;
@@ -710,7 +859,7 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
if (nb == 0)
goto Succeed;
}
- *dest-- = *ssa--;
+ sortslice_copy_decr (&dest, &ssa);
--na;
if (na == 0)
goto Succeed;
@@ -721,16 +870,16 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na,
Succeed:
ms->reloc = (struct reloc){NULL, NULL, NULL, 0};
if (nb)
- memcpy (dest - nb + 1, baseb, nb * word_size);
+ sortslice_memcpy (&dest, -(nb-1), &baseb, 0, nb);
return;
CopyA:
eassume (nb == 1 && na > 0);
ms->reloc = (struct reloc){NULL, NULL, NULL, 0};
/* The first element of ssb belongs at the front of the merge. */
- memmove (dest + 1 - na, ssa + 1 - na, na * word_size);
- dest += -na;
- ssa += -na;
- dest[0] = ssb[0];
+ sortslice_memmove (&dest, 1-na, &ssa, 1-na, na);
+ sortslice_advance (&dest, -na);
+ sortslice_advance (&ssa, -na);
+ sortslice_copy (&dest, 0, &ssb, 0);
}
@@ -744,12 +893,12 @@ merge_at (merge_state *ms, const ptrdiff_t i)
eassume (i >= 0);
eassume (i == ms->n - 2 || i == ms->n - 3);
- Lisp_Object *ssa = ms->pending[i].base;
+ sortslice ssa = ms->pending[i].base;
ptrdiff_t na = ms->pending[i].len;
- Lisp_Object *ssb = ms->pending[i + 1].base;
+ sortslice ssb = ms->pending[i + 1].base;
ptrdiff_t nb = ms->pending[i + 1].len;
eassume (na > 0 && nb > 0);
- eassume (ssa + na == ssb);
+ eassume (ssa.keys + na == ssb.keys);
/* Record the length of the combined runs. The current run i+1 goes
away after the merge. If i is the 3rd-last run now, slide the
@@ -761,16 +910,16 @@ merge_at (merge_state *ms, const ptrdiff_t i)
/* Where does b start in a? Elements in a before that can be
ignored (they are already in place). */
- ptrdiff_t k = gallop_right (ms, *ssb, ssa, na, 0);
+ ptrdiff_t k = gallop_right (ms, *ssb.keys, ssa.keys, na, 0);
eassume (k >= 0);
- ssa += k;
+ sortslice_advance (&ssa, k);
na -= k;
if (na == 0)
return;
/* Where does a end in b? Elements in b after that can be ignored
(they are already in place). */
- nb = gallop_left (ms, ssa[na - 1], ssb, nb, nb - 1);
+ nb = gallop_left (ms, ssa.keys[na - 1], ssb.keys, nb, nb - 1);
if (nb == 0)
return;
eassume (nb > 0);
@@ -841,7 +990,7 @@ found_new_run (merge_state *ms, const ptrdiff_t n2)
{
eassume (ms->n > 0);
struct stretch *p = ms->pending;
- ptrdiff_t s1 = p[ms->n - 1].base - ms->listbase;
+ ptrdiff_t s1 = p[ms->n - 1].base.keys - ms->basekeys;
ptrdiff_t n1 = p[ms->n - 1].len;
int power = powerloop (s1, n1, n2, ms->listlen);
while (ms->n > 1 && p[ms->n - 2].power > power)
@@ -898,39 +1047,80 @@ merge_compute_minrun (ptrdiff_t n)
static void
-reverse_vector (Lisp_Object *s, const ptrdiff_t n)
+reverse_sortslice (sortslice *s, const ptrdiff_t n)
{
- for (ptrdiff_t i = 0; i < n >> 1; i++)
- {
- Lisp_Object tem = s[i];
- s[i] = s[n - i - 1];
- s[n - i - 1] = tem;
- }
+ reverse_slice(s->keys, &s->keys[n]);
+ if (s->values != NULL)
+ reverse_slice(s->values, &s->values[n]);
}
-/* Sort the array SEQ with LENGTH elements in the order determined by
- PREDICATE. */
-
-void
-tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length)
+static Lisp_Object
+resolve_fun (Lisp_Object fun)
{
- if (SYMBOLP (predicate))
+ if (SYMBOLP (fun))
{
/* Attempt to resolve the function as far as possible ahead of time,
to avoid having to do it for each call. */
- Lisp_Object fun = XSYMBOL (predicate)->u.s.function;
- if (SYMBOLP (fun))
+ Lisp_Object f = XSYMBOL (fun)->u.s.function;
+ if (SYMBOLP (f))
/* Function was an alias; use slow-path resolution. */
- fun = indirect_function (fun);
+ f = indirect_function (f);
/* Don't resolve to an autoload spec; that would be very slow. */
- if (!NILP (fun) && !(CONSP (fun) && EQ (XCAR (fun), Qautoload)))
- predicate = fun;
+ if (!NILP (f) && !(CONSP (f) && EQ (XCAR (f), Qautoload)))
+ fun = f;
}
+ return fun;
+}
+/* Sort the array SEQ with LENGTH elements in the order determined by
+ PREDICATE (where Qnil means value<) and KEYFUNC (where Qnil means identity),
+ optionally reversed. */
+void
+tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
+ Lisp_Object *seq, const ptrdiff_t length, bool reverse)
+{
+ /* FIXME: hoist this to the caller? */
+ if (EQ (predicate, Qvaluelt))
+ predicate = Qnil;
+ if (!NILP (predicate))
+ predicate = resolve_fun (predicate);
+ if (EQ (keyfunc, Qidentity))
+ keyfunc = Qnil;
+
+ sortslice lo;
+ Lisp_Object *keys;
+ Lisp_Object *allocated_keys = NULL;
merge_state ms;
- Lisp_Object *lo = seq;
- merge_init (&ms, length, lo, predicate);
+ if (reverse)
+ reverse_slice (seq, seq + length); /* preserve stability */
+
+ if (NILP (keyfunc))
+ {
+ keys = NULL;
+ lo.keys = seq;
+ lo.values = NULL;
+ }
+ else
+ {
+ keyfunc = resolve_fun (keyfunc);
+ if (length < MERGESTATE_TEMP_SIZE / 2)
+ keys = &ms.temparray[length + 1];
+ else
+ keys = allocated_keys = xmalloc (length * word_size);
+
+ for (ptrdiff_t i = 0; i < length; i++)
+ keys[i] = call1 (keyfunc, seq[i]);
+
+ lo.keys = keys;
+ lo.values = seq;
+ }
+
+ /* FIXME: This is where we would check the keys for interesting
+ properties for more optimised comparison (such as all being fixnums
+ etc). */
+
+ merge_init (&ms, length, allocated_keys, &lo, predicate);
/* March over the array once, left to right, finding natural runs,
and extending short natural runs to minrun elements. */
@@ -940,19 +1130,19 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length)
bool descending;
/* Identify the next run. */
- ptrdiff_t n = count_run (&ms, lo, lo + nremaining, &descending);
+ ptrdiff_t n = count_run (&ms, lo.keys, lo.keys + nremaining, &descending);
if (descending)
- reverse_vector (lo, n);
+ reverse_sortslice (&lo, n);
/* If the run is short, extend it to min(minrun, nremaining). */
if (n < minrun)
{
- const ptrdiff_t force = nremaining <= minrun ?
- nremaining : minrun;
- binarysort (&ms, lo, lo + force, lo + n);
+ const ptrdiff_t force = min (nremaining, minrun);
+ binarysort (&ms, lo, lo.keys + force, lo.keys + n);
n = force;
}
- eassume (ms.n == 0 || ms.pending[ms.n - 1].base +
- ms.pending[ms.n - 1].len == lo);
+ eassume (ms.n == 0
+ || (ms.pending[ms.n - 1].base.keys + ms.pending[ms.n - 1].len
+ == lo.keys));
found_new_run (&ms, n);
/* Push the new run on to the stack. */
eassume (ms.n < MAX_MERGE_PENDING);
@@ -960,7 +1150,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length)
ms.pending[ms.n].len = n;
++ms.n;
/* Advance to find the next run. */
- lo += n;
+ sortslice_advance(&lo, n);
nremaining -= n;
} while (nremaining);
@@ -969,6 +1159,9 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length)
eassume (ms.pending[0].len == length);
lo = ms.pending[0].base;
- if (ms.a != ms.temparray)
+ if (reverse)
+ reverse_slice (seq, seq + length);
+
+ if (ms.a.keys != ms.temparray || allocated_keys != NULL)
unbind_to (ms.count, Qnil);
}
diff --git a/src/sqlite.c b/src/sqlite.c
index 7a018b28aa4..261080da673 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -349,9 +349,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
value = XCAR (values);
values = XCDR (values);
}
- Lisp_Object type = Ftype_of (value);
-
- if (EQ (type, Qstring))
+ if (STRINGP (value))
{
Lisp_Object encoded;
bool blob = false;
@@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
SSDATA (encoded), SBYTES (encoded),
NULL);
}
- else if (EQ (type, Qinteger))
- {
- if (BIGNUMP (value))
- ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
- else
- ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
- }
- else if (EQ (type, Qfloat))
+ else if (FIXNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
+ else if (BIGNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
+ else if (FLOATP (value))
ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
else if (NILP (value))
ret = sqlite3_bind_null (stmt, i + 1);
diff --git a/src/sysdep.c b/src/sysdep.c
index 3a6829dd27a..cf2985b4b89 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1853,11 +1853,7 @@ init_sigbus (void)
#endif
-/* This does not work on Android and interferes with the system
- tombstone generation. */
-
-#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT \
- && (!defined HAVE_ANDROID || defined ANDROID_STUBIFY)
+#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT
/* Alternate stack used by SIGSEGV handler below. */
@@ -1921,6 +1917,8 @@ stack_overflow (siginfo_t *siginfo)
return 0 <= top - addr && top - addr < (bot - top) >> LG_STACK_HEURISTIC;
}
+/* Signal handler for SIGSEGV before our new handler was installed. */
+static struct sigaction old_sigsegv_handler;
/* Attempt to recover from SIGSEGV caused by C stack overflow. */
@@ -1939,6 +1937,15 @@ handle_sigsegv (int sig, siginfo_t *siginfo, void *arg)
if (!fatal && stack_overflow (siginfo))
siglongjmp (return_to_command_loop, 1);
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* Tombstones (crash reports with stack traces) won't be generated on
+ Android unless the original SIGSEGV handler is installed and the
+ signal is resent, such as by returning from the first signal
+ handler called. */
+ sigaction (SIGSEGV, &old_sigsegv_handler, NULL);
+ return;
+#endif /* HAVE_ANDROID && ANDROID_STUBIFY */
+
/* Otherwise we can't do anything with this. */
deliver_fatal_thread_signal (sig);
}
@@ -1961,7 +1968,7 @@ init_sigsegv (void)
sigfillset (&sa.sa_mask);
sa.sa_sigaction = handle_sigsegv;
sa.sa_flags = SA_SIGINFO | SA_ONSTACK | emacs_sigaction_flags ();
- if (sigaction (SIGSEGV, &sa, NULL) < 0)
+ if (sigaction (SIGSEGV, &sa, &old_sigsegv_handler) < 0)
return 0;
return 1;
@@ -1969,16 +1976,12 @@ init_sigsegv (void)
#else /* not HAVE_STACK_OVERFLOW_HANDLING or WINDOWSNT */
-#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
-
static bool
init_sigsegv (void)
{
return 0;
}
-#endif
-
#endif /* HAVE_STACK_OVERFLOW_HANDLING && !WINDOWSNT */
static void
@@ -2125,10 +2128,8 @@ init_signals (void)
#endif
sigaction (SIGBUS, &thread_fatal_action, 0);
#endif
-#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
if (!init_sigsegv ())
sigaction (SIGSEGV, &thread_fatal_action, 0);
-#endif
#ifdef SIGSYS
sigaction (SIGSYS, &thread_fatal_action, 0);
#endif
diff --git a/src/term.c b/src/term.c
index d3c858c6bf2..3fa244be824 100644
--- a/src/term.c
+++ b/src/term.c
@@ -86,12 +86,12 @@ static AVOID vfatal (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
#ifndef HAVE_ANDROID
#define OUTPUT(tty, a) \
- emacs_tputs ((tty), a, \
+ emacs_tputs (tty, a, \
FRAME_TOTAL_LINES (XFRAME (selected_frame)) - curY (tty), \
cmputc)
-#define OUTPUT1(tty, a) emacs_tputs ((tty), a, 1, cmputc)
-#define OUTPUTL(tty, a, lines) emacs_tputs ((tty), a, lines, cmputc)
+#define OUTPUT1(tty, a) emacs_tputs (tty, a, 1, cmputc)
+#define OUTPUTL(tty, a, lines) emacs_tputs (tty, a, lines, cmputc)
#define OUTPUT_IF(tty, a) \
do { \
@@ -99,7 +99,8 @@ static AVOID vfatal (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
OUTPUT (tty, a); \
} while (0)
-#define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0)
+#define OUTPUT1_IF(tty, a) \
+ do { if (a) emacs_tputs (tty, a, 1, cmputc); } while (0)
#endif
@@ -1117,7 +1118,7 @@ per_line_cost (const char *str)
int *char_ins_del_vector;
-#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))])
+#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS (f)])
static void
calculate_ins_del_char_costs (struct frame *f)
@@ -1630,8 +1631,19 @@ produce_glyphs (struct it *it)
it->pixel_width = it->nglyphs = 0;
else if (it->char_to_display == '\t')
{
+ /* wrap-prefix strings are prepended to continuation lines, so
+ the width of tab characters inside should be computed from
+ the start of this screen line rather than as a product of the
+ total width of the physical line being wrapped. */
int absolute_x = (it->current_x
- + it->continuation_lines_width);
+ + (it->string_from_prefix_prop_p
+ /* Subtract the width of the
+ prefix from it->current_x if
+ it exists. */
+ ? 0 : (it->continuation_lines_width
+ ? (it->continuation_lines_width
+ - it->wrap_prefix_width)
+ : 0)));
int x0 = absolute_x;
/* Adjust for line numbers. */
if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p)
@@ -1703,7 +1715,13 @@ produce_glyphs (struct it *it)
/* Advance current_x by the pixel width as a convenience for
the caller. */
if (it->area == TEXT_AREA)
- it->current_x += it->pixel_width;
+ {
+ it->current_x += it->pixel_width;
+
+ if (it->continuation_lines_width
+ && it->string_from_prefix_prop_p)
+ it->wrap_prefix_width = it->current_x;
+ }
it->ascent = it->max_ascent = it->phys_ascent = it->max_phys_ascent = 0;
it->descent = it->max_descent = it->phys_descent = it->max_phys_descent = 1;
#endif
diff --git a/src/termhooks.h b/src/termhooks.h
index 8defebb20bd..d828c62ce33 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -343,6 +343,10 @@ enum event_kind
the notification that was clicked. */
, NOTIFICATION_CLICKED_EVENT
#endif /* HAVE_HAIKU */
+#ifdef HAVE_ANDROID
+ /* In a NOTIFICATION_EVENT, .arg is a lambda to evaluate. */
+ , NOTIFICATION_EVENT
+#endif /* HAVE_ANDROID */
};
/* Bit width of an enum event_kind tag at the start of structs and unions. */
diff --git a/src/textconv.c b/src/textconv.c
index 2a7b0ed330d..9625c884e16 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -649,8 +649,7 @@ really_commit_text (struct frame *f, EMACS_INT position,
start of the text that was inserted. */
wanted = start;
- if (INT_ADD_WRAPV (wanted, position, &wanted)
- || wanted < BEGV)
+ if (ckd_add (&wanted, wanted, position) || wanted < BEGV)
wanted = BEGV;
if (wanted > ZV)
@@ -664,8 +663,7 @@ really_commit_text (struct frame *f, EMACS_INT position,
TEXT. */
wanted = PT;
- if (INT_ADD_WRAPV (wanted, position - 1, &wanted)
- || wanted > ZV)
+ if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV)
wanted = ZV;
if (wanted < BEGV)
@@ -712,8 +710,7 @@ really_commit_text (struct frame *f, EMACS_INT position,
if (position <= 0)
{
- if (INT_ADD_WRAPV (wanted, position, &wanted)
- || wanted < BEGV)
+ if (ckd_add (&wanted, wanted, position) || wanted < BEGV)
wanted = BEGV;
if (wanted > ZV)
@@ -725,8 +722,7 @@ really_commit_text (struct frame *f, EMACS_INT position,
{
wanted = PT;
- if (INT_ADD_WRAPV (wanted, position - 1, &wanted)
- || wanted > ZV)
+ if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV)
wanted = ZV;
if (wanted < BEGV)
@@ -870,8 +866,7 @@ really_set_composing_text (struct frame *f, ptrdiff_t position,
{
wanted = start;
- if (INT_SUBTRACT_WRAPV (wanted, position, &wanted)
- || wanted < BEGV)
+ if (ckd_sub (&wanted, wanted, position) || wanted < BEGV)
wanted = BEGV;
if (wanted > ZV)
@@ -885,8 +880,7 @@ really_set_composing_text (struct frame *f, ptrdiff_t position,
/* end should be PT after the edit. */
eassert (end == PT);
- if (INT_ADD_WRAPV (wanted, position - 1, &wanted)
- || wanted > ZV)
+ if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV)
wanted = ZV;
if (wanted < BEGV)
@@ -1256,8 +1250,7 @@ really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end,
if (position <= 0)
{
- if (INT_ADD_WRAPV (wanted, position, &wanted)
- || wanted < BEGV)
+ if (ckd_add (&wanted, wanted, position) || wanted < BEGV)
wanted = BEGV;
if (wanted > ZV)
@@ -1269,8 +1262,7 @@ really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end,
{
wanted = PT;
- if (INT_ADD_WRAPV (wanted, position - 1, &wanted)
- || wanted > ZV)
+ if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV)
wanted = ZV;
if (wanted < BEGV)
@@ -1713,11 +1705,8 @@ set_composing_region (struct frame *f, ptrdiff_t start,
{
struct text_conversion_action *action, **last;
- if (start > MOST_POSITIVE_FIXNUM)
- start = MOST_POSITIVE_FIXNUM;
-
- if (end > MOST_POSITIVE_FIXNUM)
- end = MOST_POSITIVE_FIXNUM;
+ start = min (start, MOST_POSITIVE_FIXNUM);
+ end = min (end, MOST_POSITIVE_FIXNUM);
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_COMPOSING_REGION;
@@ -1742,8 +1731,7 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t point,
{
struct text_conversion_action *action, **last;
- if (point > MOST_POSITIVE_FIXNUM)
- point = MOST_POSITIVE_FIXNUM;
+ point = min (point, MOST_POSITIVE_FIXNUM);
action = xmalloc (sizeof *action);
action->operation = TEXTCONV_SET_POINT_AND_MARK;
@@ -2020,8 +2008,8 @@ get_surrounding_text (struct frame *f, ptrdiff_t left,
/* And subtract left and right. */
- if (INT_SUBTRACT_WRAPV (start, left, &start)
- || INT_ADD_WRAPV (end, right, &end))
+ if (ckd_sub (&start, start, left)
+ || ckd_add (&end, end, right))
goto finish;
start = max (start, BEGV);
@@ -2330,6 +2318,7 @@ void
syms_of_textconv (void)
{
DEFSYM (Qaction, "action");
+ DEFSYM (Qpassword, "password");
DEFSYM (Qtext_conversion, "text-conversion");
DEFSYM (Qpush_mark, "push-mark");
DEFSYM (Qunderline, "underline");
@@ -2337,7 +2326,7 @@ syms_of_textconv (void)
"overriding-text-conversion-style");
DEFVAR_LISP ("text-conversion-edits", Vtext_conversion_edits,
- doc: /* List of buffers that were last edited as result of text conversion.
+ doc: /* List of buffers last edited as a result of text conversion.
This list can be used while handling a `text-conversion' event to
determine which changes have taken place.
diff --git a/src/thread.c b/src/thread.c
index 040ca39511e..2f5d7a08838 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -106,6 +106,12 @@ post_acquire_global_lock (struct thread_state *self)
{
struct thread_state *prev_thread = current_thread;
+ /* Switch the JNI interface pointer to the environment assigned to the
+ current thread. */
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ android_java_env = self->java_env;
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
/* Do this early on, so that code below could signal errors (e.g.,
unbind_for_thread_switch might) correctly, because we are already
running in the context of the thread pointed by SELF. */
@@ -126,6 +132,12 @@ post_acquire_global_lock (struct thread_state *self)
set_buffer_internal_2 (current_buffer);
}
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* This step is performed in android_select when built without
+ threads. */
+ android_check_query ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
/* We could have been signaled while waiting to grab the global lock
for the first time since this thread was created, in which case
we didn't yet have the opportunity to set up the handlers. Delay
@@ -756,6 +768,11 @@ run_thread (void *state)
struct thread_state *self = state;
struct thread_state **iter;
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ jint rc;
+#endif /* #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
#ifdef HAVE_NS
/* Allocate an autorelease pool in case this thread calls any
@@ -766,6 +783,16 @@ run_thread (void *state)
void *pool = ns_alloc_autorelease_pool ();
#endif
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ rc
+ = (*android_jvm)->AttachCurrentThread (android_jvm, &self->java_env,
+ NULL);
+ if (rc != JNI_OK)
+ emacs_abort ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
+
self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
@@ -812,6 +839,14 @@ run_thread (void *state)
ns_release_autorelease_pool (pool);
#endif
+#ifdef THREADS_ENABLED
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ rc = (*android_jvm)->DetachCurrentThread (android_jvm);
+ if (rc != JNI_OK)
+ emacs_abort ();
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+#endif /* THREADS_ENABLED */
+
/* Unlink this thread from the list of all threads. Note that we
have to do this very late, after broadcasting our death.
Otherwise the GC may decide to reap the thread_state object,
@@ -1131,6 +1166,10 @@ init_threads (void)
sys_mutex_init (&global_lock);
sys_mutex_lock (&global_lock);
current_thread = &main_thread.s;
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ current_thread->java_env = android_java_env;
+#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
+
main_thread.s.thread_id = sys_thread_self ();
init_bc_thread (&main_thread.s.bc);
}
diff --git a/src/thread.h b/src/thread.h
index 6ce2b7f30df..1844cf03967 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -30,6 +30,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <signal.h> /* sigset_t */
#endif
+#ifdef HAVE_ANDROID
+#ifndef ANDROID_STUBIFY
+#include "android.h"
+#endif /* ANDROID_STUBIFY */
+#endif /* HAVE_ANDROID */
+
#include "sysselect.h" /* FIXME */
#include "systhread.h"
@@ -84,6 +90,11 @@ struct thread_state
Lisp_Object event_object;
/* event_object must be the last Lisp field. */
+#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
+ /* Pointer to an object to call Java functions through. */
+ JNIEnv *java_env;
+#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */
+
/* An address near the bottom of the stack.
Tells GC how to save a copy of the stack. */
char const *m_stack_bottom;
diff --git a/src/timefns.c b/src/timefns.c
index 1541583b485..0ecbb6e6793 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -225,7 +225,7 @@ tzlookup (Lisp_Object zone, bool settz)
if (NILP (zone))
return local_tz;
- else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt))
+ else if (BASE_EQ (zone, make_fixnum (0)) || EQ (zone, Qt))
{
zone_string = "UTC0";
new_tz = utc_tz;
@@ -234,7 +234,7 @@ tzlookup (Lisp_Object zone, bool settz)
{
bool plain_integer = FIXNUMP (zone);
- if (BASE2_EQ (zone, Qwall))
+ if (EQ (zone, Qwall))
zone_string = 0;
else if (STRINGP (zone))
zone_string = SSDATA (ENCODE_SYSTEM (zone));
@@ -1548,7 +1548,7 @@ usage: (decode-time &optional TIME ZONE FORM) */)
/* Compute SEC from LOCAL_TM.tm_sec and HZ. */
Lisp_Object hz = lt.hz, sec;
- if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt))
+ if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt))
sec = make_fixnum (local_tm.tm_sec);
else
{
@@ -1765,10 +1765,8 @@ but new code should not rely on it. */)
well, since we accept it as input? */
struct lisp_time t;
enum timeform input_form = decode_lisp_time (time, false, &t, 0);
- if (NILP (form))
- form = current_time_list ? Qlist : Qt;
- if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form))
- form = SYMBOL_WITH_POS_SYM (form);
+ form = (!NILP (form) ? maybe_remove_pos_from_symbol (form)
+ : current_time_list ? Qlist : Qt);
if (BASE_EQ (form, Qlist))
return ticks_hz_list4 (t.ticks, t.hz);
if (BASE_EQ (form, Qinteger))
diff --git a/src/treesit.c b/src/treesit.c
index 12915ea9a10..d86ab501187 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -3275,11 +3275,11 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
static Lisp_Object
treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language)
{
- Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings);
+ Lisp_Object cons = assq_no_signal (language, Vtreesit_thing_settings);
if (NILP (cons))
return Qnil;
Lisp_Object definitions = XCDR (cons);
- Lisp_Object entry = assq_no_quit (thing, definitions);
+ Lisp_Object entry = assq_no_signal (thing, definitions);
if (NILP (entry))
return Qnil;
/* ENTRY looks like (THING PRED). */
diff --git a/src/verbose.mk.in b/src/verbose.mk.in
index e72c182f276..6efb6b9416b 100644
--- a/src/verbose.mk.in
+++ b/src/verbose.mk.in
@@ -53,38 +53,39 @@ have_working_info = $(filter notintermediate,$(value .FEATURES))
# The workaround is done only for AM_V_ELC and AM_V_ELN,
# since the bug is not annoying elsewhere.
-AM_V_AR = @$(info $ AR $@)
+. :=
+AM_V_AR = @$(info $. AR $@)
AM_V_at = @
-AM_V_CC = @$(info $ CC $@)
-AM_V_CXX = @$(info $ CXX $@)
-AM_V_CCLD = @$(info $ CCLD $@)
-AM_V_CXXLD = @$(info $ CXXLD $@)
+AM_V_CC = @$(info $. CC $@)
+AM_V_CXX = @$(info $. CXX $@)
+AM_V_CCLD = @$(info $. CCLD $@)
+AM_V_CXXLD = @$(info $. CXXLD $@)
ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--)
ifneq (,$(have_working_info))
-AM_V_ELC = @$(info $ ELC+ELN $@)
-AM_V_ELN = @$(info $ ELN $@)
+AM_V_ELC = @$(info $. ELC+ELN $@)
+AM_V_ELN = @$(info $. ELN $@)
else
AM_V_ELC = @echo " ELC+ELN " $@;
AM_V_ELN = @echo " ELN " $@;
endif
else
ifneq (,$(have_working_info))
-AM_V_ELC = @$(info $ ELC $@)
+AM_V_ELC = @$(info $. ELC $@)
else
AM_V_ELC = @echo " ELC " $@;
endif
AM_V_ELN =
endif
-AM_V_GEN = @$(info $ GEN $@)
-AM_V_GLOBALS = @$(info $ GEN globals.h)
+AM_V_GEN = @$(info $. GEN $@)
+AM_V_GLOBALS = @$(info $. GEN globals.h)
AM_V_NO_PD = --no-print-directory
-AM_V_RC = @$(info $ RC $@)
+AM_V_RC = @$(info $. RC $@)
# These are used for the Android port.
-AM_V_JAVAC = @$(info $ JAVAC $@)
-AM_V_D8 = @$(info $ D8 $@)
-AM_V_AAPT = @$(info $ AAPT $@)
+AM_V_JAVAC = @$(info $. JAVAC $@)
+AM_V_D8 = @$(info $. D8 $@)
+AM_V_AAPT = @$(info $. AAPT $@)
AM_V_SILENT = @
endif
diff --git a/src/w16select.c b/src/w16select.c
index c8b91bfa883..ed450c665ff 100644
--- a/src/w16select.c
+++ b/src/w16select.c
@@ -275,7 +275,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw)
{
clipboard_storage_size = truelen + 100;
last_clipboard_text =
- (char *) xrealloc (last_clipboard_text, clipboard_storage_size);
+ xrealloc (last_clipboard_text, clipboard_storage_size);
}
if (last_clipboard_text)
dosmemget (xbuf_addr, truelen, last_clipboard_text);
diff --git a/src/w32.c b/src/w32.c
index f365616db2b..d34ab70f82d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -9414,7 +9414,7 @@ sys_write (int fd, const void * buffer, unsigned int count)
errno = 0;
while (count > 0)
{
- unsigned this_chunk = count < chunk ? count : chunk;
+ unsigned this_chunk = min (count, chunk);
int n = _write (fd, p, this_chunk);
if (n > 0)
@@ -10392,11 +10392,16 @@ check_windows_init_file (void)
}
}
+/* from w32fns.c */
+extern void remove_w32_kbdhook (void);
+
void
term_ntproc (int ignored)
{
(void)ignored;
+ remove_w32_kbdhook ();
+
term_timers ();
/* shutdown the socket interface if necessary */
diff --git a/src/w32console.c b/src/w32console.c
index c2b87928cc1..7dcbc795cac 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -659,6 +659,24 @@ w32_face_attributes (struct frame *f, int face_id)
return char_attr;
}
+/* The IME window is needed to receive the session notifications
+ required to reset the low level keyboard hook state. */
+
+static BOOL CALLBACK
+find_ime_window (HWND hwnd, LPARAM arg)
+{
+ char window_class[32];
+
+ GetClassName (hwnd, window_class, sizeof (window_class));
+ if (strcmp (window_class, "IME") == 0)
+ {
+ *(HWND *) arg = hwnd;
+ return FALSE;
+ }
+ /* keep looking */
+ return TRUE;
+}
+
void
initialize_w32_display (struct terminal *term, int *width, int *height)
{
@@ -705,6 +723,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height)
/* Remember original console settings. */
keyboard_handle = GetStdHandle (STD_INPUT_HANDLE);
GetConsoleMode (keyboard_handle, &prev_console_mode);
+ /* Make sure ENABLE_EXTENDED_FLAGS is set in console settings,
+ otherwise restoring the original setting of ENABLE_MOUSE_INPUT
+ will not work. */
+ prev_console_mode |= ENABLE_EXTENDED_FLAGS;
prev_screen = GetStdHandle (STD_OUTPUT_HANDLE);
@@ -814,11 +836,14 @@ initialize_w32_display (struct terminal *term, int *width, int *height)
else
w32_console_unicode_input = 0;
- /* Setup w32_display_info structure for this frame. */
+ /* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
+ HWND hwnd = NULL;
+ EnumThreadWindows (GetCurrentThreadId (), find_ime_window, (LPARAM) &hwnd);
+
/* Set up the keyboard hook. */
- setup_w32_kbdhook ();
+ setup_w32_kbdhook (hwnd);
}
diff --git a/src/w32fns.c b/src/w32fns.c
index f8de45da7c9..ace8d1016a5 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -47,8 +47,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "w32inevt.h"
#ifdef WINDOWSNT
+/* mingw.org's MinGW headers mistakenly omit this enumeration: */
+# ifndef MINGW_W64
+typedef enum _WTS_VIRTUAL_CLASS {
+ WTSVirtualClientData,
+ WTSVirtualFileHandle
+} WTS_VIRTUAL_CLASS;
+# endif
#include <mbstring.h>
#include <mbctype.h> /* for _getmbcp */
+#include <wtsapi32.h> /* for WTS(Un)RegisterSessionNotification */
#endif /* WINDOWSNT */
#if CYGWIN
@@ -204,6 +212,10 @@ typedef HRESULT (WINAPI * SetWindowTheme_Proc)
typedef HRESULT (WINAPI * DwmSetWindowAttribute_Proc)
(HWND hwnd, DWORD dwAttribute, IN LPCVOID pvAttribute, DWORD cbAttribute);
+typedef BOOL (WINAPI * WTSRegisterSessionNotification_Proc)
+ (HWND hwnd, DWORD dwFlags);
+typedef BOOL (WINAPI * WTSUnRegisterSessionNotification_Proc) (HWND hwnd);
+
TrackMouseEvent_Proc track_mouse_event_fn = NULL;
ImmGetCompositionString_Proc get_composition_string_fn = NULL;
ImmGetContext_Proc get_ime_context_fn = NULL;
@@ -220,6 +232,8 @@ IsDebuggerPresent_Proc is_debugger_present = NULL;
SetThreadDescription_Proc set_thread_description = NULL;
SetWindowTheme_Proc SetWindowTheme_fn = NULL;
DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL;
+WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn = NULL;
+WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL;
extern AppendMenuW_Proc unicode_append_menu;
@@ -291,10 +305,12 @@ static unsigned int sound_type = 0xFFFFFFFF;
/* Special virtual key code for indicating "any" key. */
#define VK_ANY 0xFF
-#ifndef WM_WTSSESSION_CHANGE
+#ifdef WINDOWSNT
+# ifndef WM_WTSSESSION_CHANGE
/* 32-bit MinGW does not define these constants. */
-# define WM_WTSSESSION_CHANGE 0x02B1
-# define WTS_SESSION_LOCK 0x7
+# define WM_WTSSESSION_CHANGE 0x02B1
+# define WTS_SESSION_LOCK 0x7
+# endif
#endif
#ifndef WS_EX_NOACTIVATE
@@ -307,6 +323,7 @@ static struct
int hook_count; /* counter, if several windows are created */
HHOOK hook; /* hook handle */
HWND console; /* console window handle */
+ HWND notified_wnd; /* window that receives session notifications */
int lwindown; /* Left Windows key currently pressed (and hooked) */
int rwindown; /* Right Windows key currently pressed (and hooked) */
@@ -2376,7 +2393,7 @@ w32_init_class (HINSTANCE hinst)
static void
w32_applytheme (HWND hwnd)
{
- if (w32_darkmode)
+ if (w32_darkmode && w32_follow_system_dark_mode)
{
/* Set window theme to that of a built-in Windows app (Explorer),
because it has dark scroll bars and other UI elements. */
@@ -2744,7 +2761,7 @@ funhook (int code, WPARAM w, LPARAM l)
/* Set up the hook; can be called several times, with matching
remove_w32_kbdhook calls. */
void
-setup_w32_kbdhook (void)
+setup_w32_kbdhook (HWND hwnd)
{
kbdhook.hook_count++;
@@ -2800,6 +2817,15 @@ setup_w32_kbdhook (void)
/* Set the hook. */
kbdhook.hook = SetWindowsHookEx (WH_KEYBOARD_LL, funhook,
GetModuleHandle (NULL), 0);
+
+ /* Register session notifications so we get notified about the
+ computer being locked. */
+ kbdhook.notified_wnd = NULL;
+ if (hwnd != NULL && WTSRegisterSessionNotification_fn != NULL)
+ {
+ WTSRegisterSessionNotification_fn (hwnd, NOTIFY_FOR_THIS_SESSION);
+ kbdhook.notified_wnd = hwnd;
+ }
}
}
@@ -2811,7 +2837,11 @@ remove_w32_kbdhook (void)
if (kbdhook.hook_count == 0 && w32_kbdhook_active)
{
UnhookWindowsHookEx (kbdhook.hook);
+ if (kbdhook.notified_wnd != NULL
+ && WTSUnRegisterSessionNotification_fn != NULL)
+ WTSUnRegisterSessionNotification_fn (kbdhook.notified_wnd);
kbdhook.hook = NULL;
+ kbdhook.notified_wnd = NULL;
}
}
#endif /* WINDOWSNT */
@@ -2884,13 +2914,12 @@ check_w32_winkey_state (int vkey)
}
return 0;
}
-#endif /* WINDOWSNT */
/* Reset the keyboard hook state. Locking the workstation with Win-L
leaves the Win key(s) "down" from the hook's point of view - the
keyup event is never seen. Thus, this function must be called when
the system is locked. */
-static void
+void
reset_w32_kbdhook_state (void)
{
kbdhook.lwindown = 0;
@@ -2900,6 +2929,7 @@ reset_w32_kbdhook_state (void)
kbdhook.suppress_lone = 0;
kbdhook.winseen = 0;
}
+#endif /* WINDOWSNT */
/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
between left and right keys as advertised. We test for this
@@ -4129,6 +4159,47 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
return 0;
}
+/* Maybe pass session notification registration to another frame. If
+ the frame with window handle HWND is deleted, we must pass the
+ notifications to some other frame, if they have been sent to this
+ frame before and have not already been passed on. If there is no
+ other frame, do nothing. */
+
+#ifdef WINDOWSNT
+static void
+maybe_pass_notification (HWND hwnd)
+{
+ if (hwnd == kbdhook.notified_wnd
+ && kbdhook.hook_count > 0 && w32_kbdhook_active)
+ {
+ Lisp_Object tail, frame;
+ struct frame *f;
+ bool found_frame = false;
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_W32_P (f) && FRAME_OUTPUT_DATA (f) != NULL
+ && FRAME_W32_WINDOW (f) != hwnd)
+ {
+ found_frame = true;
+ break;
+ }
+ }
+
+ if (found_frame && WTSUnRegisterSessionNotification_fn != NULL
+ && WTSRegisterSessionNotification_fn != NULL)
+ {
+ /* There is another frame, pass on the session notification. */
+ HWND next_wnd = FRAME_W32_WINDOW (f);
+ WTSUnRegisterSessionNotification_fn (hwnd);
+ WTSRegisterSessionNotification_fn (next_wnd, NOTIFY_FOR_THIS_SESSION);
+ kbdhook.notified_wnd = next_wnd;
+ }
+ }
+}
+#endif /* WINDOWSNT */
+
/* Main window procedure */
static LRESULT CALLBACK
@@ -5301,23 +5372,29 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
#ifdef WINDOWSNT
case WM_CREATE:
- setup_w32_kbdhook ();
+ setup_w32_kbdhook (hwnd);
goto dflt;
#endif
case WM_DESTROY:
#ifdef WINDOWSNT
+ maybe_pass_notification (hwnd);
remove_w32_kbdhook ();
#endif
CoUninitialize ();
return 0;
+#ifdef WINDOWSNT
case WM_WTSSESSION_CHANGE:
if (wParam == WTS_SESSION_LOCK)
reset_w32_kbdhook_state ();
goto dflt;
+#endif
case WM_CLOSE:
+#ifdef WINDOWSNT
+ maybe_pass_notification (hwnd);
+#endif
wmsg.dwModifiers = w32_get_modifiers ();
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
return 0;
@@ -11121,12 +11198,20 @@ my_exception_handler (EXCEPTION_POINTERS * exception_data)
return prev_exception_handler (exception_data);
return EXCEPTION_EXECUTE_HANDLER;
}
-#endif
+#endif /* !CYGWIN */
typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
PULONG);
#define BACKTRACE_LIMIT_MAX 62
+/* The below must be kept in sync with the value of the
+ -Wl,-image-base switch we use in LD_SWITCH_SYSTEM_TEMACS, see
+ configure.ac. */
+#if defined MINGW_W64 && EMACS_INT_MAX > LONG_MAX
+# define DEFAULT_IMAGE_BASE (ptrdiff_t)0x400000000
+#else /* 32-bit MinGW build */
+# define DEFAULT_IMAGE_BASE (ptrdiff_t)0x01000000
+#endif
static int
w32_backtrace (void **buffer, int limit)
@@ -11181,6 +11266,13 @@ emacs_abort (void)
{
void *stack[BACKTRACE_LIMIT_MAX + 1];
int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
+#ifdef CYGWIN
+ ptrdiff_t addr_offset = 0;
+#else /* MinGW */
+ /* The offset below is zero unless ASLR is in effect. */
+ ptrdiff_t addr_offset
+ = DEFAULT_IMAGE_BASE - (ptrdiff_t)GetModuleHandle (NULL);
+#endif /* MinGW */
if (i)
{
@@ -11231,8 +11323,13 @@ emacs_abort (void)
{
/* stack[] gives the return addresses, whereas we want
the address of the call, so decrease each address
- by approximate size of 1 CALL instruction. */
- sprintf (buf, "%p\r\n", (char *)stack[j] - sizeof(void *));
+ by approximate size of 1 CALL instruction. We add
+ ADDR_OFFSET to account for ASLR which changes the
+ base address of the program's image in memory,
+ whereas 'addr2line' needs to see addresses relative
+ to the fixed base recorded in the PE header. */
+ sprintf (buf, "%p\r\n",
+ (char *)stack[j] - sizeof(void *) + addr_offset);
if (stderr_fd >= 0)
write (stderr_fd, buf, strlen (buf));
if (errfile_fd >= 0)
@@ -11315,6 +11412,14 @@ globals_of_w32fns (void)
set_thread_description = (SetThreadDescription_Proc)
get_proc_addr (hm_kernel32, "SetThreadDescription");
+#ifdef WINDOWSNT
+ HMODULE wtsapi32_lib = LoadLibrary ("wtsapi32.dll");
+ WTSRegisterSessionNotification_fn = (WTSRegisterSessionNotification_Proc)
+ get_proc_addr (wtsapi32_lib, "WTSRegisterSessionNotification");
+ WTSUnRegisterSessionNotification_fn = (WTSUnRegisterSessionNotification_Proc)
+ get_proc_addr (wtsapi32_lib, "WTSUnRegisterSessionNotification");
+#endif
+
/* Support OS dark mode on Windows 10 version 1809 and higher.
See `w32_applytheme' which uses appropriate APIs per version of Windows.
For future wretches who may need to understand Windows build numbers:
@@ -11373,6 +11478,14 @@ This variable is used for debugging, and takes precedence over any
value of the `inhibit-double-buffering' frame parameter. */);
w32_disable_double_buffering = false;
+ DEFVAR_BOOL ("w32-follow-system-dark-mode", w32_follow_system_dark_mode,
+ doc: /* Whether to follow the system's Dark mode on MS-Windows.
+If this is nil, Emacs on MS-Windows will not follow the system's Dark
+mode as far as the appearance of title bars and scroll bars is
+concerned, it will always use the default Light mode instead.
+Changing the value takes effect only for frames created after the change. */);
+ w32_follow_system_dark_mode = true;
+
if (os_subtype == OS_SUBTYPE_NT)
w32_unicode_gui = 1;
else
diff --git a/src/w32font.c b/src/w32font.c
index c4718053a34..56061c0d9ce 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -2265,14 +2265,14 @@ font_supported_scripts (FONTSIGNATURE * sig)
/* Match a single subrange. SYM is set if bit N is set in subranges. */
#define SUBRANGE(n,sym) \
if (subranges[(n) / 32] & (1U << ((n) % 32))) \
- supported = Fcons ((sym), supported)
+ supported = Fcons (sym, supported)
/* Match multiple subranges. SYM is set if any MASK bit is set in
subranges[0 - 3]. */
#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
|| (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
- supported = Fcons ((sym), supported)
+ supported = Fcons (sym, supported)
/* 0: ASCII (a.k.a. "Basic Latin"),
1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B,
diff --git a/src/w32notify.c b/src/w32notify.c
index 9f8a62a1daa..c93e8796fe2 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -350,6 +350,7 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags)
xfree (dirwatch->io_info);
xfree (dirwatch->watchee);
xfree (dirwatch);
+ return NULL;
}
return dirwatch;
}
@@ -412,10 +413,7 @@ add_watch (const char *parent_dir, const char *file, BOOL subdirs, DWORD flags)
return NULL;
if ((dirwatch = start_watching (file, hdir, subdirs, flags)) == NULL)
- {
- CloseHandle (hdir);
- dirwatch->dir = NULL;
- }
+ CloseHandle (hdir);
return dirwatch;
}
diff --git a/src/w32term.c b/src/w32term.c
index 816584a13be..7afd1303b4d 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -776,12 +776,13 @@ w32_buffer_flipping_unblocked_hook (struct frame *f)
/* Flip buffers on F if drawing has happened. This function is not
called to flush the display connection of a frame (which doesn't
- exist on MS Windows), but also called in some situations in
+ exist on MS Windows), but is called in some situations in
minibuf.c to make the contents of the back buffer visible. */
void
w32_flip_buffers_if_dirty (struct frame *f)
{
- if (FRAME_OUTPUT_DATA (f)->paint_buffer
+ if (FRAME_W32_P (f) /* do nothing in TTY frames */
+ && FRAME_OUTPUT_DATA (f)->paint_buffer
&& FRAME_OUTPUT_DATA (f)->paint_buffer_dirty
&& !f->garbaged && !buffer_flipping_blocked_p ())
w32_show_back_buffer (f);
@@ -949,7 +950,7 @@ w32_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd)
{
int i = max_fringe_bmp;
max_fringe_bmp = which + 20;
- fringe_bmp = (HBITMAP *) xrealloc (fringe_bmp, max_fringe_bmp * sizeof (HBITMAP));
+ fringe_bmp = xrealloc (fringe_bmp, max_fringe_bmp * sizeof (HBITMAP));
while (i < max_fringe_bmp)
fringe_bmp[i++] = 0;
}
diff --git a/src/w32term.h b/src/w32term.h
index 29ace0b2797..3120c8bd71f 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -779,8 +779,9 @@ extern bool w32_image_rotations_p (void);
#ifdef WINDOWSNT
/* Keyboard hooks. */
-extern void setup_w32_kbdhook (void);
+extern void setup_w32_kbdhook (HWND);
extern void remove_w32_kbdhook (void);
+extern void reset_w32_kbdhook_state (void);
extern int check_w32_winkey_state (int);
#define w32_kbdhook_active (os_subtype != OS_SUBTYPE_9X)
#else
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index a73c0de06f9..b3112912c76 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -33,11 +33,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef HAVE_HARFBUZZ
# include <hb.h>
# include <hb-ot.h> /* for hb_ot_font_set_funcs */
-# if GNUC_PREREQ (4, 3, 0)
-# define bswap_32(v) __builtin_bswap32(v)
-# else
-# include <byteswap.h>
-# endif
#endif
#include "lisp.h"
@@ -330,8 +325,7 @@ uniscribe_shape (Lisp_Object lgstring, Lisp_Object direction)
{
/* If that wasn't enough, keep trying with one more run. */
max_items++;
- items = (SCRIPT_ITEM *) xrealloc (items,
- sizeof (SCRIPT_ITEM) * max_items + 1);
+ items = xrealloc (items, sizeof (SCRIPT_ITEM) * max_items + 1);
}
if (FAILED (result))
@@ -1271,7 +1265,11 @@ w32hb_get_font_table (hb_face_t *face, hb_tag_t tag, void *data)
HFONT old_font = SelectObject (context, (HFONT) data);
char *font_data = NULL;
DWORD font_data_size = 0, val;
+#if GNUC_PREREQ (4, 3, 0)
+ DWORD table = __builtin_bswap32 (tag);
+#else
DWORD table = bswap_32 (tag);
+#endif
hb_blob_t *blob = NULL;
val = GetFontData (context, table, 0, font_data, font_data_size);
diff --git a/src/w32xfns.c b/src/w32xfns.c
index fa7d5fbdb61..b248697e658 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -23,6 +23,20 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <windows.h>
#include <windowsx.h>
+#ifdef WINDOWSNT
+/* Override API version to get the required functionality. */
+# undef _WIN32_WINNT
+# define _WIN32_WINNT 0x0501
+/* mingw.org's MinGW headers mistakenly omit this enumeration: */
+# ifndef MINGW_W64
+typedef enum _WTS_VIRTUAL_CLASS {
+ WTSVirtualClientData,
+ WTSVirtualFileHandle
+} WTS_VIRTUAL_CLASS;
+# endif
+#include <wtsapi32.h> /* for WM_WTSSESSION_CHANGE, WTS_SESSION_LOCK */
+#endif /* WINDOWSNT */
+
#include "lisp.h"
#include "frame.h"
#include "w32term.h"
@@ -413,8 +427,18 @@ drain_message_queue (void)
while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE))
{
- if (msg.message == WM_EMACS_FILENOTIFY)
- retval = 1;
+ switch (msg.message)
+ {
+#ifdef WINDOWSNT
+ case WM_WTSSESSION_CHANGE:
+ if (msg.wParam == WTS_SESSION_LOCK)
+ reset_w32_kbdhook_state ();
+ break;
+#endif
+ case WM_EMACS_FILENOTIFY:
+ retval = 1;
+ break;
+ }
TranslateMessage (&msg);
DispatchMessage (&msg);
}
diff --git a/src/window.c b/src/window.c
index 90e47dd7278..fe26311fbb2 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4151,6 +4151,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer,
buffer);
w->start_at_line_beg = false;
w->force_start = false;
+ /* Flush the base_line cache since it applied to another buffer. */
+ w->base_line_number = 0;
}
wset_redisplay (w);
@@ -5331,7 +5333,17 @@ resize_mini_window_apply (struct window *w, int delta)
w->pixel_top = r->pixel_top + r->pixel_height;
w->top_line = r->top_line + r->total_lines;
- /* Enforce full redisplay of the frame. */
+ /* Enforce full redisplay of the frame. If f->redisplay is already
+ set, which it generally is in the wake of a ConfigureNotify
+ (frame resize) event, merely setting f->redisplay is insufficient
+ for redisplay_internal to continue redisplaying the frame, as
+ redisplay_internal cannot distinguish between f->redisplay set
+ before it calls redisplay_window and that after, so garbage the
+ frame as well. */
+
+ if (f->redisplay)
+ SET_FRAME_GARBAGED (f);
+
/* FIXME: Shouldn't some of the caller do it? */
fset_redisplay (f);
adjust_frame_glyphs (f);
@@ -5368,7 +5380,14 @@ grow_mini_window (struct window *w, int delta)
grow = call3 (Qwindow__resize_root_window_vertically,
root, make_fixnum (- delta), Qt);
- if (FIXNUMP (grow) && window_resize_check (r, false))
+ if (FIXNUMP (grow)
+ /* It might be impossible to resize the window, in which case
+ calling resize_mini_window_apply will set off an infinite
+ loop where the redisplay cycle so forced returns to
+ resize_mini_window, making endless attempts to expand the
+ minibuffer window to this impossible size. (bug#69140) */
+ && XFIXNUM (grow) != 0
+ && window_resize_check (r, false))
resize_mini_window_apply (w, -XFIXNUM (grow));
}
}
@@ -6485,13 +6504,16 @@ When calling from a program, supply as argument a number, nil, or `-'. */)
}
DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, Sother_window_for_scrolling, 0, 0, 0,
- doc: /* Return the other window for \"other window scroll\" commands.
-If in the minibuffer, `minibuffer-scroll-window' if non-nil
-specifies the window.
-Otherwise, if `other-window-scroll-buffer' is non-nil, a window
-showing that buffer is used, popping the buffer up if necessary.
-Finally, look for a neighboring window on the selected frame,
-followed by all visible frames on the current terminal. */)
+ doc: /* Return \"the other\" window for \"other window scroll\" commands.
+If in the minibuffer, and `minibuffer-scroll-window' is non-nil,
+it specifies the window to use.
+Otherwise, if `other-window-scroll-buffer' is a buffer, a window
+showing that buffer is the window to use, popping it up if necessary.
+Otherwise, if `other-window-scroll-default' is a function, call it,
+and the window it returns is the window to use.
+Finally, the function looks for a neighboring window on the selected
+frame, followed by windows on all the visible frames on the current
+terminal. */)
(void)
{
Lisp_Object window;
@@ -7090,6 +7112,10 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil,
the mini-window of the frame doesn't get set to the corresponding element
of CONFIGURATION.
+This function consults the variable `window-restore-killed-buffer-windows'
+when restoring a window whose buffer was killed after CONFIGURATION was
+recorded.
+
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
the return value is nil. Otherwise the value is t. */)
@@ -7100,6 +7126,7 @@ the return value is nil. Otherwise the value is t. */)
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
+ Lisp_Object kept_windows = Qnil;
Lisp_Object old_frame = selected_frame;
struct frame *f;
ptrdiff_t old_point = -1;
@@ -7340,6 +7367,13 @@ the return value is nil. Otherwise the value is t. */)
BUF_PT (XBUFFER (w->contents)),
BUF_PT_BYTE (XBUFFER (w->contents)));
w->start_at_line_beg = true;
+ if (FUNCTIONP (window_restore_killed_buffer_windows)
+ && !MINI_WINDOW_P (w))
+ kept_windows = Fcons (listn (6, window, p->buffer,
+ Fmarker_last_position (p->start),
+ Fmarker_last_position (p->pointm),
+ p->dedicated, Qt),
+ kept_windows);
}
else if (!NILP (w->start))
/* Leaf window has no live buffer, get one. */
@@ -7355,11 +7389,25 @@ the return value is nil. Otherwise the value is t. */)
set_marker_restricted_both (w->pointm, w->contents, 0, 0);
set_marker_restricted_both (w->old_pointm, w->contents, 0, 0);
w->start_at_line_beg = true;
- if (!NILP (w->dedicated))
- /* Record this window as dead. */
- dead_windows = Fcons (window, dead_windows);
- /* Make sure window is no more dedicated. */
- wset_dedicated (w, Qnil);
+ if (!MINI_WINDOW_P (w))
+ {
+ if (FUNCTIONP (window_restore_killed_buffer_windows))
+ kept_windows
+ = Fcons (listn (6, window, p->buffer,
+ Fmarker_last_position (p->start),
+ Fmarker_last_position (p->pointm),
+ p->dedicated, Qnil),
+ kept_windows);
+ else if (EQ (window_restore_killed_buffer_windows, Qdelete)
+ || (!NILP (p->dedicated)
+ && (NILP (window_restore_killed_buffer_windows)
+ || EQ (window_restore_killed_buffer_windows,
+ Qdedicated))))
+ /* Try to delete this window later. */
+ dead_windows = Fcons (window, dead_windows);
+ /* Make sure window is no more dedicated. */
+ wset_dedicated (w, Qnil);
+ }
}
}
@@ -7463,6 +7511,11 @@ the return value is nil. Otherwise the value is t. */)
minibuf_selected_window = data->minibuf_selected_window;
SAFE_FREE ();
+
+ if (!NILP (Vrun_hooks) && FUNCTIONP (window_restore_killed_buffer_windows))
+ safe_calln (window_restore_killed_buffer_windows,
+ frame, kept_windows, Qconfiguration);
+
return FRAME_LIVE_P (f) ? Qt : Qnil;
}
@@ -7826,7 +7879,11 @@ means no margin.
Leave margins unchanged if WINDOW is not large enough to accommodate
margins of the desired width. Return t if any margin was actually
-changed and nil otherwise. */)
+changed and nil otherwise.
+
+The margins specified by calling this function may be later overridden
+by invoking `set-window-buffer' for the same WINDOW, with its
+KEEP-MARGINS argument nil or omitted. */)
(Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width)
{
struct window *w = set_window_margins (decode_live_window (window),
@@ -8456,6 +8513,9 @@ syms_of_window (void)
DEFSYM (Qheader_line_format, "header-line-format");
DEFSYM (Qtab_line_format, "tab-line-format");
DEFSYM (Qno_other_window, "no-other-window");
+ DEFSYM (Qconfiguration, "configuration");
+ DEFSYM (Qdelete, "delete");
+ DEFSYM (Qdedicated, "dedicated");
DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function,
doc: /* Non-nil means call as function to display a help buffer.
@@ -8613,6 +8673,62 @@ its buffer or its total or body size since the last redisplay. Each
call is performed with the frame temporarily selected. */);
Vwindow_configuration_change_hook = Qnil;
+ DEFVAR_LISP ("window-restore-killed-buffer-windows",
+ window_restore_killed_buffer_windows,
+ doc: /* Control restoring windows whose buffer was killed.
+This variable specifies how the functions `set-window-configuration' and
+`window-state-put' shall handle a window whose buffer has been killed
+since the corresponding configuration or state was recorded. Any such
+window may be live -- in which case it shows some other buffer -- or
+dead at the time one of these functions is called.
+
+By default, `set-window-configuration' leaves the window alone if it is
+live, while `window-state-put' deletes it. The following values can be
+used to override the default behavior for dead windows in the case of
+`set-window-configuration' and for dead and live windows in the case of
+`window-state-put'.
+
+ - t means to restore the window and show some other buffer in it.
+
+ - `delete' means to try to delete the window.
+
+ - `dedicated' means to try to delete the window if and only if it is
+ dedicated to its buffer.
+
+ - nil, the default, which means that `set-window-configuration' will
+ try to delete the window if and only if it is dedicated to its
+ buffer while `window-state-put' will unconditionally try to delete
+ it.
+
+ - a function means to restore the window and show some other buffer in
+ it, like if the value were t, but also to add an entry for that
+ window to a list that will be later passed as argument to that
+ function.
+
+If a window cannot be deleted (typically, because it is the last window
+on its frame), show another buffer in it.
+
+If the value is a function, it should take three arguments. The first
+argument specifies the frame whose windows have been restored. The
+third argument is the symbol `configuration' if the windows are
+restored by `set-window-configuration' and the symbol `state' if the
+windows are restored by `window-state-put'.
+
+The second argument specifies a list of entries for all windows whose
+previous buffers have been found dead at the time
+`set-window-configuration' or `window-state-put' tried to restore them
+(minibuffer windows are excluded). This means that the function
+specified by this variable may also delete windows which were found to
+be alive by `set-window-configuration'.
+
+Each entry is a list of six values: the window whose buffer was found
+dead, the dead buffer or its name, the positions of window-start and
+window-point of the buffer in that window, the dedicated state of the
+window as reported by `window-dedicated-p', and a boolean -- t if the
+window was live when `set-window-configuration' tried to restore it,
+and nil otherwise. */);
+ window_restore_killed_buffer_windows = Qnil;
+
DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay,
doc: /* Non-nil means `recenter' redraws entire frame.
If this option is non-nil, then the `recenter' command with a nil
diff --git a/src/window.h b/src/window.h
index 31fcbbd5541..19283725931 100644
--- a/src/window.h
+++ b/src/window.h
@@ -595,11 +595,11 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Non-nil if window W is leaf window (has a buffer). */
#define WINDOW_LEAF_P(W) \
- (BUFFERP ((W)->contents))
+ BUFFERP ((W)->contents)
/* Non-nil if window W is internal (is a parent window). */
#define WINDOW_INTERNAL_P(W) \
- (WINDOWP ((W)->contents))
+ WINDOWP ((W)->contents)
/* True if window W is a horizontal combination of windows. */
#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
@@ -610,7 +610,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
(WINDOW_INTERNAL_P (W) && !(W)->horizontal)
/* Window W's XFRAME. */
-#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
+#define WINDOW_XFRAME(W) XFRAME (WINDOW_FRAME (W))
/* Whether window W is a pseudo window. */
#define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p)
@@ -630,11 +630,11 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Return the canonical column width of the frame of window W. */
#define WINDOW_FRAME_COLUMN_WIDTH(W) \
- (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W))))
+ FRAME_COLUMN_WIDTH (WINDOW_XFRAME (W))
/* Return the canonical line height of the frame of window W. */
#define WINDOW_FRAME_LINE_HEIGHT(W) \
- (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W))))
+ FRAME_LINE_HEIGHT (WINDOW_XFRAME (W))
/* Return the pixel width of window W. This includes dividers, scroll
bars, fringes and margins, if any. */
@@ -666,7 +666,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define MIN_SAFE_WINDOW_HEIGHT (1)
#define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \
- (WINDOW_FRAME_LINE_HEIGHT (W))
+ WINDOW_FRAME_LINE_HEIGHT (W)
/* True if window W has no other windows to its left on its frame. */
#define WINDOW_LEFTMOST_P(W) \
@@ -1011,7 +1011,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Height in pixels of the mode line.
May be zero if W doesn't have a mode line. */
#define WINDOW_MODE_LINE_HEIGHT(W) \
- (window_wants_mode_line ((W)) \
+ (window_wants_mode_line (W) \
? CURRENT_MODE_LINE_HEIGHT (W) \
: 0)
@@ -1049,7 +1049,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Pixel height of window W without mode and header/tab line and bottom
divider. */
#define WINDOW_BOX_TEXT_HEIGHT(W) \
- (WINDOW_PIXEL_HEIGHT ((W)) \
+ (WINDOW_PIXEL_HEIGHT (W) \
- WINDOW_BOTTOM_DIVIDER_WIDTH (W) \
- WINDOW_SCROLL_BAR_AREA_HEIGHT (W) \
- WINDOW_MODE_LINE_HEIGHT (W) \
@@ -1065,7 +1065,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Convert window W relative pixel X to frame pixel coordinates. */
#define WINDOW_TO_FRAME_PIXEL_X(W, X) \
- ((X) + WINDOW_BOX_LEFT_EDGE_X ((W)))
+ ((X) + WINDOW_BOX_LEFT_EDGE_X (W))
/* Convert window W relative pixel Y to frame pixel coordinates. */
#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \
@@ -1073,7 +1073,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Convert frame relative pixel X to window relative pixel X. */
#define FRAME_TO_WINDOW_PIXEL_X(W, X) \
- ((X) - WINDOW_BOX_LEFT_EDGE_X ((W)))
+ ((X) - WINDOW_BOX_LEFT_EDGE_X (W))
/* Convert frame relative pixel Y to window relative pixel Y. */
#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \
@@ -1082,7 +1082,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Convert a text area relative x-position in window W to frame X
pixel coordinates. */
#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \
- (window_box_left ((W), TEXT_AREA) + (X))
+ window_box_left (W, TEXT_AREA) + (X)
/* This is the window in which the terminal's cursor should be left when
nothing is being done with it. This must always be a leaf window, and its
diff --git a/src/xdisp.c b/src/xdisp.c
index aeaf8b34652..140d71129f3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2508,7 +2508,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int
r.x = s->clip_head->x;
}
if (s->clip_tail)
- if (r.x + r.width > s->clip_tail->x + s->clip_tail->background_width)
+ if (r.x + (int) r.width > s->clip_tail->x + s->clip_tail->background_width)
{
if (s->clip_tail->x + s->clip_tail->background_width >= r.x)
r.width = s->clip_tail->x + s->clip_tail->background_width - r.x;
@@ -2588,7 +2588,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int
height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent + glyph->descent);
if (height < r.height)
{
- max_y = r.y + r.height;
+ max_y = r.y + (int) r.height;
r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height));
r.height = min (max_y - r.y, height);
}
@@ -2629,7 +2629,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int
if (s->for_overlaps & OVERLAPS_PRED)
{
rs[i] = r;
- if (r.y + r.height > row_y)
+ if (r.y + (int) r.height > row_y)
{
if (r.y < row_y)
rs[i].height = row_y - r.y;
@@ -2643,10 +2643,10 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int
rs[i] = r;
if (r.y < row_y + s->row->visible_height)
{
- if (r.y + r.height > row_y + s->row->visible_height)
+ if (r.y + (int) r.height > row_y + s->row->visible_height)
{
rs[i].y = row_y + s->row->visible_height;
- rs[i].height = r.y + r.height - rs[i].y;
+ rs[i].height = r.y + (int) r.height - rs[i].y;
}
else
rs[i].height = 0;
@@ -2831,7 +2831,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
text_glyph:
gr = 0; gy = 0;
for (; r <= end_row && r->enabled_p; ++r)
- if (r->y + r->height > y)
+ if (r->y + (int) r->height > y)
{
gr = r; gy = r->y;
break;
@@ -2931,7 +2931,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
row_glyph:
gr = 0, gy = 0;
for (; r <= end_row && r->enabled_p; ++r)
- if (r->y + r->height > y)
+ if (r->y + (int) r->height > y)
{
gr = r; gy = r->y;
break;
@@ -3072,10 +3072,24 @@ dsafe__call (bool inhibit_quit, Lisp_Object (f) (ptrdiff_t, Lisp_Object *),
return val;
}
+static Lisp_Object
+funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args)
+{
+ /* If an error is signaled during a Lisp hook in redisplay, write a
+ backtrace into the buffer *Redisplay-trace*. */
+ push_handler_bind (list_of_error, Qdebug_early__muted, 0);
+ Lisp_Object res = Ffuncall (nargs, args);
+ pop_handler ();
+ return res;
+}
+
#define SAFE_CALLMANY(inhibit_quit, f, array) \
- dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array)
-#define dsafe_calln(inhibit_quit, ...) \
- SAFE_CALLMANY ((inhibit_quit), Ffuncall, ((Lisp_Object []) {__VA_ARGS__}))
+ dsafe__call (inhibit_quit, f, ARRAYELTS (array), array)
+#define dsafe_calln(inhibit_quit, ...) \
+ SAFE_CALLMANY (inhibit_quit, \
+ backtrace_on_redisplay_error \
+ ? funcall_with_backtraces : Ffuncall, \
+ ((Lisp_Object []) {__VA_ARGS__}))
static Lisp_Object
dsafe_call1 (Lisp_Object f, Lisp_Object arg)
@@ -3807,7 +3821,7 @@ start_display (struct it *it, struct window *w, struct text_pos pos)
it->current_y = first_y;
it->vpos = 0;
- it->current_x = it->hpos = 0;
+ it->current_x = it->hpos = it->wrap_prefix_width = 0;
}
}
}
@@ -4331,10 +4345,7 @@ compute_stop_pos (struct it *it)
}
}
- if (it->cmp_it.id < 0
- && (STRINGP (it->string)
- || ((!it->bidi_p || it->bidi_it.scan_dir >= 0)
- && it->cmp_it.stop_pos <= IT_CHARPOS (*it))))
+ if (it->cmp_it.id < 0)
{
ptrdiff_t stoppos = it->end_charpos;
@@ -4342,8 +4353,10 @@ compute_stop_pos (struct it *it)
an automatic composition, limit the search of composable
characters to that position. */
if (it->bidi_p && it->bidi_it.scan_dir < 0)
- stoppos = -1;
- else if (cmp_limit_pos > 0)
+ stoppos = bidi_level_start (it->bidi_it.resolved_level) - 1;
+ else if (!STRINGP (it->string)
+ && it->cmp_it.stop_pos <= IT_CHARPOS (*it)
+ && cmp_limit_pos > 0)
stoppos = cmp_limit_pos;
/* Force composition_compute_stop_pos avoid the costly search
for static compositions, since those were already found by
@@ -5048,31 +5061,169 @@ handle_invisible_prop (struct it *it)
{
enum prop_handled handled = HANDLED_NORMALLY;
int invis;
- Lisp_Object prop;
+ ptrdiff_t curpos, endpos;
+ Lisp_Object prop, pos, overlay;
+ /* Get the value of the invisible text property at the current
+ position. Value will be nil if there is no such property. */
if (STRINGP (it->string))
{
- Lisp_Object end_charpos, limit;
+ curpos = IT_STRING_CHARPOS (*it);
+ endpos = SCHARS (it->string);
+ pos = make_fixnum (curpos);
+ prop = Fget_text_property (pos, Qinvisible, it->string);
+ }
+ else /* buffer */
+ {
+ curpos = IT_CHARPOS (*it);
+ endpos = ZV;
+ pos = make_fixnum (curpos);
+ prop = get_char_property_and_overlay (pos, Qinvisible, it->window,
+ &overlay);
+ }
- /* Get the value of the invisible text property at the
- current position. Value will be nil if there is no such
- property. */
- end_charpos = make_fixnum (IT_STRING_CHARPOS (*it));
- prop = Fget_text_property (end_charpos, Qinvisible, it->string);
- invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* Do we have anything to do here? */
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ if (invis == 0 || curpos >= it->end_charpos)
+ return handled;
- if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ /* If not bidi, or the bidi iteration is at base paragraph level, we
+ can use a faster method; otherwise we need to check invisibility
+ of every character while bidi-iterating out of invisible text. */
+ bool slow = it->bidi_p && !BIDI_AT_BASE_LEVEL (it->bidi_it);
+ /* Record whether we have to display an ellipsis for the
+ invisible text. */
+ bool display_ellipsis_p = (invis == 2);
+
+ handled = HANDLED_RECOMPUTE_PROPS;
+
+ if (slow)
+ {
+ if (it->bidi_it.first_elt && it->bidi_it.charpos < endpos)
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
+
+ if (STRINGP (it->string))
{
- /* Record whether we have to display an ellipsis for the
- invisible text. */
- bool display_ellipsis_p = (invis == 2);
- ptrdiff_t len, endpos;
+ bool done = false;
+ /* Bidi-iterate out of the invisible part of the string. */
+ do
+ {
+ bidi_move_to_visually_next (&it->bidi_it);
+ if (it->bidi_it.charpos < 0 || it->bidi_it.charpos >= endpos)
+ done = true;
+ else
+ {
+ pos = make_fixnum (it->bidi_it.charpos);
+ prop = Fget_text_property (pos, Qinvisible, it->string);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* If there are adjacent invisible texts, don't lose
+ the second one's ellipsis. */
+ if (invis == 2)
+ display_ellipsis_p = true;
+ }
+ }
+ while (!done && invis != 0);
- handled = HANDLED_RECOMPUTE_PROPS;
+ if (display_ellipsis_p)
+ it->ellipsis_p = true;
+ IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
+ IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos;
+ if (IT_STRING_BYTEPOS (*it) >= endpos)
+ {
+ /* The rest of the string is invisible. If this is an
+ overlay string, proceed with the next overlay string
+ or whatever comes and return a character from there. */
+ if (it->current.overlay_string_index >= 0
+ && !display_ellipsis_p)
+ {
+ next_overlay_string (it);
+ /* Don't check for overlay strings when we just
+ finished processing them. */
+ handled = HANDLED_OVERLAY_STRING_CONSUMED;
+ }
+ }
+ }
+ else
+ {
+ bool done = false;
+ /* Bidi-iterate out of the invisible text. */
+ do
+ {
+ bidi_move_to_visually_next (&it->bidi_it);
+ if (it->bidi_it.charpos < BEGV || it->bidi_it.charpos >= endpos)
+ done = true;
+ else
+ {
+ pos = make_fixnum (it->bidi_it.charpos);
+ prop = Fget_char_property (pos, Qinvisible, it->window);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* If there are adjacent invisible texts, don't lose
+ the second one's ellipsis. */
+ if (invis == 2)
+ display_ellipsis_p = true;
+ }
+ }
+ while (!done && invis != 0);
+
+ IT_CHARPOS (*it) = it->bidi_it.charpos;
+ IT_BYTEPOS (*it) = it->bidi_it.bytepos;
+ if (display_ellipsis_p)
+ {
+ /* Make sure that the glyphs of the ellipsis will get
+ correct `charpos' values. See below for detailed
+ explanation why this is needed. */
+ it->position.charpos = IT_CHARPOS (*it) - 1;
+ it->position.bytepos = CHAR_TO_BYTE (it->position.charpos);
+ }
+ /* If there are before-strings at the start of invisible
+ text, and the text is invisible because of a text
+ property, arrange to show before-strings because 20.x did
+ it that way. (If the text is invisible because of an
+ overlay property instead of a text property, this is
+ already handled in the overlay code.) */
+ if (NILP (overlay)
+ && get_overlay_strings (it, it->stop_charpos))
+ {
+ handled = HANDLED_RECOMPUTE_PROPS;
+ if (it->sp > 0)
+ {
+ it->stack[it->sp - 1].display_ellipsis_p = display_ellipsis_p;
+ /* The call to get_overlay_strings above recomputes
+ it->stop_charpos, but it only considers changes
+ in properties and overlays beyond iterator's
+ current position. This causes us to miss changes
+ that happen exactly where the invisible property
+ ended. So we play it safe here and force the
+ iterator to check for potential stop positions
+ immediately after the invisible text. Note that
+ if get_overlay_strings returns true, it
+ normally also pushed the iterator stack, so we
+ need to update the stop position in the slot
+ below the current one. */
+ it->stack[it->sp - 1].stop_charpos
+ = CHARPOS (it->stack[it->sp - 1].current.pos);
+ }
+ }
+ else if (display_ellipsis_p)
+ {
+ it->ellipsis_p = true;
+ /* Let the ellipsis display before
+ considering any properties of the following char.
+ Fixes jasonr@gnu.org 01 Oct 07 bug. */
+ handled = HANDLED_RETURN;
+ }
+ }
+ }
+ else if (STRINGP (it->string))
+ {
+ Lisp_Object end_charpos = pos, limit;
+
+ if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ {
+ ptrdiff_t len = endpos;
/* Get the position at which the next visible text can be
found in IT->string, if any. */
- endpos = len = SCHARS (it->string);
XSETINT (limit, len);
do
{
@@ -5123,7 +5274,7 @@ handle_invisible_prop (struct it *it)
IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos;
- if (IT_CHARPOS (*it) >= endpos)
+ if (IT_STRING_CHARPOS (*it) >= endpos)
it->prev_stop = endpos;
}
else
@@ -5153,27 +5304,14 @@ handle_invisible_prop (struct it *it)
}
}
}
- else
+ else /* we are iterating over buffer text at base paragraph level */
{
- ptrdiff_t newpos, next_stop, start_charpos, tem;
- Lisp_Object pos, overlay;
-
- /* First of all, is there invisible text at this position? */
- tem = start_charpos = IT_CHARPOS (*it);
- pos = make_fixnum (tem);
- prop = get_char_property_and_overlay (pos, Qinvisible, it->window,
- &overlay);
- invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ ptrdiff_t newpos, next_stop, tem = curpos;
+ Lisp_Object pos;
/* If we are on invisible text, skip over it. */
- if (invis != 0 && start_charpos < it->end_charpos)
+ if (invis != 0 && curpos < it->end_charpos)
{
- /* Record whether we have to display an ellipsis for the
- invisible text. */
- bool display_ellipsis_p = invis == 2;
-
- handled = HANDLED_RECOMPUTE_PROPS;
-
/* Loop skipping over invisible text. The loop is left at
ZV or with IT on the first char being visible again. */
do
@@ -5473,9 +5611,6 @@ display_min_width (struct it *it, ptrdiff_t bufpos,
if (!NILP (it->min_width_property)
&& !EQ (width_spec, it->min_width_property))
{
- if (!it->glyph_row)
- return;
-
/* When called from display_string (i.e., the mode line),
we're being called with a string as the object, and we
may be called with many sub-strings belonging to the same
@@ -5518,7 +5653,13 @@ display_min_width (struct it *it, ptrdiff_t bufpos,
it->object = list3 (Qspace, QCwidth, w);
produce_stretch_glyph (it);
if (it->area == TEXT_AREA)
- it->current_x += it->pixel_width;
+ {
+ it->current_x += it->pixel_width;
+
+ if (it->continuation_lines_width
+ && it->string_from_prefix_prop_p)
+ it->wrap_prefix_width = it->current_x;
+ }
it->min_width_property = Qnil;
}
}
@@ -6761,7 +6902,7 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
\
entries[n].string = (STRING); \
entries[n].overlay = (OVERLAY); \
- priority = Foverlay_get ((OVERLAY), Qpriority); \
+ priority = Foverlay_get (OVERLAY, Qpriority); \
entries[n].priority = FIXNUMP (priority) ? XFIXNUM (priority) : 0; \
entries[n].after_string_p = (AFTER_P); \
++n; \
@@ -8571,9 +8712,8 @@ set_iterator_to_next (struct it *it, bool reseat_p)
ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
- /* Now we are scanning backward and don't know
- where to stop. */
- stop = -1;
+ /* Now we are scanning backward; figure out where to stop. */
+ stop = bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil, true);
}
@@ -8604,7 +8744,7 @@ set_iterator_to_next (struct it *it, bool reseat_p)
re-compute the stop position for composition. */
ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
- stop = -1;
+ stop = bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil,
true);
@@ -9049,7 +9189,9 @@ get_visually_first_element (struct it *it)
bytepos = IT_BYTEPOS (*it);
}
if (it->bidi_it.scan_dir < 0)
- stop = -1;
+ stop = STRINGP (it->string)
+ ? -1
+ : bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop,
it->string, true);
}
@@ -9553,9 +9695,10 @@ next_element_from_buffer (struct it *it)
&& PT < it->end_charpos) ? PT : it->end_charpos;
}
else
- stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos;
- if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it),
- stop)
+ stop = it->bidi_it.scan_dir < 0
+ ? bidi_level_start (it->bidi_it.resolved_level) - 1
+ : it->end_charpos;
+ if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop)
&& next_element_from_composition (it))
{
return true;
@@ -9719,6 +9862,13 @@ move_it_in_display_line_to (struct it *it,
ptrdiff_t prev_pos = IT_CHARPOS (*it);
bool saw_smaller_pos = prev_pos < to_charpos;
bool line_number_pending = false;
+ int this_line_subject_to_line_prefix = 0;
+
+#ifdef GLYPH_DEBUG
+ /* atx_flag, atpos_flag and wrap_flag are assigned but never used;
+ these hold information useful while debugging. */
+ int atx_flag, atpos_flag, wrap_flag;
+#endif /* GLYPH_DEBUG */
/* Don't produce glyphs in produce_glyphs. */
saved_glyph_row = it->glyph_row;
@@ -9784,6 +9934,11 @@ move_it_in_display_line_to (struct it *it,
/* If there's a line-/wrap-prefix, handle it, if we didn't already. */
if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p)
handle_line_prefix (it);
+
+ /* Save whether this line has received a wrap prefix, as this
+ affects whether Emacs attempts to move glyphs into
+ continuation lines. */
+ this_line_subject_to_line_prefix = it->string_from_prefix_prop_p;
}
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
@@ -9827,10 +9982,15 @@ move_it_in_display_line_to (struct it *it,
break;
}
else if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0)
- /* If wrap_it is valid, the current position might be in a
- word that is wrapped. So, save the iterator in
- atpos_it and continue to see if wrapping happens. */
- SAVE_IT (atpos_it, *it, atpos_data);
+ {
+ /* If wrap_it is valid, the current position might be in
+ a word that is wrapped. So, save the iterator in
+ atpos_it and continue to see if wrapping happens. */
+ SAVE_IT (atpos_it, *it, atpos_data);
+#ifdef GLYPH_DEBUG
+ atpos_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
+ }
}
/* Stop when ZV reached.
@@ -9892,6 +10052,9 @@ move_it_in_display_line_to (struct it *it,
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
+#ifdef GLYPH_DEBUG
+ wrap_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
}
/* Update may_wrap for the next iteration. */
may_wrap = next_may_wrap;
@@ -9970,6 +10133,9 @@ move_it_in_display_line_to (struct it *it,
{
SAVE_IT (atpos_it, *it, atpos_data);
IT_RESET_X_ASCENT_DESCENT (&atpos_it);
+#ifdef GLYPH_DEBUG
+ atpos_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
}
}
else
@@ -9984,6 +10150,9 @@ move_it_in_display_line_to (struct it *it,
{
SAVE_IT (atx_it, *it, atx_data);
IT_RESET_X_ASCENT_DESCENT (&atx_it);
+#ifdef GLYPH_DEBUG
+ atx_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
}
}
}
@@ -9998,12 +10167,27 @@ move_it_in_display_line_to (struct it *it,
&& FRAME_WINDOW_P (it->f)
&& ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
? WINDOW_LEFT_FRINGE_WIDTH (it->w)
- : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))
+ /* There is no line prefix, next to which the
+ iterator _must_ produce a minimum of one actual
+ glyph. */
+ && (!this_line_subject_to_line_prefix
+ /* Or this is the second glyph to be produced
+ beyond the confines of the line. */
+ || (i != 0
+ && (x > it->last_visible_x
+ || (x == it->last_visible_x
+ && FRAME_WINDOW_P (it->f)
+ && ((it->bidi_p
+ && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))))
{
bool moved_forward = false;
if (/* IT->hpos == 0 means the very first glyph
- doesn't fit on the line, e.g. a wide image. */
+ doesn't fit on the line, e.g. a wide
+ image. */
it->hpos == 0
|| (new_x == it->last_visible_x
&& FRAME_WINDOW_P (it->f)))
@@ -10064,6 +10248,9 @@ move_it_in_display_line_to (struct it *it,
SAVE_IT (atpos_it, *it, atpos_data);
atpos_it.current_x = x_before_this_char;
atpos_it.hpos = hpos_before_this_char;
+#ifdef GLYPH_DEBUG
+ atpos_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
}
}
@@ -10161,6 +10348,9 @@ move_it_in_display_line_to (struct it *it,
if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0)
{
SAVE_IT (atpos_it, *it, atpos_data);
+#ifdef GLYPH_DEBUG
+ atpos_flag = this_line_subject_to_line_prefix;
+#endif /* GLYPH_DEBUG */
IT_RESET_X_ASCENT_DESCENT (&atpos_it);
}
}
@@ -10259,24 +10449,24 @@ move_it_in_display_line_to (struct it *it,
if (it->method == GET_FROM_BUFFER)
prev_pos = IT_CHARPOS (*it);
- /* Detect overly-wide wrap-prefixes made of (space ...) display
- properties. When such a wrap prefix reaches past the right
- margin of the window, we need to avoid the call to
- set_iterator_to_next below, so that it->line_wrap is left at
- its TRUNCATE value wisely set by handle_line_prefix.
- Otherwise, set_iterator_to_next will pop the iterator stack,
- restore it->line_wrap, and we might miss the opportunity to
- exit the loop and return. */
- bool overwide_wrap_prefix =
- CONSP (it->object) && EQ (XCAR (it->object), Qspace)
- && it->sp > 0 && it->method == GET_FROM_STRETCH
- && it->current_x >= it->last_visible_x
- && it->continuation_lines_width > 0
- && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE;
- /* The current display element has been consumed. Advance
- to the next. */
- if (!overwide_wrap_prefix)
- set_iterator_to_next (it, true);
+ /* The current display element has been consumed. Advance to
+ the next. */
+ set_iterator_to_next (it, true);
+
+ /* If IT has just finished producing glyphs for the wrap prefix
+ and is proceeding to the next method, there might not be
+ sufficient space remaining in this line to accommodate its
+ glyphs, and one real glyph must be produced to prevent an
+ infinite loop. Next, clear this flag if such a glyph has
+ already been produced. */
+
+ if (this_line_subject_to_line_prefix == 1
+ && !it->string_from_prefix_prop_p)
+ this_line_subject_to_line_prefix = 2;
+ else if (this_line_subject_to_line_prefix == 2
+ && !it->string_from_prefix_prop_p)
+ this_line_subject_to_line_prefix = 0;
+
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it));
if (IT_CHARPOS (*it) < to_charpos)
@@ -10360,11 +10550,26 @@ move_it_in_display_line_to (struct it *it,
&& wrap_it.sp >= 0
&& ((atpos_it.sp >= 0 && wrap_it.current_x < atpos_it.current_x)
|| (atx_it.sp >= 0 && wrap_it.current_x < atx_it.current_x)))
- RESTORE_IT (it, &wrap_it, wrap_data);
+ {
+#ifdef GLYPH_DEBUG
+ this_line_subject_to_line_prefix = wrap_flag;
+#endif /* GLYPH_DEBUG */
+ RESTORE_IT (it, &wrap_it, wrap_data);
+ }
else if (atpos_it.sp >= 0)
- RESTORE_IT (it, &atpos_it, atpos_data);
+ {
+#ifdef GLYPH_DEBUG
+ this_line_subject_to_line_prefix = atpos_flag;
+#endif /* GLYPH_DEBUG */
+ RESTORE_IT (it, &atpos_it, atpos_data);
+ }
else if (atx_it.sp >= 0)
- RESTORE_IT (it, &atx_it, atx_data);
+ {
+#ifdef GLYPH_DEBUG
+ this_line_subject_to_line_prefix = atx_flag;
+#endif /* GLYPH_DEBUG */
+ RESTORE_IT (it, &atx_it, atx_data);
+ }
done:
@@ -10438,13 +10643,9 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
int line_height, line_start_x = 0, reached = 0;
int max_current_x = 0;
void *backup_data = NULL;
- ptrdiff_t orig_charpos = -1;
- enum it_method orig_method = NUM_IT_METHODS;
for (;;)
{
- orig_charpos = IT_CHARPOS (*it);
- orig_method = it->method;
if (op & MOVE_TO_VPOS)
{
/* If no TO_CHARPOS and no TO_X specified, stop at the
@@ -10716,21 +10917,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
}
}
else
- {
- /* Make sure we do advance, otherwise we might infloop.
- This could happen when the first display element is
- wider than the window, or if we have a wrap-prefix
- that doesn't leave enough space after it to display
- even a single character. We only do this for moving
- through buffer text, as with display/overlay strings
- we'd need to also compare it->object's, and this is
- unlikely to happen in that case anyway. */
- if (IT_CHARPOS (*it) == orig_charpos
- && it->method == orig_method
- && orig_method == GET_FROM_BUFFER)
- set_iterator_to_next (it, false);
- it->continuation_lines_width += it->current_x;
- }
+ it->continuation_lines_width += it->current_x;
break;
default:
@@ -10739,6 +10926,7 @@ 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. */
it->current_x = line_start_x;
+ it->wrap_prefix_width = 0;
line_start_x = 0;
it->hpos = 0;
it->line_number_produced_p = false;
@@ -10769,6 +10957,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
{
it->continuation_lines_width += it->current_x;
it->current_x = it->hpos = it->max_ascent = it->max_descent = 0;
+ it->wrap_prefix_width = 0;
it->current_y += it->max_ascent + it->max_descent;
++it->vpos;
last_height = it->max_ascent + it->max_descent;
@@ -10828,6 +11017,7 @@ move_it_vertically_backward (struct it *it, int dy)
reseat_1 (it, it->current.pos, true);
/* We are now surely at a line start. */
+ it->wrap_prefix_width = 0;
it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi
reordering is in effect. */
it->continuation_lines_width = 0;
@@ -11106,7 +11296,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
dvpos--;
}
- it->current_x = it->hpos = 0;
+ it->current_x = it->hpos = it->wrap_prefix_width = 0;
/* Above call may have moved too far if continuation lines
are involved. Scan forward and see if it did. */
@@ -11115,7 +11305,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
move_it_to (&it2, start_charpos, -1, -1, -1, MOVE_TO_POS);
it->vpos -= it2.vpos;
it->current_y -= it2.current_y;
- it->current_x = it->hpos = 0;
+ it->current_x = it->hpos = it->wrap_prefix_width = 0;
/* If we moved too far back, move IT some lines forward. */
if (it2.vpos > -dvpos)
@@ -11394,7 +11584,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
IT.current_x will be incorrectly set to zero at some arbitrary
non-zero X coordinate. */
move_it_by_lines (&it, 0);
- it.current_x = it.hpos = 0;
+ it.current_x = it.hpos = it.wrap_prefix_width = 0;
if (IT_CHARPOS (it) != start)
{
void *it1data = NULL;
@@ -11447,7 +11637,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to,
/* If FROM is on a newline, pretend that we start at the beginning
of the next line, because the newline takes no place on display. */
if (FETCH_BYTE (start) == '\n')
- it.current_x = 0;
+ it.current_x = 0, it.wrap_prefix_width = 0;
if (!NILP (x_limit))
{
it.last_visible_x = max_x;
@@ -14359,7 +14549,7 @@ display_tab_bar_line (struct it *it, int height)
row->truncated_on_left_p = false;
row->truncated_on_right_p = false;
- it->current_x = it->hpos = 0;
+ it->current_x = it->hpos = it->wrap_prefix_width = 0;
it->current_y += row->height;
++it->vpos;
++it->glyph_row;
@@ -15383,7 +15573,7 @@ display_tool_bar_line (struct it *it, int height)
row->truncated_on_left_p = false;
row->truncated_on_right_p = false;
- it->current_x = it->hpos = 0;
+ it->current_x = it->hpos = it->wrap_prefix_width = 0;
it->current_y += row->height;
++it->vpos;
++it->glyph_row;
@@ -17083,6 +17273,7 @@ redisplay_internal (void)
NULL, DEFAULT_FACE_ID);
it.current_x = this_line_start_x;
it.current_y = this_line_y;
+ it.wrap_prefix_width = 0;
it.vpos = this_line_vpos;
if (current_buffer->long_line_optimizations_p
@@ -18668,6 +18859,14 @@ enum
`scroll-conservatively' and the Emacs manual. */
#define SCROLL_LIMIT 100
+/* The freshness of the w->base_line_number cache is only ensured at every
+ redisplay cycle, so the cache can be used only if there's been
+ no relevant changes to the buffer since the last redisplay. */
+#define BASE_LINE_NUMBER_VALID_P(w) \
+ (eassert (current_buffer == XBUFFER ((w)->contents)), \
+ !current_buffer->clip_changed \
+ && BEG_UNCHANGED >= (w)->base_line_pos)
+
static int
try_scrolling (Lisp_Object window, bool just_this_one_p,
intmax_t arg_scroll_conservatively, intmax_t scroll_step,
@@ -18968,9 +19167,10 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
else
{
/* Maybe forget recorded base line for line number display. */
- if (!just_this_one_p
- || current_buffer->clip_changed
- || BEG_UNCHANGED < CHARPOS (startp))
+ /* FIXME: Why do we need this? `try_scrolling` can only be called from
+ `redisplay_window` which should have flushed this cache already when
+ eeded. */
+ if (!BASE_LINE_NUMBER_VALID_P (w))
w->base_line_number = 0;
/* If cursor ends up on a partially visible line,
@@ -19740,9 +19940,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
/* Record it now because it's overwritten. */
bool current_matrix_up_to_date_p = false;
bool used_current_matrix_p = false;
- /* This is less strict than current_matrix_up_to_date_p.
- It indicates that the buffer contents and narrowing are unchanged. */
- bool buffer_unchanged_p = false;
bool temp_scroll_step = false;
specpdl_ref count = SPECPDL_INDEX ();
int rc;
@@ -19848,11 +20045,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
specbind (Qinhibit_point_motion_hooks, Qt);
- buffer_unchanged_p
- = (w->window_end_valid
- && !current_buffer->clip_changed
- && !window_outdated (w));
-
/* When windows_or_buffers_changed is non-zero, we can't rely
on the window end being valid, so set it to zero there. */
if (windows_or_buffers_changed)
@@ -19992,6 +20184,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
}
}
+ if (!BASE_LINE_NUMBER_VALID_P (w))
+ /* Forget any recorded base line for line number display. */
+ w->base_line_number = 0;
+
force_start:
/* Handle case where place to start displaying has been specified,
@@ -20012,10 +20208,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
w->preserve_vscroll_p = false;
w->window_end_valid = false;
- /* Forget any recorded base line for line number display. */
- if (!buffer_unchanged_p)
- w->base_line_number = 0;
-
/* Redisplay the mode line. Select the buffer properly for that.
Also, run the hook window-scroll-functions
because we have scrolled. */
@@ -20344,12 +20536,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
if (w->cursor.vpos >= 0)
{
- if (!just_this_one_p
- || current_buffer->clip_changed
- || BEG_UNCHANGED < CHARPOS (startp))
- /* Forget any recorded base line for line number display. */
- w->base_line_number = 0;
-
if (!cursor_row_fully_visible_p (w, true, false, false))
{
clear_glyph_matrix (w->desired_matrix);
@@ -20420,10 +20606,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
debug_method_add (w, "recenter");
#endif
- /* Forget any previously recorded base line for line number display. */
- if (!buffer_unchanged_p)
- w->base_line_number = 0;
-
/* Determine the window start relative to point. */
init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID);
it.current_y = it.last_visible_y;
@@ -20529,7 +20711,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
it.current_y = 0;
}
- it.current_x = it.hpos = 0;
+ it.current_x = it.wrap_prefix_width = it.hpos = 0;
/* Set the window start position here explicitly, to avoid an
infinite loop in case the functions in window-scroll-functions
@@ -22497,7 +22679,7 @@ try_window_id (struct window *w)
/* We may start in a continuation line. If so, we have to
get the right continuation_lines_width and current_x. */
it.continuation_lines_width = last_row->continuation_lines_width;
- it.hpos = it.current_x = 0;
+ it.hpos = it.current_x = it.wrap_prefix_width = 0;
/* Display the rest of the lines at the window end. */
it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos);
@@ -23102,6 +23284,7 @@ insert_left_trunc_glyphs (struct it *it)
/* Get the truncation glyphs. */
truncate_it = *it;
truncate_it.current_x = 0;
+ truncate_it.wrap_prefix_width = 0;
truncate_it.face_id = DEFAULT_FACE_ID;
truncate_it.glyph_row = &scratch_glyph_row;
truncate_it.area = TEXT_AREA;
@@ -23864,6 +24047,10 @@ extend_face_to_end_of_line (struct it *it)
for (it->current_x = 0; g < e; g++)
it->current_x += g->pixel_width;
+ if (it->continuation_lines_width
+ && it->string_from_prefix_prop_p)
+ it->wrap_prefix_width = it->current_x;
+
it->area = LEFT_MARGIN_AREA;
it->face_id = default_face->id;
while (it->glyph_row->used[LEFT_MARGIN_AREA]
@@ -24585,6 +24772,13 @@ maybe_produce_line_number (struct it *it)
if (!last_line)
{
/* If possible, reuse data cached by line-number-mode. */
+ /* NOTE: We use `base_line_number` without checking
+ BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window`
+ has already flushed this cache for us when needed.
+ NOTE2: Checking BASE_LINE_NUMBER_VALID_P here would be
+ overly pessimistic because it might say that the cache
+ was invalid before entering `redisplay_window` yet the
+ value has just been refreshed. */
if (it->w->base_line_number > 0
&& it->w->base_line_pos > 0
&& it->w->base_line_pos <= IT_CHARPOS (*it)
@@ -24634,7 +24828,7 @@ maybe_produce_line_number (struct it *it)
/* Produce the glyphs for the line number. */
struct it tem_it;
char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1];
- bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false;
+ bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE;
ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */
int lnum_face_id = merge_faces (it->w, Qline_number, 0, DEFAULT_FACE_ID);
int current_lnum_face_id
@@ -24864,7 +25058,7 @@ should_produce_line_number (struct it *it)
because get-char-property always returns nil for ZV, except if
the property is in 'default-text-properties'. */
if (NILP (val) && IT_CHARPOS (*it) >= ZV)
- val = disable_line_numbers_overlay_at_eob ();
+ return !disable_line_numbers_overlay_at_eob ();
return NILP (val) ? true : false;
}
@@ -24929,6 +25123,7 @@ display_line (struct it *it, int cursor_vpos)
int first_visible_x = it->first_visible_x;
int last_visible_x = it->last_visible_x;
int x_incr = 0;
+ int this_line_subject_to_line_prefix = 0;
/* We always start displaying at hpos zero even if hscrolled. */
eassert (it->hpos == 0 && it->current_x == 0);
@@ -25005,7 +25200,10 @@ display_line (struct it *it, int cursor_vpos)
if (it->current_x < it->first_visible_x
&& (move_result == MOVE_NEWLINE_OR_CR
|| move_result == MOVE_POS_MATCH_OR_ZV))
- it->current_x = it->first_visible_x;
+ {
+ it->current_x = it->first_visible_x;
+ it->wrap_prefix_width = 0;
+ }
/* In case move_it_in_display_line_to above "produced" the line
number. */
@@ -25034,6 +25232,7 @@ display_line (struct it *it, int cursor_vpos)
/* We only do this when not calling move_it_in_display_line_to
above, because that function calls itself handle_line_prefix. */
handle_line_prefix (it);
+ this_line_subject_to_line_prefix = it->string_from_prefix_prop_p;
}
else
{
@@ -25200,12 +25399,15 @@ display_line (struct it *it, int cursor_vpos)
process the prefix now. */
if (it->area == TEXT_AREA && pending_handle_line_prefix)
{
- /* Line numbers should precede the line-prefix or wrap-prefix. */
+ /* Line numbers should precede the line-prefix or
+ wrap-prefix. */
if (line_number_needed)
maybe_produce_line_number (it);
pending_handle_line_prefix = false;
handle_line_prefix (it);
+ this_line_subject_to_line_prefix
+ = it->string_from_prefix_prop_p;
}
continue;
}
@@ -25226,7 +25428,16 @@ display_line (struct it *it, int cursor_vpos)
if (/* Not a newline. */
nglyphs > 0
/* Glyphs produced fit entirely in the line. */
- && it->current_x < it->last_visible_x)
+ && (it->current_x < it->last_visible_x
+ /* Or a line or wrap prefix is in effect, and not
+ truncating the glyph produced immediately after it
+ would cause an infinite cycle. */
+ || (it->line_wrap != TRUNCATE
+ /* This code is not valid if multiple glyphs were
+ produced, as some of these glyphs might remain
+ within this line. */
+ && nglyphs == 1
+ && this_line_subject_to_line_prefix)))
{
it->hpos += nglyphs;
row->ascent = max (row->ascent, it->max_ascent);
@@ -25277,7 +25488,20 @@ display_line (struct it *it, int cursor_vpos)
&& FRAME_WINDOW_P (it->f)
&& (row->reversed_p
? WINDOW_LEFT_FRINGE_WIDTH (it->w)
- : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))
+ /* There is no line prefix, next to which the
+ iterator _must_ produce a minimum of one actual
+ glyph. */
+ && (!this_line_subject_to_line_prefix
+ /* Or this is the second glyph to be produced
+ beyond the confines of the line. */
+ || (i != 0
+ && (x > it->last_visible_x
+ || (x == it->last_visible_x
+ && FRAME_WINDOW_P (it->f)
+ && (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))))
{
/* End of a continued line. */
@@ -25574,24 +25798,23 @@ display_line (struct it *it, int cursor_vpos)
break;
}
- /* Detect overly-wide wrap-prefixes made of (space ...) display
- properties. When such a wrap prefix reaches past the right
- margin of the window, we need to avoid the call to
- set_iterator_to_next below, so that it->line_wrap is left at
- its TRUNCATE value wisely set by handle_line_prefix.
- Otherwise, set_iterator_to_next will pop the iterator stack,
- restore it->line_wrap, and redisplay might infloop. */
- bool overwide_wrap_prefix =
- CONSP (it->object) && EQ (XCAR (it->object), Qspace)
- && it->sp > 0 && it->method == GET_FROM_STRETCH
- && it->current_x >= it->last_visible_x
- && it->continuation_lines_width > 0
- && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE;
-
/* Proceed with next display element. Note that this skips
over lines invisible because of selective display. */
- if (!overwide_wrap_prefix)
- set_iterator_to_next (it, true);
+ set_iterator_to_next (it, true);
+
+ /* If IT has just finished producing glyphs for the wrap prefix
+ and is proceeding to the next method, there might not be
+ sufficient space remaining in this line to accommodate its
+ glyphs, and one real glyph must be produced to prevent an
+ infinite loop. Next, clear this flag if such a glyph has
+ already been produced. */
+
+ if (this_line_subject_to_line_prefix == 1
+ && !it->string_from_prefix_prop_p)
+ this_line_subject_to_line_prefix = 2;
+ else if (this_line_subject_to_line_prefix == 2
+ && !it->string_from_prefix_prop_p)
+ this_line_subject_to_line_prefix = 0;
/* If we truncate lines, we are done when the last displayed
glyphs reach past the right margin of the window. */
@@ -25837,7 +26060,7 @@ display_line (struct it *it, int cursor_vpos)
HPOS) = (0 0). Vertical positions are incremented. As a
convenience for the caller, IT->glyph_row is set to the next
row to be used. */
- it->current_x = it->hpos = 0;
+ it->wrap_prefix_width = it->current_x = it->hpos = 0;
it->current_y += row->height;
/* Restore the first and last visible X if we adjusted them for
current-line hscrolling. */
@@ -26316,7 +26539,7 @@ Value is the new character position of point. */)
{
struct text_pos pt;
struct it it;
- int pt_x, target_x, pixel_width, pt_vpos;
+ int pt_x, pt_wrap_prefix_x, target_x, pixel_width, pt_vpos;
bool at_eol_p;
bool overshoot_expected = false;
bool target_is_eol_p = false;
@@ -26348,6 +26571,7 @@ Value is the new character position of point. */)
reseat:
reseat_at_previous_visible_line_start (&it);
it.current_x = it.hpos = it.current_y = it.vpos = 0;
+ it.wrap_prefix_width = 0;
if (IT_CHARPOS (it) != PT)
{
move_it_to (&it, overshoot_expected ? PT - 1 : PT,
@@ -26366,6 +26590,7 @@ Value is the new character position of point. */)
move_it_in_display_line (&it, PT, -1, MOVE_TO_POS);
}
pt_x = it.current_x;
+ pt_wrap_prefix_x = it.wrap_prefix_width;
pt_vpos = it.vpos;
if (dir > 0 || overshoot_expected)
{
@@ -26380,10 +26605,11 @@ Value is the new character position of point. */)
it.glyph_row = NULL;
PRODUCE_GLYPHS (&it); /* compute it.pixel_width */
it.glyph_row = row;
- /* PRODUCE_GLYPHS advances it.current_x, so we must restore
- it, lest it will become out of sync with it's buffer
+ /* PRODUCE_GLYPHS advances it.current_x, so it must be
+ restored, lest it become out of sync with its buffer
position. */
it.current_x = pt_x;
+ it.wrap_prefix_width = pt_wrap_prefix_x;
}
else
at_eol_p = ITERATOR_AT_END_OF_LINE_P (&it);
@@ -26428,6 +26654,7 @@ Value is the new character position of point. */)
it.last_visible_x = DISP_INFINITY;
reseat_at_previous_visible_line_start (&it);
it.current_x = it.current_y = it.hpos = 0;
+ it.wrap_prefix_width = 0;
if (pt_vpos != 0)
move_it_by_lines (&it, pt_vpos);
}
@@ -27944,6 +28171,11 @@ are the selected window and the WINDOW's buffer). */)
init_iterator (&it, w, -1, -1, NULL, face_id);
+ /* Make sure `base_line_number` is fresh in case we encounter a `%l`. */
+ if (current_buffer == XBUFFER ((w)->contents)
+ && !BASE_LINE_NUMBER_VALID_P (w))
+ w->base_line_number = 0;
+
if (no_props)
{
mode_line_target = MODE_LINE_NOPROP;
@@ -28396,30 +28628,29 @@ decode_mode_spec (struct window *w, register int c, int field_width,
when the buffer's restriction was changed, but the window
wasn't yet redisplayed after that. If that happens, we
need to determine a new base line. */
- if (!(BUF_BEGV_BYTE (b) <= startpos_byte
+ if (current_buffer != XBUFFER (w->contents)
+ || !(BUF_BEGV_BYTE (b) <= startpos_byte
&& startpos_byte <= BUF_ZV_BYTE (b)))
{
startpos = BUF_BEGV (b);
startpos_byte = BUF_BEGV_BYTE (b);
- w->base_line_pos = 0;
- w->base_line_number = 0;
}
/* If we decided that this buffer isn't suitable for line numbers,
- don't forget that too fast. */
+ don't forget that too fast.
+ FIXME: What if `current_buffer != w->contents`? */
if (w->base_line_pos == -1)
goto no_value;
/* If the buffer is very big, don't waste time. */
if (FIXNUMP (Vline_number_display_limit)
&& BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit))
- {
- w->base_line_pos = 0;
- w->base_line_number = 0;
- goto no_value;
- }
+ goto no_value;
- if (w->base_line_number > 0
+ /* Callers of `display_mode_element` are in charge of flushing
+ any stale `base_line_number` cache. */
+ if (current_buffer == XBUFFER ((w)->contents)
+ && w->base_line_number > 0
&& w->base_line_pos > 0
&& w->base_line_pos <= startpos)
{
@@ -28445,7 +28676,9 @@ decode_mode_spec (struct window *w, register int c, int field_width,
or too far away, or if we did not have one.
"Too close" means it's plausible a scroll-down would
go back past it. */
- if (startpos == BUF_BEGV (b))
+ if (current_buffer != XBUFFER (w->contents))
+ ; /* The base line is for another buffer, don't touch it! */
+ else if (startpos == BUF_BEGV (b))
{
w->base_line_number = topline;
w->base_line_pos = BUF_BEGV (b);
@@ -28482,6 +28715,12 @@ decode_mode_spec (struct window *w, register int c, int field_width,
goto no_value;
}
+ /* NOTE: if `clip_changed` is set or if `BEG_UNCHANGED` is
+ before `position`, this new cached value may get flushed
+ soon needlessly, because we can't reset `BEG_UNCHANGED` or
+ `clip_changed` from here (since they reflect the changes
+ since the last redisplay so they can only be reset from
+ `mark_window_display_accurate_1`). :-( */
w->base_line_number = topline - nlines;
w->base_line_pos = BYTE_TO_CHAR (position);
}
@@ -29509,9 +29748,9 @@ dump_glyph_string (struct glyph_string *s)
# define ALLOCATE_HDC(hdc, f) \
Lisp_Object prev_quit = Vinhibit_quit; \
Vinhibit_quit = Qt; \
- HDC hdc = get_frame_dc ((f))
+ HDC hdc = get_frame_dc (f)
# define RELEASE_HDC(hdc, f) \
- release_frame_dc ((f), (hdc)); \
+ release_frame_dc (f, hdc); \
Vinhibit_quit = prev_quit
#else
# define ALLOCATE_HDC(hdc, f)
@@ -30942,7 +31181,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row,
#ifdef HAVE_RSVG
/* Update SVG image glyphs with mouse face features. FIXME: it
- should be possible to have this behaviour with transparent
+ should be possible to have this behavior with transparent
background PNG. */
if (hl == DRAW_MOUSE_FACE)
{
@@ -32575,7 +32814,19 @@ gui_produce_glyphs (struct it *it)
if (font->space_width > 0)
{
int tab_width = it->tab_width * font->space_width;
- int x = it->current_x + it->continuation_lines_width;
+ /* wrap-prefix strings are prepended to continuation
+ lines, so the width of tab characters inside should
+ be computed from the start of this screen line rather
+ than as a product of the total width of the physical
+ line being wrapped. */
+ int x = it->current_x + (it->string_from_prefix_prop_p
+ /* Subtract the width of the
+ prefix from it->current_x if
+ it exists. */
+ ? 0 : (it->continuation_lines_width
+ ? (it->continuation_lines_width
+ - it->wrap_prefix_width)
+ : 0));
int x0 = x;
/* Adjust for line numbers, if needed. */
if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p)
@@ -33046,7 +33297,13 @@ gui_produce_glyphs (struct it *it)
because this isn't true for images with `:ascent 100'. */
eassert (it->ascent >= 0 && it->descent >= 0);
if (it->area == TEXT_AREA)
- it->current_x += it->pixel_width;
+ {
+ it->current_x += it->pixel_width;
+
+ if (it->continuation_lines_width
+ && it->string_from_prefix_prop_p)
+ it->wrap_prefix_width = it->current_x;
+ }
if (extra_line_spacing > 0)
{
@@ -36205,7 +36462,7 @@ expose_area (struct window *w, struct glyph_row *row, const Emacs_Rectangle *r,
/* Use a signed int intermediate value to avoid catastrophic
failures due to comparison between signed and unsigned, when
x is negative (can happen for wide images that are hscrolled). */
- int r_end = r->x + r->width;
+ int r_end = r->x + (int) r->width;
while (last < end && x < r_end)
{
x += last->pixel_width;
@@ -36504,7 +36761,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr)
/* Use a signed int intermediate value to avoid catastrophic
failures due to comparison between signed and unsigned, when
y0 or y1 is negative (can happen for tall images). */
- int r_bottom = r.y + r.height;
+ int r_bottom = r.y + (int) r.height;
/* We must temporarily switch to the window's buffer, in case
the fringe face has been remapped in that buffer's
@@ -36551,7 +36808,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr)
/* We must redraw a row overlapping the exposed area. */
if (y0 < r.y
? y0 + row->phys_height > r.y
- : y0 + row->ascent - row->phys_ascent < r.y +r.height)
+ : y0 + row->ascent - row->phys_ascent < r.y + (int) r.height)
{
if (first_overlapping_row == NULL)
first_overlapping_row = row;
@@ -36730,7 +36987,7 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2,
const Emacs_Rectangle *upper, *lower;
bool intersection_p = false;
- /* Rearrange so that R1 is the left-most rectangle. */
+ /* Rearrange so that left is the left-most rectangle. */
if (r1->x < r2->x)
left = r1, right = r2;
else
@@ -36738,13 +36995,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2,
/* X0 of the intersection is right.x0, if this is inside R1,
otherwise there is no intersection. */
- if (right->x <= left->x + left->width)
+ if (right->x <= left->x + (int) left->width)
{
result->x = right->x;
/* The right end of the intersection is the minimum of
the right ends of left and right. */
- result->width = (min (left->x + left->width, right->x + right->width)
+ result->width = (min (left->x + (int) left->width,
+ right->x + (int) right->width)
- result->x);
/* Same game for Y. */
@@ -36755,14 +37013,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2,
/* The upper end of the intersection is lower.y0, if this is inside
of upper. Otherwise, there is no intersection. */
- if (lower->y <= upper->y + upper->height)
+ if (lower->y <= upper->y + (int) upper->height)
{
result->y = lower->y;
/* The lower end of the intersection is the minimum of the lower
ends of upper and lower. */
- result->height = (min (lower->y + lower->height,
- upper->y + upper->height)
+ result->height = (min (lower->y + (int) lower->height,
+ upper->y + (int) upper->height)
- result->y);
intersection_p = true;
}
@@ -37753,6 +38011,8 @@ cursor shapes. */);
DEFSYM (Qthin_space, "thin-space");
DEFSYM (Qzero_width, "zero-width");
+ DEFSYM (Qdebug_early__muted, "debug-early--muted");
+
DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function,
doc: /* Function run just before redisplay.
It is called with one argument, which is the set of windows that are to
diff --git a/src/xfaces.c b/src/xfaces.c
index e30c2fac70c..a558e7328c0 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -293,15 +293,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* True if face attribute ATTR is unspecified. */
-#define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
+#define UNSPECIFIEDP(ATTR) EQ (ATTR, Qunspecified)
/* True if face attribute ATTR is `ignore-defface'. */
-#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
+#define IGNORE_DEFFACE_P(ATTR) EQ (ATTR, QCignore_defface)
/* True if face attribute ATTR is `reset'. */
-#define RESET_P(ATTR) EQ ((ATTR), Qreset)
+#define RESET_P(ATTR) EQ (ATTR, Qreset)
/* Size of hash table of realized faces in face caches (should be a
prime number). */
@@ -1756,26 +1756,26 @@ the WIDTH times as wide as FACE on FRAME. */)
/* Access face attributes of face LFACE, a Lisp vector. */
-#define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
-#define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
-#define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
-#define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
-#define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
-#define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
-#define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
-#define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
-#define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
-#define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
-#define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
-#define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
-#define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
-#define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
-#define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
-#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
-#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
-#define LFACE_EXTEND(LFACE) AREF ((LFACE), LFACE_EXTEND_INDEX)
+#define LFACE_FAMILY(LFACE) AREF (LFACE, LFACE_FAMILY_INDEX)
+#define LFACE_FOUNDRY(LFACE) AREF (LFACE, LFACE_FOUNDRY_INDEX)
+#define LFACE_HEIGHT(LFACE) AREF (LFACE, LFACE_HEIGHT_INDEX)
+#define LFACE_WEIGHT(LFACE) AREF (LFACE, LFACE_WEIGHT_INDEX)
+#define LFACE_SLANT(LFACE) AREF (LFACE, LFACE_SLANT_INDEX)
+#define LFACE_UNDERLINE(LFACE) AREF (LFACE, LFACE_UNDERLINE_INDEX)
+#define LFACE_INVERSE(LFACE) AREF (LFACE, LFACE_INVERSE_INDEX)
+#define LFACE_FOREGROUND(LFACE) AREF (LFACE, LFACE_FOREGROUND_INDEX)
+#define LFACE_BACKGROUND(LFACE) AREF (LFACE, LFACE_BACKGROUND_INDEX)
+#define LFACE_STIPPLE(LFACE) AREF (LFACE, LFACE_STIPPLE_INDEX)
+#define LFACE_SWIDTH(LFACE) AREF (LFACE, LFACE_SWIDTH_INDEX)
+#define LFACE_OVERLINE(LFACE) AREF (LFACE, LFACE_OVERLINE_INDEX)
+#define LFACE_STRIKE_THROUGH(LFACE) AREF (LFACE, LFACE_STRIKE_THROUGH_INDEX)
+#define LFACE_BOX(LFACE) AREF (LFACE, LFACE_BOX_INDEX)
+#define LFACE_FONT(LFACE) AREF (LFACE, LFACE_FONT_INDEX)
+#define LFACE_INHERIT(LFACE) AREF (LFACE, LFACE_INHERIT_INDEX)
+#define LFACE_FONTSET(LFACE) AREF (LFACE, LFACE_FONTSET_INDEX)
+#define LFACE_EXTEND(LFACE) AREF (LFACE, LFACE_EXTEND_INDEX)
#define LFACE_DISTANT_FOREGROUND(LFACE) \
- AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX)
+ AREF (LFACE, LFACE_DISTANT_FOREGROUND_INDEX)
/* True if LFACE is a Lisp face. A Lisp face is a vector of size
LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
@@ -2245,20 +2245,20 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
/* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
store the resulting attributes in TO, which must be already be
- completely specified and contain only absolute attributes.
- Every specified attribute of FROM overrides the corresponding
- attribute of TO; relative attributes in FROM are merged with the
- absolute value in TO and replace it. NAMED_MERGE_POINTS is used
- internally to detect loops in face inheritance/remapping; it should
- be 0 when called from other places. If window W is non-NULL, use W
- to interpret face specifications. */
+ completely specified and contain only absolute attributes. Every
+ specified attribute of FROM overrides the corresponding attribute of
+ TO; merge relative attributes in FROM with the absolute value in TO,
+ which attributes also replace it. Use NAMED_MERGE_POINTS internally
+ to detect loops in face inheritance/remapping; it should be 0 when
+ called from other places. If window W is non-NULL, use W to
+ interpret face specifications. */
static void
merge_face_vectors (struct window *w,
struct frame *f, const Lisp_Object *from, Lisp_Object *to,
struct named_merge_point *named_merge_points)
{
int i;
- Lisp_Object font = Qnil;
+ Lisp_Object font = Qnil, tospec, adstyle;
/* If FROM inherits from some other faces, merge their attributes into
TO before merging FROM's direct attributes. Note that an :inherit
@@ -2318,6 +2318,25 @@ merge_face_vectors (struct window *w,
to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
+
+ if (!NILP (AREF (font, FONT_ADSTYLE_INDEX)))
+ {
+ /* If an adstyle is specified in FROM's font spec, create a
+ font spec for TO if none exists, and transfer the adstyle
+ there. */
+
+ tospec = to[LFACE_FONT_INDEX];
+ adstyle = AREF (font, FONT_ADSTYLE_INDEX);
+
+ if (!NILP (tospec))
+ tospec = copy_font_spec (tospec);
+ else
+ tospec = Ffont_spec (0, NULL);
+
+ to[LFACE_FONT_INDEX] = tospec;
+ ASET (tospec, FONT_ADSTYLE_INDEX, adstyle);
+ }
+
ASET (font, FONT_SIZE_INDEX, Qnil);
}
@@ -6646,7 +6665,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
/* Get the `face' or `mouse_face' text property at POS, and
determine the next position at which the property changes. */
prop = Fget_text_property (position, propname, w->contents);
- XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
+ XSETFASTINT (limit1, min (limit, endpos));
end = Fnext_single_property_change (position, propname, w->contents, limit1);
if (FIXNUMP (end))
endpos = XFIXNUM (end);
@@ -6782,7 +6801,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos,
/* Get the `face' or `mouse_face' text property at POS, and
determine the next position at which the property changes. */
prop = Fget_text_property (position, propname, w->contents);
- XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
+ XSETFASTINT (limit1, min (limit, endpos));
end = Fnext_single_property_change (position, propname, w->contents, limit1);
if (FIXNUMP (end))
endpos = XFIXNUM (end);
@@ -7333,8 +7352,7 @@ only for this purpose. */);
doc: /* Hash table of global face definitions (for internal use only.) */);
Vface_new_frame_defaults =
/* 33 entries is enough to fit all basic faces */
- make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ make_hash_table (&hashtest_eq, 33, Weak_None, false);
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
doc: /* Default stipple pattern used on monochrome displays.
diff --git a/src/xselect.c b/src/xselect.c
index bb82798bb62..fd0f06eeed9 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -19,6 +19,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Rewritten by jwz */
#include <config.h>
+
+/* Work around GCC bug 102671. */
+#if 10 <= __GNUC__
+# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference"
+#endif
+
#include <limits.h>
#ifdef HAVE_SYS_TYPES_H
diff --git a/src/xterm.c b/src/xterm.c
index 1f398b2e39a..c0aef65ab66 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -7292,6 +7292,11 @@ x_sync_init_fences (struct frame *f)
&& dpyinfo->xsync_minor < 1))
return;
+ /* Suppress errors around XSyncCreateFence requests, since its
+ implementations on certain X servers erroneously reject valid
+ drawables, such as the frame's inner window. (bug#69762) */
+
+ x_catch_errors (dpyinfo->display);
output->sync_fences[0]
= XSyncCreateFence (FRAME_X_DISPLAY (f),
/* The drawable given below is only used to
@@ -7303,6 +7308,9 @@ x_sync_init_fences (struct frame *f)
= XSyncCreateFence (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
False);
+ if (x_had_errors_p (dpyinfo->display))
+ output->sync_fences[1] = output->sync_fences[0] = None;
+ x_uncatch_errors_after_check ();
XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
dpyinfo->Xatom_net_wm_sync_fences, XA_CARDINAL,
@@ -13370,13 +13378,12 @@ xi_focus_handle_for_device (struct x_display_info *dpyinfo,
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
+ that 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
@@ -28805,6 +28812,36 @@ x_focus_frame (struct frame *f, bool noactivate)
friends being set. */
block_input ();
+#ifdef HAVE_GTK3
+ /* read_minibuf assumes that calling Fx_focus_frame on a frame that
+ is already selected won't move the focus elsewhere, and thereby
+ disrupt any focus redirection to e.g. a minibuffer frame that
+ might be activated between that call being made and the
+ consequent XI_FocusIn/Out events arriving. This is true whether
+ the focus is ultimately transferred back to the frame it was
+ initially on or not.
+
+ GTK 3 moves the keyboard focus to the edit widget's window
+ whenever it receives a FocusIn event targeting the outer window.
+ This operation gives rise to a FocusOut event that clears
+ device->focus_frame, which in turn prompts xi_handle_focus_change
+ to clear the display's focus frame. The next FocusIn event
+ destined for the same frame registers as a new focus, which
+ cancels any focus redirection from that frame.
+
+ To prevent this chain of events from disrupting focus redirection
+ when the minibuffer is activated twice in rapid succession while
+ configured to redirect focus to a minibuffer frame, ignore frames
+ which hold the input focus and are connected to a minibuffer
+ window. (bug#65116)*/
+
+ if (f == dpyinfo->x_focus_frame && !FRAME_HAS_MINIBUF_P (f))
+ {
+ unblock_input ();
+ return;
+ }
+#endif /* HAVE_GTK3 */
+
if (FRAME_X_EMBEDDED_P (f))
/* For Xembedded frames, normally the embedder forwards key
events. See XEmbed Protocol Specification at
@@ -31503,7 +31540,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
dpyinfo->selection_tracking_window,
selection_name,
(XFixesSetSelectionOwnerNotifyMask
- | XFixesSetSelectionOwnerNotifyMask
| XFixesSelectionClientCloseNotifyMask));
}
@@ -32508,38 +32544,45 @@ Android does not support scroll bars at all. */);
DEFSYM (Qreally_fast, "really-fast");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
- doc: /* Which keys Emacs uses for the ctrl modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `ctrl' means use the Ctrl_L and Ctrl_R keysyms.
-The default is nil, which is the same as `ctrl'. */);
+ doc: /* Which modifer value Emacs reports when Ctrl is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed, with nil or
+any other value equivalent to `ctrl'. */);
Vx_ctrl_keysym = Qnil;
DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym,
- doc: /* Which keys Emacs uses for the alt modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `alt' means use the Alt_L and Alt_R keysyms.
-The default is nil, which is the same as `alt'. */);
+ doc: /* Which modifer value Emacs reports when Alt is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Alt modifier (e.g. the keysym Alt_L or Alt_R, if the keyboard features a
+dedicated key for Meta) depressed, with nil or any other value
+equivalent to `alt'. */);
Vx_alt_keysym = Qnil;
DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym,
- doc: /* Which keys Emacs uses for the hyper modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `hyper' means use the Hyper_L and Hyper_R
-keysyms. The default is nil, which is the same as `hyper'. */);
+ doc: /* Which modifer value Emacs reports when Hyper is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed, with nil
+or any other value equivalent to `hyper'. */);
Vx_hyper_keysym = Qnil;
DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym,
- doc: /* Which keys Emacs uses for the meta modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `meta' means use the Meta_L and Meta_R keysyms.
-The default is nil, which is the same as `meta'. */);
+ doc: /* Which modifer value Emacs reports when Meta is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Meta modifier (e.g. the keysym Alt_L or Alt_R, when the keyboard does
+not feature a dedicated key for Meta) depressed, with nil or any other
+value equivalent to `meta'. */);
Vx_meta_keysym = Qnil;
DEFVAR_LISP ("x-super-keysym", Vx_super_keysym,
- doc: /* Which keys Emacs uses for the super modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `super' means use the Super_L and Super_R
-keysyms. The default is nil, which is the same as `super'. */);
+ doc: /* Which modifer value Emacs reports when Super is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Super modifier (i.e. the keysym Super_L or Super_R) depressed, with nil
+or any other value equivalent to `super'. */);
Vx_super_keysym = Qnil;
DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout,
@@ -32555,10 +32598,7 @@ If set to a non-float value, there will be no wait at all. */);
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vx_keysym_table = make_hash_table (hashtest_eql, 900,
- DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD,
- Qnil, false);
+ Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false);
DEFVAR_BOOL ("x-frame-normalize-before-maximize",
x_frame_normalize_before_maximize,
diff --git a/src/xterm.h b/src/xterm.h
index 3c128148270..2c00b1e7bec 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -84,7 +84,7 @@ typedef GtkWidget *xt_or_gtk_widget;
#undef XSync
/* gdk_window_process_all_updates is deprecated in GDK 3.22. */
#if GTK_CHECK_VERSION (3, 22, 0)
-#define XSync(d, b) do { XSync ((d), (b)); } while (false)
+#define XSync(d, b) do { XSync (d, b); } while (false)
#else
#define XSync(d, b) do { gdk_window_process_all_updates (); \
XSync (d, b); } while (false)
@@ -1402,7 +1402,7 @@ extern void x_mark_frame_dirty (struct frame *f);
code after any drawing command, but we can run code whenever
someone asks for the handle necessary to draw. */
#define FRAME_X_DRAWABLE(f) \
- (x_mark_frame_dirty ((f)), FRAME_X_RAW_DRAWABLE ((f)))
+ (x_mark_frame_dirty (f), FRAME_X_RAW_DRAWABLE (f))
#ifdef HAVE_XDBE
#define FRAME_X_DOUBLE_BUFFERED_P(f) \
@@ -1447,7 +1447,7 @@ extern void x_mark_frame_dirty (struct frame *f);
FRAME_X_WINDOW (f))
#else /* !USE_GTK */
-#define FRAME_OUTER_WINDOW(f) (FRAME_X_WINDOW (f))
+#define FRAME_OUTER_WINDOW(f) FRAME_X_WINDOW (f)
#endif /* !USE_GTK */
#endif
diff --git a/src/xwidget.c b/src/xwidget.c
index 58910459142..389c48ca7f5 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "coding.h"
#include "xwidget.h"
-
#include "lisp.h"
#include "blockinput.h"
#include "dispextern.h"
@@ -379,6 +378,8 @@ fails. */)
/* Enable the developer extras. */
settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW (xw->widget_osr));
g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, NULL);
+ g_object_set (G_OBJECT (settings), "enable-javascript",
+ (gboolean) (!xwidget_webkit_disable_javascript), NULL);
}
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
@@ -3972,6 +3973,13 @@ syms_of_xwidget (void)
doc: /* List of all xwidget views. */);
Vxwidget_view_list = Qnil;
+ DEFVAR_BOOL ("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript,
+ doc: /* If non-nil, disable execution of JavaScript in xwidget WebKit widgets.
+Modifications to this setting do not take effect in existing WebKit
+widgets; kill all xwidget-webkit buffers for changes in this setting
+to take effect. */);
+ xwidget_webkit_disable_javascript = false;
+
Fprovide (intern ("xwidget-internal"), Qnil);
id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq,
diff --git a/test/Makefile.in b/test/Makefile.in
index 720f5c7ff8c..3cbdbec4414 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \
# Additional settings for ert.
ert_opts =
+# Supply a path to local tree-sitter installations, as we run tests
+# without a valid HOME.
+ert_opts += --eval "(setq treesit-extra-load-path '(\"$(HOME)/.emacs.d/tree-sitter\"))"
+
# Maximum length of lines in ert backtraces; nil for no limit.
# (if empty, use the default ert-batch-backtrace-right-margin).
TEST_BACKTRACE_LINE_LENGTH =
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 8e583fade9f..d79072b06b5 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \
(java "https://github.com/tree-sitter/tree-sitter-java") \
(javascript "https://github.com/tree-sitter/tree-sitter-javascript") \
(json "https://github.com/tree-sitter/tree-sitter-json") \
- (lua "https://github.com/MunifTanjim/tree-sitter-lua") \
+ (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \
(python "https://github.com/tree-sitter/tree-sitter-python") \
(ruby "https://github.com/tree-sitter/tree-sitter-ruby") \
(tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index bfdfac8be1b..cdd1a7832d3 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -57,12 +57,10 @@
(ert-deftest abbrev-make-abbrev-table-test ()
;; Table without properties:
(let ((table (make-abbrev-table)))
- (should (abbrev-table-p table))
- (should (= (length table) obarray-default-size)))
+ (should (abbrev-table-p table)))
;; Table with one property 'foo with value 'bar:
(let ((table (make-abbrev-table '(foo bar))))
(should (abbrev-table-p table))
- (should (= (length table) obarray-default-size))
(should (eq (abbrev-table-get table 'foo) 'bar))))
(ert-deftest abbrev--table-symbols-test ()
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 5452501b861..c091a7dd060 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -33,8 +33,8 @@
(require 'secrets)
(defun auth-source-ensure-ignored-backend (source)
- (auth-source-validate-backend source '((:source . "")
- (:type . ignore))))
+ (auth-source-validate-backend source '((source . "")
+ (type . ignore))))
(defun auth-source-validate-backend (source validation-alist)
(let ((backend (auth-source-backend-parse source)))
@@ -44,84 +44,101 @@
(ert-deftest auth-source-backend-parse-macos-keychain ()
(auth-source-validate-backend '(:source (:macos-keychain-generic foobar))
- '((:source . "foobar")
- (:type . macos-keychain-generic)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-generic)
+ (search-function . auth-source-macos-keychain-search)
+ (create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-string ()
(auth-source-validate-backend "macos-keychain-generic:foobar"
- '((:source . "foobar")
- (:type . macos-keychain-generic)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-generic)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-string ()
(auth-source-validate-backend "macos-keychain-internet:foobar"
- '((:source . "foobar")
- (:type . macos-keychain-internet)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "foobar")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol ()
(auth-source-validate-backend 'macos-keychain-internet
- '((:source . "default")
- (:type . macos-keychain-internet)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol ()
(auth-source-validate-backend 'macos-keychain-generic
- '((:source . "default")
- (:type . macos-keychain-generic)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-generic)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string ()
(auth-source-validate-backend 'macos-keychain-internet
- '((:source . "default")
- (:type . macos-keychain-internet)
- (:search-function . auth-source-macos-keychain-search)
- (:create-function . auth-source-macos-keychain-create))))
+ '((source . "default")
+ (type . macos-keychain-internet)
+ (search-function
+ . auth-source-macos-keychain-search)
+ (create-function
+ . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-plstore ()
(auth-source-validate-backend '(:source "foo.plist")
- '((:source . "foo.plist")
- (:type . plstore)
- (:search-function . auth-source-plstore-search)
- (:create-function . auth-source-plstore-create))))
+ '((source . "foo.plist")
+ (type . plstore)
+ (search-function . auth-source-plstore-search)
+ (create-function
+ . auth-source-plstore-create))))
(ert-deftest auth-source-backend-parse-netrc ()
(auth-source-validate-backend '(:source "foo")
- '((:source . "foo")
- (:type . netrc)
- (:search-function . auth-source-netrc-search)
- (:create-function . auth-source-netrc-create))))
+ '((source . "foo")
+ (type . netrc)
+ (search-function . auth-source-netrc-search)
+ (create-function
+ . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-netrc-string ()
(auth-source-validate-backend "foo"
- '((:source . "foo")
- (:type . netrc)
- (:search-function . auth-source-netrc-search)
- (:create-function . auth-source-netrc-create))))
+ '((source . "foo")
+ (type . netrc)
+ (search-function . auth-source-netrc-search)
+ (create-function
+ . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-secrets ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend '(:source (:secrets "foo"))
- '((:source . "foo")
- (:type . secrets)
- (:search-function . auth-source-secrets-search)
- (:create-function . auth-source-secrets-create)))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-strings ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend "secrets:foo"
- '((:source . "foo")
- (:type . secrets)
- (:search-function . auth-source-secrets-search)
- (:create-function . auth-source-secrets-create)))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -129,10 +146,12 @@
;; Redefine `secrets-get-alias' to map 'foo to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend '(:source (:secrets foo))
- '((:source . "foo")
- (:type . secrets)
- (:search-function . auth-source-secrets-search)
- (:create-function . auth-source-secrets-create))))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-symbol ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -140,10 +159,12 @@
;; Redefine `secrets-get-alias' to map 'default to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend 'default
- '((:source . "foo")
- (:type . secrets)
- (:search-function . auth-source-secrets-search)
- (:create-function . auth-source-secrets-create))))))
+ '((source . "foo")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-no-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -152,10 +173,12 @@
;; "Login" is used by default
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil)))
(auth-source-validate-backend '(:source (:secrets foo))
- '((:source . "Login")
- (:type . secrets)
- (:search-function . auth-source-secrets-search)
- (:create-function . auth-source-secrets-create))))))
+ '((source . "Login")
+ (type . secrets)
+ (search-function
+ . auth-source-secrets-search)
+ (create-function
+ . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-invalid-or-nil-source ()
(provide 'secrets) ; simulates the presence of the `secrets' package
@@ -411,7 +434,7 @@ machine c1 port c2 user c3 password c4\n"
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))))
-(ert-deftest test-netrc-credentials ()
+(ert-deftest auth-source-test-netrc-credentials ()
(let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo"))))
(should data)
(let ((imap (seq-find (lambda (elem)
@@ -427,7 +450,7 @@ machine c1 port c2 user c3 password c4\n"
(should (equal (cdr (assoc "login" imap)) "jrh"))
(should (equal (cdr (assoc "password" imap)) "*baz*")))))
-(ert-deftest test-netrc-credentials-2 ()
+(ert-deftest auth-source-test-netrc-credentials-2 ()
(let ((data (auth-source-netrc-parse-all
(ert-resource-file "netrc-folding"))))
(should
@@ -435,25 +458,33 @@ machine c1 port c2 user c3 password c4\n"
'((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
(("machine" . "YM") ("login" . "YL") ("password" . "YP")))))))
-(ert-deftest test-macos-keychain-search ()
+(ert-deftest auth-source-test-macos-keychain-search ()
"Test if the constructed command line arglist is correct."
(let ((auth-sources '(macos-keychain-internet macos-keychain-generic)))
;; Redefine `call-process' to check command line arguments.
(cl-letf (((symbol-function 'call-process)
(lambda (_program _infile _destination _display
&rest args)
- ;; Arguments must be all strings
+ ;; Arguments must be all strings.
(should (cl-every #'stringp args))
- ;; Argument number should be even
+ ;; Argument number should be even.
(should (cl-evenp (length args)))
- (should (cond ((string= (car args) "find-internet-password")
- (let ((protocol (cl-member "-r" args :test #'string=)))
- (if protocol
- (= 4 (length (cadr protocol)))
- t)))
- ((string= (car args) "find-generic-password")
- t))))))
- (auth-source-search :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https")))))
+ (should
+ (cond
+ ((string= (car args) "find-internet-password")
+ (let ((protocol-r (cl-member "-r" args :test #'string=))
+ (protocol-P (cl-member "-P" args :test #'string=)))
+ (cond (protocol-r
+ (= 4 (length (cadr protocol-r))))
+ (protocol-P
+ (string-match-p
+ "\\`[[:digit:]]+\\'" (cadr protocol-P)))
+ (t))))
+ ((string= (car args) "find-generic-password")
+ t))))))
+ (auth-source-search
+ :user '("a" "b") :host '("example.org")
+ :port '("irc" "ftp" "https" 123)))))
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index a44a5898055..b64c1682efe 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -734,6 +734,31 @@ An existing calc stack is reused, otherwise a new one is created."
(var c var-c))))))
(calc-set-language nil)))
+(ert-deftest calc-frac-input ()
+ ;; precomposed fraction
+ (should (equal (math-read-expr "Ā½")
+ '(frac 1 2)))
+ ;; ascii solidus
+ (should (equal (math-read-expr "123/456")
+ '(/ 123 456)))
+ (should (equal (math-read-expr "a/b")
+ '(/ (var a var-a) (var b var-b))))
+ ;; fraction slash
+ (should (equal (math-read-expr "123ā„456")
+ '(frac 41 152)))
+ (should (equal (math-read-expr "aā„b")
+ '(error 1 "Syntax error")))
+ ;; division slash
+ (should (equal (math-read-expr "123āˆ•456")
+ '(/ 123 456)))
+ (should (equal (math-read-expr "aāˆ•b")
+ '(/ (var a var-a) (var b var-b))))
+ ;; division sign
+ (should (equal (math-read-expr "123Ć·456")
+ '(frac 41 152)))
+ (should (equal (math-read-expr "aĆ·b") ; I think this one is wrong
+ '(error 1 "Syntax error"))))
+
(defvar var-g)
;; Test `let'.
@@ -836,7 +861,7 @@ An existing calc stack is reused, otherwise a new one is created."
;; exponent/subscript
(should (string= (concat "+/-*:-/*inf<=>=<=>=Ī¼(1:4)(1:2)(3:4)(1:3)(2:3)"
"(1:5)(2:5)(3:5)(4:5)(1:6)(5:6)"
- "(1:8)(3:8)(5:8)(7:8)1:^(0123456789+-()ni)"
+ "(1:8)(3:8)(5:8)(7:8)1::^(0123456789+-()ni)"
"_(0123456789+-())")
(math-read-preprocess-string
(mapconcat #'car math-read-replacement-list))))
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 7d3af25ea49..39ad735a789 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -68,7 +68,7 @@
(with-temp-buffer
(insert diary-string)
(icalendar-export-region (point-min) (point-max) file))
- (with-current-buffer (get-buffer "*icalendar-errors*")
+ (with-current-buffer "*icalendar-errors*"
(buffer-string))))
;; ======================================================================
diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el
index 190764e9125..5b2c28bd3dd 100644
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -181,4 +181,19 @@ instead."
(completion-preview--post-command))
(completion-preview-tests--check-preview "barbaz" 'exact)))
+(ert-deftest completion-preview-mid-symbol-cycle ()
+ "Test cycling the completion preview with point at the middle of a symbol."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "fooba")
+ (forward-char -2)
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "r")
+ (completion-preview-next-candidate 1)
+ (completion-preview-tests--check-preview "z")))
+
;;; completion-preview-tests.el ends here
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index 8cbfb9ad9df..a4e913541bf 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -209,6 +209,16 @@ child results in an error."
(dom-pp node t)
(should (equal (buffer-string) "(\"foo\" nil)")))))
+(ert-deftest dom-tests-print ()
+ "Test that `dom-print' correctly encodes HTML reserved characters."
+ (with-temp-buffer
+ (dom-print '(samp ((class . "samp")) "<div class=\"default\"> </div>"))
+ (should (equal
+ (buffer-string)
+ (concat "<samp class=\"samp\">"
+ "&lt;div class=&quot;default&quot;&gt; &lt;/div&gt;"
+ "</samp>")))))
+
(ert-deftest dom-test-search ()
(let ((dom '(a nil (b nil (c nil)))))
(should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a)))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
index 94b0e80c979..571f7f6f095 100644
--- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
@@ -1,3 +1,4 @@
;;; -*- lexical-binding: t -*-
(defun foo ()
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
+ nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 293d3025420..26408e8685a 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -800,6 +800,9 @@ inner loops respectively."
;; Aristotelian identity optimization
(let ((x (bytecomp-test-identity 1)))
(list (eq x x) (eql x x) (equal x x)))
+
+ ;; Legacy single-arg `apply' call
+ (apply '(* 2 3))
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -848,6 +851,22 @@ byte-compiled. Run with dynamic binding."
(should (equal (bytecomp-tests--eval-interpreted form)
(bytecomp-tests--eval-compiled form)))))))
+(ert-deftest bytecomp--fun-value-as-head ()
+ ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931).
+ ;; (There is also a warning but this test does not check that.)
+ (dolist (lb '(nil t))
+ (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ")
+ (let* ((lexical-binding lb)
+ (s-int '(lambda (x) (1+ x)))
+ (s-comp (byte-compile s-int))
+ (v-int (lambda (x) (1+ x)))
+ (v-comp (byte-compile v-int))
+ (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3)))))))
+ (should (equal (funcall comp s-int) 4))
+ (should (equal (funcall comp s-comp) 4))
+ (should (equal (funcall comp v-int) 4))
+ (should (equal (funcall comp v-comp) 4))))))
+
(defmacro bytecomp-tests--with-fresh-warnings (&rest body)
`(let ((macroexp--warned ; oh dear
(make-hash-table :test #'equal :weakness 'key)))
@@ -2087,18 +2106,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
(defun bytecomp-tests--error-frame (fun args)
"Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)."
- (let* ((debugger
- (lambda (&rest args)
- ;; Make sure Emacs doesn't think our debugger is buggy.
- (cl-incf num-nonmacro-input-events)
- (throw 'bytecomp-tests--backtrace
- (cons args (cadr (backtrace-get-frames debugger))))))
- (debug-on-error t)
- (backtrace-on-error-noninteractive nil)
- (debug-on-quit t)
- (debug-ignored-errors nil))
+ (letrec ((handler (lambda (e)
+ (throw 'bytecomp-tests--backtrace
+ (cons e (cadr (backtrace-get-frames handler)))))))
(catch 'bytecomp-tests--backtrace
- (apply fun args))))
+ (handler-bind ((error handler))
+ (apply fun args)))))
(defconst bytecomp-tests--byte-op-error-cases
'(((car a) (wrong-type-argument listp a))
@@ -2143,7 +2156,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
`(lambda ,formals (,fun-sym ,@formals)))))))
(error-frame (bytecomp-tests--error-frame fun actuals)))
(should (consp error-frame))
- (should (equal (car error-frame) (list 'error expected-error)))
+ (should (equal (car error-frame) expected-error))
(let ((frame (cdr error-frame)))
(should (equal (type-of frame) 'backtrace-frame))
(should (equal (cons (backtrace-frame-fun frame)
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 086ac399352..1241d28ab74 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -319,5 +319,18 @@ Edebug symbols (Bug#42672)."
(and (eq 'error (car err))
(string-match "Stray.*declare" (cadr err)))))))
+(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4)))
+ (+ function 1))
+
+(ert-deftest cl-generic-tests--print-quoted ()
+ (with-temp-buffer
+ (cl--generic-describe 'cl-generic-tests--print-quoted-method)
+ (goto-char (point-min))
+ ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4)
+ (should-not (re-search-forward "#'" nil t))
+ (goto-char (point-min))
+ ;; But we don't want (eql '4) to turn into (eql (quote 4)) either.
+ (should (re-search-forward "(eql '4)" nil t))))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el
index fb1770f1f4a..b823a190d5a 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -29,218 +29,211 @@
(require 'cl-lib)
(require 'comp-cstr)
-(cl-eval-when (compile eval load)
-
- (defun comp-cstr-test-ts (type-spec)
- "Create a constraint from TYPE-SPEC and convert it back to type specifier."
- (let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
-
- (defun comp-cstr-typespec-test (number type-spec expected-type-spec)
- `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) ()
- (should (equal (comp-cstr-test-ts ',type-spec)
- ',expected-type-spec))))
-
- (defconst comp-cstr-typespec-tests-alist
- '(;; 1
- (symbol . symbol)
- ;; 2
- ((or string array) . array)
- ;; 3
- ((or symbol number) . (or number symbol))
- ;; 4
- ((or cons atom) . t) ;; SBCL return T
- ;; 5
- ((or integer number) . number)
- ;; 6
- ((or (or integer symbol) number) . (or number symbol))
- ;; 7
- ((or (or integer symbol) (or number list)) . (or list number symbol))
- ;; 8
- ((or (or integer number) nil) . number)
- ;; 9
- ((member foo) . (member foo))
- ;; 10
- ((member foo bar) . (member bar foo))
- ;; 11
- ((or (member foo) (member bar)) . (member bar foo))
- ;; 12
- ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
- ;; 13
- ((or (member foo) number) . (or (member foo) number))
- ;; 14
- ((or (integer 1 3) number) . number)
- ;; 15
- (integer . integer)
- ;; 16
- ((integer 1 2) . (integer 1 2))
- ;; 17
- ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
- ;; 18
- ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
- ;; 19
- ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
- ;; 20
- ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
- ;; 21
- ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
- ;; 22
- ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
- ;; 23
- ((or (integer -1 2) (integer * 4)) . (integer * 4))
- ;; 24
- ((and string array) . string)
- ;; 25
- ((and cons atom) . nil)
- ;; 26
- ((and (member foo) (member foo bar baz)) . (member foo))
- ;; 27
- ((and (member foo) (member bar)) . nil)
- ;; 28
- ((and (member foo) symbol) . (member foo))
- ;; 29
- ((and (member foo) string) . nil)
- ;; 30
- ((and (member foo) (integer 1 2)) . nil)
- ;; 31
- ((and (member 1 2) (member 3 2)) . (integer 2 2))
- ;; 32
- ((and number (integer 1 2)) . (integer 1 2))
- ;; 33
- ((and integer (integer 1 2)) . (integer 1 2))
- ;; 34
- ((and (integer -1 0) (integer 3 5)) . nil)
- ;; 35
- ((and (integer -1 2) (integer 3 5)) . nil)
- ;; 36
- ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
- ;; 37
- ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
- ;; 38
- ((and (integer -1 5) nil) . nil)
- ;; 39
- ((not symbol) . (not symbol))
- ;; 40
- ((or (member foo) (not (member foo bar))) . (not (member bar)))
- ;; 41
- ((or (member foo bar) (not (member foo))) . t)
- ;; 42
- ((or symbol (not sequence)) . (not sequence))
- ;; 43
- ((or symbol (not symbol)) . t)
- ;; 44
- ((or symbol (not sequence)) . (not sequence))
- ;; 45 Conservative.
- ((or vector (not sequence)) . t)
- ;; 46
- ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 47
- ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 48
- ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
- ;; 49
- ((or symbol (not (member foo))) . (not (member foo)))
- ;; 50
- ((or (not symbol) (not (member foo))) . (not symbol))
- ;; 51 Conservative.
- ((or (not (member foo)) string) . (not (member foo)))
- ;; 52 Conservative.
- ((or (member foo) (not string)) . (not string))
- ;; 53
- ((or (not (integer 1 2)) integer) . t)
- ;; 54
- ((or (not (integer 1 2)) (not integer)) . (not integer))
- ;; 55
- ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
- ;; 56
- ((or number (not (integer 1 2))) . t)
- ;; 57
- ((or atom (not (integer 1 2))) . t)
- ;; 58
- ((or atom (not (member foo))) . t)
- ;; 59
- ((and symbol (not cons)) . symbol)
- ;; 60
- ((and symbol (not symbol)) . nil)
- ;; 61
- ((and atom (not symbol)) . atom)
- ;; 62
- ((and atom (not string)) . (or array sequence atom))
- ;; 63 Conservative
- ((and symbol (not (member foo))) . symbol)
- ;; 64 Conservative
- ((and symbol (not (member 3))) . symbol)
- ;; 65
- ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
- ;; 66
- ((and (member foo) (not (integer 1 10))) . (member foo))
- ;; 67
- ((and t (not (member foo))) . (not (member foo)))
- ;; 68
- ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
- ;; 69
- ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
- ;; 70
- ((and (not (member a)) (not (member b))) . (not (member a b)))
- ;; 71
- ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
- ;; 72
- ((and t (integer 1 1)) . (integer 1 1))
- ;; 73
- ((not (integer -1 5)) . (not (integer -1 5)))
- ;; 74
- ((and boolean (or number marker)) . nil)
- ;; 75
- ((and atom (or number marker)) . number-or-marker)
- ;; 76
- ((and symbol (or number marker)) . nil)
- ;; 77
- ((and (or symbol string) (or number marker)) . nil)
- ;; 78
- ((and t t) . t)
- ;; 79
- ((and (or marker number) (integer 0 0)) . (integer 0 0))
- ;; 80
- ((and t (not t)) . nil)
- ;; 81
- ((or (integer 1 1) (not (integer 1 1))) . t)
- ;; 82
- ((not t) . nil)
- ;; 83
- ((not nil) . t)
- ;; 84
- ((or (not string) t) . t)
- ;; 85
- ((or (not vector) sequence) . sequence)
- ;; 86
- ((or (not symbol) null) . t)
- ;; 87
- ((and (or null integer) (not (or null integer))) . nil)
- ;; 88
- ((and (or (member a b c)) (not (or (member a b)))) . (member c))
- ;; 89
- ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'?
- ;; 90
- ((or string char-table bool-vector vector) . array)
- ;; 91
- ((or string char-table bool-vector vector number) . (or array number))
- ;; 92
- ((or string char-table bool-vector vector cons symbol number) .
- (or number sequence symbol))
- ;; 93?
- ;; FIXME: I get `cons' rather than `list'?
- ;;((or null cons) . list)
- )
- "Alist type specifier -> expected type specifier."))
-
-(defmacro comp-cstr-synthesize-tests ()
- "Generate all tests from `comp-cstr-typespec-tests-alist'."
+(defun comp-cstr-test-ts (type-spec)
+ "Create a constraint from TYPE-SPEC and convert it back to type specifier."
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
+
+(defmacro comp-cstr-synthesize-tests (typespec-tests-alist)
+ "Generate all tests from TYPESPEC-TESTS-ALIST.
+The arg is an alist of: type specifier -> expected type specifier."
`(progn
,@(cl-loop
for i from 1
- for (ts . exp-ts) in comp-cstr-typespec-tests-alist
- append (list (comp-cstr-typespec-test i ts exp-ts)))))
-
-(comp-cstr-synthesize-tests)
+ for (type-spec . expected-type-spec) in typespec-tests-alist
+ collect
+ `(ert-deftest ,(intern (format "comp-cstr-test-%d" i)) ()
+ (should (equal (comp-cstr-test-ts ',type-spec)
+ ',expected-type-spec))))))
+
+(comp-cstr-synthesize-tests
+ (;; 1
+ (symbol . symbol)
+ ;; 2
+ ((or string array) . array)
+ ;; 3
+ ((or symbol number) . (or number symbol))
+ ;; 4
+ ((or cons atom) . t) ;; Like SBCL
+ ;; 5
+ ((or integer number) . number)
+ ;; 6
+ ((or (or integer symbol) number) . (or number symbol))
+ ;; 7
+ ((or (or integer symbol) (or number list)) . (or list number symbol))
+ ;; 8
+ ((or (or integer number) nil) . number)
+ ;; 9
+ ((member foo) . (member foo))
+ ;; 10
+ ((member foo bar) . (member bar foo))
+ ;; 11
+ ((or (member foo) (member bar)) . (member bar foo))
+ ;; 12
+ ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
+ ;; 13
+ ((or (member foo) number) . (or (member foo) number))
+ ;; 14
+ ((or (integer 1 3) number) . number)
+ ;; 15
+ (integer . integer)
+ ;; 16
+ ((integer 1 2) . (integer 1 2))
+ ;; 17
+ ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
+ ;; 18
+ ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
+ ;; 19
+ ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
+ ;; 20
+ ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
+ ;; 21
+ ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
+ ;; 22
+ ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
+ ;; 23
+ ((or (integer -1 2) (integer * 4)) . (integer * 4))
+ ;; 24
+ ((and string array) . string)
+ ;; 25
+ ((and cons atom) . nil)
+ ;; 26
+ ((and (member foo) (member foo bar baz)) . (member foo))
+ ;; 27
+ ((and (member foo) (member bar)) . nil)
+ ;; 28
+ ((and (member foo) symbol) . (member foo))
+ ;; 29
+ ((and (member foo) string) . nil)
+ ;; 30
+ ((and (member foo) (integer 1 2)) . nil)
+ ;; 31
+ ((and (member 1 2) (member 3 2)) . (integer 2 2))
+ ;; 32
+ ((and number (integer 1 2)) . (integer 1 2))
+ ;; 33
+ ((and integer (integer 1 2)) . (integer 1 2))
+ ;; 34
+ ((and (integer -1 0) (integer 3 5)) . nil)
+ ;; 35
+ ((and (integer -1 2) (integer 3 5)) . nil)
+ ;; 36
+ ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
+ ;; 37
+ ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
+ ;; 38
+ ((and (integer -1 5) nil) . nil)
+ ;; 39
+ ((not symbol) . (not symbol))
+ ;; 40
+ ((or (member foo) (not (member foo bar))) . (not (member bar)))
+ ;; 41
+ ((or (member foo bar) (not (member foo))) . t)
+ ;; 42
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 43
+ ((or symbol (not symbol)) . t)
+ ;; 44
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 45 Conservative.
+ ((or vector (not sequence)) . t)
+ ;; 46
+ ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 47
+ ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 48
+ ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
+ ;; 49
+ ((or symbol (not (member foo))) . (not (member foo)))
+ ;; 50
+ ((or (not symbol) (not (member foo))) . (not symbol))
+ ;; 51 Conservative.
+ ((or (not (member foo)) string) . (not (member foo)))
+ ;; 52 Conservative.
+ ((or (member foo) (not string)) . (not string))
+ ;; 53
+ ((or (not (integer 1 2)) integer) . t)
+ ;; 54
+ ((or (not (integer 1 2)) (not integer)) . (not integer))
+ ;; 55
+ ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
+ ;; 56
+ ((or number (not (integer 1 2))) . t)
+ ;; 57
+ ((or atom (not (integer 1 2))) . t)
+ ;; 58
+ ((or atom (not (member foo))) . t)
+ ;; 59
+ ((and symbol (not cons)) . symbol)
+ ;; 60
+ ((and symbol (not symbol)) . nil)
+ ;; 61
+ ((and atom (not symbol)) . atom)
+ ;; 62 Conservative FIXME
+ ((and atom (not string)) . (or array sequence atom))
+ ;; 63 Conservative
+ ((and symbol (not (member foo))) . symbol)
+ ;; 64 Conservative
+ ((and symbol (not (member 3))) . symbol)
+ ;; 65
+ ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
+ ;; 66
+ ((and (member foo) (not (integer 1 10))) . (member foo))
+ ;; 67
+ ((and t (not (member foo))) . (not (member foo)))
+ ;; 68
+ ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
+ ;; 69
+ ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
+ ;; 70
+ ((and (not (member a)) (not (member b))) . (not (member a b)))
+ ;; 71
+ ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
+ ;; 72
+ ((and t (integer 1 1)) . (integer 1 1))
+ ;; 73
+ ((not (integer -1 5)) . (not (integer -1 5)))
+ ;; 74
+ ((and boolean (or number marker)) . nil)
+ ;; 75
+ ((and atom (or number marker)) . number-or-marker)
+ ;; 76
+ ((and symbol (or number marker)) . nil)
+ ;; 77
+ ((and (or symbol string) (or number marker)) . nil)
+ ;; 78
+ ((and t t) . t)
+ ;; 79
+ ((and (or marker number) (integer 0 0)) . (integer 0 0))
+ ;; 80
+ ((and t (not t)) . nil)
+ ;; 81
+ ((or (integer 1 1) (not (integer 1 1))) . t)
+ ;; 82
+ ((not t) . nil)
+ ;; 83
+ ((not nil) . t)
+ ;; 84
+ ((or (not string) t) . t)
+ ;; 85
+ ((or (not vector) sequence) . sequence)
+ ;; 86
+ ((or (not symbol) null) . t)
+ ;; 87
+ ((and (or null integer) (not (or null integer))) . nil)
+ ;; 88
+ ((and (or (member a b c)) (not (or (member a b)))) . (member c))
+ ;; 89
+ ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'?
+ ;; 90
+ ((or string char-table bool-vector vector) . array)
+ ;; 91
+ ((or string char-table bool-vector vector number) . (or array number))
+ ;; 92
+ ((or string char-table bool-vector vector cons symbol number) .
+ (or number sequence symbol))
+ ;; 93
+ ((or list (not null)) . t)
+ ))
;;; comp-cstr-tests.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 8c0f729dc39..29adbcff947 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -860,8 +860,7 @@ test and possibly others should be updated."
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "`1"))
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun nil))
+ (eval-defun nil)
;; `eval-defun' outputs its message to the echo area in a rather
;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
;; there in separate pieces (via `print' rather than via `message').
@@ -871,18 +870,21 @@ test and possibly others should be updated."
(setq edebug-initial-mode 'go)
;; In Bug#23651 Edebug would hang reading `1.
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun t))))
+ (eval-defun t)
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
+ edebug-tests-messages))))
(ert-deftest edebug-tests-trivial-comma ()
"Edebug can read a trivial comma expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert ",1")
- (read-only-mode)
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (should-error (edebug-eval-defun t)))))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert ",1"))
+ ;; FIXME: This currently signals a "Source has changed" error, which is
+ ;; itself a bug (the source hasn't changed). All we're testing here
+ ;; is that the Edebug gets past the step of reading the sexp.
+ (should-error (let ((eval-expression-debug-on-error nil))
+ (eval-defun t)))))
(ert-deftest edebug-tests-circular-read-syntax ()
"Edebug can instrument code using circular read object syntax (Bug#23660)."
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index b244a56779a..fb2c6ea3b68 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -259,7 +259,7 @@
(ans '(
(:PRIMARY D)
(:PRIMARY D-base1)
- ;; (:PRIMARY D-base2)
+ (:PRIMARY D-base2)
(:PRIMARY D-base0)
)))
(eitest-F (D nil))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 83fc476c911..bc226757ff2 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1011,24 +1011,24 @@ Subclasses to override slot attributes."))
(B (clone A :b "bb"))
(C (clone B :a "aa")))
- (should (string= "aa" (oref C :a)))
- (should (string= "bb" (oref C :b)))
+ (should (string= "aa" (oref C a)))
+ (should (string= "bb" (oref C b)))
- (should (slot-boundp A :a))
- (should-not (slot-boundp A :b))
- (should-not (slot-boundp A :c))
+ (should (slot-boundp A 'a))
+ (should-not (slot-boundp A 'b))
+ (should-not (slot-boundp A 'c))
- (should-not (slot-boundp B :a))
- (should (slot-boundp B :b))
- (should-not (slot-boundp A :c))
+ (should-not (slot-boundp B 'a))
+ (should (slot-boundp B 'b))
+ (should-not (slot-boundp A 'c))
- (should (slot-boundp C :a))
- (should-not (slot-boundp C :b))
- (should-not (slot-boundp C :c))
+ (should (slot-boundp C 'a))
+ (should-not (slot-boundp C 'b))
+ (should-not (slot-boundp C 'c))
- (should (eieio-instance-inheritor-slot-boundp C :a))
- (should (eieio-instance-inheritor-slot-boundp C :b))
- (should-not (eieio-instance-inheritor-slot-boundp C :c))))
+ (should (eieio-instance-inheritor-slot-boundp C 'a))
+ (should (eieio-instance-inheritor-slot-boundp C 'b))
+ (should-not (eieio-instance-inheritor-slot-boundp C 'c))))
;;;; Interaction with defstruct
diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
new file mode 100644
index 00000000000..5eae9af212f
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,2 @@
+var abc = function(d) {
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..fa2e5dc4db7 100644
--- a/test/lisp/emacs-lisp/ert-font-lock-tests.el
+++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el
@@ -138,13 +138,24 @@ print(\"Hello, world!\")"
(forward-line)
(should (ert-font-lock--line-comment-p))))
+(ert-deftest test-parse-comments--no-assertion-error ()
+ (let* ((str "
+not_an_assertion
+random_symbol
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (should-error (ert-font-lock--parse-comments) :type 'user-error))))
+
(ert-deftest test-parse-comments--single-line-error ()
(let* ((str "// ^ face.face1"))
(with-temp-buffer
(insert str)
(javascript-mode)
- (should-error (ert-font-lock--parse-comments)))))
+ (should-error (ert-font-lock--parse-comments) :type 'user-error))))
(ert-deftest test-parse-comments--single-line-single-caret ()
(let* ((str "
@@ -159,7 +170,46 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil))))))
+
+(ert-deftest test-parse-comments--single-line-many-carets ()
+ (let* ((str "
+multiplecarets
+//^^^ ^^ ^ face.face1
+")
+ asserts)
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (setq asserts (ert-font-lock--parse-comments))
+ (should (eql (length asserts) 6))
+ (should (equal asserts
+ '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil)))))))
+
+(ert-deftest test-parse-comments--face-list ()
+ (let* ((str "
+facelist
+// ^ (face1 face2)
+// ^ !(face3 face4)
+// ^ (face5)
+")
+ asserts)
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (setq asserts (ert-font-lock--parse-comments))
+ (should (eql (length asserts) 3))
+ (should (equal asserts
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t)
+ (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil)))))))
(ert-deftest test-parse-comments--caret-negation ()
(let* ((str "
@@ -175,11 +225,11 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 2))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t)
- (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t)
+ (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil)))))))
-(ert-deftest test-parse-comments--single-line-multiple-carets ()
+(ert-deftest test-parse-comments--single-line-multiple-assert-lines ()
(let* ((str "
first
// ^ face1
@@ -196,12 +246,12 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 4))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil)
- (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil)
+ (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil)))))))
-(ert-deftest test-parse-comments--multiple-line-multiple-carets ()
+(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines ()
(let* ((str "
first
// ^ face1
@@ -218,9 +268,9 @@ third
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil)
- (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil)
- (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil)
+ (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil)
+ (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil)))))))
(ert-deftest test-parse-comments--arrow-single-line-single ()
@@ -236,7 +286,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil))))))
(ert-deftest test-parse-comments-arrow-multiple-line-single ()
@@ -254,9 +304,9 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil)))))))
(ert-deftest test-parse-comments--non-assert-comment-single ()
(let* ((str "
@@ -271,7 +321,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil))))))
(ert-deftest test-parse-comments--non-assert-comment-multiple ()
(let* ((str "
@@ -288,9 +338,9 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil)))))))
(ert-deftest test-parse-comments--multiline-comment-single ()
@@ -308,7 +358,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil))))))
+ '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil))))))
(ert-deftest test-parse-comments--multiline-comment-multiple ()
(let* ((str "
@@ -327,13 +377,47 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 2))
(should (equal asserts
- '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)
- (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil)))))))
+ '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)
+ (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil)))))))
;;; Syntax highlighting assertion tests
;;
-(ert-deftest test-syntax-highlight-inline--caret-multiple-faces ()
+(ert-deftest test-syntax-highlight-inline--nil-list ()
+ (let ((str "
+var abc = function(d) {
+// ^ nil
+// ^ !nil
+};
+
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
+
+(ert-deftest test-syntax-highlight-inline--face-list ()
+ (let ((str "
+var abc = function(d) {
+// ^ (test-face-2 test-face-1 font-lock-variable-name-face)
+};
+
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (add-face-text-property (point-min) (point-max) 'test-face-1)
+ (add-face-text-property (point-min) (point-max) 'test-face-2)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
+
+(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions ()
(let ((str "
var abc = function(d) {
// ^ font-lock-variable-name-face
@@ -364,6 +448,19 @@ var abc = function(d) {
(should-error (ert-font-lock--check-faces
(ert-font-lock--parse-comments))))))
+(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face ()
+ (let* ((str "
+var abc = function(d) {
+// ^ !not-a-face
+};
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
(ert-deftest test-syntax-highlight-inline--comment-face ()
(let* ((str "
@@ -455,6 +552,12 @@ var abc = function(d) {
javascript-mode
"correct.js")
+(ert-font-lock-deftest-file test-macro-test--file-no-asserts
+ "Check failing on files without assertions"
+ :expected-result :failed
+ javascript-mode
+ "no-asserts.js")
+
(ert-font-lock-deftest-file test-macro-test--file-failing
"Test reading wrong assertions from a file"
:expected-result :failed
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 768a3a726aa..1aff73d66f6 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -1,6 +1,6 @@
;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
@@ -93,16 +93,6 @@ failed or if there was a problem."
'(ert-test-failed "failure message"))
t))))
-(ert-deftest ert-test-fail-debug-with-condition-case ()
- (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
- (condition-case condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
-
(ert-deftest ert-test-fail-debug-with-debugger-1 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(let ((debugger (lambda (&rest _args)
@@ -146,16 +136,6 @@ failed or if there was a problem."
'(error "Error message"))
t))))
-(ert-deftest ert-test-error-debug ()
- (let ((test (make-ert-test :body (lambda () (error "Error message")))))
- (condition-case condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (cl-assert (equal condition '(error "Error message")) t)))))
-
;;; Test that `should' works.
(ert-deftest ert-test-should ()
@@ -359,14 +339,10 @@ This macro is used to test if macroexpansion in `should' works."
(,(lambda () (let ((_x t)) (should (error "Foo"))))
(error "Foo")))
do
- (let ((test (make-ert-test :body body)))
- (condition-case actual-condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (should (equal actual-condition expected-condition)))))))
+ (let* ((test (make-ert-test :body body))
+ (result (ert-run-test test)))
+ (should (ert-test-failed-p result))
+ (should (equal (ert-test-failed-condition result) expected-condition)))))
(defun ert-test--which-file ()
"Dummy function to help test `symbol-file' for tests.")
@@ -392,9 +368,9 @@ This macro is used to test if macroexpansion in `should' works."
(result (ert-run-test test)))
(should (ert-test-failed-p result))
(should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result)))
- ;;; This is `ert-fail' on nativecomp and `signal'
- ;;; otherwise. It's not clear whether that's a bug
- ;;; or not (bug#51308).
+ ;; This is `ert-fail' on nativecomp and `signal'
+ ;; otherwise. It's not clear whether that's a bug
+ ;; or not (bug#51308).
'(ert-fail signal)))))
(ert-deftest ert-test-messages ()
@@ -880,7 +856,6 @@ This macro is used to test if macroexpansion in `should' works."
(ert-deftest ert-test-with-demoted-errors ()
"Check that ERT correctly handles `with-demoted-errors'."
- :expected-result :failed ;; FIXME! Bug#11218
(should-not (with-demoted-errors "FOO: %S" (error "Foo"))))
(ert-deftest ert-test-fail-inside-should ()
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el
index 97a0f7ba52c..3333f4014e6 100644
--- a/test/lisp/emacs-lisp/hierarchy-tests.el
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -570,8 +570,9 @@ should fail as this function will crash."
(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."
+Basically, 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))))
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el
index 460b7a8e516..5358bcaeb5c 100644
--- a/test/lisp/emacs-lisp/macroexp-resources/vk.el
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -25,7 +25,7 @@
(if (macroexp--dynamic-variable-p var) ''dyn ''lex))
(defvar vk-a 1)
-(defconst vk-b 2)
+(defvar vk-b 2)
(defvar vk-c)
(defun vk-f1 (x)
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index d062965952a..c79adcdfec5 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -160,4 +160,18 @@
(should-error (pcase-setq a)
:type '(wrong-number-of-arguments)))
+(ert-deftest pcase-tests-mutually-exclusive ()
+ (dolist (x '((functionp consp nil)
+ (functionp stringp t)
+ (compiled-function-p consp t)
+ (keywordp symbolp nil)
+ (keywordp symbol-with-pos-p nil)
+ (keywordp stringp t)))
+ (if (nth 2 x)
+ (should (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x)))
+ (should-not (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x))))
+ (if (nth 2 x)
+ (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))
+ (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))))))
+
;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el
index b663fb365a8..7606183d645 100644
--- a/test/lisp/emacs-lisp/pp-tests.el
+++ b/test/lisp/emacs-lisp/pp-tests.el
@@ -36,4 +36,53 @@
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "code-formats.erts")))
+(defun pp-tests--dimensions ()
+ (save-excursion
+ (let ((width 0)
+ (height 0))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (end-of-line)
+ (setq height (1+ height))
+ (setq width (max width (current-column)))
+ (forward-char 1))
+ (cons width height))))
+
+(ert-deftest pp-tests--cut-before ()
+ (with-temp-buffer
+ (lisp-data-mode)
+ (pp '(1 (quite-a-long-package-name
+ . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar
+ ((:url . "https://github.com/abo-abo/ace-window")
+ (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com")
+ (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com"))
+ (:keywords "window" "location"))]))
+ (current-buffer))
+ ;; (message "Filled:\n%s" (buffer-string))
+ (let ((dimensions (pp-tests--dimensions)))
+ (should (< (car dimensions) 80))
+ (should (< (cdr dimensions) 8)))
+ (goto-char (point-min))
+ (while (search-forward "." nil t)
+ (should (not (eolp))))))
+
+(ert-deftest pp-tests--sanity ()
+ (with-temp-buffer
+ (lisp-data-mode)
+ (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))"))
+ (let ((res (car (read-from-string testdata))))
+ (dotimes (i (length testdata))
+ (erase-buffer)
+ (insert testdata)
+ (let ((fill-column i))
+ (pp-fill (point-min) (point-max))
+ (goto-char (point-min))
+ (condition-case err
+ (should (equal (read (current-buffer)) res))
+ (invalid-read-syntax
+ (message "Invalid fill result with i=%d:\n%s"
+ i (buffer-string))
+ (signal (car err) (cdr err))
+ ))))))))
+
;;; pp-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el
index 8be2be3139e..e53268b3f14 100644
--- a/test/lisp/emacs-lisp/tabulated-list-tests.el
+++ b/test/lisp/emacs-lisp/tabulated-list-tests.el
@@ -130,4 +130,45 @@
(should-error (tabulated-list-sort) :type 'user-error)
(should-error (tabulated-list-sort 4) :type 'user-error)))
+(ert-deftest tabulated-list-groups ()
+ (with-temp-buffer
+ (tabulated-list-mode)
+ (setq tabulated-list-groups
+ (reverse
+ (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3)))
+ tabulated-list--test-entries)))
+ (setq tabulated-list-format tabulated-list--test-format)
+ (setq tabulated-list-padding 7)
+ (tabulated-list-init-header)
+ (tabulated-list-print)
+ ;; Basic printing.
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+ mode mode 1128 installed A simple mode for editing Actionscript 3 files
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions
+"))
+ ;; Sort and preserve position.
+ (forward-line 2)
+ (let ((pos (thing-at-point 'line)))
+ (tabulated-list-next-column 2)
+ (tabulated-list-sort)
+ (should (equal (thing-at-point 'line) pos))
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ mode mode 1128 installed A simple mode for editing Actionscript 3 files
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions
+")))))
+
;;; tabulated-list-tests.el ends here
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index ba6fe9fd8c1..603b3745a27 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -20,14 +20,13 @@
;;; Commentary:
;;; Code:
+(require 'erc-button)
(require 'ert-x) ; cl-lib
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-button)
-
(ert-deftest erc-button-alist--url ()
(erc-tests-common-init-server-proc "sleep" "1")
(with-current-buffer (erc--open-target "#chan")
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index a2fb0392727..d4b5919a1cc 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -243,7 +243,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
@@ -264,7 +264,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
@@ -289,7 +289,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 0f19b481f37..3c4ad04abd7 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -23,13 +23,13 @@
;; scenarios.
;;; Code:
+(require 'erc-fill)
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-fill)
-
(defvar erc-fill-tests--buffers nil)
(defvar erc-fill-tests--current-time-value nil)
@@ -52,6 +52,7 @@
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
+ (erc--fill-wrap-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index b8e00c57ef5..7cbaa39d3f7 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -19,29 +19,33 @@
;;; Commentary:
;;; Code:
+(require 'erc-goodies)
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-goodies)
-
(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
(setq beg (+ beg (point-min)))
(let ((end (+ beg (1- (length end-str)))))
- (while (and beg (< beg end))
- (let* ((val (get-text-property beg 'font-lock-face))
- (ft (flatten-tree (ensure-list val))))
- (dolist (p (ensure-list present))
- (if (consp p)
- (should (member p val))
- (should (memq p ft))))
- (dolist (a (ensure-list absent))
- (if (consp a)
- (should-not (member a val))
- (should-not (memq a ft))))
- (setq beg (text-property-not-all beg (point-max)
- 'font-lock-face val))))))
+ (ert-info ((format "beg: %S, end-str: %S" beg end-str))
+ (while (and beg (< beg end))
+ (let* ((val (get-text-property beg 'font-lock-face))
+ (ft (flatten-tree (ensure-list val))))
+ (ert-info ((format "looking-at: %S, val: %S"
+ (buffer-substring-no-properties beg end)
+ val))
+ (dolist (p (ensure-list present))
+ (if (consp p)
+ (should (member p val))
+ (should (memq p ft))))
+ (dolist (a (ensure-list absent))
+ (if (consp a)
+ (should-not (member a val))
+ (should-not (memq a ft)))))
+ (setq beg (text-property-not-all beg (point-max)
+ 'font-lock-face val)))))))
;; These are from the "Examples" section of
;; https://modern.ircdocs.horse/formatting.html
@@ -129,39 +133,205 @@
;; Hovering over the redacted area should reveal its underlying text
;; in a high-contrast face.
-(ert-deftest erc-controls-highlight--inverse ()
+(ert-deftest erc-controls-highlight--spoilers ()
(should (eq t erc-interpret-controls-p))
- (let ((erc-insert-modify-hook '(erc-controls-highlight))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq-local erc-interpret-mirc-color t)
- (erc--initialize-markers (point) nil)
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (let* ((raw (concat "BEGIN "
+ "\C-c0,0 WhiteOnWhite "
+ "\C-c1,1 BlackOnBlack "
+ "\C-c99,99 Default "
+ "\C-o END"))
+ (msg (erc-format-privmessage "bob" raw nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ ;; Narrow to EOL or start of right-side stamp.
+ (narrow-to-region (point) (line-end-position))
+ (save-excursion
+ (search-forward "WhiteOn")
+ (should (eq (get-text-property (point) 'mouse-face)
+ 'erc-spoiler-face))
+ (search-forward "BlackOn")
+ (should (eq (get-text-property (point) 'mouse-face)
+ 'erc-spoiler-face)))
+ ;; Start wtih ERC default face.
+ (erc-goodies-tests--assert-face
+ 0 "BEGIN " 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))
+ ;; Masked in all white.
+ (erc-goodies-tests--assert-face
+ 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0)
+ '(fg:erc-color-face1 bg:erc-color-face1))
+ ;; Masked in all black.
+ (erc-goodies-tests--assert-face
+ 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil)
+ ;; Explicit "default" code ignoerd.
+ (erc-goodies-tests--assert-face
+ 34 "Default" '(erc-default-face)
+ '(fg:erc-color-face1 bg:erc-color-face1))
+ (erc-goodies-tests--assert-face
+ 43 "END" 'erc-default-face nil)))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
- (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
- (msg (erc-format-privmessage "bob" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (should (eq (get-text-property (+ 9 (point)) 'mouse-face)
- 'erc-inverse-face))
- (should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
- 'erc-inverse-face))
- (erc-goodies-tests--assert-face
- 0 "Spoiler: " 'erc-default-face
- '(fg:erc-color-face0 bg:erc-color-face0))
- (erc-goodies-tests--assert-face
- 9 "Hello" '(erc-spoiler-face)
- '( fg:erc-color-face0 bg:erc-color-face0
- fg:erc-color-face1 bg:erc-color-face1))
- (erc-goodies-tests--assert-face
- 18 " World" '(erc-spoiler-face)
- '( fg:erc-color-face0 bg:erc-color-face0
- fg:erc-color-face1 bg:erc-color-face1 )))
- (when noninteractive
- (kill-buffer)))))
+(ert-deftest erc-controls-highlight--inverse ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let* ((erc-fill-column 90)
+ (raw (concat "BEGIN "
+ "\C-c3,13 GreenOnPink "
+ "\C-v PinkOnGreen "
+ "\C-c99,99 ReversedDefault "
+ "\C-v NormalDefault "
+ "\C-o END"))
+ (msg (erc-format-privmessage "bob" raw nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ ;; Narrow to EOL or start of right-side stamp.
+ (narrow-to-region (point) (line-end-position))
+ ;; Baseline.
+ (erc-goodies-tests--assert-face
+ 0 "BEGIN " 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))
+ ;; Normal fg/bg combo.
+ (erc-goodies-tests--assert-face
+ 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13)
+ '(erc-inverse-face))
+ ;; Reverse of previous, so former-bg on former-fg.
+ (erc-goodies-tests--assert-face
+ 19 "PinkOnGreen"
+ '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13)
+ nil)
+ ;; The inverse of `default' because reverse still in effect.
+ (erc-goodies-tests--assert-face
+ 32 "ReversedDefault" '(erc-inverse-face erc-default-face)
+ '(fg:erc-color-face3 bg:erc-color-face13))
+ (erc-goodies-tests--assert-face
+ 49 "NormalDefault" '(erc-default-face)
+ '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1))
+ (erc-goodies-tests--assert-face
+ 64 "END" 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+;; This is meant to assert two behavioral properties:
+;;
+;; 1) The background is preserved when only a new foreground is
+;; defined, in accordance with this bit from the spec: "If only the
+;; foreground color is set, the background color stays the same."
+;; https://modern.ircdocs.horse/formatting#color
+;;
+;; 2) The same holds true for a new, lone foreground of 99. Rather
+;; than prepend `erc-default-face', this causes the removal of an
+;; existing foreground face and likewise doesn't clobber the
+;; existing background.
+(ert-deftest erc-controls-highlight/default-foreground ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c99 BlackOnYellow "
+ "\C-o END")
+ nil t)))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BlackOnYellow END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 36 (font-lock-face (bg:erc-color-face8
+ erc-default-face))
+ 36 40 (font-lock-face (erc-default-face)))))
+ (should (search-forward "BlackOnYellow"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil (cdr faces))
+ "yellow")))
+
+ ;; Redefine background color alongside default foreground.
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c99,07 BlackOnOrange "
+ "\C-o END")
+ nil t)))
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BlackOnOrange END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 36 (font-lock-face (bg:erc-color-face7
+ erc-default-face))
+ 36 40 (font-lock-face (erc-default-face)))))
+ (should (search-forward "BlackOnOrange"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil (cdr faces))
+ "orange")))) ; as opposed to white or black
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+;; This merely asserts our current interpretation of "default faces":
+;; that they reflect the foreground and background exhibited by normal
+;; chat messages before any control-code formatting is applied (rather
+;; than, e.g., some sort of negation or no-op).
+(ert-deftest erc-controls-highlight/default-background ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c05,99 BrownOnWhite "
+ "\C-o END")
+ nil t)))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BrownOnWhite END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 35 (font-lock-face (fg:erc-color-face5
+ erc-default-face))
+ 35 39 (font-lock-face (erc-default-face)))))
+ ;; Ensure the background is white or black, rather than yellow.
+ (should (search-forward "BrownOnWhite"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil `(,@(cdr faces) default))
+ (face-background 'default)))))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
(defvar erc-goodies-tests--motd
;; This is from ergo's MOTD
@@ -251,15 +421,16 @@
(defun erc-goodies-tests--assert-kp-indicator-on ()
(should erc--keep-place-indicator-overlay)
- (should (local-variable-p 'window-buffer-change-functions))
- (should window-configuration-change-hook)
+ (should (memq 'erc--keep-place-indicator-on-window-buffer-change
+ window-buffer-change-functions))
(should (memq 'erc-keep-place erc-insert-pre-hook))
(should (eq erc-keep-place-mode
(not (local-variable-p 'erc-insert-pre-hook)))))
(defun erc-goodies-tests--assert-kp-indicator-off ()
(should-not (local-variable-p 'erc-insert-pre-hook))
- (should-not (local-variable-p 'window-buffer-change-functions))
+ (should-not (memq 'erc--keep-place-indicator-on-window-buffer-change
+ window-buffer-change-functions))
(should-not erc--keep-place-indicator-overlay))
(defun erc-goodies-tests--kp-indicator-populate ()
@@ -272,12 +443,9 @@
(goto-char erc-input-marker))
(defun erc-goodies-tests--keep-place-indicator (test)
- (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
- (erc-mode)
- (erc--initialize-markers (point) nil)
- (setq erc-server-process
- (start-process "sleep" (current-buffer) "sleep" "1"))
- (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-keep-place-mode -1)
+ (with-current-buffer (erc-tests-common-make-server-buf
+ "*erc-keep-place-indicator-mode*")
(let (erc-connect-pre-hook
erc-modules)
@@ -294,7 +462,7 @@
(should-not (member 'erc-keep-place
(default-value 'erc-insert-pre-hook)))
(should-not (local-variable-p 'erc-insert-pre-hook))
- (kill-buffer))))
+ (erc-tests-common-kill-buffers))))
(ert-deftest erc-keep-place-indicator-mode--no-global ()
(erc-goodies-tests--keep-place-indicator
diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el
index d8d8c6fa9cd..0d8861f2167 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -18,6 +18,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+(require 'erc-compat)
(require 'ert-x) ; cl-lib
(eval-and-compile
@@ -1348,7 +1349,7 @@
(should-not
(erc-server-process-alive
(should (get-buffer "#chan/irc.foonet.org"))))
- (with-current-buffer (get-buffer "#chan/irc.foonet.org")
+ (with-current-buffer "#chan/irc.foonet.org"
(should-not erc-server-connected)
(should (eq erc-server-process old-proc))
(erc-with-server-buffer
@@ -1761,4 +1762,50 @@
(should (equal (erc-ports-list (nth 4 srv))
'(6697 9999))))))
+(ert-deftest erc-networks--examine-targets ()
+ (with-current-buffer (erc-tests-common-make-server-buf "foonet")
+ (erc--open-target "#chan")
+ (erc--open-target "#spam"))
+
+ (with-current-buffer (erc-tests-common-make-server-buf "barnet")
+ (with-current-buffer (erc--open-target "*query")
+ (setq erc-networks--id nil))
+ (with-current-buffer (erc--open-target "#chan")
+ (let ((calls ())
+ (snap (lambda (parameter)
+ (list parameter
+ (erc-target)
+ (erc-networks--id-symbol erc-networks--id)))))
+
+ ;; Search for "#chan" dupes among targets of all servers.
+ (should (equal
+ (erc-networks--examine-targets erc-networks--id erc--target
+ (lambda () (push (funcall snap 'ON-DUPE) calls))
+ (lambda () (push (funcall snap 'ON-COLL) calls)))
+ (list (get-buffer "#chan@foonet")
+ (get-buffer "#chan@barnet"))))
+
+ (should (equal (pop calls) '(ON-DUPE "#chan" barnet)))
+ (should (equal (pop calls) '(ON-COLL "#chan" foonet)))
+ (should-not calls)
+ (should-not (get-buffer "#chan"))
+ (should (get-buffer "#chan@barnet"))
+ (should (get-buffer "#chan@foonet"))
+
+ ;; Search for "*query" dupes among targets of all servers.
+ (should (equal (erc-networks--examine-targets erc-networks--id
+ (buffer-local-value 'erc--target
+ (get-buffer "*query"))
+ (lambda () (push (funcall snap 'ON-DUPE) calls))
+ (lambda () (push (funcall snap 'ON-COLL) calls)))
+ (list (get-buffer "*query"))))
+
+ (should (equal (pop calls) '(ON-DUPE "*query" barnet)))
+ (should-not calls)))
+
+ (goto-char (point-min))
+ (should (search-forward "Missing network session" nil t)))
+
+ (erc-tests-common-kill-buffers))
+
;;; erc-networks-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el
index 73fba65acf4..3183cd27370 100644
--- a/test/lisp/erc/erc-scenarios-base-chan-modes.el
+++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el
@@ -81,4 +81,62 @@
(should-not erc-channel-user-limit)
(funcall expect 10 "<Chad> after"))))
+;; This asserts proper recognition of nonstandard prefixes advertised
+;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3
+;; `multi-prefix' extension, we can't easily sync a user's channel
+;; membership status on receipt of a 352/353 by parsing the "flags"
+;; parameter because even though servers remember multiple prefixes,
+;; they only ever return the one with the highest rank. For example,
+;; if on receipt of a 352, we were to "update" someone we believe to
+;; be @+ by changing them to a to @, we'd be guilty of willful
+;; munging. And if they later lose that @, we'd then see them as null
+;; when in fact they're still +. However, we *could* use a single
+;; degenerate prefix to "validate" an existing record to ensure
+;; correctness of our processing logic, but it's unclear how such a
+;; discrepancy ought to be handled beyond asking the user to file a
+;; bug.
+(ert-deftest erc-scenarios-base-chan-modes--speaker-status ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'speaker-status))
+ (erc-show-speaker-membership-status t)
+ (erc-autojoin-channels-alist '(("." "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :user "tester")
+ (funcall expect 5 "Here on foonet, we provide services")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+
+ (ert-info ("Prefixes printed correctly in 353")
+ (funcall expect 10 "chan: +alice @fsbot -bob !foop"))
+
+ (ert-info ("Speakers honor option `erc-show-speaker-membership-status'")
+ (funcall expect 10 "<-bob> alice: Of that which hath")
+ (funcall expect 10 "<+alice> Hie you, make haste")
+ (funcall expect 10 "<!foop> hi"))
+
+ (ert-info ("Status conferred and rescinded")
+ (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ")
+ (funcall expect 10 "mode for #chan to +v bob")
+ (funcall expect 10 "<+bob> alice: Fair as a text B")
+ (funcall expect 10 "<+alice> bob: Even as Apemantus")
+ (funcall expect 10 "mode for #chan to -v bob")
+ (funcall expect 10 "<-bob> alice: That's the way")
+ (funcall expect 10 "<+alice> Give it the beasts"))
+
+ ;; If it had instead overwritten it, our two states would be
+ ;; out of sync. (See comment above.)
+ (ert-info ("/WHO output confirms server shadowed V status")
+ (erc-scenarios-common-say "/who #chan")
+ (funcall expect 10 '(: "bob" (+ " ") "H-"))
+ (funcall expect 10 "<-bob> alice: Remains in danger")
+ (erc-cmd-QUIT "")))))
+
;;; erc-scenarios-base-chan-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el
index ca22728b152..e0fcb8b9366 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -281,12 +281,12 @@
(should-not (get-buffer "rando@barnet"))
(with-current-buffer "frenemy@foonet"
- (funcall expect 1 "now known as")
- (funcall expect 1 "doubly so"))
+ (funcall expect 10 "now known as")
+ (funcall expect 10 "doubly so"))
(with-current-buffer "frenemy@barnet"
- (funcall expect 1 "now known as")
- (funcall expect 1 "reality picture"))
+ (funcall expect 10 "now known as")
+ (funcall expect 10 "reality picture"))
(when noninteractive
(with-current-buffer "frenemy@barnet" (kill-buffer))
diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
index bbd9c79f593..f3905974a11 100644
--- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
+++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
@@ -42,4 +42,50 @@
'znc-foonet
'znc-barnet))
+;; Here, the upstream connection is already severed when first
+;; connecting. The bouncer therefore sends query messages from an
+;; administrative bot before the first numerics burst, which results
+;; in a target buffer not being associated with an `erc-networks--id'.
+;; The problem only manifests later, when the buffer-association
+;; machinery checks the names of all target buffers and assumes a
+;; non-nil `erc-networks--id'.
+(ert-deftest erc-scenarios-upstream-recon--znc/severed ()
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/upstream-reconnect")
+ (erc-d-t-cleanup-sleep-secs 1)
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'znc-severed))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester@vanilla/foonet"
+ :password "changeme"
+ :full-name "tester")
+ (erc-scenarios-common-assert-initial-buf-name nil port)
+ (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status"))
+ (funcall expect 10 "Connection Refused. Reconnecting...")
+ (funcall expect 10 "Connected!"))
+
+ (ert-info ("Join #chan")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 10 "<alice> tester, welcome!")
+ (funcall expect 10 "<bob> alice: And see a fearful sight")
+ (funcall expect 10 "<eve> hola")
+ (funcall expect 10 "<Evel> hell o")
+ ;;
+ (funcall expect 10 "<alice> bob: Or to drown my clothes")))
+
+ (ert-info ("Buffer not renamed with net id")
+ (should (get-buffer "*status")))
+
+ (ert-info ("No error")
+ (with-current-buffer (messages-buffer)
+ (funcall expect -0.1 "error in process filter")))))
+
;;; erc-scenarios-base-upstream-recon-znc.el ends here
diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el
index b8ff59f4e02..ccd6f81b7d2 100644
--- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el
+++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el
@@ -85,8 +85,8 @@
(goto-char (window-point))
(should (looking-back (rx "<bob> tester, welcome!")))
(should (= (pos-bol) (window-start)))
- (should (= (overlay-start erc--keep-place-indicator-overlay)
- (pos-bol))))
+ (erc-d-t-wait-for 20
+ (= (overlay-start erc--keep-place-indicator-overlay) (pos-bol))))
;; Lower window is still centered at start.
(other-window 1)
(switch-to-buffer "#chan")
@@ -101,7 +101,7 @@
(recenter 0)
(redisplay) ; force ^ to appear on first line
- (other-window 1) ; upper still at indicator, swtiches first
+ (other-window 1) ; upper still at indicator, switches first
(switch-to-buffer "#spam")
(other-window 1)
(switch-to-buffer "#spam") ; lower follows, speaks to sync
diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el
index d6ed53b5358..da6855caf57 100644
--- a/test/lisp/erc/erc-scenarios-misc-commands.el
+++ b/test/lisp/erc/erc-scenarios-misc-commands.el
@@ -123,4 +123,94 @@
(should (string= (erc-server-user-host (erc-get-server-user "tester"))
"some.host.test.cc"))))))
+;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME,
+;; the latter three introduced by bug#68401. It mainly asserts
+;; correct routing behavior, especially not sending or inserting
+;; messages in buffers belonging to disconnected sessions. Left
+;; unaddressed are interactions with the `command-indicator' module
+;; (`erc-noncommands-list') and whatever future `echo-message'
+;; implementation manifests out of bug#49860.
+(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME ()
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "commands")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet))
+ (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet and join #foo")
+ (with-current-buffer
+ (erc :server "127.0.0.1"
+ :port (process-contact dumb-server-foonet :service)
+ :nick "tester")
+ (funcall expect 10 "debug mode")
+ (erc-cmd-JOIN "#foo")))
+
+ (ert-info ("Connect to barnet and join #bar")
+ (with-current-buffer
+ (erc :server "127.0.0.1"
+ :port (process-contact dumb-server-barnet :service)
+ :nick "tester")
+ (funcall expect 10 "debug mode")
+ (erc-cmd-JOIN "#bar")))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo"))
+ (funcall expect 10 "welcome"))
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar"))
+ (funcall expect 10 "welcome"))
+
+ (ert-info ("/AMSG only sent to issuing context's server")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/amsg 1 foonet only"))
+ (with-current-buffer "barnet"
+ (erc-scenarios-common-say "/amsg 2 barnet only"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 1 foonet only")
+ (funcall expect 10 "<alice> bob: Our queen and all"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "<tester> 2 barnet only")
+ (funcall expect 10 "<joe> mike: And secretly to greet")))
+
+ (ert-info ("/AME only sent to issuing context's server")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/ame 3 foonet only"))
+ (with-current-buffer "barnet"
+ (erc-scenarios-common-say "/ame 4 barnet only"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "* tester 3 foonet only")
+ (funcall expect 10 "<alice> bob: You have discharged this"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "* tester 4 barnet only")
+ (funcall expect 10 "<joe> mike: That same Berowne")))
+
+ (ert-info ("/GMSG and /GME sent to all servers")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/gmsg 5 all nets")
+ (erc-scenarios-common-say "/gme 6 all nets"))
+ (with-current-buffer "#bar"
+ (funcall expect 10 "<tester> 5 all nets")
+ (funcall expect 10 "* tester 6 all nets")
+ (funcall expect 10 "<joe> mike: Mehercle! if their sons")))
+
+ (ert-info ("/GMSG and /GME only sent to connected servers")
+ (with-current-buffer "barnet"
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "ERC finished"))
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 5 all nets")
+ (funcall expect 10 "* tester 6 all nets")
+ (funcall expect 10 "<alice> bob: Stand you!"))
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/gmsg 7 all live nets")
+ (erc-scenarios-common-say "/gme 8 all live nets"))
+ ;; Message *not* inserted in disconnected buffer.
+ (with-current-buffer "#bar"
+ (funcall expect -0.1 "<tester> 7 all live nets")
+ (funcall expect -0.1 "* tester 8 all live nets")))
+
+ (with-current-buffer "#foo"
+ (funcall expect 10 "<tester> 7 all live nets")
+ (funcall expect 10 "* tester 8 all live nets")
+ (funcall expect 10 "<bob> alice: Live, and be prosperous;"))))
+
;;; erc-scenarios-misc-commands.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el
index 8f6042de5c2..2afa1ce67a4 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -126,7 +126,7 @@
(erc-d-t-wait-for 10 (get-buffer "foonet"))
(ert-info ("Channel buffer #foo playback received")
- (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo"))
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo"))
(funcall expect 10 "Excellent workman")))
(ert-info ("Global notices routed to server buffer")
diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el
index ab4a97c5724..47d0bcff41a 100644
--- a/test/lisp/erc/erc-scenarios-services-misc.el
+++ b/test/lisp/erc/erc-scenarios-services-misc.el
@@ -186,7 +186,7 @@
(funcall expect 10 "Last login from")
(funcall expect 10 "Your new nickname is tester")))
- (with-current-buffer (get-buffer "#test")
+ (with-current-buffer "#test"
(funcall expect 10 "tester ")
(funcall expect 10 "was created on"))))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index ef292ccb618..5fee21ec28f 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -20,14 +20,14 @@
;;; Commentary:
;;; Code:
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-stamp)
-(require 'erc-goodies) ; for `erc-make-read-only'
-
;; These display-oriented tests are brittle because many factors
;; influence how text properties are applied. We should just
;; rework these into full scenarios.
@@ -46,7 +46,7 @@
(with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
(erc-mode)
- (erc-munge-invisibility-spec)
+ (erc-stamp--manage-local-options-state)
(erc--initialize-markers (point) nil)
(erc-tests-common-init-server-proc "sleep" "1")
@@ -168,11 +168,11 @@
(put-text-property 0 (length msg) 'wrap-prefix 10 msg)
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
- ;; Space not added (treated as opaque string).
- (should (search-forward "msg one[" nil t))
- ;; Field covers stamp alone
+ ;; Leading space added as part of the stamp's field.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers stamp and space.
(should (eql ?e (char-before (field-beginning (point)))))
- ;; Vanity props extended
+ ;; Vanity props extended.
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
(should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
(should (get-text-property (1- (field-end (point))) 'wrap-prefix))
@@ -183,10 +183,10 @@
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
- ;; No hard wrap
- (should (search-forward "oooo[" nil t))
- ;; Field starts at format string (right bracket)
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; No hard wrap.
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at managed space before format string.
+ (should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
@@ -235,7 +235,7 @@
(with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
(erc-mode)
(erc--initialize-markers (point) nil)
- (erc-munge-invisibility-spec)
+ (erc-stamp--manage-local-options-state)
(erc-display-message nil 'notice (current-buffer) "Welcome")
;;
;; Pretend `fill' is active and that these lines are
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 2cd47ec3f89..3e8ddef3731 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -20,13 +20,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+(require 'erc-ring)
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-tests-common)))
-(require 'erc-ring)
(ert-deftest erc--read-time-period ()
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -302,6 +302,7 @@
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
+ (erc-last-input-time 0)
(erc-modules (remq 'stamp erc-modules))
(erc-send-input-line-function #'ignore)
(erc--input-review-functions erc--input-review-functions)
@@ -381,7 +382,7 @@
(should-not (search-forward (rx (or "9" "10") ">") nil t)))))
(ert-info ("Query buffer")
- (with-current-buffer (get-buffer "bob")
+ (with-current-buffer "bob"
(goto-char erc-insert-marker)
(should (looking-at-p "bob@ServNet 14>"))
(goto-char erc-input-marker)
@@ -674,7 +675,7 @@
;; checking if null beforehand.
(should-not erc--parsed-prefix)
(should (equal (erc--parsed-prefix)
- #s(erc--parsed-prefix nil "qaohv" "~&@%+"
+ #s(erc--parsed-prefix nil "vhoaq" "+%@&~"
((?q . ?~) (?a . ?&)
(?o . ?@) (?h . ?%) (?v . ?+)))))
(let ((cached (should erc--parsed-prefix)))
@@ -696,7 +697,7 @@
(should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
(setq cached erc--parsed-prefix)
(should (equal cached
- #s(erc--parsed-prefix ("(ov)@+") "ov" "@+"
+ #s(erc--parsed-prefix ("(ov)@+") "vo" "+@"
((?o . ?@) (?v . ?+)))))
;; Second target buffer reuses cached value.
(with-temp-buffer
@@ -714,6 +715,88 @@
(erc-with-server-buffer erc--parsed-prefix))
'((?q . ?~) (?h . ?%)))))))
+(ert-deftest erc--get-prefix-flag ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should-not erc--parsed-prefix)
+ (should (= (erc--get-prefix-flag ?v) 1))
+ (should (= (erc--get-prefix-flag ?h) 2))
+ (should (= (erc--get-prefix-flag ?o) 4))
+ (should (= (erc--get-prefix-flag ?a) 8))
+ (should (= (erc--get-prefix-flag ?q) 16))
+
+ (ert-info ("With optional `from-prefix-p'")
+ (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1))
+ (should (= (erc--get-prefix-flag ?% nil 'fpp) 2))
+ (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4))
+ (should (= (erc--get-prefix-flag ?& nil 'fpp) 8))
+ (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--init-cusr-fallback-status ()
+ ;; Fallback behavior active because no `erc--parsed-prefix'.
+ (should-not erc--parsed-prefix)
+ (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
+ (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil)))
+ (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil)))
+ (should-not erc--parsed-prefix) ; not created in non-ERC buffer.
+
+ ;; Uses advertised server parameter.
+ (erc-tests-common-make-server-buf (buffer-name))
+ (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-")))
+ (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
+ (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil)))
+ (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--compute-cusr-fallback-status ()
+ ;; Useless without an `erc--parsed-prefix'.
+ (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
+ (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on)))
+
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off)))
+ (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off)))
+ (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil)))
+ (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil))))
+
+(ert-deftest erc--cusr-status-p ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should-not erc--parsed-prefix)
+ (let ((cusr (make-erc-channel-user :voice t :op t)))
+ (should-not (erc--cusr-status-p cusr ?q))
+ (should-not (erc--cusr-status-p cusr ?a))
+ (should-not (erc--cusr-status-p cusr ?h))
+ (should (erc--cusr-status-p cusr ?o))
+ (should (erc--cusr-status-p cusr ?v)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--cusr-change-status ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (let ((cusr (make-erc-channel-user)))
+ (should-not (erc--cusr-status-p cusr ?o))
+ (should-not (erc--cusr-status-p cusr ?v))
+ (erc--cusr-change-status cusr ?o t)
+ (erc--cusr-change-status cusr ?v t)
+ (should (erc--cusr-status-p cusr ?o))
+ (should (erc--cusr-status-p cusr ?v))
+
+ (ert-info ("Reset with optional param")
+ (erc--cusr-change-status cusr ?q t 'reset)
+ (should-not (erc--cusr-status-p cusr ?o))
+ (should-not (erc--cusr-status-p cusr ?v))
+ (should (erc--cusr-status-p cusr ?q)))
+
+ (ert-info ("Clear with optional param")
+ (erc--cusr-change-status cusr ?v t)
+ (should (erc--cusr-status-p cusr ?v))
+ (erc--cusr-change-status cusr ?q nil 'reset)
+ (should-not (erc--cusr-status-p cusr ?v))
+ (should-not (erc--cusr-status-p cusr ?q)))))
+
;; This exists as a reference to assert legacy behavior in order to
;; preserve and incorporate it as a fallback in the 5.6+ replacement.
(ert-deftest erc-parse-modes ()
@@ -737,12 +820,9 @@
(should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
(ert-deftest erc--update-channel-modes ()
- (erc-mode)
+ (erc-tests-common-make-server-buf)
(setq erc-channel-users (make-hash-table :test #'equal)
- erc-server-users (make-hash-table :test #'equal)
- erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test"))
- (erc-tests-common-init-server-proc "sleep" "1")
(let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
calls)
@@ -849,7 +929,7 @@
;; truncation ellipsis when run interactively. Rather than have
;; hard-to-read "nondeterministic" comparisons against sets of
;; acceptable values, we use separate tests.
- (when (display-graphic-p) (ert-pass))
+ (when (char-displayable-p ?ā€¦) (ert-pass))
;; Truncation cache populated and used.
(let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
@@ -877,7 +957,7 @@
(ert-deftest erc--channel-modes/graphic-p ()
:tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL")
'(:erc--graphical)))
- (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant"))
+ (unless (char-displayable-p ?ā€¦) (ert-skip "See non-/graphic-p variant"))
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc--isupport-params (make-hash-table)
@@ -969,11 +1049,13 @@
(should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" ")))
(should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/")))
(should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19")))
+ (should (equal (erc--parse-isupport-value "a\\x3Db") '("a=b")))
(should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c"))))
(ert-deftest erc--get-isupport-entry ()
(let ((erc--isupport-params (make-hash-table))
- (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
+ (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")
+ ("SPAM" . "")))
(items (lambda ()
(cl-loop for k being the hash-keys of erc--isupport-params
using (hash-values v) collect (cons k v)))))
@@ -994,7 +1076,9 @@
(should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
(should (equal (funcall items)
- '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
+ '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))
+ (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM)))
+ (should-not (erc--get-isupport-entry 'SPAM 'single))))
(ert-deftest erc-server-005 ()
(let* ((hooked 0)
@@ -1012,34 +1096,41 @@
(lambda (_ _ _ line) (push line calls))))
(ert-info ("Baseline")
- (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
+ (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+"
+ "are supp...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ov)@+") ("EXCEPTS")
+ ;; Should be ("CHANTYPES") but
+ ;; retained for compatibility.
+ ("CHANTYPES" . "")
("BOT" . "B"))))
(should (zerop (hash-table-count erc--isupport-params)))
(should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
- (should (string= (pop calls)
- "BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
+ (should (string=
+ (pop calls)
+ "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp..."))
(should (equal args (erc-response.command-args parsed)))))
(erc-call-hooks nil parsed))
(ert-info ("Negated, updated")
- (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
+ (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+"
+ "are su...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
- (should (string= (pop calls)
- "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
+ (should (string-prefix-p
+ "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ "
+ (pop calls)))
(should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
(should-not (erc--get-isupport-entry 'EXCEPTS))
@@ -1076,25 +1167,37 @@
(should (equal (erc-downcase "\\O/") "|o/" )))))
(ert-deftest erc-channel-p ()
- (let ((erc--isupport-params (make-hash-table))
- erc-server-parameters)
-
- (should (erc-channel-p "#chan"))
- (should (erc-channel-p "##chan"))
- (should (erc-channel-p "&chan"))
- (should (erc-channel-p "+chan"))
- (should (erc-channel-p "!chan"))
- (should-not (erc-channel-p "@chan"))
-
- (push '("CHANTYPES" . "#&@+!") erc-server-parameters)
-
- (should (erc-channel-p "!chan"))
- (should (erc-channel-p "#chan"))
-
- (with-current-buffer (get-buffer-create "#chan")
- (setq erc--target (erc--target-from-string "#chan")))
- (should (erc-channel-p (get-buffer "#chan"))))
- (kill-buffer "#chan"))
+ (erc-tests-common-make-server-buf)
+
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "##chan"))
+ (should (erc-channel-p "&chan"))
+ (should-not (erc-channel-p "+chan"))
+ (should-not (erc-channel-p "!chan"))
+ (should-not (erc-channel-p "@chan"))
+
+ ;; Server sends "CHANTYPES=#&+!"
+ (should-not erc-server-parameters)
+ (setq erc-server-parameters '(("CHANTYPES" . "#&+!")))
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "&chan"))
+ (should (erc-channel-p "+chan"))
+ (should (erc-channel-p "!chan"))
+
+ (with-current-buffer (erc--open-target "#chan")
+ (should (erc-channel-p (current-buffer))))
+ (with-current-buffer (erc--open-target "+chan")
+ (should (erc-channel-p (current-buffer))))
+ (should (erc-channel-p (get-buffer "#chan")))
+ (should (erc-channel-p (get-buffer "+chan")))
+
+ ;; Server sends "CHANTYPES=" because it's query only.
+ (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params)
+ (should-not (erc-channel-p "#spam"))
+ (should-not (erc-channel-p "&spam"))
+ (should-not (erc-channel-p (save-excursion (erc--open-target "#spam"))))
+
+ (erc-tests-common-kill-buffers))
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
@@ -1109,12 +1212,16 @@
(should (erc--valid-local-channel-p "&local")))))
(ert-deftest erc--restore-initialize-priors ()
+ (unless (>= emacs-major-version 28)
+ (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'"))
(should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode
foo (ignore 1 2 3)
bar #'spam
baz nil))
(`(let* ((,p (or erc--server-reconnecting erc--target-priors))
(,q (and ,p (alist-get 'erc-my-mode ,p))))
+ (unless (local-variable-if-set-p 'erc-my-mode)
+ (error "Not a local minor mode var: %s" 'erc-my-mode))
(setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3))
bar (if ,q (alist-get 'bar ,p) #'spam)
baz (if ,q (alist-get 'baz ,p) nil)))
@@ -1193,7 +1300,7 @@
(setq erc-server-current-nick "tester")
(setq-local erc-last-input-time 0)
(should-not (local-variable-if-set-p 'erc-send-completed-hook))
- (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
+ (setq-local erc-send-completed-hook nil) ; skip t (globals)
;; Just in case erc-ring-mode is already on
(setq-local erc--input-review-functions erc--input-review-functions)
(add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
@@ -1298,6 +1405,14 @@
(should-not erc-debug-irc-protocol)))
(ert-deftest erc--split-line ()
+ (let ((erc-split-line-length 0))
+ (should (equal (erc--split-line "") '("")))
+ (should (equal (erc--split-line " ") '(" ")))
+ (should (equal (erc--split-line "1") '("1")))
+ (should (equal (erc--split-line " 1") '(" 1")))
+ (should (equal (erc--split-line "1 ") '("1 ")))
+ (should (equal (erc--split-line "abc") '("abc"))))
+
(let ((erc-default-recipients '("#chan"))
(erc-split-line-length 10))
(should (equal (erc--split-line "") '("")))
@@ -1655,17 +1770,64 @@
(should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))))
(should-not erc-ask-about-multiline-input)))
+(ert-deftest erc-extract-command-from-line ()
+ ;; FIXME when next modifying `erc-command-regexp's default value,
+ ;; move the single quote in the first group's character alternative
+ ;; to the front, i.e., [A-Za-z'] -> ['A-Za-z], so we can assert
+ ;; equivalence with this more readable `rx' form.
+ (rx bol
+ "/"
+ (group (+ (in "'A-Za-z")))
+ (group (| (: (+ (syntax whitespace)) (* nonl))
+ (* (syntax whitespace))))
+ eol)
+ (erc-mode) ; for `erc-mode-syntax-table'
+
+ ;; Non-command.
+ (should-not (erc-extract-command-from-line "FAKE\n"))
+ ;; Unknown command.
+ (should (equal (erc-extract-command-from-line "/FAKE\n")
+ '(erc-cmd-default "/FAKE\n")))
+
+ (ert-info ("With `do-not-parse-args'")
+ (should (equal (erc-extract-command-from-line "/MSG\n")
+ '(erc-cmd-MSG "\n")))
+ (should (equal (erc-extract-command-from-line "/MSG \n")
+ '(erc-cmd-MSG " \n")))
+ (should (equal (erc-extract-command-from-line "/MSG \n\n")
+ '(erc-cmd-MSG " \n\n")))
+ (should (equal (erc-extract-command-from-line "/MSG foo\n")
+ '(erc-cmd-MSG " foo")))
+ (should (equal (erc-extract-command-from-line "/MSG foo\n\n")
+ '(erc-cmd-MSG " foo")))
+ (should (equal (erc-extract-command-from-line "/MSG foo\n \n")
+ '(erc-cmd-MSG " foo")))
+ (should (equal (erc-extract-command-from-line "/MSG foo\n")
+ '(erc-cmd-MSG " foo"))))
+
+ (ert-info ("Without `do-not-parse-args'")
+ (should (equal (erc-extract-command-from-line "/HELP\n")
+ '(erc-cmd-HELP nil)))
+ (should (equal (erc-extract-command-from-line "/HELP \n")
+ '(erc-cmd-HELP nil)))
+ (should (equal (erc-extract-command-from-line "/HELP foo\n")
+ '(erc-cmd-HELP ("foo"))))
+ (should (equal (erc-extract-command-from-line "/HELP foo\n")
+ '(erc-cmd-HELP ("foo"))))
+ (should (equal (erc-extract-command-from-line "/HELP foo bar\n")
+ '(erc-cmd-HELP ("foo" "bar"))))))
+
;; The point of this test is to ensure output is handled identically
;; regardless of whether a command handler is summoned.
(ert-deftest erc-process-input-line ()
- (let (erc-server-last-sent-time
- erc-server-flood-queue
- (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
- (erc-default-recipients '("#chan"))
+ (erc-tests-common-make-server-buf)
+ (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
+ (pop-flood-queue (lambda () (erc-with-server-buffer
+ (pop erc-server-flood-queue))))
calls)
- (with-temp-buffer
- (erc-tests-common-init-server-proc "sleep" "1")
+ (setq erc-server-current-nick "tester")
+ (with-current-buffer (erc--open-target "#chan")
(cl-letf (((symbol-function 'erc-cmd-MSG)
(lambda (line)
(push line calls)
@@ -1679,49 +1841,50 @@
(ert-info ("Baseline")
(erc-process-input-line "/msg #chan hi\n")
(should (equal (pop calls) " #chan hi"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi\r\n" . utf-8))))
(ert-info ("Quote preserves line intact")
(erc-process-input-line "/QUOTE FAKE foo bar\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("FAKE foo bar\r\n" . utf-8))))
(ert-info ("Unknown command respected")
(erc-process-input-line "/FAKE foo bar\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("FAKE foo bar\r\n" . utf-8))))
(ert-info ("Spaces preserved")
(erc-process-input-line "/msg #chan hi you\n")
(should (equal (pop calls) " #chan hi you"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
(ert-info ("Empty line honored")
(erc-process-input-line "/msg #chan\n")
(should (equal (pop calls) " #chan"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :\r\n" . utf-8)))))
(ert-info ("Implicit cmd via `erc-send-input-line-function'")
(ert-info ("Baseline")
(erc-process-input-line "hi\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi\r\n" . utf-8))))
(ert-info ("Spaces preserved")
(erc-process-input-line "hi you\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
(ert-info ("Empty line transmitted with injected-space kludge")
(erc-process-input-line "\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan : \r\n" . utf-8))))
- (should-not calls))))))
+ (should-not calls)))))
+ (erc-tests-common-kill-buffers))
(ert-deftest erc--get-inserted-msg-beg/basic ()
(erc-tests-common-assert-get-inserted-msg/basic
@@ -2069,6 +2232,58 @@
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--restore-important-text-props ()
+ (erc-mode)
+ (let ((erc--msg-props (map-into '((erc--important-prop-names a))
+ 'hash-table)))
+ (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A))
+ " "
+ (propertize "bar" 'c 'C 'a 'A 'b 'B
+ 'erc--important-props '(a A c C)))
+
+ ;; Attempt to restore a and c when only a is registered.
+ (remove-list-of-text-properties (point-min) (point-max) '(a c))
+ (erc--restore-important-text-props '(a c))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar"
+ 0 3 (a A b B erc--important-props (a A))
+ 4 7 (a A b B erc--important-props (a A c C)))))
+
+ ;; Add d between 3 and 6.
+ (erc--reserve-important-text-props 3 6 '(d D))
+ (put-text-property 3 6 'd 'D)
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar" ; #1
+ 0 2 (a A b B erc--important-props (a A))
+ 2 3 (d D a A b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D a A b B erc--important-props (d D a A c C))
+ 5 7 (a A b B erc--important-props (a A c C)))))
+ ;; Remove a and d, and attempt to restore d.
+ (remove-list-of-text-properties (point-min) (point-max) '(a d))
+ (erc--restore-important-text-props '(d))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar"
+ 0 2 (b B erc--important-props (a A))
+ 2 3 (d D b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D b B erc--important-props (d D a A c C))
+ 5 7 (b B erc--important-props (a A c C)))))
+
+ ;; Restore a only.
+ (erc--restore-important-text-props '(a))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar" ; same as #1 above
+ 0 2 (a A b B erc--important-props (a A))
+ 2 3 (d D a A b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D a A b B erc--important-props (d D a A c C))
+ 5 7 (a A b B erc--important-props (a A c C)))))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
@@ -2651,7 +2866,7 @@
(list :server "irc.libera.chat"
:port 6697
:nick (user-login-name)
- '&interactive-env
+ '--interactive-env--
'((erc-server-connect-function . erc-open-tls-stream)
(erc-join-buffer . window))))))
@@ -2661,7 +2876,7 @@
(list :server "irc.gnu.org"
:port 6697
:nick (user-login-name)
- '&interactive-env
+ '--interactive-env--
'((erc-server-connect-function . erc-open-tls-stream)
(erc-join-buffer . window))))))
@@ -2672,7 +2887,7 @@
(list :server "irc.gnu.org"
:port 6697
:nick (user-login-name)
- '&interactive-env
+ '--interactive-env--
'((erc-server-connect-function
. erc-open-tls-stream)
(erc--display-context
@@ -3178,6 +3393,7 @@
(should (eq (erc--find-group 'autojoin) 'erc-autojoin))
(should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete))
(should (eq (erc--find-group 'capab-identify) 'erc-capab))
+ (should (eq (erc--find-group 'completion) 'erc-pcomplete))
;; No group specified.
(should (eq (erc--find-group 'smiley nil) 'erc))
(should (eq (erc--find-group 'unmorse nil) 'erc)))
@@ -3525,6 +3741,20 @@ connection."
(should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val"))
(makunbound (intern "erc-message-test-top-s221"))
- (unintern "erc-message-test-top-s221" obarray))
+ (unintern "erc-message-test-top-s221" obarray)
+
+ ;; Inheritance.
+ (let ((obarray (obarray-make)))
+ (set (intern "erc-message-test1-abc") "val test1 abc")
+ (set (intern "erc-message-test2-abc") "val test2 abc")
+ (set (intern "erc-message-test2-def") "val test2 def")
+ (put (intern "test0") 'erc--base-format-catalog (intern "test1"))
+ (put (intern "test1") 'erc--base-format-catalog (intern "test2"))
+ (should (equal (erc-retrieve-catalog-entry 'abc (intern "test0"))
+ "val test1 abc"))
+ (should (equal (erc-retrieve-catalog-entry 'def (intern "test0"))
+ "val test2 def"))
+ ;; Terminates.
+ (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0")))))
;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/base/modes/speaker-status.eld b/test/lisp/erc/resources/base/modes/speaker-status.eld
new file mode 100644
index 00000000000..4a7d508e35c
--- /dev/null
+++ b/test/lisp/erc/resources/base/modes/speaker-status.eld
@@ -0,0 +1,69 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER tester 0 * :unknown")
+ (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
+ (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")
+ (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100")
+ (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3")
+ (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024")
+ (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy")
+ (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
+ (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server")
+ (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
+ (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers")
+ (0.00 ":irc.example.net 252 tester 1 :operator(s) online")
+ (0.00 ":irc.example.net 253 tester 1 :unknown connections")
+ (0.00 ":irc.example.net 254 tester 2 :channels formed")
+ (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers")
+ (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5")
+ (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5")
+ (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
+ (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues")
+ (0.00 ":irc.example.net 372 tester : ")
+ (0.00 ":irc.example.net 372 tester : Have fun with the image!")
+ (0.00 ":irc.example.net 376 tester :End of message of the day.")
+ (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.")
+ (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2."))
+
+((mode 10 "MODE tester +i")
+ (0.01 ":tester!tester@10.0.2.100 MODE tester :+i"))
+
+((join 10 "JOIN #chan")
+ (0.02 ":tester!tester@10.0.2.100 JOIN :#chan")
+ (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester")
+ (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.")
+ (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!"))
+
+((mode-chan 10 "MODE #chan")
+ (0.00 ":irc.example.net 324 tester #chan :+nt")
+ (0.01 ":irc.example.net 329 tester #chan :1705909863")
+ (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.")
+ (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.")
+ (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi")
+ ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.")
+ ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.")
+ ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.")
+ (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob")
+ (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.")
+ (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.")
+ (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.")
+ (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob")
+ (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.")
+ (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.")
+ ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.")
+ )
+
+((who-chan 10 "who #chan")
+ (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io")
+ (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot")
+ (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io")
+ (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown")
+ (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown")
+ (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.")
+ ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.")
+ ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.")
+ (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]"))
diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld
new file mode 100644
index 00000000000..32d05cc8a3a
--- /dev/null
+++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld
@@ -0,0 +1,87 @@
+;; -*- mode: lisp-data; -*-
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER tester@vanilla/foonet 0 * :tester")
+ (0.00 ":irc.znc.in 001 tester :Welcome to ZNC")
+ (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
+ (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
+ (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
+ (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!")
+ (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC")
+ (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +Zi")
+ (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+
+((mode 10 "MODE tester +i")
+ (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in")
+ (0.01 ":irc.foonet.org 315 tester tester :End of WHO list")
+
+ (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve"))
+
+((mode 10 "MODE #chan")
+ (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.")
+ (0.02 ":irc.foonet.org 221 tester +Zi")
+ (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.")
+ (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.")
+ (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.03 ":irc.foonet.org 329 tester #chan 1706698713")
+ (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.")
+ (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.")
+ (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola")
+ (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel")
+ (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o")
+ (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.")
+ (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.")
+ (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.")
+
+ (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...")
+ (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...")
+ (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!")
+ (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC")
+ (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.02 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")
+ (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in")
+ (0.01 ":irc.foonet.org 315 tester tester :End of WHO list")
+ (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan"))
+
+((mode 10 "MODE #chan")
+ (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!")
+ (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.")
+ (0.03 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.01 ":irc.foonet.org 329 tester #chan 1706698713")
+ (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.")
+ (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped."))
diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld
new file mode 100644
index 00000000000..53b3e18651a
--- /dev/null
+++ b/test/lisp/erc/resources/commands/amsg-barnet.eld
@@ -0,0 +1,54 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
+ (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC")
+ (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
+ (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
+ (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
+ (0 ":irc.barnet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.barnet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.barnet.org 254 tester 1 :channels formed")
+ (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.barnet.org 221 tester +i")
+ (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #bar")
+ (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar")
+ (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester")
+ (0 ":irc.barnet.org 366 tester #bar :End of NAMES list"))
+
+((mode-bar 10 "MODE #bar")
+ (0 ":irc.barnet.org 324 tester #bar +nt")
+ (0 ":irc.barnet.org 329 tester #bar 1620104779")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now."))
+
+((privmsg-2 10 "PRIVMSG #bar :2 barnet only")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends."))
+
+((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go."))
+
+((privmsg-5 10 "PRIVMSG #bar :5 all nets"))
+
+((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1")
+ (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.")
+ (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us."))
+
+((quit 5 "QUIT :\2ERC\2")
+ (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit"))
+
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld
new file mode 100644
index 00000000000..eb3d84d646a
--- /dev/null
+++ b/test/lisp/erc/resources/commands/amsg-foonet.eld
@@ -0,0 +1,56 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
+ (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
+ (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)")
+ (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.foonet.org 221 tester +i")
+ (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #foo")
+ (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo")
+ (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob")
+ (0 ":irc.foonet.org 366 tester #foo :End of NAMES list"))
+
+((mode-foo 10 "MODE #foo")
+ (0 ":irc.foonet.org 324 tester #foo +nt")
+ (0 ":irc.foonet.org 329 tester #foo 1620104779")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden."))
+
+((privmsg-1 10 "PRIVMSG #foo :1 foonet only")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon."))
+
+((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon."))
+
+((privmsg-5 10 "PRIVMSG #foo :5 all nets"))
+
+((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground."))
+
+((privmsg-6 10 "PRIVMSG #foo :7 all live nets")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself."))
+
+((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1")
+ (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.")
+ (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow."))
diff --git a/test/lisp/erc/resources/erc-d/resources/basic.eld b/test/lisp/erc/resources/erc-d/resources/basic.eld
index a020eec3fff..80e46d9a279 100644
--- a/test/lisp/erc/resources/erc-d/resources/basic.eld
+++ b/test/lisp/erc/resources/erc-d/resources/basic.eld
@@ -8,8 +8,7 @@
(0 ":irc.example.org 002 tester :Your host is irc.example.org")
(0 ":irc.example.org 003 tester :This server was created just now")
(0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
;; Just to mix thing's up (force handler to schedule timer)
(0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
@@ -24,7 +23,7 @@
(0 ":irc.example.org 221 tester +Zi")
(0 ":irc.example.org 306 tester :You have been marked as being away")
(0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #chan :+alice @bob")
(0 ":irc.example.org 366 alice #chan :End of NAMES list"))
;; Some comment (to prevent regression)
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
index e8feb2e6fd8..47be0722115 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
@@ -22,7 +22,7 @@
(0. ":irc.barnet.org 221 tester +Zi")
(0. ":irc.barnet.org 306 tester :You have been marked as being away")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org")
+ (0 ":irc.barnet.org 353 joe = #chan :+joe @mike")
(0 ":irc.barnet.org 366 joe #chan :End of NAMES list"))
((mode 3 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
index 2db750e49da..5d5f8ed18a8 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
@@ -21,7 +21,7 @@
(0. ":irc.foonet.org 221 tester +Zi")
(0. ":irc.foonet.org 306 tester :You have been marked as being away")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
- (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.foonet.org 353 alice = #chan :+alice @bob")
(0 ":irc.foonet.org 366 alice #chan :End of NAMES list"))
((mode 3 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic.eld b/test/lisp/erc/resources/erc-d/resources/dynamic.eld
index 459b6e52bfe..64d8c091ad7 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic.eld
@@ -7,8 +7,7 @@
(0.0 ":" dom " 002 " nick " :Your host is " dom)
(0.0 ":" dom " 003 " nick " :This server was created just now")
(0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)")
(0.0 ":" dom " 252 " nick " 0 :IRC Operators online")
(0.0 ":" dom " 253 " nick " 0 :unregistered connections")
@@ -23,7 +22,7 @@
(0.0 ":" dom " 306 " nick " :You have been marked as being away")
(0.0 ":" nick "!~" nick "@localhost JOIN #chan")
- (0.0 ":" dom " 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0.0 ":" dom " 353 alice = #chan :+alice @bob")
(0.0 ":" dom " 366 alice #chan :End of NAMES list"))
((mode 2.2 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/eof.eld b/test/lisp/erc/resources/erc-d/resources/eof.eld
index 5da84b2e74f..db39b3d4af1 100644
--- a/test/lisp/erc/resources/erc-d/resources/eof.eld
+++ b/test/lisp/erc/resources/erc-d/resources/eof.eld
@@ -8,8 +8,7 @@
(0 ":irc.example.org 002 tester :Your host is irc.example.org")
(0 ":irc.example.org 003 tester :This server was created just now")
(0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
;; Just to mix thing's up (force handler to schedule timer)
(0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
@@ -24,7 +23,7 @@
(0 ":irc.example.org 221 tester +Zi")
(0 ":irc.example.org 306 tester :You have been marked as being away")
(0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #chan :+alice @bob")
(0 ":irc.example.org 366 alice #chan :End of NAMES list"))
((mode-chan 1.2 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld
index 0504b6a6682..cf64004da0d 100644
--- a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld
+++ b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld
@@ -23,12 +23,12 @@
((~join-foo 3.2 "JOIN #foo")
(0 "@time=" now " :tester!~tester@localhost JOIN #foo")
- (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice @bob")
(0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list"))
((~join-bar 1.2 "JOIN #bar")
(0 "@time=" now " :tester!~tester@localhost JOIN #bar")
- (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice @bob")
(0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list"))
((~mode-foo 3.2 "MODE #foo")
diff --git a/test/lisp/erc/resources/erc-d/resources/incremental.eld b/test/lisp/erc/resources/erc-d/resources/incremental.eld
index a1b48495ec3..7d192a53066 100644
--- a/test/lisp/erc/resources/erc-d/resources/incremental.eld
+++ b/test/lisp/erc/resources/erc-d/resources/incremental.eld
@@ -7,8 +7,7 @@
(0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net")
(0.0 ":irc.foo.net 003 tester :This server was created just now")
(0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)")
(0.0 ":irc.foo.net 252 tester 0 :IRC Operators online")
(0.0 ":irc.foo.net 253 tester 0 :unregistered connections")
@@ -24,7 +23,7 @@
((join 3 "JOIN #foo")
(0 ":tester!~tester@localhost JOIN #foo")
- (0 ":irc.foo.net 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.foo.net 353 alice = #foo :+alice @bob")
(0 ":irc.foo.net 366 alice #foo :End of NAMES list"))
((mode 3 "MODE #foo")
diff --git a/test/lisp/erc/resources/erc-d/resources/linger.eld b/test/lisp/erc/resources/erc-d/resources/linger.eld
index e456370a800..d68da730581 100644
--- a/test/lisp/erc/resources/erc-d/resources/linger.eld
+++ b/test/lisp/erc/resources/erc-d/resources/linger.eld
@@ -8,8 +8,7 @@
(0 ":irc.example.org 002 tester :Your host is irc.example.org")
(0 ":irc.example.org 003 tester :This server was created just now")
(0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
;; Just to mix thing's up (force handler to schedule timer)
(0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
@@ -24,7 +23,7 @@
(0 ":irc.example.org 221 tester +Zi")
(0 ":irc.example.org 306 tester :You have been marked as being away")
(0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #chan :+alice @bob")
(0 ":irc.example.org 366 alice #chan :End of NAMES list"))
((mode-chan 2 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/no-block.eld b/test/lisp/erc/resources/erc-d/resources/no-block.eld
index 2811923d8ac..af2f4a83ff6 100644
--- a/test/lisp/erc/resources/erc-d/resources/no-block.eld
+++ b/test/lisp/erc/resources/erc-d/resources/no-block.eld
@@ -7,8 +7,7 @@
(0.0 ":irc.org 002 tester :Your host is irc.org")
(0.0 ":irc.org 003 tester :This server was created just now")
(0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
(0.0 ":irc.org 252 tester 0 :IRC Operators online")
(0.0 ":irc.org 253 tester 0 :unregistered connections")
@@ -24,13 +23,13 @@
((join-foo 1.2 "JOIN #foo")
(0 ":tester!~tester@localhost JOIN #foo")
- (0 ":irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #foo :+alice @bob")
(0 ":irc.example.org 366 alice #foo :End of NAMES list"))
;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see)
((~join-bar 1.5 "JOIN #bar")
(0 ":tester!~tester@localhost JOIN #bar")
- (0 ":irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #bar :+alice @bob")
(0 ":irc.example.org 366 alice #bar :End of NAMES list"))
((mode-foo 1.2 "MODE #foo")
diff --git a/test/lisp/erc/resources/erc-d/resources/no-match.eld b/test/lisp/erc/resources/erc-d/resources/no-match.eld
index d147be1e084..d12854de551 100644
--- a/test/lisp/erc/resources/erc-d/resources/no-match.eld
+++ b/test/lisp/erc/resources/erc-d/resources/no-match.eld
@@ -8,8 +8,7 @@
(0 ":irc.example.org 002 tester :Your host is irc.example.org")
(0 ":irc.example.org 003 tester :This server was created just now")
(0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
(0 ":irc.example.org 252 tester 0 :IRC Operators online")
(0 ":irc.example.org 253 tester 0 :unregistered connections")
@@ -25,7 +24,7 @@
((join 1.2 "JOIN #chan")
(0 ":tester!~tester@localhost JOIN #chan")
- (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 353 alice = #chan :+alice @bob")
(0 ":irc.example.org 366 alice #chan :End of NAMES list"))
((mode-chan 0.2 "MODE #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/unexpected.eld b/test/lisp/erc/resources/erc-d/resources/unexpected.eld
index ac0a8fecfa6..c03b1dbcfdb 100644
--- a/test/lisp/erc/resources/erc-d/resources/unexpected.eld
+++ b/test/lisp/erc/resources/erc-d/resources/unexpected.eld
@@ -7,8 +7,7 @@
(0.0 ":irc.example.org 002 tester :Your host is irc.example.org")
(0.0 ":irc.example.org 003 tester :This server was created just now")
(0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
- (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
- " :are supported by this server")
+ (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
(0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
(0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
(0.0 ":irc.example.org 253 tester 0 :unregistered connections")
@@ -23,6 +22,6 @@
(0.0 ":irc.example.org 306 tester :You have been marked as being away")
(0.0 ":tester!~tester@localhost JOIN #chan")
- (0.0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0.0 ":irc.example.org 353 alice = #chan :+alice @bob")
(0.0 ":irc.example.org 366 alice #chan :End of NAMES list")
(0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 0ec48d766ef..9ad5ce49429 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -94,7 +94,8 @@
(require 'erc)
(eval-when-compile (require 'erc-join)
- (require 'erc-services))
+ (require 'erc-services)
+ (require 'erc-fill))
(declare-function erc-network "erc-networks")
(defvar erc-network)
@@ -148,9 +149,11 @@
(timer-list (copy-sequence timer-list))
(timer-idle-list (copy-sequence timer-idle-list))
(erc-auth-source-parameters-join-function nil)
+ (erc--fill-wrap-scrolltobottom-exempt-p t)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
(erc-after-connect nil)
+ (erc-last-input-time 0)
(erc-d-linger-secs 10)
,@bindings)))
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index fc5649798b5..99f15b89b03 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -122,7 +122,7 @@ Use NAME for the network and the session server as well."
erc--isupport-params (make-hash-table)
erc-session-port 6667
erc-network (intern name)
- erc-networks--id (erc-networks--id-create nil))
+ erc-networks--id (erc-networks--id-create name))
(current-buffer)))
(defun erc-tests-common-string-to-propertized-parts (string)
@@ -150,7 +150,7 @@ between literal strings."
For simplicity, assume string evaluates to itself."
(interactive "P")
(let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
- (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp))))
+ (if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp))))
;; The following utilities are meant to help prepare tests for
;; `erc--get-inserted-msg-bounds' and friends.
@@ -206,7 +206,7 @@ For simplicity, assume string evaluates to itself."
(defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn)
"Compare `buffer-string' to snapshot NAME.eld in DIR, if present.
-When non-nil, run TRANS-FN to fiter the current buffer string,
+When non-nil, run TRANS-FN to filter the current buffer string,
and expect a similar string in return. Call BUF-INIT-FN, when
non-nil, in the preview buffer after inserting the filtered
string."
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 3c32719a052..6ff7af218c0 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index e2064b914c4..7d9822c80bc 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 349 350 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 455 456 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index feaba85ec90..2d0e5a5965f 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
index ed1488c8595..e019e60bb26 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 507 508 (display #("~\n" 0 2 (font-lock-face shadow))) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
index a3530a6c44d..615de982b1e 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 509 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 514 (wrap-prefix #1# line-prefix #12# display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index c94629cf357..0228e716731 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index 127c0b29bc9..9ab89041b53 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index a9f3f1d1904..87ea4692d9d 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index c94629cf357..0228e716731 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 754d7989cea..ae364accdea 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 438 441 (wrap-prefix #1# line-prefix #5# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file
diff --git a/test/lisp/eshell/em-basic-tests.el b/test/lisp/eshell/em-basic-tests.el
index 960e04690a5..ebb91cdeea0 100644
--- a/test/lisp/eshell/em-basic-tests.el
+++ b/test/lisp/eshell/em-basic-tests.el
@@ -33,7 +33,7 @@
;;; Tests:
-(ert-deftest em-basic-test/umask-print-numeric ()
+(ert-deftest em-basic-test/umask/print-numeric ()
"Test printing umask numerically."
(cl-letf (((symbol-function 'default-file-modes) (lambda () #o775)))
(eshell-command-result-equal "umask" "002\n"))
@@ -43,7 +43,7 @@
(cl-letf (((symbol-function 'default-file-modes) (lambda () #o1775)))
(eshell-command-result-equal "umask" "002\n")))
-(ert-deftest em-basic-test/umask-read-symbolic ()
+(ert-deftest em-basic-test/umask/print-symbolic ()
"Test printing umask symbolically."
(cl-letf (((symbol-function 'default-file-modes) (lambda () #o775)))
(eshell-command-result-equal "umask -S"
@@ -56,8 +56,8 @@
(eshell-command-result-equal "umask -S"
"u=rwx,g=rwx,o=rx\n")))
-(ert-deftest em-basic-test/umask-set ()
- "Test setting umask."
+(ert-deftest em-basic-test/umask/set-numeric ()
+ "Test setting umask numerically."
(let ((file-modes 0))
(cl-letf (((symbol-function 'set-default-file-modes)
(lambda (mode) (setq file-modes mode))))
@@ -68,4 +68,30 @@
(eshell-test-command-result "umask $(identity #o222)")
(should (= file-modes #o555)))))
+(ert-deftest em-basic-test/umask/set-symbolic ()
+ "Test setting umask symbolically."
+ (let ((file-modes 0))
+ (cl-letf (((symbol-function 'default-file-modes)
+ (lambda() file-modes))
+ ((symbol-function 'set-default-file-modes)
+ (lambda (mode) (setq file-modes mode))))
+ (eshell-test-command-result "umask u=rwx,g=rwx,o=rx")
+ (should (= file-modes #o775))
+ (eshell-test-command-result "umask u=rw,g=rx,o=x")
+ (should (= file-modes #o651))
+ (eshell-test-command-result "umask u+x,o-x")
+ (should (= file-modes #o750))
+ (eshell-test-command-result "umask a+rx")
+ (should (= file-modes #o755)))))
+
+(ert-deftest em-basic-test/umask/set-with-S ()
+ "Test that passing \"-S\" and a umask still sets the umask."
+ (let ((file-modes 0))
+ (cl-letf (((symbol-function 'set-default-file-modes)
+ (lambda (mode) (setq file-modes mode))))
+ (eshell-test-command-result "umask -S 002")
+ (should (= file-modes #o775))
+ (eshell-test-command-result "umask -S 123")
+ (should (= file-modes #o654)))))
+
;; em-basic-tests.el ends here
diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el
index 13e42ffac88..f778816c4e1 100644
--- a/test/lisp/eshell/em-cmpl-tests.el
+++ b/test/lisp/eshell/em-cmpl-tests.el
@@ -175,18 +175,18 @@ ACTUAL and EXPECTED should both be lists of strings."
(ert-with-temp-directory default-directory
(write-region nil nil (expand-file-name "file.txt"))
(write-region nil nil (expand-file-name "file.el"))
+ ;; Complete the first time. This should insert the common prefix
+ ;; of our completions.
(should (equal (eshell-insert-and-complete "echo fi")
"echo file."))
+ ;; Make sure the completions buffer isn't displayed.
+ (should-not (get-buffer-window "*Completions*"))
;; Now try completing again.
(let ((minibuffer-message-timeout 0)
(inhibit-message t))
(completion-at-point))
- ;; FIXME: We can't use `current-message' here.
- (with-current-buffer (messages-buffer)
- (save-excursion
- (goto-char (point-max))
- (forward-line -1)
- (should (looking-at "Complete, but not unique")))))))
+ ;; This time, we should display the completions buffer.
+ (should (get-buffer-window "*Completions*")))))
(ert-deftest em-cmpl-test/file-completion/glob ()
"Test completion of file names using a glob."
diff --git a/test/lisp/eshell/em-dirs-tests.el b/test/lisp/eshell/em-dirs-tests.el
index 2f170fb0c63..9789e519f4c 100644
--- a/test/lisp/eshell/em-dirs-tests.el
+++ b/test/lisp/eshell/em-dirs-tests.el
@@ -34,6 +34,9 @@
default-directory))))
;;; Tests:
+
+;; Variables
+
(ert-deftest em-dirs-test/pwd-var ()
"Test using the $PWD variable."
(let ((default-directory "/some/path"))
@@ -99,6 +102,25 @@
(eshell-match-command-output "echo $-[1][/ 1 3]"
"(\"some\" \"here\")\n"))))
+
+;; Argument expansion
+
+(ert-deftest em-dirs-test/expand-user-reference/local ()
+ "Test expansion of \"~USER\" references."
+ (eshell-command-result-equal "echo ~" (expand-file-name "~"))
+ (eshell-command-result-equal
+ (format "echo ~%s" user-login-name)
+ (expand-file-name (format "~%s" user-login-name))))
+
+(ert-deftest em-dirs-test/expand-user-reference/quoted ()
+ "Test that a quoted \"~\" isn't expanded."
+ (eshell-command-result-equal "echo \\~" "~")
+ (eshell-command-result-equal "echo \"~\"" "~")
+ (eshell-command-result-equal "echo '~'" "~"))
+
+
+;; `cd'
+
(ert-deftest em-dirs-test/cd ()
"Test that changing directories with `cd' works."
(ert-with-temp-directory tmpdir
diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el
index 6d922666ea3..fc460a59eed 100644
--- a/test/lisp/eshell/em-glob-tests.el
+++ b/test/lisp/eshell/em-glob-tests.el
@@ -61,6 +61,9 @@ component ending in \"symlink\" is treated as a symbolic link."
;;; Tests:
+
+;; Glob expansion
+
(ert-deftest em-glob-test/expand/splice-results ()
"Test that globs are spliced into the argument list when
`eshell-glob-splice-results' is non-nil."
@@ -115,6 +118,33 @@ value of `eshell-glob-splice-results'."
(eshell-command-result-equal "list ${listify *.no}"
'(("*.no"))))))))
+
+;; Glob conversion
+
+(ert-deftest em-glob-test/convert/current-start-directory ()
+ "Test converting a glob starting in the current directory."
+ (should (equal (eshell-glob-convert "*.el")
+ '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/relative-start-directory ()
+ "Test converting a glob starting in a relative directory."
+ (should (equal (eshell-glob-convert "some/where/*.el")
+ '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/absolute-start-directory ()
+ "Test converting a glob starting in an absolute directory."
+ (should (equal (eshell-glob-convert "/some/where/*.el")
+ '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+(ert-deftest em-glob-test/convert/remote-start-directory ()
+ "Test converting a glob starting in a remote directory."
+ (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el")
+ '("/ssh:nowhere.invalid:/some/where/"
+ (("\\`.*\\.el\\'" . "\\`\\.")) nil))))
+
+
+;; Glob matching
+
(ert-deftest em-glob-test/match-any-string ()
"Test that \"*\" pattern matches any string."
(with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el")
diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el
index d33f6a2b46a..3be5d3542ca 100644
--- a/test/lisp/eshell/em-tramp-tests.el
+++ b/test/lisp/eshell/em-tramp-tests.el
@@ -59,35 +59,31 @@
"cd"
(list ,(format "/su:root@%s:~/" tramp-default-host))))))
-(defun mock-eshell-named-command (&rest args)
- "Dummy function to test Eshell `sudo' command rewriting."
- (list default-directory args))
-
(ert-deftest em-tramp-test/sudo-basic ()
"Test Eshell `sudo' command with default user."
- (cl-letf (((symbol-function 'eshell-named-command)
- #'mock-eshell-named-command))
- (should (equal
- (catch 'eshell-external (eshell/sudo "echo" "hi"))
- `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory)
- ("echo" ("hi")))))
- (should (equal
- (catch 'eshell-external (eshell/sudo "echo" "-u" "hi"))
- `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory)
- ("echo" ("-u" "hi")))))))
+ (let ((sudo-directory (format "/sudo:root@%s:%s"
+ tramp-default-host default-directory)))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/sudo "echo" "hi"))
+ `(let ((default-directory ,sudo-directory))
+ (eshell-named-command '"echo" '("hi")))))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/sudo "echo" "-u" "hi"))
+ `(let ((default-directory ,sudo-directory))
+ (eshell-named-command '"echo" '("-u" "hi")))))))
(ert-deftest em-tramp-test/sudo-user ()
"Test Eshell `sudo' command with specified user."
- (cl-letf (((symbol-function 'eshell-named-command)
- #'mock-eshell-named-command))
- (should (equal
- (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "hi"))
- `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory)
- ("echo" ("hi")))))
- (should (equal
- (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "-u" "hi"))
- `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory)
- ("echo" ("-u" "hi")))))))
+ (let ((sudo-directory (format "/sudo:USER@%s:%s"
+ tramp-default-host default-directory)))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/sudo "-u" "USER" "echo" "hi"))
+ `(let ((default-directory ,sudo-directory))
+ (eshell-named-command '"echo" '("hi")))))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/sudo "-u" "USER" "echo" "-u" "hi"))
+ `(let ((default-directory ,sudo-directory))
+ (eshell-named-command '"echo" '("-u" "hi")))))))
(ert-deftest em-tramp-test/sudo-shell ()
"Test Eshell `sudo' command with -s/--shell option."
@@ -109,34 +105,29 @@
(ert-deftest em-tramp-test/doas-basic ()
"Test Eshell `doas' command with default user."
- (cl-letf (((symbol-function 'eshell-named-command)
- #'mock-eshell-named-command))
- (should (equal
- (catch 'eshell-external (eshell/doas "echo" "hi"))
- `(,(format "/doas:root@%s:%s"
- tramp-default-host default-directory)
- ("echo" ("hi")))))
- (should (equal
- (catch 'eshell-external (eshell/doas "echo" "-u" "hi"))
- `(,(format "/doas:root@%s:%s"
- tramp-default-host default-directory)
- ("echo" ("-u" "hi")))))))
+ (let ((doas-directory (format "/doas:root@%s:%s"
+ tramp-default-host default-directory)))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/doas "echo" "hi"))
+ `(let ((default-directory ,doas-directory))
+ (eshell-named-command '"echo" '("hi")))))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/doas "echo" "-u" "hi"))
+ `(let ((default-directory ,doas-directory))
+ (eshell-named-command '"echo" '("-u" "hi")))))))
(ert-deftest em-tramp-test/doas-user ()
"Test Eshell `doas' command with specified user."
- (cl-letf (((symbol-function 'eshell-named-command)
- #'mock-eshell-named-command))
- (should (equal
- (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi"))
- `(,(format "/doas:USER@%s:%s"
- tramp-default-host default-directory)
- ("echo" ("hi")))))
- (should (equal
- (catch 'eshell-external
- (eshell/doas "-u" "USER" "echo" "-u" "hi"))
- `(,(format "/doas:USER@%s:%s"
- tramp-default-host default-directory)
- ("echo" ("-u" "hi")))))))
+ (let ((doas-directory (format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/doas "-u" "USER" "echo" "hi"))
+ `(let ((default-directory ,doas-directory))
+ (eshell-named-command '"echo" '("hi")))))
+ (should (equal (catch 'eshell-replace-command
+ (eshell/doas "-u" "USER" "echo" "-u" "hi"))
+ `(let ((default-directory ,doas-directory))
+ (eshell-named-command '"echo" '("-u" "hi")))))))
(ert-deftest em-tramp-test/doas-shell ()
"Test Eshell `doas' command with -s/--shell option."
diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el
index b626cf10bf1..b748c5ab4c0 100644
--- a/test/lisp/eshell/esh-arg-tests.el
+++ b/test/lisp/eshell/esh-arg-tests.el
@@ -60,13 +60,17 @@ chars."
"he\\\\llo\n")))
(ert-deftest esh-arg-test/escape/newline ()
- "Test that an escaped newline is equivalent to the empty string.
-When newlines are *nonspecial*, an escaped newline should be
-treated as just a newline."
+ "Test that an escaped newline is equivalent to the empty string."
(with-temp-eshell
(eshell-match-command-output "echo hi\\\nthere"
"hithere\n")))
+(ert-deftest esh-arg-test/escape/trailing-newline ()
+ "Test that an escaped newline is equivalent to the empty string."
+ (with-temp-eshell
+ (eshell-match-command-output "echo hi\\\n"
+ "hi\n")))
+
(ert-deftest esh-arg-test/escape/newline-conditional ()
"Test invocation of an if/else statement using line continuations."
(let ((eshell-test-value t))
@@ -95,9 +99,7 @@ chars."
"\\\"hi\\\\\n")))
(ert-deftest esh-arg-test/escape-quoted/newline ()
- "Test that an escaped newline is equivalent to the empty string.
-When newlines are *nonspecial*, an escaped newline should be
-treated literally, as a backslash and a newline."
+ "Test that an escaped newline is equivalent to the empty string."
(with-temp-eshell
(eshell-match-command-output "echo \"hi\\\nthere\""
"hithere\n")))
diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el
index be31681267b..ef965a896c1 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -469,6 +469,28 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"no"))
+;; Direct invocation
+
+(defmacro esh-cmd-test--deftest-invoke-directly (name command expected)
+ "Test `eshell-invoke-directly-p' returns EXPECTED for COMMAND.
+NAME is the name of the test case."
+ (declare (indent 2))
+ `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/"
+ (symbol-name name)))
+ ()
+ (with-temp-eshell
+ (should (equal (eshell-invoke-directly-p
+ (eshell-parse-command ,command nil t))
+ ,expected)))))
+
+(esh-cmd-test--deftest-invoke-directly no-args "echo" t)
+(esh-cmd-test--deftest-invoke-directly with-args "echo hi" t)
+(esh-cmd-test--deftest-invoke-directly multiple-cmds "echo hi; echo bye" nil)
+(esh-cmd-test--deftest-invoke-directly subcmd "echo ${echo hi}" t)
+(esh-cmd-test--deftest-invoke-directly complex "ls ." nil)
+(esh-cmd-test--deftest-invoke-directly complex-subcmd "echo {ls .}" nil)
+
+
;; Error handling
(ert-deftest esh-cmd-test/throw ()
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el
index 8d6e0c1e426..4e5373e53cd 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -29,13 +29,15 @@
(eshell--process-args
"sudo" '("-a")
'((?a "all" nil show-all
- "do not ignore entries starting with .")))))
+ "do not ignore entries starting with ."))
+ '(show-all))))
(should
(equal '("root" "world")
(eshell--process-args
"sudo" '("-u" "root" "world")
'((?u "user" t user
- "execute a command as another USER"))))))
+ "execute a command as another USER"))
+ '(user)))))
(ert-deftest esh-opt-test/process-args-parse-leading-options-only ()
"Test behavior of :parse-leading-options-only in `eshell--process-args'."
@@ -45,20 +47,23 @@
"sudo" '("emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
- :parse-leading-options-only))))
+ :parse-leading-options-only)
+ '(user))))
(should
(equal '("root" "emerge" "-uDN" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
- :parse-leading-options-only))))
+ :parse-leading-options-only)
+ '(user))))
(should
(equal '("DN" "emerge" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
- "execute a command as another USER"))))))
+ "execute a command as another USER"))
+ '(user)))))
(ert-deftest esh-opt-test/process-args-external ()
"Test behavior of :external in `eshell--process-args'."
@@ -69,7 +74,8 @@
"ls" '("/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls")))))
+ :external "ls")
+ '(show-all)))))
(cl-letf (((symbol-function 'eshell-search-path) #'identity))
(should
(equal '(no-catch eshell-ext-command "ls")
@@ -78,7 +84,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls"))
+ :external "ls")
+ '(show-all))
:type 'no-catch))))
(cl-letf (((symbol-function 'eshell-search-path) #'ignore))
(should-error
@@ -86,7 +93,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
- :external "ls"))
+ :external "ls")
+ '(show-all))
:type 'error)))
(ert-deftest esh-opt-test/eval-using-options-short ()
diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el
index 39c278a6277..b94e8a276d7 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -653,6 +653,21 @@ nil, use FUNCTION instead."
"VAR=hello\n")
(should (equal (getenv "VAR") "value"))))
+(ert-deftest esh-var-test/local-variables/cd ()
+ "Test that \"VAR=value cd DIR\" properly changes the directory."
+ (let ((parent-directory (file-name-directory
+ (directory-file-name default-directory))))
+ (with-temp-eshell
+ (eshell-insert-command "VAR=hello cd ..")
+ (should (equal default-directory parent-directory)))))
+
+(ert-deftest esh-var-test/local-variables/env ()
+ "Test that \"env VAR=value command\" temporarily sets variables."
+ (with-temp-eshell
+ (push "VAR=value" process-environment)
+ (eshell-match-command-output "env VAR=hello env" "VAR=hello\n")
+ (should (equal (getenv "VAR") "value"))))
+
;; Variable aliases
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index e01e033e25e..e58b5a14ed9 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run it."
"Test flushing of previous output"
(with-temp-eshell
(eshell-insert-command "echo alpha")
- (eshell-kill-output)
+ (eshell-delete-output)
(should (eshell-match-output
(concat "^" (regexp-quote "*** output flushed ***\n") "$")))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 11af1f75574..28f4d5fa181 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -74,8 +74,8 @@
(defvar file-notify--test-events nil)
(defvar file-notify--test-monitors nil)
-(defun file-notify--test-read-event ()
- "Read one event.
+(defun file-notify--test-wait-event ()
+ "Wait for one event.
There are different timeouts for local and remote file notification libraries."
(read-event
nil nil
@@ -87,7 +87,8 @@ There are different timeouts for local and remote file notification libraries."
;; for any monitor.
((file-notify--test-monitor) 7)
((file-remote-p temporary-file-directory) 0.1)
- (t 0.01))))
+ (t 0.01)))
+ nil)
(defun file-notify--test-timeout ()
"Timeout to wait for arriving a bunch of events, in seconds."
@@ -103,7 +104,7 @@ There are different timeouts for local and remote file notification libraries."
TIMEOUT is the maximum time to wait for, in seconds."
`(with-timeout (,timeout (ignore))
(while (null ,until)
- (file-notify--test-read-event))))
+ (file-notify--test-wait-event))))
(defun file-notify--test-no-descriptors ()
"Check that `file-notify-descriptors' is an empty hash table.
@@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Check, that removing watch descriptors out of order do not
;; harm. This fails on cygwin because of timing issues unless a
;; long `sit-for' is added before the call to
- ;; `file-notify--test-read-event'.
+ ;; `file-notify--test-wait-event'.
(unless (eq system-type 'cygwin)
(let (results)
(cl-flet ((first-callback (event)
@@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Remove first watch.
(file-notify-rm-watch file-notify--test-desc)
;; Only the second callback shall run.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile)
(file-notify--test-wait-for-events
(file-notify--test-timeout) results)
@@ -622,7 +623,7 @@ delivered."
(cons 'file-notify while-no-input-ignore-events))
create-lockfiles)
;; Flush pending actions.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(file-notify--test-wait-for-events
(file-notify--test-timeout)
(not (input-pending-p)))
@@ -671,7 +672,7 @@ delivered."
(t '(created changed deleted stopped)))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -707,7 +708,7 @@ delivered."
(changed changed deleted stopped))))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -755,7 +756,7 @@ delivered."
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -805,14 +806,14 @@ delivered."
deleted deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; The next two events shall not be visible.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-modes file-notify--test-tmpfile 000 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -860,10 +861,10 @@ delivered."
(t '(created changed renamed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; After the rename, we won't get events anymore.
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
(file-notify-rm-watch file-notify--test-desc)
@@ -912,11 +913,11 @@ delivered."
(t '(attribute-changed attribute-changed)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-modes file-notify--test-tmpfile 000 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(set-file-times file-notify--test-tmpfile '(0 0) 'nofollow)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc)
@@ -1087,7 +1088,7 @@ delivered."
(changed changed deleted stopped))))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file-notify--test-tmpfile))
;; After deleting the file, the descriptor is not valid anymore.
(should-not (file-notify-valid-p file-notify--test-desc))
@@ -1134,7 +1135,7 @@ delivered."
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-directory file-notify--test-tmpdir 'recursive))
;; After deleting the parent directory, the descriptor must
;; not be valid anymore.
@@ -1247,9 +1248,9 @@ delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(write-region "" nil (pop source-file-list) nil 'no-message)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(write-region "" nil (pop target-file-list) nil 'no-message))))
(file-notify--test-with-actions
(cond
@@ -1272,11 +1273,11 @@ delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(rename-file (pop source-file-list) (pop target-file-list) t))))
(file-notify--test-with-actions (make-list n 'deleted)
(dolist (file target-file-list)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(delete-file file)))
(delete-directory file-notify--test-tmpfile)
(if (or (string-equal (file-notify--test-library) "w32notify")
@@ -1464,7 +1465,7 @@ the file watch."
;; does not report the `changed' event.
(make-list (/ n 2) 'created)))
(dotimes (i n)
- (file-notify--test-read-event)
+ (file-notify--test-wait-event)
(if (zerop (mod i 2))
(write-region
"any text" nil file-notify--test-tmpfile1 t 'no-message)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 718ecd51f8b..d4c1ef3ba67 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1656,30 +1656,47 @@ The door of all subtleties!
(should (equal (file-name-base "foo") "foo"))
(should (equal (file-name-base "foo/bar") "bar")))
-(defun files-tests--check-shebang (shebang expected-mode)
- "Assert that mode for SHEBANG derives from EXPECTED-MODE."
- (let ((actual-mode
- (ert-with-temp-file script-file
- :text shebang
- (find-file script-file)
- (if (derived-mode-p expected-mode)
- expected-mode
- major-mode))))
- ;; Tuck all the information we need in the `should' form: input
- ;; shebang, expected mode vs actual.
- (should
- (equal (list shebang actual-mode)
- (list shebang expected-mode)))))
+(defvar sh-shell)
+
+(defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect)
+ "Assert that mode for SHEBANG derives from EXPECTED-MODE.
+
+If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be
+set to."
+ (ert-with-temp-file script-file
+ :text shebang
+ (find-file script-file)
+ (let ((actual-mode (if (derived-mode-p expected-mode)
+ expected-mode
+ major-mode)))
+ ;; Tuck all the information we need in the `should' form: input
+ ;; shebang, expected mode vs actual.
+ (should
+ (equal (list shebang actual-mode)
+ (list shebang expected-mode)))
+ (when (eq expected-mode 'sh-base-mode)
+ (should (eq sh-shell expected-dialect))))))
(ert-deftest files-tests-auto-mode-interpreter ()
"Test that `set-auto-mode' deduces correct modes from shebangs."
- (files-tests--check-shebang "#!/bin/bash" 'sh-mode)
- (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode)
+ ;; Straightforward interpreter invocation.
+ (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)
+ ;; Invocation through env.
+ (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash)
(files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode)
(files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode)
+ ;; Invocation through env, with supplementary arguments.
+ (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash)
(files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode)
(files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)
- (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode))
+ (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash)
+ (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)
+ ;; Invocation through env, with modified environment.
+ (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode))
(ert-deftest files-test-dir-locals-auto-mode-alist ()
"Test an `auto-mode-alist' entry in `.dir-locals.el'"
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index a2f16d5ae35..528467a5641 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -553,6 +553,49 @@ If it's not initialized yet, initialize it."
(should-not (boundp 'remote-shell-file-name))
(should (string-equal (symbol-value 'remote-null-device) "null"))))
+ ;; `connection-local-value' and `connection-local-p' care about a
+ ;; local default directory.
+ (with-temp-buffer
+ (let ((enable-connection-local-variables t)
+ (default-directory temporary-file-directory)
+ (remote-null-device "null"))
+ (should-not connection-local-variables-alist)
+ (should-not (local-variable-p 'remote-shell-file-name))
+ (should-not (local-variable-p 'remote-null-device))
+ (should-not (boundp 'remote-shell-file-name))
+ (should (string-equal (symbol-value 'remote-null-device) "null"))
+
+ ;; The recent variable values are used.
+ (should-not (connection-local-p remote-shell-file-name))
+ ;; `remote-shell-file-name' is not defined, so we get an error.
+ (should-error
+ (connection-local-value remote-shell-file-name) :type 'void-variable)
+ (should-not (connection-local-p remote-null-device))
+ (should
+ (string-equal
+ (connection-local-value remote-null-device) remote-null-device))
+ (should-not (connection-local-p remote-lazy-var))
+
+ ;; Run with a different application.
+ (should-not
+ (connection-local-p
+ remote-shell-file-name (cadr files-x-test--application)))
+ ;; `remote-shell-file-name' is not defined, so we get an error.
+ (should-error
+ (connection-local-value
+ remote-shell-file-name (cadr files-x-test--application))
+ :type 'void-variable)
+ (should-not
+ (connection-local-p
+ remote-null-device (cadr files-x-test--application)))
+ (should
+ (string-equal
+ (connection-local-value
+ remote-null-device (cadr files-x-test--application))
+ remote-null-device))
+ (should-not
+ (connection-local-p remote-lazy-var (cadr files-x-test--application)))))
+
;; Cleanup.
(custom-set-variables
`(connection-local-profile-alist ',clpa now)
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 7035c8b7773..1beeb77640c 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -48,12 +48,12 @@ Return first line of the output of (describe-function-1 FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-built-in ()
- (let ((regexp "a built-in function in .C source code")
+ (let ((regexp "a primitive-function in .C source code")
(result (help-fns-tests--describe-function 'mapcar)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-interactive-built-in ()
- (let ((regexp "an interactive built-in function in .C source code")
+ (let ((regexp "an interactive primitive-function in .C source code")
(result (help-fns-tests--describe-function 're-search-forward)))
(should (string-match regexp result))))
@@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1 FUNC)."
(ert-deftest help-fns-test-lisp-defun ()
(let ((regexp (if (featurep 'native-compile)
- "a native-compiled Lisp function in .+subr\\.el"
- "a byte-compiled Lisp function in .+subr\\.el"))
+ "a subr-native-elisp in .+subr\\.el"
+ "a compiled-function in .+subr\\.el"))
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defsubst ()
- (let ((regexp "a byte-compiled Lisp function in .+subr\\.el")
+ (let ((regexp "a compiled-function in .+subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..6a5f03e38a0 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,148 @@
(image-rotate -154.5)
(should (equal image '(image :rotation 91.0)))))
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+ "Test that `create-image' correctly adds :map and/or :original-map."
+ (skip-unless (display-images-p))
+ (let ((data "foo")
+ (map '(((circle (1 . 1) . 1) a)))
+ (original-map '(((circle (2 . 2) . 2) a)))
+ (original-map-other '(((circle (3 . 3) . 3) a))))
+ ;; Generate :original-map from :map.
+ (let* ((image (create-image data 'svg t :map map :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map)))
+ ;; Generate :map from :original-map.
+ (let* ((image (create-image
+ data 'svg t :original-map original-map :scale 0.5))
+ (got-map (image-property image :map)))
+ (should (equal got-map map)))
+ ;; Use :original-map if both it and :map are specified.
+ (let* ((image (create-image
+ data 'svg t :map map
+ :original-map original-map-other :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map-other)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+ "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B. When nil, TOLERANCE defaults to 5."
+ (unless tolerance (setq tolerance 5))
+ (catch 'different
+ (cl-labels ((check-tolerance
+ (coord-a coord-b)
+ (unless (>= tolerance (abs (- coord-a coord-b)))
+ (throw 'different nil))))
+ (dotimes (i (length a))
+ (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+ (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+ (unless (eq type-a type-b)
+ (throw 'different nil))
+ (pcase-exhaustive type-a
+ ('rect
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cadr coords-a) (cadr coords-b))
+ (check-tolerance (cddr coords-a) (cddr coords-b)))
+ ('circle
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b)))
+ ('poly
+ (dotimes (i (length coords-a))
+ (check-tolerance (aref coords-a i) (aref coords-b i))))))))
+ t))
+
+(ert-deftest image--compute-map-and-original-map ()
+ "Test `image--compute-map' and `image--compute-original-map'."
+ (skip-unless (display-images-p))
+ (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+ (original-map
+ '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+ ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+ ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+ (scaled-map
+ '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+ ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+ ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+ (flipped-map
+ '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+ ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+ ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+ (rotated-map
+ '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+ ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+ ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+ (scaled-rotated-flipped-map
+ '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+ ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+ ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+ (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+ :scale 2 :rotation 90 :flip t)))
+ ;; Test that `image--compute-original-map' correctly generates
+ ;; original-map when creating an already transformed image.
+ (should (image-tests--map-equal (image-property image :original-map)
+ original-map))
+ (setf (image-property image :flip) nil)
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :scale) 2)
+ (should (image-tests--map-equal (image--compute-map image)
+ scaled-map))
+ (setf (image-property image :scale) 1)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-equal (image--compute-map image)
+ rotated-map))
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :flip) t)
+ (should (image-tests--map-equal (image--compute-map image)
+ flipped-map))
+ (setf (image-property image :scale) 2)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-equal (image--compute-map image)
+ scaled-rotated-flipped-map))
+
+ ;; Uncomment to test manually by interactively transforming the
+ ;; image and checking the map boundaries by hovering them.
+
+ ;; (with-current-buffer (get-buffer-create "*test image map*")
+ ;; (erase-buffer)
+ ;; (insert-image image)
+ ;; (goto-char (point-min))
+ ;; (pop-to-buffer (current-buffer)))
+ ))
+
+(ert-deftest image-transform-map ()
+ "Test functions related to transforming image maps."
+ (let ((map '(((circle (4 . 3) . 2) "circle")
+ ((rect (3 . 6) 8 . 8) "rect")
+ ((poly . [6 11 7 13 2 14]) "poly")))
+ (width 10)
+ (height 15))
+ (should (equal (image--scale-map (copy-tree map t) 2)
+ '(((circle (8 . 6) . 4) "circle")
+ ((rect (6 . 12) 16 . 16) "rect")
+ ((poly . [12 22 14 26 4 28]) "poly"))))
+ (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+ '(((circle (12 . 4) . 2) "circle")
+ ((rect (7 . 3) 9 . 8) "rect")
+ ((poly . [4 6 2 7 1 2]) "poly"))))
+ (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+ '(((circle (6 . 3) . 2) "circle")
+ ((rect (2 . 6) 7 . 8) "rect")
+ ((poly . [4 11 3 13 8 14]) "poly"))))
+ (let ((copy (copy-tree map t)))
+ (image--scale-map copy 2)
+ ;; Scale size because the map has been scaled.
+ (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+ ;; Swap width and height because the map has been flipped.
+ (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+ (should (equal copy
+ '(((circle (6 . 8) . 4) "circle")
+ ((rect (12 . 6) 16 . 16) "rect")
+ ((poly . [22 12 26 14 28 4]) "poly")))))))
+
;;; image-tests.el ends here
diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el
index ebe718167bf..8020a7419cf 100644
--- a/test/lisp/info-tests.el
+++ b/test/lisp/info-tests.el
@@ -28,12 +28,20 @@
(require 'ert-x)
(ert-deftest test-info-urls ()
+ (should (equal (Info-url-for-node "(tramp)Top")
+ "https://www.gnu.org/software/emacs/manual/html_node/tramp/"))
(should (equal (Info-url-for-node "(emacs)Minibuffer")
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html"))
(should (equal (Info-url-for-node "(emacs)Minibuffer File")
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html"))
(should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving")
"https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html"))
- (should-error (Info-url-for-node "(gnus)Minibuffer File")))
+ (should (equal (Info-url-for-node "(eintr)car & cdr")
+ "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html"))
+ (should (equal (Info-url-for-node "(emacs-mime)\tIndex")
+ "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html"))
+ (should (equal (Info-url-for-node "(gnus) Don't Panic")
+ "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html"))
+ (should-error (Info-url-for-node "(nonexistent)Example")))
;;; info-tests.el ends here
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 72b6706a22c..c8eb18501f3 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -92,7 +92,15 @@ text.
"
)
(write-region nil nil file nil 'silent))
- (should (equal 0 (call-process "makeinfo" file))))
+ (if (and (eq system-type 'windows-nt)
+ (executable-find "sh"))
+ ;; If we are running from MSYS Bash, makeinfo.bat might find the
+ ;; wrong version of Perl, so make sure to run the shell script
+ ;; named just 'makeinfo' instead, because it names the correct
+ ;; Perl.
+ (should (equal 0 (call-process "sh" nil t nil
+ "-c" (format "makeinfo '%s'" file))))
+ (should (equal 0 (call-process "makeinfo" file)))))
(ert-deftest info-xref-test-makeinfo ()
"Test that info-xref can parse basic makeinfo output."
diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el
index 5c742451a57..9a80ced55ae 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -96,10 +96,10 @@
;;; Testing `sgml-html-meta-auto-coding-function'.
-(defconst sgml-html-meta-pre "<!doctype html><html><head>"
+(defvar sgml-html-meta-pre "<!doctype html><html><head>"
"The beginning of a minimal HTML document.")
-(defconst sgml-html-meta-post "</head></html>"
+(defvar sgml-html-meta-post "</head></html>"
"The end of a minimal HTML document.")
(defun sgml-html-meta-run (coding-system)
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index 140482ee622..ecda189b6b2 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -161,6 +161,24 @@ DESCRIPTION
(let ((button (button-at (match-beginning 0))))
(should (and button (eq 'Man-xref-header-file (button-type button))))))))))
+(ert-deftest man-tests-Man-translate-references ()
+ (should (equal (Man-translate-references "basename")
+ (if (memq system-type '(ms-dos windows-nt))
+ "\"basename\""
+ "basename")))
+ (should (equal (Man-translate-references "basename(3)")
+ "3 basename"))
+ (should (equal (Man-translate-references "basename(3v)")
+ "3v basename"))
+ (should (equal (Man-translate-references ";id")
+ (if (memq system-type '(ms-dos windows-nt))
+ "\";id\""
+ "\\;id")))
+ (should (equal (Man-translate-references "-k basename")
+ (if (memq system-type '(ms-dos windows-nt))
+ "\"-k\" \"basename\""
+ "-k basename"))))
+
(provide 'man-tests)
;;; man-tests.el ends here
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 6dc15d0801f..c4a7de9e51f 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -201,6 +201,13 @@
'completions-first-difference)
return pos))
+(ert-deftest completion-test--pcm-bug38458 ()
+ (should (equal (let ((completion-ignore-case t))
+ (completion-pcm--merge-try '("tes" point "ing")
+ '("Testing" "testing")
+ "" ""))
+ '("testing" . 4))))
+
(ert-deftest completion-pcm-test-1 ()
;; Point is at end, this does not match anything
(should (null
@@ -465,6 +472,20 @@
(previous-line-completion 4)
(should (equal "ac" (get-text-property (point) 'completion--string))))))
+(ert-deftest completion-next-line-multline-test ()
+ (let ((completion-auto-wrap t))
+ (completing-read-with-minibuffer-setup
+ '("a\na" "a\nb" "ac")
+ (insert "a")
+ (minibuffer-completion-help)
+ (switch-to-completions)
+ (goto-char (point-min))
+ (next-line-completion 5)
+ (should (equal "a\nb" (get-text-property (point) 'completion--string)))
+ (goto-char (point-min))
+ (previous-line-completion 5)
+ (should (equal "a\nb" (get-text-property (point) 'completion--string))))))
+
(ert-deftest completions-header-format-test ()
(let ((completion-show-help nil)
(completions-header-format nil))
@@ -505,11 +526,11 @@
(ert-deftest completions-affixation-navigation-test ()
(let ((completion-extra-properties
- '(:affixation-function
- (lambda (completions)
- (mapcar (lambda (c)
- (list c "prefix " " suffix"))
- completions)))))
+ `(:affixation-function
+ ,(lambda (completions)
+ (mapcar (lambda (c)
+ (list c "prefix " " suffix"))
+ completions)))))
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
(insert "a")
@@ -551,35 +572,63 @@
(if transform
name
(pcase name
- (`"aa" "Group 1")
- (`"ab" "Group 2")
- (`"ac" "Group 3")))))
+ (`"aa1" "Group 1")
+ (`"aa2" "Group 1")
+ (`"aa3" "Group 1")
+ (`"aa4" "Group 1")
+ (`"ab1" "Group 2")
+ (`"ac1" "Group 3")
+ (`"ac2" "Group 3")))))
(category . unicode-name))
- (complete-with-action action '("aa" "ab" "ac") string pred)))
+ (complete-with-action action '("aa1" "aa2" "aa3" "aa4" "ab1" "ac1" "ac2")
+ string pred)))
(insert "a")
(minibuffer-completion-help)
(switch-to-completions)
- (should (equal "aa" (get-text-property (point) 'completion--string)))
+ (should (equal "aa1" (get-text-property (point) 'completion--string)))
(let ((completion-auto-wrap t))
- (next-completion 3))
- (should (equal "aa" (get-text-property (point) 'completion--string)))
+ (next-completion 7))
+ (should (equal "aa1" (get-text-property (point) 'completion--string)))
(let ((completion-auto-wrap nil))
- (next-completion 3))
- (should (equal "ac" (get-text-property (point) 'completion--string)))
+ (next-completion 7))
+ (should (equal "ac2" (get-text-property (point) 'completion--string)))
- (first-completion)
(let ((completion-auto-wrap t))
+ ;; First column
+ (first-completion)
(next-line-completion 1)
- (should (equal "ab" (get-text-property (point) 'completion--string)))
- (next-line-completion 2)
- (should (equal "aa" (get-text-property (point) 'completion--string)))
+ (should (equal "aa4" (get-text-property (point) 'completion--string)))
+ (next-line-completion 3)
+ (should (equal "aa1" (get-text-property (point) 'completion--string)))
(previous-line-completion 2)
- (should (equal "ab" (get-text-property (point) 'completion--string))))
+ (should (equal "ab1" (get-text-property (point) 'completion--string)))
+
+ ;; Second column
+ (first-completion)
+ (next-completion 1)
+ (should (equal "aa2" (get-text-property (point) 'completion--string)))
+ (next-line-completion 1)
+ (should (equal "ac2" (get-text-property (point) 'completion--string)))
+ (next-line-completion 1)
+ (should (equal "aa2" (get-text-property (point) 'completion--string)))
+ (previous-line-completion 1)
+ (should (equal "ac2" (get-text-property (point) 'completion--string)))
+ (previous-line-completion 1)
+ (should (equal "aa2" (get-text-property (point) 'completion--string)))
+
+ ;; Third column
+ (first-completion)
+ (next-completion 2)
+ (should (equal "aa3" (get-text-property (point) 'completion--string)))
+ (next-line-completion 1)
+ (should (equal "aa3" (get-text-property (point) 'completion--string))))
+
(let ((completion-auto-wrap nil))
- (next-line-completion 3)
- (should (equal "ac" (get-text-property (point) 'completion--string)))
- (previous-line-completion 3)
- (should (equal "aa" (get-text-property (point) 'completion--string))))))
+ (first-completion)
+ (next-line-completion 7)
+ (should (equal "ac2" (get-text-property (point) 'completion--string)))
+ (previous-line-completion 7)
+ (should (equal "aa1" (get-text-property (point) 'completion--string))))))
(provide 'minibuffer-tests)
;;; minibuffer-tests.el ends here
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
new file mode 100644
index 00000000000..b83435e0bd9
--- /dev/null
+++ b/test/lisp/net/eww-tests.el
@@ -0,0 +1,247 @@
+;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 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 'eww)
+
+(defvar eww-test--response-function (lambda (url) (concat "\n" url))
+ "A function for returning a mock response for URL.
+The default just returns an empty list of headers and the URL as the
+body.")
+
+(defmacro eww-test--with-mock-retrieve (&rest body)
+ "Evaluate BODY with a mock implementation of `eww-retrieve'.
+This avoids network requests during our tests. Additionally, prepare a
+temporary EWW buffer for our tests."
+ (declare (indent 0))
+ `(cl-letf (((symbol-function 'eww-retrieve)
+ (lambda (url callback args)
+ (with-temp-buffer
+ (insert (funcall eww-test--response-function url))
+ (apply callback nil args)))))
+ (with-temp-buffer
+ (eww-mode)
+ ,@body)))
+
+(defun eww-test--history-urls ()
+ (mapcar (lambda (elem) (plist-get elem :url)) eww-history))
+
+;;; Tests:
+
+(ert-deftest eww-test/display/html ()
+ "Test displaying a simple HTML page."
+ (eww-test--with-mock-retrieve
+ (let ((eww-test--response-function
+ (lambda (url)
+ (concat "Content-Type: text/html\n\n"
+ (format "<html><body><h1>Hello</h1>%s</body></html>"
+ url)))))
+ (eww "example.invalid")
+ ;; Check that the buffer contains the rendered HTML.
+ (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n"))
+ (should (equal (get-text-property (point-min) 'face)
+ '(shr-text shr-h1)))
+ ;; Check that the DOM includes the `base'.
+ (should (equal (pcase (plist-get eww-data :dom)
+ (`(base ((href . ,url)) ,_) url))
+ "http://example.invalid/")))))
+
+(ert-deftest eww-test/history/new-page ()
+ "Test that when visiting a new page, the previous one goes into the history."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (should (equal (eww-test--history-urls)
+ '("http://one.invalid/")))
+ (eww "three.invalid")
+ (should (equal (eww-test--history-urls)
+ '("http://two.invalid/"
+ "http://one.invalid/")))))
+
+(ert-deftest eww-test/history/back-forward ()
+ "Test that navigating through history just changes our history position.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (let ((url-history '("http://three.invalid/"
+ "http://two.invalid/"
+ "http://one.invalid/")))
+ ;; Go back one page. This should add "three.invalid" to the
+ ;; history, making our position in the list 2.
+ (eww-back-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 2))
+ ;; Go back again.
+ (eww-back-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 3))
+ ;; At the beginning of the history, so trying to go back should
+ ;; signal an error.
+ (should-error (eww-back-url))
+ ;; Go forward once.
+ (eww-forward-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 2))
+ ;; Go forward again.
+ (eww-forward-url)
+ (should (equal (eww-test--history-urls) url-history))
+ (should (= eww-history-position 1))
+ ;; At the end of the history, so trying to go forward should
+ ;; signal an error.
+ (should-error (eww-forward-url)))))
+
+(ert-deftest eww-test/history/reload-in-place ()
+ "Test that reloading historical pages updates their history entry in-place.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ ;; Make sure our history has the original page text.
+ (should (equal (plist-get (nth 1 eww-history) :text)
+ "http://two.invalid/"))
+ (should (= eww-history-position 2))
+ ;; Reload the page.
+ (let ((eww-test--response-function
+ (lambda (url) (concat "\nreloaded " url))))
+ (eww-reload)
+ (should (= eww-history-position 2)))
+ ;; Go to another page, and make sure the history is correct,
+ ;; including the reloaded page text.
+ (eww "four.invalid")
+ (should (equal (eww-test--history-urls) '("http://two.invalid/"
+ "http://one.invalid/")))
+ (should (equal (plist-get (nth 0 eww-history) :text)
+ "reloaded http://two.invalid/"))
+ (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/delete-future-history ()
+ "Test that going to a new page from a historical one deletes future history.
+See bug#69232."
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls) '("http://four.invalid/"
+ "http://two.invalid/"
+ "http://one.invalid/")))
+ (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/ignore-history ()
+ "Test that going to a new page from a historical one preserves history.
+This sets `eww-before-browse-history-function' to `ignore' to preserve
+history. See bug#69232."
+ (let ((eww-before-browse-history-function #'ignore))
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls) '("http://four.invalid/"
+ "http://three.invalid/"
+ "http://two.invalid/"
+ "http://one.invalid/")))
+ (should (= eww-history-position 0)))))
+
+(ert-deftest eww-test/history/before-navigate/clone-previous ()
+ "Test that going to a new page from a historical one clones prior history.
+This sets `eww-before-browse-history-function' to
+`eww-clone-previous-history' to clone the history. See bug#69232."
+ (let ((eww-before-browse-history-function #'eww-clone-previous-history))
+ (eww-test--with-mock-retrieve
+ (eww "one.invalid")
+ (eww "two.invalid")
+ (eww "three.invalid")
+ (eww-back-url)
+ (eww "four.invalid")
+ (eww "five.invalid")
+ (should (equal (eww-test--history-urls)
+ '(;; New page and cloned history.
+ "http://four.invalid/"
+ "http://two.invalid/"
+ "http://one.invalid/"
+ ;; Original history.
+ "http://three.invalid/"
+ "http://two.invalid/"
+ "http://one.invalid/")))
+ (should (= eww-history-position 0)))))
+
+(ert-deftest eww-test/readable/toggle-display ()
+ "Test toggling the display of the \"readable\" parts of a web page."
+ (eww-test--with-mock-retrieve
+ (let* ((shr-width most-positive-fixnum)
+ (shr-use-fonts nil)
+ (words (string-join
+ (make-list
+ 20 "All work and no play makes Jack a dull boy.")
+ " "))
+ (eww-test--response-function
+ (lambda (_url)
+ (concat "Content-Type: text/html\n\n"
+ "<html><body>"
+ "<a>This is an uninteresting sentence.</a>"
+ "<div>"
+ words
+ "</div>"
+ "</body></html>"))))
+ (eww "example.invalid")
+ ;; Make sure EWW renders the whole document.
+ (should-not (plist-get eww-data :readable))
+ (should (string-prefix-p
+ "This is an uninteresting sentence."
+ (buffer-substring-no-properties (point-min) (point-max))))
+ (eww-readable 'toggle)
+ ;; Now, EWW should render just the "readable" parts.
+ (should (plist-get eww-data :readable))
+ (should (string-match-p
+ (concat "\\`" (regexp-quote words) "\n*\\'")
+ (buffer-substring-no-properties (point-min) (point-max))))
+ (eww-readable 'toggle)
+ ;; Finally, EWW should render the whole document again.
+ (should-not (plist-get eww-data :readable))
+ (should (string-prefix-p
+ "This is an uninteresting sentence."
+ (buffer-substring-no-properties (point-min) (point-max)))))))
+
+(ert-deftest eww-test/readable/default-readable ()
+ "Test that EWW displays readable parts of pages by default when applicable."
+ (eww-test--with-mock-retrieve
+ (let* ((eww-test--response-function
+ (lambda (_url)
+ (concat "Content-Type: text/html\n\n"
+ "<html><body>Hello there</body></html>")))
+ (eww-readable-urls '("://example\\.invalid/")))
+ (eww "example.invalid")
+ ;; Make sure EWW uses "readable" mode.
+ (should (plist-get eww-data :readable)))))
+
+(provide 'eww-tests)
+;; eww-tests.el ends here
diff --git a/test/lisp/net/shr-resources/blockquote.html b/test/lisp/net/shr-resources/blockquote.html
new file mode 100644
index 00000000000..412caf8bae6
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.html
@@ -0,0 +1,2 @@
+<blockquote>Citation.</blockquote>
+<div>Reply.</div>
diff --git a/test/lisp/net/shr-resources/blockquote.txt b/test/lisp/net/shr-resources/blockquote.txt
new file mode 100644
index 00000000000..8ed610b8ea2
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.txt
@@ -0,0 +1,3 @@
+ Citation.
+
+Reply.
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 0c6e2c091bf..17138053450 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -29,30 +29,62 @@
(declare-function libxml-parse-html-region "xml.c")
-(defun shr-test (name)
- (with-temp-buffer
- (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name))
- (let ((dom (libxml-parse-html-region (point-min) (point-max)))
- (shr-width 80)
- (shr-use-fonts nil))
- (erase-buffer)
- (shr-insert-document dom)
- (cons (buffer-substring-no-properties (point-min) (point-max))
- (with-temp-buffer
- (insert-file-contents
- (format (concat (ert-resource-directory) "/%s.txt") name))
- (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
- (replace-match (string (string-to-number (match-string 1) 16))
- t t))
- (buffer-string))))))
+(defun shr-test--rendering-check (name &optional context)
+ "Render NAME.html and compare it to NAME.txt.
+Raise a test failure if the rendered buffer does not match NAME.txt.
+Append CONTEXT to the failure data, if non-nil."
+ (let ((text-file (file-name-concat (ert-resource-directory) (concat name ".txt")))
+ (html-file (file-name-concat (ert-resource-directory) (concat name ".html")))
+ (description (if context (format "%s (%s)" name context) name)))
+ (with-temp-buffer
+ (insert-file-contents html-file)
+ (let ((dom (libxml-parse-html-region (point-min) (point-max)))
+ (shr-width 80)
+ (shr-use-fonts nil))
+ (erase-buffer)
+ (shr-insert-document dom)
+ (let ((result (buffer-substring-no-properties (point-min) (point-max)))
+ (expected
+ (with-temp-buffer
+ (insert-file-contents text-file)
+ (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
+ (replace-match (string (string-to-number (match-string 1) 16))
+ t t))
+ (buffer-string))))
+ (unless (equal result expected)
+ (ert-fail (list description result expected))))))))
+
+(defconst shr-test--rendering-extra-configs
+ '(("blockquote"
+ ;; Make sure blockquotes remain indented even when filling is
+ ;; disabled (bug#69555).
+ . ((shr-fill-text . nil))))
+ "Extra customizations which can impact rendering.
+This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a
+set of txt/html files under shr-resources/, as passed to `shr-test'.
+SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to
+validate for the NAME testcase.
+
+The `rendering' testcase will test NAME once without altering any
+settings, then once more for each (OPTION . VALUE) pair.")
(ert-deftest rendering ()
(skip-unless (fboundp 'libxml-parse-html-region))
(dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'"))
- (let* ((name (replace-regexp-in-string "\\.html\\'" "" file))
- (result (shr-test name)))
- (unless (equal (car result) (cdr result))
- (should (not (list name (car result) (cdr result))))))))
+ (let* ((name (string-remove-suffix ".html" file))
+ (extra-options (alist-get name shr-test--rendering-extra-configs
+ nil nil 'string=)))
+ ;; Test once with default settings.
+ (shr-test--rendering-check name)
+ ;; Test once more for every extra option for this specific NAME.
+ (pcase-dolist (`(,option-sym ,option-val)
+ extra-options)
+ (let ((option-old (symbol-value option-sym)))
+ (set option-sym option-val)
+ (unwind-protect
+ (shr-test--rendering-check
+ name (format "with %s %s" option-sym option-val))
+ (set option-sym option-old)))))))
(ert-deftest use-cookies ()
(let ((shr-cookie-policy 'same-origin))
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 978342b1bb1..1ca2fa9b9b3 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -77,7 +77,7 @@ A resource file is in the resource directory as per
`ert-resource-directory'."
`(expand-file-name ,file (ert-resource-directory)))))
-(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz")
+(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz")
"The test file archive.")
(defun tramp-archive-test-file-archive-hexlified ()
@@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs."
(let* ((url-unreserved-chars (cons ?/ url-unreserved-chars)))
(url-hexify-string tramp-archive-test-file-archive)))
-(defconst tramp-archive-test-archive
+(defvar tramp-archive-test-archive
(file-name-as-directory tramp-archive-test-file-archive)
"The test archive.")
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3216a8be1b0..cdd2a1efdb2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -134,7 +134,7 @@ A resource file is in the resource directory as per
(eval-and-compile
;; There is no default value on w32 systems, which could work out
;; of the box.
- (defconst ert-remote-temporary-file-directory
+ (defvar ert-remote-temporary-file-directory
(cond
((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
((eq system-type 'windows-nt) null-device)
@@ -265,8 +265,8 @@ is greater than 10.
`(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
(debug-ignored-errors
(append
- '("^make-symbolic-link not supported$"
- "^error with add-name-to-file")
+ '("\\`make-symbolic-link not supported\\'"
+ "\\`error with add-name-to-file")
debug-ignored-errors))
inhibit-message)
(unwind-protect
@@ -379,7 +379,7 @@ is greater than 10.
(let (tramp-mode)
(should-not (tramp-tramp-file-p "/method:user@host:")))
;; `tramp-ignored-file-name-regexp' suppresses Tramp.
- (let ((tramp-ignored-file-name-regexp "^/method:user@host:"))
+ (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, except the
;; default method.
@@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (not (tramp--test-rsync-p)))
;; Wildcards are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
+ ;; Wildcards are not supported with "docker cp ..." or "podman cp ...".
+ (skip-unless (not (tramp--test-container-oob-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -3815,15 +3817,24 @@ This tests also `access-file', `file-readable-p',
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
+(defun tramp--test-set-ert-test-documentation (test command)
+ "Set the documentation string for a derived test.
+The test is derived from TEST and COMMAND."
+ (let ((test-doc
+ (split-string (ert-test-documentation (get test 'ert--test)) "\n")))
+ ;; The first line must be extended.
+ (setcar
+ test-doc (format "%s Use the \"%s\" command." (car test-doc) command))
+ (setf (ert-test-documentation
+ (get (intern (format "%s-with-%s" test command)) 'ert--test))
+ (string-join test-doc "\n"))))
+
(defmacro tramp--test-deftest-with-stat (test)
"Define ert `TEST-with-stat'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"stat\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "stat")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
@@ -3842,11 +3853,8 @@ This tests also `access-file', `file-readable-p',
"Define ert `TEST-with-perl'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"perl\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "perl")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
@@ -3870,11 +3878,8 @@ This tests also `access-file', `file-readable-p',
"Define ert `TEST-with-ls'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse the \"ls\" command.")
:tags '(:expensive-test)
+ (tramp--test-set-ert-test-documentation ',test "ls")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(if-let ((default-directory ert-remote-temporary-file-directory)
@@ -4719,57 +4724,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `file-name-completion' and `file-name-all-completions'."
(skip-unless (tramp--test-enabled))
- ;; Method and host name in completion mode. This kind of completion
- ;; does not work on MS Windows.
- (unless (memq system-type '(cygwin windows-nt))
- (let ((tramp-fuse-remove-hidden-files t)
- (method (file-remote-p ert-remote-temporary-file-directory 'method))
- (host (file-remote-p ert-remote-temporary-file-directory 'host))
- (orig-syntax tramp-syntax)
- (minibuffer-completing-file-name t))
- (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
- (setq host (match-string 1 host)))
+ ;; Method and host name in completion mode.
+ (let ((tramp-fuse-remove-hidden-files t)
+ (method (file-remote-p ert-remote-temporary-file-directory 'method))
+ (host (file-remote-p ert-remote-temporary-file-directory 'host))
+ (orig-syntax tramp-syntax)
+ (minibuffer-completing-file-name t))
+ (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
+ (setq host (match-string 1 host)))
- (unwind-protect
- (dolist (syntax (if (tramp--test-expensive-test-p)
- (tramp-syntax-values) `(,orig-syntax)))
- (tramp-change-syntax syntax)
- ;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
- (tramp-set-connection-property tramp-test-vec "property" nil)
-
- (let (;; This is needed for the `separate' syntax.
- (prefix-format (substring tramp-prefix-format 1))
- ;; This is needed for the IPv6 host name syntax.
- (ipv6-prefix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-prefix-ipv6-format))
- (ipv6-postfix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-postfix-ipv6-format)))
- ;; Complete method name.
- (unless (or (tramp-string-empty-or-nil-p method)
- (string-empty-p tramp-method-regexp))
- (should
- (member
- (concat prefix-format method tramp-postfix-method-format)
- (file-name-all-completions
- (concat prefix-format (substring method 0 1)) "/"))))
- ;; Complete host name.
- (unless (or (tramp-string-empty-or-nil-p method)
- (string-empty-p tramp-method-regexp)
- (tramp-string-empty-or-nil-p host))
- (should
- (member
- (concat
- prefix-format method tramp-postfix-method-format
- ipv6-prefix host ipv6-postfix tramp-postfix-host-format)
- (file-name-all-completions
- (concat prefix-format method tramp-postfix-method-format)
- "/"))))))
+ (unwind-protect
+ (dolist (syntax (if (tramp--test-expensive-test-p)
+ (tramp-syntax-values) `(,orig-syntax)))
+ (tramp-change-syntax syntax)
+ ;; This has cleaned up all connection data, which are used
+ ;; for completion. We must refill the cache.
+ (tramp-set-connection-property tramp-test-vec "property" nil)
- ;; Cleanup.
- (tramp-change-syntax orig-syntax))))
+ (let (;; This is needed for the `separate' syntax.
+ (prefix-format (substring tramp-prefix-format 1))
+ ;; This is needed for the IPv6 host name syntax.
+ (ipv6-prefix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-prefix-ipv6-format))
+ (ipv6-postfix
+ (and (string-match-p tramp-ipv6-regexp host)
+ tramp-postfix-ipv6-format)))
+ ;; Complete method name.
+ (unless (or (tramp-string-empty-or-nil-p method)
+ (string-empty-p tramp-method-regexp))
+ (should
+ (member
+ (concat prefix-format method tramp-postfix-method-format)
+ (file-name-all-completions
+ (concat prefix-format (substring method 0 1)) "/"))))
+ ;; Complete host name.
+ (unless (or (tramp-string-empty-or-nil-p method)
+ (string-empty-p tramp-method-regexp)
+ (tramp-string-empty-or-nil-p host))
+ (should
+ (member
+ (concat
+ prefix-format method tramp-postfix-method-format
+ ipv6-prefix host ipv6-postfix tramp-postfix-host-format)
+ (file-name-all-completions
+ (concat prefix-format method tramp-postfix-method-format)
+ "/"))))))
+
+ ;; Cleanup.
+ (tramp-change-syntax orig-syntax)))
(dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
@@ -4851,9 +4854,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; and Bug#60505.
(ert-deftest tramp-test26-interactive-file-name-completion ()
"Check interactive completion with different `completion-styles'."
- ;; Method, user and host name in completion mode. This kind of
- ;; completion does not work on MS Windows.
- (skip-unless (not (memq system-type '(cygwin windows-nt))))
+ ;; Method, user and host name in completion mode.
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
(let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
@@ -5159,8 +5160,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))
- ;; Check remote and local DESTNATION file. This isn't
- ;; implemented yet ina all file name handler backends.
+ ;; Check remote and local DESTINATION file. This isn't
+ ;; implemented yet in all file name handler backends.
;; (dolist (local '(nil t))
;; (setq tmp-name (tramp--test-make-temp-name local quoted))
;; (should
@@ -6380,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process."
(setq tramp-remote-path orig-tramp-remote-path)
;; We make a super long `tramp-remote-path'.
- (make-directory tmp-name)
- (should (file-directory-p tmp-name))
- (while (tramp-compat-length< (string-join orig-exec-path ":") 5000)
- (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir)))
- (should (file-directory-p dir))
- (setq tramp-remote-path
- (append
- tramp-remote-path `(,(file-remote-p dir 'localname)))
- orig-exec-path
- (append
- (butlast orig-exec-path)
- `(,(file-remote-p dir 'localname))
- (last orig-exec-path)))))
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (should (equal (exec-path) orig-exec-path))
- ;; Ignore trailing newline.
- (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
- ;; The shell doesn't handle such long strings.
- (unless (tramp-compat-length>
- path
- (tramp-get-connection-property
- tramp-test-vec "pipe-buf" 4096))
- ;; The last element of `exec-path' is `exec-directory'.
- (should
- (string-equal path (string-join (butlast orig-exec-path) ":"))))
- ;; The shell "sh" shall always exist.
- (should (executable-find "sh" 'remote)))
+ (unless (tramp--test-container-oob-p)
+ (make-directory tmp-name)
+ (should (file-directory-p tmp-name))
+ (while (tramp-compat-length< (string-join orig-exec-path ":") 5000)
+ (let ((dir (make-temp-file
+ (file-name-as-directory tmp-name) 'dir)))
+ (should (file-directory-p dir))
+ (setq tramp-remote-path
+ (append
+ tramp-remote-path `(,(file-remote-p dir 'localname)))
+ orig-exec-path
+ (append
+ (butlast orig-exec-path)
+ `(,(file-remote-p dir 'localname))
+ (last orig-exec-path)))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (should (equal (exec-path) orig-exec-path))
+ ;; Ignore trailing newline.
+ (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
+ ;; The shell doesn't handle such long strings.
+ (unless (tramp-compat-length>
+ path
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
+ ;; The last element of `exec-path' is `exec-directory'.
+ (should
+ (string-equal path (string-join (butlast orig-exec-path) ":"))))
+ ;; The shell "sh" shall always exist.
+ (should (executable-find "sh" 'remote))))
;; Cleanup.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@@ -7057,17 +7060,24 @@ This is used in tests which we don't want to tag
(not (and (tramp--test-adb-p)
(string-match-p (rx multibyte) default-directory)))))
-(defun tramp--test-crypt-p ()
- "Check, whether the remote directory is encrypted."
- (tramp-crypt-file-name-p ert-remote-temporary-file-directory))
-
(defun tramp--test-container-p ()
"Check, whether a container method is used.
This does not support some special file names."
(string-match-p
- (rx bol (| "docker" "podman") eol)
+ (rx bol (| "docker" "podman"))
+ (file-remote-p ert-remote-temporary-file-directory 'method)))
+
+(defun tramp--test-container-oob-p ()
+ "Check, whether the dockercp or podmancp method is used.
+They does not support wildcard copy."
+ (string-match-p
+ (rx bol (| "dockercp" "podmancp") eol)
(file-remote-p ert-remote-temporary-file-directory 'method)))
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is encrypted."
+ (tramp-crypt-file-name-p ert-remote-temporary-file-directory))
+
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
This is used in tests which we don't want to tag `:expensive'
@@ -7484,7 +7494,8 @@ This requires restrictions of file name syntax."
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"?foo?bar?baz?")
- (unless (or (tramp--test-ftp-p)
+ (unless (or (tramp--test-container-oob-p)
+ (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"*foo+bar*baz+")
@@ -7504,7 +7515,10 @@ This requires restrictions of file name syntax."
(unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"<foo>bar<baz>")
"(foo)bar(baz)"
- (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
+ (unless (or (tramp--test-container-oob-p)
+ (tramp--test-ftp-p)
+ (tramp--test-gvfs-p))
+ "[foo]bar[baz]")
"{foo}bar{baz}")))
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el
index d7e547fcf29..f9f97dba535 100644
--- a/test/lisp/obarray-tests.el
+++ b/test/lisp/obarray-tests.el
@@ -32,27 +32,18 @@
(should-not (obarrayp "aoeu"))
(should-not (obarrayp '()))
(should-not (obarrayp []))
- (should (obarrayp (make-vector 7 0))))
-
-(ert-deftest obarrayp-unchecked-content-test ()
- "Should fail to check content of passed obarray."
- :expected-result :failed
(should-not (obarrayp ["a" "b" "c"]))
- (should-not (obarrayp [1 2 3])))
-
-(ert-deftest obarray-make-default-test ()
- (let ((table (obarray-make)))
- (should (obarrayp table))
- (should (eq (obarray-size table) obarray-default-size))))
+ (should-not (obarrayp [1 2 3]))
+ (should-not (obarrayp (make-vector 7 0)))
+ (should-not (obarrayp (vector (obarray-make))))
+ (should (obarrayp (obarray-make)))
+ (should (obarrayp (obarray-make 7))))
(ert-deftest obarray-make-with-size-test ()
;; FIXME: Actually, `wrong-type-argument' is not the right error to signal,
;; so we shouldn't enforce this misbehavior in tests!
(should-error (obarray-make -1) :type 'wrong-type-argument)
- (should-error (obarray-make 0) :type 'wrong-type-argument)
- (let ((table (obarray-make 1)))
- (should (obarrayp table))
- (should (eq (obarray-size table) 1))))
+ (should-error (obarray-make 'a) :type 'wrong-type-argument))
(ert-deftest obarray-get-test ()
(let ((table (obarray-make 3)))
@@ -88,5 +79,15 @@
(obarray-map collect-names table)
(should (equal (sort syms #'string<) '("a" "b" "c")))))
+(ert-deftest obarray-clear ()
+ (let ((o (obarray-make)))
+ (intern "a" o)
+ (intern "b" o)
+ (intern "c" o)
+ (obarray-clear o)
+ (let ((n 0))
+ (mapatoms (lambda (_) (setq n (1+ n))) o)
+ (should (equal n 0)))))
+
(provide 'obarray-tests)
;;; obarray-tests.el ends here
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
index 2fd26d75844..24b244c1611 100644
--- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
@@ -84,7 +84,7 @@ int main()
}
=-=-=
-Name: Concecutive blocks (GNU Style) (bug#60873)
+Name: Consecutive blocks (GNU Style) (bug#60873)
=-=
int
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index f5b5cad9c0b..20beed955d2 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -206,6 +206,33 @@
1 0 31 "/usr/include/c++/3.3/backward/iostream.h")
(gcc-include " from test_clt.cc:1:"
1 nil 1 "test_clt.cc")
+ ;; Lua
+ (lua "lua: database.lua:10: assertion failed!\nstack traceback:\n\t"
+ 6 nil 10 "database.lua")
+ (lua "lua 5.4: database 2.lua:10: assertion failed!\nstack traceback:\n\t"
+ 10 nil 10 "database 2.lua")
+ (lua "/usr/local/bin/lua: core/database.lua:20: assertion failed!\nstack traceback:\n\t"
+ 21 nil 20 "core/database.lua")
+ (lua "C:\\Lua\\Lua.exe: Core\\Database.lua:20: assertion failed!\nstack traceback:\n\t"
+ 17 nil 20 "Core\\Database.lua")
+ (lua "lua: /tmp/database.lua:20: assertion failed!\nstack traceback:\n\t"
+ 6 nil 20 "/tmp/database.lua")
+ (lua "Lua.exe: C:\\Temp\\Database.lua:20: assertion failed!\nstack traceback:\n\t"
+ 10 nil 20 "C:\\Temp\\Database.lua")
+ (lua-stack " database.lua: in field 'statement'"
+ 2 nil nil "database.lua" 0)
+ (lua-stack " database.lua:10: in field 'statement'"
+ 2 nil 10 "database.lua" 0)
+ (lua-stack " core/database.lua:20: in field 'statement'"
+ 2 nil 20 "core/database.lua" 0)
+ (lua-stack " database 2.lua: in field 'statement'"
+ 2 nil nil "database 2.lua" 0)
+ (lua-stack " Core\\Database.lua:20: in field 'statement'"
+ 2 nil 20 "Core\\Database.lua" 0)
+ (lua-stack " /tmp/database.lua: in field 'statement'"
+ 2 nil nil "/tmp/database.lua" 0)
+ (lua-stack " C:\\Core\\Database.lua: in field 'statement'"
+ 2 nil nil "C:\\Core\\Database.lua" 0)
;; gmake
(gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0)
(gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19
@@ -507,9 +534,9 @@ The test data is in `compile-tests--test-regexps-data'."
1 15 5 "alpha.c")))
(compile--test-error-line test))
- (should (eq compilation-num-errors-found 100))
+ (should (eq compilation-num-errors-found 106))
(should (eq compilation-num-warnings-found 35))
- (should (eq compilation-num-infos-found 28)))))
+ (should (eq compilation-num-infos-found 35)))))
(ert-deftest compile-test-grep-regexps ()
"Test the `grep-regexp-alist' regexps.
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index e3026dbfb5a..9d9718f719c 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -111,9 +111,8 @@ end of the statement."
(skip-unless (eq cperl-test-mode #'cperl-mode))
(cperl--run-test-cases
(ert-resource-file "cperl-indent-styles.pl")
- (cperl-set-style "PBP")
- (indent-region (point-min) (point-max)) ; here we go!
- (cperl-set-style-back)))
+ (cperl-file-style "PBP")
+ (indent-region (point-min) (point-max)))) ; here we go!
;;; Fontification tests
@@ -1145,17 +1144,16 @@ Perl is not Lisp: An open paren in column 0 does not start a function."
(ert-deftest cperl-test-bug-35925 ()
"Check that indentation is correct after a terminating format declaration."
- (cperl-set-style "PBP") ; Make cperl-mode use the same settings as perl-mode.
(cperl--run-test-cases
(ert-resource-file "cperl-bug-35925.pl")
+ (cperl-file-style "PBP") ; Make cperl-mode use the same settings as perl-mode.
(let ((tab-function
(if (equal cperl-test-mode 'perl-mode)
#'indent-for-tab-command
#'cperl-indent-command)))
(goto-char (point-max))
(forward-line -2)
- (funcall tab-function)))
- (cperl-set-style-back))
+ (funcall tab-function))))
(ert-deftest cperl-test-bug-37127 ()
"Verify that closing a paren in a regex goes without a message.
@@ -1363,12 +1361,13 @@ as a regex."
(ert-deftest cperl-test-bug-64364 ()
"Check that multi-line subroutine declarations indent correctly."
- (cperl-set-style "PBP") ; make cperl-mode use the same settings as perl-mode
(cperl--run-test-cases
(ert-resource-file "cperl-bug-64364.pl")
+ (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode
(indent-region (point-min) (point-max)))
(cperl--run-test-cases
(ert-resource-file "cperl-bug-64364.pl")
+ (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode
(let ((tab-function
(if (equal cperl-test-mode 'perl-mode)
#'indent-for-tab-command
@@ -1376,8 +1375,7 @@ as a regex."
(goto-char (point-min))
(while (null (eobp))
(funcall tab-function)
- (forward-line 1))))
- (cperl-set-style-back))
+ (forward-line 1)))))
(ert-deftest cperl-test-bug-65834 ()
"Verify that CPerl mode identifies a left-shift operator.
@@ -1433,6 +1431,25 @@ cperl-mode fontifies text after the delimiter as Perl code."
(should (equal (get-text-property (point) 'face)
font-lock-comment-face))))
+(ert-deftest cperl-test-bug-69604 ()
+ "Verify that $\" in a double-quoted string does not end the string.
+Both `perl-mode' and `cperl-mode' treat ?$ as a quoting/escaping char to
+avoid issues with punctuation variables. In a string, however, this is
+not appropriate."
+ (let ((strings
+ '("\"$\\\" in string ---\"; # \"" ; $ must not quote \
+ "$\" . \" in string ---\"; # \"" ; $ must quote \
+ "\"\\$\" . \" in string ---\"; # \""))) ; \$ must not quote
+ (dolist (string strings)
+ (with-temp-buffer
+ (insert string)
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (search-forward "in string")
+ (should (equal (get-text-property (point) 'face)
+ font-lock-string-face))))))
+
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "cperl-indents.erts")))
diff --git a/test/lisp/progmodes/csharp-mode-resources/indent.erts b/test/lisp/progmodes/csharp-mode-resources/indent.erts
new file mode 100644
index 00000000000..a676ecc9728
--- /dev/null
+++ b/test/lisp/progmodes/csharp-mode-resources/indent.erts
@@ -0,0 +1,19 @@
+Code:
+ (lambda ()
+ (csharp-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Don't consider closed statements as object initializers. (bug#69571)
+
+=-=
+public class Foo {
+ void Bar () {
+ var x = new X(); // [1]
+ for (;;) {
+ x();
+ } // [2]
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/csharp-mode-tests.el b/test/lisp/progmodes/csharp-mode-tests.el
new file mode 100644
index 00000000000..f50fabf5836
--- /dev/null
+++ b/test/lisp/progmodes/csharp-mode-tests.el
@@ -0,0 +1,30 @@
+;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 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 'csharp-mode)
+
+(ert-deftest csharp-mode-test-indentation ()
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(provide 'csharp-mode-tests)
+;;; csharp-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
index fe09a37a32b..f2d0eacee5b 100644
--- a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
@@ -134,7 +134,7 @@ Name: Pipe statements with fn
end)
=-=-=
-Name: Pipe statements stab clases
+Name: Pipe statements stab clauses
=-=
[1, 2]
diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
index 4fca74dd2e1..514d2e08977 100644
--- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
@@ -110,3 +110,34 @@ public class Java {
}
}
=-=-=
+
+Name: Opening bracket on separate line (bug#67556)
+
+=-=
+public class Java {
+ void foo(
+ String foo)
+ {
+ for (var f : rs)
+ return new String[]
+ {
+ "foo",
+ "bar"
+ };
+ if (a == 0)
+ {
+ return 0;
+ } else if (a == 1)
+ {
+ return 1;
+ }
+
+ switch(expr)
+ {
+ case x:
+ // code block
+ break;
+ }
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
index 9797467bbe5..48184160b4d 100644
--- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts
@@ -529,6 +529,58 @@ local Other = {
}
=-=-=
+Name: Continuation Indent
+
+=-=
+local very_long_variable_name =
+"ok"..
+ "ok"
+local n = a +
+b *
+c /
+1
+local x = "A"..
+"B"
+.."C"
+if a
+ and b
+ and c then
+ if x
+ and y then
+ local x = 1 +
+2 *
+ 3
+ end
+elseif a
+ or b
+ or c then
+end
+=-=
+local very_long_variable_name =
+ "ok"..
+ "ok"
+local n = a +
+ b *
+ c /
+ 1
+local x = "A"..
+ "B"
+ .."C"
+if a
+ and b
+ and c then
+ if x
+ and y then
+ local x = 1 +
+ 2 *
+ 3
+ end
+elseif a
+ or b
+ or c then
+end
+=-=-=
+
Code:
(lambda ()
(setq indent-tabs-mode nil)
@@ -677,3 +729,57 @@ function e (n, t)
end)(i(...))
end end end
=-=-=
+
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq lua-ts-indent-continuation-lines nil)
+ (setq lua-ts-indent-offset 2)
+ (lua-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Name: Unaligned Continuation Indent
+
+=-=
+local n = a +
+ b *
+ c /
+ 1
+if a
+ and b
+and c then
+ if x
+ and y then
+ local x = 1 +
+ 2 *
+ 3
+ end
+elseif a
+ or b
+ or c then
+ if x
+ or y
+ end
+end
+=-=
+local n = a +
+ b *
+ c /
+ 1
+if a
+and b
+and c then
+ if x
+ and y then
+ local x = 1 +
+ 2 *
+ 3
+ end
+elseif a
+or b
+or c then
+ if x
+ or y
+ end
+end
+=-=-=
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 1df0c42a0ce..e11440cdb5b 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -55,21 +55,27 @@ 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))))))))
+ (let ((dir (make-symbol "dir")))
+ `(with-temp-buffer
+ (let ((python-indent-guess-indent-offset nil)
+ (python-shell-completion-native-enable nil))
+ (python-mode)
+ (unwind-protect
+ ;; Prevent test failures when Jedi is used as a completion
+ ;; backend, either directly or indirectly (e.g., via
+ ;; IPython). Jedi needs to store cache, but the
+ ;; "/nonexistent" HOME directory is not writable.
+ (ert-with-temp-directory ,dir
+ (with-environment-variables (("XDG_CACHE_HOME" ,dir))
+ (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.
@@ -474,6 +480,28 @@ def f(x: CustomInt) -> CustomInt:
(136 . font-lock-operator-face) (137)
(144 . font-lock-keyword-face) (150))))
+(ert-deftest python-font-lock-operator-1 ()
+ (python-tests-assert-faces
+ "1 << 2 ** 3 == +4%-5|~6&7^8%9"
+ '((1)
+ (3 . font-lock-operator-face) (5)
+ (8 . font-lock-operator-face) (10)
+ (13 . font-lock-operator-face) (15)
+ (16 . font-lock-operator-face) (17)
+ (18 . font-lock-operator-face) (20)
+ (21 . font-lock-operator-face) (23)
+ (24 . font-lock-operator-face) (25)
+ (26 . font-lock-operator-face) (27)
+ (28 . font-lock-operator-face) (29))))
+
+(ert-deftest python-font-lock-operator-2 ()
+ "Keyword operators are font-locked as keywords."
+ (python-tests-assert-faces
+ "is_ is None"
+ '((1)
+ (5 . font-lock-keyword-face) (7)
+ (8 . font-lock-constant-face))))
+
(ert-deftest python-font-lock-escape-sequence-string-newline ()
(python-tests-assert-faces
"'\\n'
@@ -585,62 +613,70 @@ u\"\\n\""
(845 . font-lock-string-face) (886))))
(ert-deftest python-font-lock-escape-sequence-bytes-newline ()
- :expected-result :failed
(python-tests-assert-faces
"b'\\n'
b\"\\n\""
'((1)
- (2 . font-lock-doc-face)
+ (2 . font-lock-string-face)
(3 . font-lock-constant-face)
- (5 . font-lock-doc-face) (6)
- (8 . font-lock-doc-face)
+ (5 . font-lock-string-face) (6)
+ (8 . font-lock-string-face)
(9 . font-lock-constant-face)
- (11 . font-lock-doc-face))))
+ (11 . font-lock-string-face))))
(ert-deftest python-font-lock-escape-sequence-hex-octal ()
- :expected-result :failed
(python-tests-assert-faces
"b'\\x12 \\777 \\1\\23'
'\\x12 \\777 \\1\\23'"
'((1)
- (2 . font-lock-doc-face)
+ (2 . font-lock-string-face)
(3 . font-lock-constant-face)
- (7 . font-lock-doc-face)
+ (7 . font-lock-string-face)
(8 . font-lock-constant-face)
- (12 . font-lock-doc-face)
+ (12 . font-lock-string-face)
(13 . font-lock-constant-face)
- (18 . font-lock-doc-face) (19)
- (20 . font-lock-doc-face)
+ (18 . font-lock-string-face) (19)
+ (20 . font-lock-string-face)
(21 . font-lock-constant-face)
- (25 . font-lock-doc-face)
+ (25 . font-lock-string-face)
(26 . font-lock-constant-face)
- (30 . font-lock-doc-face)
+ (30 . font-lock-string-face)
(31 . font-lock-constant-face)
- (36 . font-lock-doc-face))))
+ (36 . font-lock-string-face))))
(ert-deftest python-font-lock-escape-sequence-unicode ()
- :expected-result :failed
(python-tests-assert-faces
"b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}'
'\\u1234 \\U00010348 \\N{Plus-Minus Sign}'"
'((1)
- (2 . font-lock-doc-face) (41)
- (42 . font-lock-doc-face)
+ (2 . font-lock-string-face) (41)
+ (42 . font-lock-string-face)
(43 . font-lock-constant-face)
- (49 . font-lock-doc-face)
+ (49 . font-lock-string-face)
(50 . font-lock-constant-face)
- (60 . font-lock-doc-face)
+ (60 . font-lock-string-face)
(61 . font-lock-constant-face)
- (80 . font-lock-doc-face))))
+ (80 . font-lock-string-face))))
(ert-deftest python-font-lock-raw-escape-sequence ()
- :expected-result :failed
(python-tests-assert-faces
"rb'\\x12 \123 \\n'
r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'"
'((1)
- (3 . font-lock-doc-face) (14)
- (16 . font-lock-doc-face))))
+ (3 . font-lock-string-face) (14)
+ (16 . font-lock-string-face))))
+
+(ert-deftest python-font-lock-string-literal-concatenation ()
+ "Test for bug#45897."
+ (python-tests-assert-faces
+ "x = \"hello\"\"\"
+y = \"confused\""
+ '((1 . font-lock-variable-name-face) (2)
+ (3 . font-lock-operator-face) (4)
+ (5 . font-lock-string-face) (14)
+ (15 . font-lock-variable-name-face) (16)
+ (17 . font-lock-operator-face) (18)
+ (19 . font-lock-string-face))))
;;; Indentation
@@ -4747,6 +4783,7 @@ def foo():
(python-tests-with-temp-buffer-with-shell
""
(python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims)
(insert "import abc")
(comint-send-input)
(python-tests-shell-wait-for-prompt)
@@ -4761,6 +4798,7 @@ def foo():
""
(python-shell-completion-native-turn-on)
(python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims)
(insert "import abc")
(comint-send-input)
(python-tests-shell-wait-for-prompt)
@@ -4769,6 +4807,114 @@ def foo():
(end-of-line 0)
(should-not (nth 2 (python-shell-completion-at-point))))))
+(defun python-tests--completion-module ()
+ "Check if modules can be completed in Python shell."
+ (insert "import datet")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "import datetime"))
+ (kill-line)
+ (insert "from datet")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "from datetime"))
+ (end-of-line)
+ (insert " import timed")
+ (completion-at-point)
+ (beginning-of-line)
+ (should (looking-at-p "from datetime import timedelta"))
+ (kill-line))
+
+(defun python-tests--completion-parameters ()
+ "Check if parameters can be completed in Python shell."
+ (insert "import re")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "re.split('b', 'abc', maxs")
+ (completion-at-point)
+ (should (string= "re.split('b', 'abc', maxsplit="
+ (buffer-substring (line-beginning-position) (point))))
+ (insert "0, ")
+ (should (python-shell-completion-at-point))
+ ;; Test if cache is used.
+ (cl-letf (((symbol-function 'python-shell-completion-get-completions)
+ 'ignore)
+ ((symbol-function 'python-shell-completion-native-get-completions)
+ 'ignore))
+ (insert "fla")
+ (completion-at-point)
+ (should (string= "re.split('b', 'abc', maxsplit=0, flags="
+ (buffer-substring (line-beginning-position) (point)))))
+ (beginning-of-line)
+ (kill-line))
+
+(defun python-tests--completion-extra-context ()
+ "Check if extra context is used for completion."
+ (insert "re.split('b', 'abc',")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "maxs")
+ (completion-at-point)
+ (should (string= "maxsplit="
+ (buffer-substring (line-beginning-position) (point))))
+ (insert "0)")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "from re import (")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "IGN")
+ (completion-at-point)
+ (should (string= "IGNORECASE"
+ (buffer-substring (line-beginning-position) (point)))))
+
+(defun python-tests--pythonstartup-file ()
+ "Return Jedi readline setup file if PYTHONSTARTUP is not set."
+ (or (getenv "PYTHONSTARTUP")
+ (with-temp-buffer
+ (if (eql 0 (call-process python-tests-shell-interpreter
+ nil t nil "-m" "jedi" "repl"))
+ (string-trim (buffer-string))
+ ""))))
+
+(ert-deftest python-shell-completion-at-point-jedi-completer ()
+ "Check if Python shell completion works when Jedi completer is used."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (with-environment-variables
+ (("PYTHONSTARTUP" (python-tests--pythonstartup-file)))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (skip-unless (string= python-shell-readline-completer-delims ""))
+ (python-shell-completion-native-turn-off)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-shell-completion-native-turn-on)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-tests--completion-extra-context)))))
+
+(ert-deftest python-shell-completion-at-point-ipython ()
+ "Check if Python shell completion works for IPython."
+ (let ((python-shell-interpreter "ipython")
+ (python-shell-interpreter-args "-i --simple-prompt"))
+ (skip-unless
+ (and
+ (executable-find python-shell-interpreter)
+ (eql (call-process python-shell-interpreter nil nil nil "--version") 0)))
+ (with-environment-variables
+ (("PYTHONSTARTUP" (python-tests--pythonstartup-file)))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (python-shell-completion-native-turn-off)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-shell-completion-native-turn-on)
+ (skip-unless (string= python-shell-readline-completer-delims ""))
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-tests--completion-extra-context))))))
;;; PDB Track integration
@@ -4783,6 +4929,8 @@ def foo():
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(goto-char (point-max))
@@ -4799,6 +4947,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(python-shell-with-shell-buffer
@@ -4818,6 +4968,8 @@ pdb.set_trace()
print('Hello')
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(goto-char (point-max))
@@ -4834,6 +4986,8 @@ import time
time.sleep(3)
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(goto-char (point-max))
(insert "time.")
@@ -4846,6 +5000,8 @@ time.sleep(3)
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -4863,6 +5019,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -4879,6 +5037,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -4895,6 +5055,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -4915,11 +5077,6 @@ import abc
(ert-deftest python-ffap-module-path-1 ()
(skip-unless (executable-find python-tests-shell-interpreter))
- ;; Skip the test on macOS, since the standard Python installation uses
- ;; libedit rather than readline which confuses the running of an inferior
- ;; interpreter in this case (see bug#59477 and bug#25753).
- (skip-when (eq system-type 'darwin))
- (trace-function 'python-shell-output-filter)
(python-tests-with-temp-buffer-with-shell
"
import abc
@@ -6647,6 +6804,15 @@ class Class:
(python-tests-look-at "Also not a docstring")
(should-not (python-info-docstring-p))))
+(ert-deftest python-info-docstring-p-8 ()
+ "Test string in the 2nd line of a buffer."
+ (python-tests-with-temp-buffer
+ "import sys
+'''Not a docstring.'''
+"
+ (python-tests-look-at "Not a docstring")
+ (should-not (python-info-docstring-p))))
+
(ert-deftest python-info-triple-quoted-string-p-1 ()
"Test triple quoted string."
(python-tests-with-temp-buffer
diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
index 7b6185e0386..bec96ad82e0 100644
--- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
@@ -110,3 +110,17 @@ const foo = (props) => {
);
}
=-=-=
+
+Name: Interface body fields are indented
+
+=-=
+interface Foo {
+foo: string;
+bar?: boolean;
+}
+=-=
+interface Foo {
+ foo: string;
+ bar?: boolean;
+}
+=-=-=
diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el b/test/lisp/progmodes/typescript-ts-mode-tests.el
index 27b7df714e6..effd9551fb0 100644
--- a/test/lisp/progmodes/typescript-ts-mode-tests.el
+++ b/test/lisp/progmodes/typescript-ts-mode-tests.el
@@ -24,7 +24,8 @@
(require 'treesit)
(ert-deftest typescript-ts-mode-test-indentation ()
- (skip-unless (treesit-ready-p 'typescript))
+ (skip-unless (and (treesit-ready-p 'typescript)
+ (treesit-ready-p 'tsx)))
(ert-test-erts-file (ert-resource-file "indent.erts")))
(provide 'typescript-ts-mode-tests)
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el
index be6784be7a0..a916aed9eb3 100644
--- a/test/lisp/ses-tests.el
+++ b/test/lisp/ses-tests.el
@@ -246,7 +246,7 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to
When setting a formula has some cell with changed references, this
cell has to be rewritten to data area."
(let ((ses-initial-size '(4 . 3))
- ses-after-entry-functions beg)
+ (ses-after-entry-functions nil))
(with-temp-buffer
(ses-mode)
(dolist (c '((0 1 1); B1
@@ -257,7 +257,7 @@ cell has to be rewritten to data area."
(apply 'ses-calculate-cell (list (car c) (cadr c) nil)))
(ses-cell-set-formula 2 1 '(+ B2 A3)); B3
(ses-command-hook)
- (ses-cell-set-formula 3 1 (+ B3 A4)); B4
+ (ses-cell-set-formula 3 1 '(+ B3 A4)); B4
(ses-command-hook)
(should (equal (ses-cell-references 1 1) '(B3)))
(ses-mode)
diff --git a/test/lisp/sqlite-tests.el b/test/lisp/sqlite-tests.el
new file mode 100644
index 00000000000..d4892a27efc
--- /dev/null
+++ b/test/lisp/sqlite-tests.el
@@ -0,0 +1,51 @@
+;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 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 'sqlite)
+
+(ert-deftest with-sqlite-transaction ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (sqlite-execute db "create table test (a)")
+ (should
+ (eql 42 (with-sqlite-transaction db
+ (sqlite-execute db "insert into test values (1)")
+ (should (equal '((1)) (sqlite-select db "select * from test")))
+ 42)))
+ ;; Body runs exactly once.
+ (should (equal '((1)) (sqlite-select db "select * from test")))))
+
+(ert-deftest with-sqlite-transaction/rollback ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (sqlite-execute db "create table test (a)")
+ (should (equal '(sqlite-error
+ ("SQL logic error" "no such function: fake" 1 1))
+ (should-error
+ (with-sqlite-transaction db
+ (sqlite-execute db "insert into test values (1)")
+ (sqlite-execute db "insert into test values (fake(2))")
+ 42))))
+ ;; First insertion (a=1) rolled back.
+ (should-not (sqlite-select db "select * from test"))))
+
+;;; sqlite-tests.el ends here
diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el
index f3a2c5fbe00..fdefca36c0b 100644
--- a/test/lisp/textmodes/page-tests.el
+++ b/test/lisp/textmodes/page-tests.el
@@ -106,10 +106,14 @@
(insert "foo\n \nbar\n \nbaz")
(goto-char (point-min))
(should (equal (page--what-page) '(1 1)))
+ (forward-char)
+ (should (equal (page--what-page) '(1 1)))
(forward-page)
+ (should (equal (page--what-page) '(2 1)))
+ (forward-line)
(should (equal (page--what-page) '(2 2)))
(forward-page)
- (should (equal (page--what-page) '(3 4)))))
+ (should (equal (page--what-page) '(3 1)))))
;;; page-tests.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index ba51f375cc6..e50738f1122 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -92,6 +92,8 @@
("1@example.com" 1 email "1@example.com")
;; email addresses user portion containing dots
("foo.bar@example.com" 1 email "foo.bar@example.com")
+ ("foo.bar@example.com" 5 email "foo.bar@example.com")
+ (" fo.ba@example.com" 6 email "fo.ba@example.com")
(".foobar@example.com" 1 email nil)
(".foobar@example.com" 2 email "foobar@example.com")
;; email addresses domain portion containing dots and dashes
@@ -180,6 +182,13 @@ position to retrieve THING.")
(should (thing-at-point-looking-at "2abcd"))
(should (equal (match-data) m2)))))
+(ert-deftest thing-at-point-looking-at-overlapping-matches ()
+ (with-temp-buffer
+ (insert "foo.bar.baz")
+ (goto-char (point-max))
+ (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+"))
+ (should (string= "bar.baz" (match-string 0)))))
+
(ert-deftest test-symbol-thing-1 ()
(with-temp-buffer
(insert "foo bar zot")
diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el
index 1a2af716f34..8373156587d 100644
--- a/test/lisp/vc/log-edit-tests.el
+++ b/test/lisp/vc/log-edit-tests.el
@@ -134,4 +134,214 @@ lines."))))
* a-very-long-directory-name/another-long-directory-name/and-a-long-file-name.ext
\(a-really-long-function-name):"))))
+(ert-deftest log-edit-fill-entry-confinement ()
+ (let (string string1 string2 string3 string4)
+ (setq string
+ ;; This entry is precisely 65 columns in length;
+ ;; log-edit-fill-column should leave it unmodified.
+ "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun1134):"
+ string1
+ ;; This entry is 66 columns in length, and must be filled.
+ "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345):"
+ string2
+ ;; The first line of this entry totals 65 columns in length,
+ ;; and should be preserved intact.
+ "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345)
+(fun11356):"
+ string3
+ ;; The first defun in this entry is a file name that brings
+ ;; the total to 40 columns in length and should be preserved
+ ;; intact.
+ "* file2.txt (abcdefghijklmnopqrstuvwxyz)
+(ABC):"
+ string4
+ ;; The first defun brings that total to 41, and should be
+ ;; placed on the next line.
+ "* file2.txt (abcdefghijklmnopqrstuvwxyz):")
+ (with-temp-buffer
+ (insert string)
+ (let ((fill-column 64)) (log-edit-fill-entry))
+ (should (equal (buffer-string) string))
+ (erase-buffer)
+ (insert string1)
+ (let ((fill-column 64)) (log-edit-fill-entry))
+ (should (equal (buffer-string)
+ "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10)
+(fun11345):"))
+ (erase-buffer)
+ (insert string2)
+ (let ((fill-column 64)) (log-edit-fill-entry))
+ (should (equal (buffer-string) string2))
+ (erase-buffer)
+ (insert string3)
+ (let ((fill-column 39)) (log-edit-fill-entry))
+ (should (equal (buffer-string) string3))
+ (erase-buffer)
+ (insert string4)
+ (let ((fill-column 39)) (log-edit-fill-entry))
+ (should (equal (buffer-string)
+ ;; There is whitespace after "file2.txt" which
+ ;; should not be erased!
+ "* file2.txt
+(abcdefghijklmnopqrstuvwxyz):")))))
+
+(ert-deftest log-edit-fill-entry-space-substitution ()
+ ;; This test verifies that filling the paragraph surrounding the
+ ;; last line of defuns does not break between defun lists with
+ ;; spaces in identifiers.
+ (let (string wanted)
+ (setq string "
+* src/sfnt.c (xmalloc, xrealloc): Improve behavior upon allocation
+failures during test.
+(sfnt_table_names): Add prep.
+(sfnt_transform_coordinates): Allow applying offsets during
+coordinate transform.
+(sfnt_decompose_compound_glyph): Defer offset computation until
+any component compound glyph is loaded, then apply it during the
+transform process.
+(sfnt_multiply_divide): Make available everywhere. Implement on
+64 bit systems.
+(sfnt_multiply_divide_signed): New function.
+(sfnt_mul_fixed): Fix division overflow.
+(sfnt_curve_to_and_build_1, sfnt_build_glyph_outline): Remove
+outdated comment.
+(sfnt_build_outline_edges): Fix coding style.
+(sfnt_lookup_glyph_metrics): Allow looking up metrics without
+scaling.
+(struct sfnt_cvt_table): Fix type of cvt values.
+(struct sfnt_prep_table): New structure.
+(sfnt_read_cvt_table): Read cvt values in terms of fwords, not
+longs (as Apple's doc seems to say).
+(sfnt_read_fpgm_table): Fix memory allocation for font program
+table.
+(sfnt_read_prep_table): New function.
+(struct sfnt_interpreter_zone): New structure.
+(struct sfnt_interpreter_graphics_state): New fields `project',
+`move', `vector_dot_product'. Rename to `sfnt_graphics_state'.
+(struct sfnt_interpreter, sfnt_mul_f26dot6): Stop doing rounding
+division.
+(sfnt_init_graphics_state, sfnt_make_interpreter, MOVE, SSW, RAW)
+(SDS, ADD, SUB, ABS, NEG, WCVTF, _MIN, S45ROUND, SVTCAx)
+(sfnt_set_srounding_state, sfnt_skip_code)
+(sfnt_interpret_unimplemented, sfnt_interpret_fdef)
+(sfnt_interpret_idef, sfnt_interpret_if, sfnt_interpret_else)
+(sfnt_round_none, sfnt_round_to_grid, sfnt_round_to_double_grid)
+"
+ wanted "
+* src/sfnt.c
+(xmalloc, xrealloc):
+Improve behavior
+upon allocation
+failures during
+test.
+(sfnt_table_names):
+Add prep.
+(sfnt_transform_coordinates):
+Allow applying
+offsets during
+coordinate
+transform.
+(sfnt_decompose_compound_glyph):
+Defer offset
+computation until
+any component
+compound glyph is
+loaded, then apply
+it during the
+transform process.
+(sfnt_multiply_divide):
+Make available
+everywhere.
+Implement on 64 bit
+systems.
+(sfnt_multiply_divide_signed):
+New function.
+(sfnt_mul_fixed):
+Fix division
+overflow.
+(sfnt_curve_to_and_build_1)
+(sfnt_build_glyph_outline):
+Remove outdated
+comment.
+(sfnt_build_outline_edges):
+Fix coding style.
+(sfnt_lookup_glyph_metrics):
+Allow looking up
+metrics without
+scaling.
+(struct sfnt_cvt_table):
+Fix type of cvt
+values.
+(struct sfnt_prep_table):
+New structure.
+(sfnt_read_cvt_table):
+Read cvt values in
+terms of fwords, not
+longs (as Apple's
+doc seems to say).
+(sfnt_read_fpgm_table):
+Fix memory
+allocation for font
+program table.
+(sfnt_read_prep_table):
+New function.
+(struct sfnt_interpreter_zone):
+New structure.
+(struct sfnt_interpreter_graphics_state):
+New fields
+`project', `move',
+`vector_dot_product'.
+Rename to
+`sfnt_graphics_state'.
+(struct sfnt_interpreter)
+(sfnt_mul_f26dot6):
+Stop doing rounding
+division.
+(sfnt_init_graphics_state)
+(sfnt_make_interpreter)
+(MOVE, SSW, RAW, SDS)
+(ADD, SUB, ABS, NEG)
+(WCVTF, _MIN)
+(S45ROUND, SVTCAx)
+(sfnt_set_srounding_state)
+(sfnt_skip_code)
+(sfnt_interpret_unimplemented)
+(sfnt_interpret_fdef)
+(sfnt_interpret_idef)
+(sfnt_interpret_if)
+(sfnt_interpret_else)
+(sfnt_round_none)
+(sfnt_round_to_grid)
+(sfnt_round_to_double_grid):
+")
+ (with-temp-buffer
+ (insert string)
+ (let ((fill-column 20)) (log-edit-fill-entry))
+ (should (equal (buffer-string) wanted)))))
+
+(ert-deftest log-edit-fill-entry-initial-wrapping ()
+ ;; This test verifies that a newline is inserted before a defun
+ ;; itself longer than the fill column when such a defun is being
+ ;; inserted after a file name, and not otherwise.
+ (let (string wanted)
+ (setq string "
+* src/sfnt.c (long_entry_1): This entry should be placed on a
+new line.
+(but_this_entry_should_not): With the prose displaced to the
+next line instead."
+ wanted "
+* src/sfnt.c
+(long_entry_1): This
+entry should be
+placed on a new
+line.
+(but_this_entry_should_not):
+With the prose
+displaced to the
+next line instead.")
+ (with-temp-buffer
+ (insert string)
+ (let ((fill-column 20)) (log-edit-fill-entry))
+ (should (equal (buffer-string) wanted)))))
+
;;; log-edit-tests.el ends here
diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el
index c52cd9c5875..f15a0f52e8c 100644
--- a/test/lisp/vc/vc-git-tests.el
+++ b/test/lisp/vc/vc-git-tests.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'ert-x)
+(require 'vc)
(require 'vc-git)
(ert-deftest vc-git-test-program-version-general ()
@@ -81,4 +83,49 @@
(should-not (vc-git-annotate-time))
(should-not (vc-git-annotate-time))))
+(defmacro vc-git-test--with-repo (name &rest body)
+ "Initialize a repository in a temporary directory and evaluate BODY.
+
+The current directory will be set to the top of that repository; NAME
+will be bound to that directory's file name. Once BODY exits, the
+directory will be deleted.
+
+Some dummy environment variables will be set for the duration of BODY to
+allow `git commit' to determine identities for authors and committers."
+ (declare (indent 1))
+ `(ert-with-temp-directory ,name
+ (let ((default-directory ,name)
+ (process-environment (append '("EMAIL=john@doe.ee"
+ "GIT_AUTHOR_NAME=A"
+ "GIT_COMMITTER_NAME=C")
+ process-environment)))
+ (vc-create-repo 'Git)
+ ,@body)))
+
+(defun vc-git-test--run (&rest args)
+ "Run git ARGSā€¦, check for non-zero status, and return output."
+ (with-temp-buffer
+ (apply 'vc-git-command t 0 nil args)
+ (buffer-string)))
+
+(ert-deftest vc-git-test-dir-track-local-branch ()
+ "Test that `vc-dir' works when tracking local branches. Bug#68183."
+ (skip-unless (executable-find vc-git-program))
+ (vc-git-test--with-repo repo
+ ;; Create an initial commit to get a branch started.
+ (write-region "hello" nil "README")
+ (vc-git-test--run "add" "README")
+ (vc-git-test--run "commit" "-mFirst")
+ ;; Get current branch name lazily, to remain agnostic of
+ ;; init.defaultbranch.
+ (let ((upstream-branch
+ (string-trim (vc-git-test--run "branch" "--show-current"))))
+ (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch)
+ (vc-dir default-directory)
+ (pcase-dolist (`(,header ,value)
+ `(("Branch" "hack")
+ ("Tracking" ,upstream-branch)))
+ (goto-char (point-min))
+ (re-search-forward (format "^%s *: %s$" header value))))))
+
;;; vc-git-tests.el ends here
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
index 5b3fb0e66fb..42a981d312e 100755
--- a/test/manual/indent/shell.sh
+++ b/test/manual/indent/shell.sh
@@ -189,3 +189,10 @@ bar () {
fi
}
+
+case $i { # Bug#55764
+ *pattern)
+ (cd .; echo hi);
+ do1 ;;
+ *pattern2) do2 ;;
+}
diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index 4cee084e211..54f339f6373 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -367,11 +367,11 @@
(while (consp insn)
(let ((newcar (car insn)))
(if (or (consp (car insn)) (comp-mvar-p (car insn)))
- (setf newcar (comp-copy-insn (car insn))))
+ (setf newcar (comp--copy-insn (car insn))))
(push newcar result))
(setf insn (cdr insn)))
(nconc (nreverse result)
- (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn) (comp--copy-insn insn) insn)))
(if (comp-mvar-p insn)
(copy-comp-mvar insn)
insn)))
@@ -559,6 +559,9 @@
(let ((time (make-comp-test-time :unix (time-convert (current-time) 'integer))))
(comp-test-67239-0-f "%F" time)))
+(defun comp-test-67883-1-f ()
+ '#1=(1 . #1#))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 0aa9e76fa2d..b2fd2f68826 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -28,6 +28,7 @@
(require 'ert)
(require 'ert-x)
(require 'cl-lib)
+(require 'cl-seq)
(require 'comp)
(require 'comp-cstr)
@@ -903,14 +904,33 @@ Return a list of results."
(should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f)))
(should (= (comp-tests-fw-prop-1-f) 6))))
+(defun comp-tests--type-lists-equal (l1 l2)
+ (and (= (length l1) (length l2))
+ (cl-every #'comp-tests--types-equal l1 l2)))
+
+(defun comp-tests--types-equal (t1 t2)
+ "Whether the types T1 and T2 are equal."
+ (or (equal t1 t2) ; for atoms, and optimization for the common case
+ (and (consp t1) (consp t2)
+ (eq (car t1) (car t2))
+ (cond ((memq (car t1) '(and or member))
+ ;; Order or duplicates don't matter.
+ (null (cl-set-exclusive-or (cdr t1) (cdr t2)
+ :test #'comp-tests--types-equal)))
+ ((eq (car t1) 'function)
+ (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2))
+ (comp-tests--types-equal (nth 2 t1) (nth 2 t2))))
+ (t (comp-tests--type-lists-equal (cdr t1) (cdr t2)))))))
+
(defun comp-tests-check-ret-type-spec (func-form ret-type)
(let ((lexical-binding t)
(native-comp-speed 2)
(f-name (cl-second func-form)))
(eval func-form t)
(native-compile f-name)
- (should (equal (cl-third (subr-type (symbol-function f-name)))
- ret-type))))
+ (should (comp-tests--types-equal
+ (cl-third (subr-type (symbol-function f-name)))
+ ret-type))))
(cl-eval-when (compile eval load)
(cl-defstruct comp-foo a b)
@@ -1476,7 +1496,14 @@ Return a list of results."
(if (comp-foo-p x)
x
(error "")))
- 'comp-foo)))
+ 'comp-foo)
+
+ ;; 80
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (functionp x)
+ (error "")
+ x))
+ '(not function))))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 8af7e902109..a1959f62fd3 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -833,4 +833,46 @@ comparing the subr with a much slower Lisp implementation."
(should-error (defalias 'data-tests--da-c 'data-tests--da-d)
:type 'cyclic-function-indirection))
+(ert-deftest data-tests-bare-symbol ()
+ (dolist (symbols-with-pos-enabled '(nil t))
+ (dolist (sym (list nil t 'xyzzy (make-symbol "")))
+ (should (eq sym (bare-symbol (position-symbol sym 0)))))))
+
+(require 'cl-extra) ;For `cl--class-children'.
+
+(ert-deftest data-tests--cl-type-of ()
+ ;; Make sure that `cl-type-of' returns the most precise type.
+ ;; Note: This doesn't work for list/vector structs since those types
+ ;; are too difficult/unreliable to detect (so `cl-type-of' only says
+ ;; it's a `cons' or a `vector').
+ (dolist (val (list -2 10 (expt 2 128) nil t 'car :car
+ (symbol-function 'car)
+ (symbol-function 'progn)
+ (eval '(lambda (x) (+ x 1)) t)
+ (position-symbol 'car 7)
+ (position-symbol :car 7)))
+ (let* ((type (cl-type-of val))
+ (class (cl-find-class type))
+ (alltypes (cl--class-allparents class))
+ ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'.
+ ;; (e.g. `symbolp' returns nil on a sympos if that var is nil).
+ (symbols-with-pos-enabled t))
+ (dolist (parent alltypes)
+ (should (cl-typep val parent))
+ (dolist (subtype (cl--class-children (cl-find-class parent)))
+ (when (and (not (memq subtype alltypes))
+ (built-in-class-p (cl-find-class subtype))
+ (not (memq subtype
+ ;; FIXME: Some types don't have any associated
+ ;; predicate,
+ '( font-spec font-entity font-object
+ finalizer condvar terminal
+ native-comp-unit interpreted-function
+ tree-sitter-compiled-query
+ tree-sitter-node tree-sitter-parser))))
+ (cond
+ ((eq subtype 'function) (cl-functionp val))
+ (t (should-not (cl-typep val subtype))))))))))
+
+
;;; data-tests.el ends here
diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c
index 06049364b1e..3aafae1b896 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -33,9 +33,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
/* Cannot include <process.h> because of the local header by the same
name, sigh. */
-uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *);
+uintptr_t _beginthread (void (__cdecl *) (void *), unsigned, void *);
# if !defined __x86_64__
-# define ALIGN_STACK __attribute__((force_align_arg_pointer))
+# define ALIGN_STACK __attribute__ ((force_align_arg_pointer))
# endif
# include <windows.h> /* for Sleep */
#else /* !WINDOWSNT */
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index b82d4a36304..052fd83dc85 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -114,15 +114,14 @@ changes."
(ert-deftest mod-test-non-local-exit-signal-test ()
(should-error (mod-test-signal))
- (let (debugger-args backtrace)
+ (let (handler-err backtrace)
(should-error
- (let ((debugger (lambda (&rest args)
- (setq debugger-args args
- backtrace (with-output-to-string (backtrace)))
- (cl-incf num-nonmacro-input-events)))
- (debug-on-signal t))
+ (handler-bind
+ ((error (lambda (err)
+ (setq handler-err err
+ backtrace (with-output-to-string (backtrace))))))
(mod-test-signal)))
- (should (equal debugger-args '(error (error . 56))))
+ (should (equal handler-err '(error . 56)))
(should (string-match-p
(rx bol " mod-test-signal()" eol)
backtrace))))
@@ -316,7 +315,7 @@ local reference."
(replace-match "`src/emacs-module-resources/"))
(should (equal
(buffer-substring-no-properties 1 (point-max))
- (format "a module function in `src/emacs-module-resources/mod-test%s'.
+ (format "a module-function in `src/emacs-module-resources/mod-test%s'.
(mod-test-sum a b)
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e4b18ec7849..187dc2f34d5 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -282,25 +282,85 @@ expressions works for identifiers starting with period."
(should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d)
:type 'cyclic-variable-indirection))
-(defvar eval-tests/global-var 'value)
-(defvar-local eval-tests/buffer-local-var 'value)
+(defvar eval-tests/global-var 'global-value)
+(defvar-local eval-tests/buffer-local-var 'default-value)
(ert-deftest eval-tests/default-value ()
;; `let' overrides the default value for global variables.
(should (default-boundp 'eval-tests/global-var))
- (should (eq 'value (default-value 'eval-tests/global-var)))
- (should (eq 'value eval-tests/global-var))
- (let ((eval-tests/global-var 'bar))
- (should (eq 'bar (default-value 'eval-tests/global-var)))
- (should (eq 'bar eval-tests/global-var)))
+ (should (eq 'global-value (default-value 'eval-tests/global-var)))
+ (should (eq 'global-value eval-tests/global-var))
+ (let ((eval-tests/global-var 'let-value))
+ (should (eq 'let-value (default-value 'eval-tests/global-var)))
+ (should (eq 'let-value eval-tests/global-var)))
;; `let' overrides the default value everywhere, but leaves
;; buffer-local values unchanged in current buffer and in the
;; buffers where there is no explicitly set buffer-local value.
(should (default-boundp 'eval-tests/buffer-local-var))
- (should (eq 'value (default-value 'eval-tests/buffer-local-var)))
- (should (eq 'value eval-tests/buffer-local-var))
+ (should (eq 'default-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'default-value eval-tests/buffer-local-var))
(with-temp-buffer
- (let ((eval-tests/buffer-local-var 'bar))
- (should (eq 'bar (default-value 'eval-tests/buffer-local-var)))
- (should (eq 'bar eval-tests/buffer-local-var)))))
+ (let ((eval-tests/buffer-local-var 'let-value))
+ (should (eq 'let-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'let-value eval-tests/buffer-local-var))))
+ ;; When current buffer has explicit buffer-local binding, `let' does
+ ;; not alter the default binding.
+ (with-temp-buffer
+ (setq-local eval-tests/buffer-local-var 'local-value)
+ (let ((eval-tests/buffer-local-var 'let-value))
+ ;; Let in a buffer with local binding does not change the
+ ;; default value for variable.
+ (should (eq 'default-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'let-value eval-tests/buffer-local-var))
+ (with-temp-buffer
+ ;; We are in a new buffer - `eval-tests/buffer-local-var' has its global default value.
+ (should (eq 'default-value (default-value 'eval-tests/buffer-local-var)))
+ (should (eq 'default-value eval-tests/buffer-local-var))))))
+
+(ert-deftest eval-tests--handler-bind ()
+ ;; A `handler-bind' has no effect if no error is signaled.
+ (should (equal (catch 'tag
+ (handler-bind ((error (lambda (_err) (throw 'tag 'wow))))
+ 'noerror))
+ 'noerror))
+ ;; The handler is called from within the dynamic extent where the
+ ;; error is signaled, unlike `condition-case'.
+ (should (equal (catch 'tag
+ (handler-bind ((error (lambda (_err) (throw 'tag 'err))))
+ (list 'inner-catch
+ (catch 'tag
+ (user-error "hello")))))
+ '(inner-catch err)))
+ ;; But inner condition handlers are temporarily muted.
+ (should (equal (condition-case nil
+ (handler-bind
+ ((error (lambda (_err)
+ (signal 'wrong-type-argument nil))))
+ (list 'result
+ (condition-case nil
+ (user-error "hello")
+ (wrong-type-argument 'inner-handler))))
+ (wrong-type-argument 'wrong-type-argument))
+ 'wrong-type-argument))
+ ;; Handlers do not apply to the code run within the handlers.
+ (should (equal (condition-case nil
+ (handler-bind
+ ((error (lambda (_err)
+ (signal 'wrong-type-argument nil)))
+ (wrong-type-argument
+ (lambda (_err) (user-error "wrong-type-argument"))))
+ (user-error "hello"))
+ (wrong-type-argument 'wrong-type-argument)
+ (error 'plain-error))
+ 'wrong-type-argument)))
+
+(ert-deftest eval-tests--error-id ()
+ (let* (inner-error
+ (outer-error
+ (condition-case err
+ (handler-bind ((error (lambda (err) (setq inner-error err))))
+ (car 1))
+ (error err))))
+ (should (eq inner-error outer-error))))
+
;;; eval-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 3893b8b0320..1b13785a9fc 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -375,6 +375,49 @@
(should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument)
'(wrong-type-argument list-or-vector-p "cba"))))
+(defun fns-tests--shuffle-vector (vect)
+ "Shuffle VECT in place."
+ (let ((n (length vect)))
+ (dotimes (i (1- n))
+ (let* ((j (+ i (random (- n i))))
+ (vi (aref vect i)))
+ (aset vect i (aref vect j))
+ (aset vect j vi)))))
+
+(ert-deftest fns-tests-sort-kw ()
+ ;; Test the `sort' keyword calling convention by comparing with
+ ;; the results from using the old (positional) style tested above.
+ (random "my seed")
+ (dolist (size '(0 1 2 3 10 100 1000))
+ ;; Use a vector with both positive and negative numbers (asymmetric).
+ (let ((numbers (vconcat
+ (number-sequence (- (/ size 3)) (- size 1 (/ size 3))))))
+ (fns-tests--shuffle-vector numbers)
+ ;; Test both list and vector input.
+ (dolist (input (list (append numbers nil) numbers))
+ (dolist (in-place '(nil t))
+ (dolist (reverse '(nil t))
+ (dolist (key '(nil abs))
+ (dolist (lessp '(nil >))
+ (let* ((seq (copy-sequence input))
+ (res (sort seq :key key :lessp lessp
+ :in-place in-place :reverse reverse))
+ (pred (or lessp #'value<))
+ (exp-in (copy-sequence input))
+ (exp-out
+ (sort (if reverse (reverse exp-in) exp-in)
+ (if key
+ (lambda (a b)
+ (funcall pred
+ (funcall key a) (funcall key b)))
+ pred)))
+ (expected (if reverse (reverse exp-out) exp-out)))
+ (should (equal res expected))
+ (if in-place
+ (should (eq res seq))
+ (should-not (and (> size 0) (eq res seq)))
+ (should (equal seq input))))))))))))
+
(defvar w32-collate-ignore-punctuation)
(ert-deftest fns-tests-collate-sort ()
@@ -1097,6 +1140,16 @@
(should (= (sxhash-equal (record 'a (make-string 10 ?a)))
(sxhash-equal (record 'a (make-string 10 ?a))))))
+(ert-deftest fns--define-hash-table-test ()
+ ;; Check that we can have two differently-named tests using the
+ ;; same functions (bug#68668).
+ (define-hash-table-test 'fns-tests--1 'my-cmp 'my-hash)
+ (define-hash-table-test 'fns-tests--2 'my-cmp 'my-hash)
+ (let ((h1 (make-hash-table :test 'fns-tests--1))
+ (h2 (make-hash-table :test 'fns-tests--2)))
+ (should (eq (hash-table-test h1) 'fns-tests--1))
+ (should (eq (hash-table-test h2) 'fns-tests--2))))
+
(ert-deftest test-secure-hash ()
(should (equal (secure-hash 'md5 "foobar")
"3858f62230ac3c915f300c664312c63f"))
@@ -1503,4 +1556,222 @@
(should-error (copy-alist "abc")
:type 'wrong-type-argument))
+(ert-deftest fns-value<-ordered ()
+ ;; values (X . Y) where X<Y
+ (let* ((big (* 10 most-positive-fixnum))
+ (buf1 (get-buffer-create " *one*"))
+ (buf2 (get-buffer-create " *two*"))
+ (buf3 (get-buffer-create " *three*"))
+ (_ (progn (with-current-buffer buf1 (insert (make-string 20 ?a)))
+ (with-current-buffer buf2 (insert (make-string 20 ?b)))))
+ (mark1 (set-marker (make-marker) 12 buf1))
+ (mark2 (set-marker (make-marker) 13 buf1))
+ (mark3 (set-marker (make-marker) 12 buf2))
+ (mark4 (set-marker (make-marker) 13 buf2))
+ (proc1 (make-pipe-process :name " *proc one*"))
+ (proc2 (make-pipe-process :name " *proc two*")))
+ (kill-buffer buf3)
+ (unwind-protect
+ (dolist (c
+ `(
+ ;; fixnums
+ (1 . 2) (-2 . -1) (-2 . 1) (-1 . 2)
+ ;; bignums
+ (,big . ,(1+ big)) (,(- big) . ,big)
+ (,(- -1 big) . ,(- big))
+ ;; fixnums/bignums
+ (1 . ,big) (-1 . ,big) (,(- big) . -1) (,(- big) . 1)
+ ;; floats
+ (1.5 . 1.6) (-1.3 . -1.2) (-13.0 . 12.0)
+ ;; floats/fixnums
+ (1 . 1.1) (1.9 . 2) (-2.0 . 1) (-2 . 1.0)
+ ;; floats/bignums
+ (,big . ,(float (* 2 big))) (,(float big) . ,(* 2 big))
+ ;; symbols
+ (a . b) (nil . nix) (b . ba) (## . a) (A . a)
+ (#:a . #:b) (a . #:b) (#:a . b)
+ ;; strings
+ ("" . "a") ("a" . "b") ("A" . "a") ("abc" . "abd")
+ ("b" . "ba")
+
+ ;; lists
+ ((1 2 3) . (2 3 4)) ((2) . (2 1)) (() . (0))
+ ((1 2 3) . (1 3)) ((1 2 3) . (1 3 2))
+ (((b a) (c d) e) . ((b a) (c d) f))
+ (((b a) (c D) e) . ((b a) (c d) e))
+ (((b a) (c d () x) e) . ((b a) (c d (1) x) e))
+ ((1 . 2) . (1 . 3)) ((1 2 . 3) . (1 2 . 4))
+
+ ;; vectors
+ ([1 2 3] . [2 3 4]) ([2] . [2 1]) ([] . [0])
+ ([1 2 3] . [1 3]) ([1 2 3] . [1 3 2])
+ ([[b a] [c d] e] . [[b a] [c d] f])
+ ([[b a] [c D] e] . [[b a] [c d] e])
+ ([[b a] [c d [] x] e] . [[b a] [c d [1] x] e])
+
+ ;; bool-vectors
+ (,(bool-vector) . ,(bool-vector nil))
+ (,(bool-vector nil) . ,(bool-vector t))
+ (,(bool-vector t nil t nil) . ,(bool-vector t nil t t))
+ (,(bool-vector t nil t) . ,(bool-vector t nil t nil))
+
+ ;; records
+ (#s(a 2 3) . #s(b 3 4)) (#s(b) . #s(b a))
+ (#s(a 2 3) . #s(a 3)) (#s(a 2 3) . #s(a 3 2))
+ (#s(#s(b a) #s(c d) e) . #s(#s(b a) #s(c d) f))
+ (#s(#s(b a) #s(c D) e) . #s(#s(b a) #s(c d) e))
+ (#s(#s(b a) #s(c d #s(u) x) e)
+ . #s(#s(b a) #s(c d #s(v) x) e))
+
+ ;; markers
+ (,mark1 . ,mark2) (,mark1 . ,mark3) (,mark1 . ,mark4)
+ (,mark2 . ,mark3) (,mark2 . ,mark4) (,mark3 . ,mark4)
+
+ ;; buffers
+ (,buf1 . ,buf2) (,buf3 . ,buf1) (,buf3 . ,buf2)
+
+ ;; processes
+ (,proc1 . ,proc2)
+ ))
+ (let ((x (car c))
+ (y (cdr c)))
+ (should (value< x y))
+ (should-not (value< y x))
+ (should-not (value< x x))
+ (should-not (value< y y))))
+
+ (delete-process proc2)
+ (delete-process proc1)
+ (kill-buffer buf2)
+ (kill-buffer buf1))))
+
+(ert-deftest fns-value<-unordered ()
+ ;; values (X . Y) where neither X<Y nor Y<X
+
+ (let ((buf1 (get-buffer-create " *one*"))
+ (buf2 (get-buffer-create " *two*")))
+ (kill-buffer buf2)
+ (kill-buffer buf1)
+ (dolist (c `(
+ ;; numbers
+ (0 . 0.0) (0 . -0.0) (0.0 . -0.0)
+
+ ;; symbols
+ (a . #:a)
+
+ ;; (dead) buffers
+ (,buf1 . ,buf2)
+
+ ;; unordered types
+ (,(make-hash-table) . ,(make-hash-table))
+ (,(obarray-make) . ,(obarray-make))
+ ;; FIXME: more?
+ ))
+ (let ((x (car c))
+ (y (cdr c)))
+ (should-not (value< x y))
+ (should-not (value< y x))))))
+
+(ert-deftest fns-value<-type-mismatch ()
+ ;; values of disjoint (incomparable) types
+ (let ((incomparable
+ `( 1 a "a" (a b) [a b] ,(bool-vector nil t) #s(a b)
+ ,(make-char-table 'test)
+ ,(make-hash-table)
+ ,(obarray-make)
+ ;; FIXME: more?
+ )))
+ (let ((tail incomparable))
+ (while tail
+ (let ((x (car tail)))
+ (dolist (y (cdr tail))
+ (should-error (value< x y) :type 'type-mismatch)
+ (should-error (value< y x) :type 'type-mismatch)))
+ (setq tail (cdr tail))))))
+
+(ert-deftest fns-value<-symbol-with-pos ()
+ ;; values (X . Y) where X<Y
+ (let* ((a-sp-1 (position-symbol 'a 1))
+ (a-sp-2 (position-symbol 'a 2))
+ (b-sp-1 (position-symbol 'b 1))
+ (b-sp-2 (position-symbol 'b 2)))
+
+ (dolist (swp '(nil t))
+ (let ((symbols-with-pos-enabled swp))
+ ;; Enabled or not, they compare by name.
+ (dolist (c `((,a-sp-1 . ,b-sp-1) (,a-sp-1 . ,b-sp-2)
+ (,a-sp-2 . ,b-sp-1) (,a-sp-2 . ,b-sp-2)))
+ (let ((x (car c))
+ (y (cdr c)))
+ (should (value< x y))
+ (should-not (value< y x))
+ (should-not (value< x x))
+ (should-not (value< y y))))
+ (should-not (value< a-sp-1 a-sp-2))
+ (should-not (value< a-sp-2 a-sp-1))))
+
+ ;; When disabled, symbol-with-pos and symbols do not compare.
+ (should-error (value< a-sp-1 'a) :type 'type-mismatch)
+ (should-error (value< 'a a-sp-1) :type 'type-mismatch)
+
+ (let ((symbols-with-pos-enabled t))
+ ;; When enabled, a symbol-with-pos compares as a plain symbol.
+ (dolist (c `((,a-sp-1 . b) (a . ,b-sp-1)))
+ (let ((x (car c))
+ (y (cdr c)))
+ (should (value< x y))
+ (should-not (value< y x))
+ (should-not (value< x x))
+ (should-not (value< y y))))
+ (should-not (value< a-sp-1 'a))
+ (should-not (value< 'a a-sp-1)))))
+
+(ert-deftest fns-value<-circle ()
+ ;; Check that we at least don't hang when comparing two circular lists.
+ (let ((a (number-sequence 1 5))
+ (b (number-sequence 1 5)))
+ (setcdr (last a) (nthcdr 2 a))
+ (setcdr (last b) (nthcdr 2 b))
+ (should-error (value< a b :type 'circular))
+ (should-error (value< b a :type 'circular))))
+
+(ert-deftest fns-value<-bool-vector ()
+ ;; More thorough test of `value<' for bool-vectors.
+ (random "my seed")
+ (dolist (na '(0 1 5 8 9 32 63 64 65 200 1001 1024))
+ (let ((a (make-bool-vector na nil)))
+ (dotimes (i na)
+ (aset a i (zerop (random 2))))
+ (dolist (nb '(0 1 5 8 9 32 63 64 65 200 1001 1024))
+ (when (<= nb na)
+ (let ((b (make-bool-vector nb nil)))
+ (dotimes (i nb)
+ (aset b i (aref a i)))
+ ;; `b' is now a prefix of `a'.
+ (should-not (value< a b))
+ (cond ((= nb na)
+ (should (equal a b))
+ (should-not (value< b a)))
+ (t
+ (should-not (equal a b))
+ (should (value< b a))))
+ (unless (zerop nb)
+ ;; Flip random bits in `b' and check how it affects the order.
+ (dotimes (_ 3)
+ (let ((i (random nb)))
+ (let ((val (aref b i)))
+ (aset b i (not val))
+ (should-not (equal a b))
+ (cond
+ (val
+ ;; t -> nil: `b' is now always a proper prefix of `a'.
+ (should-not (value< a b))
+ (should (value< b a)))
+ (t
+ ;; nil -> t: `a' is now less than `b'.
+ (should (value< a b))
+ (should-not (value< b a))))
+ ;; Undo the flip.
+ (aset b i val)))))))))))
+
;;; fns-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index bc9977f31bf..04b897045db 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -23,6 +23,7 @@
;;; Code:
(require 'ert)
+(require 'cl-lib)
(defun keymap-tests--make-keymap-test (fun)
(should (eq (car (funcall fun)) 'keymap))
@@ -470,10 +471,18 @@ g .. h foo
ert-keymap-duplicate
"a" #'next-line
"a" #'previous-line))
- (should-error
- (define-keymap
- "a" #'next-line
- "a" #'previous-line)))
+ (let ((msg ""))
+ ;; FIXME: It would be nicer to use `current-message' rather than override
+ ;; `message', but `current-message' returns always nil in batch mode :-(
+ (cl-letf (((symbol-function 'message)
+ (lambda (fmt &rest args) (setq msg (apply #'format fmt args)))))
+ (should
+ (string-match "duplicate"
+ (progn
+ (define-keymap
+ "a" #'next-line
+ "a" #'previous-line)
+ msg))))))
(ert-deftest keymap-unset-test-remove-and-inheritance ()
"Check various behaviors of keymap-unset. (Bug#62207)"
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index 14d160df25c..99d522d1856 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -34,7 +34,7 @@
(let ((num 0))
(mapcar (lambda (str) (cons str (cl-incf num))) list)))
(defun minibuf-tests--strings-to-obarray (list)
- (let ((ob (make-vector 7 0)))
+ (let ((ob (obarray-make 7)))
(mapc (lambda (str) (intern str ob)) list)
ob))
(defun minibuf-tests--strings-to-string-hashtable (list)
@@ -61,6 +61,9 @@
;;; Testing functions that are agnostic to type of COLLECTION.
+(defun minibuf-tests--set-equal (a b)
+ (null (cl-set-exclusive-or a b :test #'equal)))
+
(defun minibuf-tests--try-completion (xform-collection)
(let* ((abcdef (funcall xform-collection '("abc" "def")))
(+abba (funcall xform-collection '("abc" "abba" "def"))))
@@ -101,7 +104,8 @@
(let* ((abcdef (funcall xform-collection '("abc" "def")))
(+abba (funcall xform-collection '("abc" "abba" "def"))))
(should (equal (all-completions "a" abcdef) '("abc")))
- (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba) '("abc")))
(should (equal (all-completions "abcd" +abba) nil))))
@@ -111,7 +115,8 @@
(+abba (funcall xform-collection '("abc" "abba" "def")))
(+abba-member (funcall collection-member +abba)))
(should (equal (all-completions "a" abcdef abcdef-member) '("abc")))
- (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba +abba-member) '("abc")))
(should (equal (all-completions "abcd" +abba +abba-member) nil))
(should-not (all-completions "a" abcdef #'ignore))
@@ -124,7 +129,8 @@
(+abba (funcall xform-collection '("abc" "abba" "def"))))
(let ((completion-regexp-list '(".")))
(should (equal (all-completions "a" abcdef) '("abc")))
- (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (minibuf-tests--set-equal (all-completions "a" +abba)
+ '("abc" "abba")))
(should (equal (all-completions "abc" +abba) '("abc")))
(should (equal (all-completions "abcd" +abba) nil)))
(let ((completion-regexp-list '("X")))
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index aedaa9a4e06..ff3a6fe7483 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -369,13 +369,6 @@ otherwise, use a different charset."
(should
(string-match
- "data ()"
- (let ((h (make-hash-table)))
- (let ((print-length 0))
- (format "%S" h)))))
-
- (should
- (string-match
"data (99 99)"
(let ((h (make-hash-table)))
(dotimes (i 100)
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index a89bf1298c0..bdc9630c783 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -254,7 +254,7 @@
(should (eq nil (treesit-node-text
(treesit-search-subtree
subarray "\\["))))
- ;; If ALL=nil, searching for number should still find the
+ ;; If ALL=t, searching for number should still find the
;; numbers.
(should (equal "1" (treesit-node-text
(treesit-search-subtree